159 lines
3 KiB
ObjectPascal
159 lines
3 KiB
ObjectPascal
program Prisoners100;
|
|
|
|
const
|
|
rounds = 100000;
|
|
|
|
type
|
|
tValue = Uint32;
|
|
tPrisNum = array of tValue;
|
|
var
|
|
drawers,
|
|
PrisonersChoice : tPrisNum;
|
|
|
|
procedure shuffle(var N:tPrisNum);
|
|
var
|
|
i,j,lmt : nativeInt;
|
|
tmp: tValue;
|
|
Begin
|
|
lmt := High(N);
|
|
For i := lmt downto 1 do
|
|
begin
|
|
//take on from index i..limit
|
|
j := random(i+1);
|
|
//exchange with i
|
|
tmp := N[i];N[i]:= N[j];N[j]:= tmp;
|
|
end;
|
|
end;
|
|
|
|
function PardonedRandom(maxTestNum: NativeInt):boolean;
|
|
var
|
|
PrisNum,TestNum,Lmt : NativeUint;
|
|
Pardoned : boolean;
|
|
Begin
|
|
IF maxTestNum <=0 then
|
|
Begin
|
|
PardonedRandom := false;
|
|
EXIT;
|
|
end;
|
|
Lmt := High(drawers);
|
|
IF (maxTestNum >= Lmt) then
|
|
Begin
|
|
PardonedRandom := true;
|
|
EXIT;
|
|
end;
|
|
|
|
shuffle(drawers);
|
|
PrisNum := 0;
|
|
repeat
|
|
//every prisoner uses his own list of drawers
|
|
shuffle(PrisonersChoice);
|
|
TestNum := 0;
|
|
repeat
|
|
Pardoned := drawers[PrisonersChoice[TestNum]] = PrisNum;
|
|
inc(TestNum);
|
|
until Pardoned OR (TestNum>=maxTestNum);
|
|
IF Not(Pardoned) then
|
|
BREAK;
|
|
inc(PrisNum);
|
|
until PrisNum>=Lmt;
|
|
PardonedRandom:= Pardoned;
|
|
end;
|
|
|
|
function PardonedOptimized(maxTestNum: NativeUint):boolean;
|
|
var
|
|
PrisNum,TestNum,NextNum,Cnt,Lmt : NativeUint;
|
|
Pardoned : boolean;
|
|
Begin
|
|
IF maxTestNum <=0 then
|
|
Begin
|
|
PardonedOptimized := false;
|
|
EXIT;
|
|
end;
|
|
Lmt := High(drawers);
|
|
IF (maxTestNum >= Lmt) then
|
|
Begin
|
|
PardonedOptimized := true;
|
|
EXIT;
|
|
end;
|
|
|
|
shuffle(drawers);
|
|
Lmt := High(drawers);
|
|
IF maxTestNum >= Lmt then
|
|
Begin
|
|
PardonedOptimized := true;
|
|
EXIT;
|
|
end;
|
|
PrisNum := 0;
|
|
repeat
|
|
Cnt := 0;
|
|
NextNum := PrisNum;
|
|
repeat
|
|
TestNum := NextNum;
|
|
NextNum := drawers[TestNum];
|
|
inc(cnt);
|
|
Pardoned := NextNum = PrisNum;
|
|
until Pardoned OR (cnt >=maxTestNum);
|
|
|
|
IF Not(Pardoned) then
|
|
BREAK;
|
|
inc(PrisNum);
|
|
until PrisNum>Lmt;
|
|
PardonedOptimized := Pardoned;
|
|
end;
|
|
|
|
procedure CheckRandom(testCount : NativeUint);
|
|
var
|
|
i,cnt : NativeInt;
|
|
Begin
|
|
cnt := 0;
|
|
For i := 1 to rounds do
|
|
IF PardonedRandom(TestCount) then
|
|
inc(cnt);
|
|
writeln('Randomly ',cnt/rounds*100:7:2,'% get pardoned out of ',rounds,' checking max ',TestCount);
|
|
end;
|
|
|
|
procedure CheckOptimized(testCount : NativeUint);
|
|
var
|
|
i,cnt : NativeInt;
|
|
Begin
|
|
cnt := 0;
|
|
For i := 1 to rounds do
|
|
IF PardonedOptimized(TestCount) then
|
|
inc(cnt);
|
|
writeln('Optimized ',cnt/rounds*100:7:2,'% get pardoned out of ',rounds,' checking max ',TestCount);
|
|
end;
|
|
|
|
procedure OneCompareRun(PrisCnt:NativeInt);
|
|
var
|
|
i,lmt :nativeInt;
|
|
begin
|
|
setlength(drawers,PrisCnt);
|
|
For i := 0 to PrisCnt-1 do
|
|
drawers[i] := i;
|
|
PrisonersChoice := copy(drawers);
|
|
|
|
//test
|
|
writeln('Checking ',PrisCnt,' prisoners');
|
|
|
|
lmt := PrisCnt;
|
|
repeat
|
|
CheckOptimized(lmt);
|
|
dec(lmt,PrisCnt DIV 10);
|
|
until lmt < 0;
|
|
writeln;
|
|
|
|
lmt := PrisCnt;
|
|
repeat
|
|
CheckRandom(lmt);
|
|
dec(lmt,PrisCnt DIV 10);
|
|
until lmt < 0;
|
|
writeln;
|
|
writeln;
|
|
end;
|
|
|
|
Begin
|
|
//init
|
|
randomize;
|
|
OneCompareRun(20);
|
|
OneCompareRun(100);
|
|
end.
|