138 lines
2.7 KiB
ObjectPascal
138 lines
2.7 KiB
ObjectPascal
program Prisoners100;
|
|
{$IFDEF FPC}
|
|
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}
|
|
{$ELSE}
|
|
{$APPTYPE CONSOLE}
|
|
{$ENDIF}
|
|
type
|
|
tValue = NativeUint;
|
|
tpValue = pNativeUint;
|
|
tPrisNum = array of tValue;
|
|
|
|
const
|
|
rounds = 1000000;
|
|
cAlreadySeen = High(tValue);
|
|
var
|
|
drawers,
|
|
Visited,
|
|
CntToPardoned : tPrisNum;
|
|
PrisCount : NativeInt;
|
|
|
|
procedure shuffle(var N:tPrisNum;lmt : nativeInt = 0);
|
|
var
|
|
pN : tpValue;
|
|
i,j : nativeInt;
|
|
tmp: tValue;
|
|
Begin
|
|
pN := @N[0];
|
|
if lmt = 0 then
|
|
lmt := High(N);
|
|
For i := lmt downto 1 do
|
|
begin
|
|
//take one from index [0..i]
|
|
j := random(i+1);
|
|
//exchange with i
|
|
tmp := pN[i];pN[i]:= pN[j];pN[j]:= tmp;
|
|
end;
|
|
end;
|
|
|
|
procedure CopyDrawers2Visited;
|
|
//drawers and Visited are of same size, so only moving values
|
|
Begin
|
|
Move(drawers[0],Visited[0],SizeOf(tValue)*PrisCount);
|
|
end;
|
|
|
|
function GetMaxCycleLen:NativeUint;
|
|
var
|
|
pVisited : tpValue;
|
|
cycleLen,MaxCycLen,Num,NumBefore : NativeUInt;
|
|
Begin
|
|
CopyDrawers2Visited;
|
|
pVisited := @Visited[0];
|
|
MaxCycLen := 0;
|
|
cycleLen := MaxCycLen;
|
|
Num := MaxCycLen;
|
|
repeat
|
|
NumBefore := Num;
|
|
Num := pVisited[Num];
|
|
pVisited[NumBefore] := cAlreadySeen;
|
|
inc(cycleLen);
|
|
IF (Num= NumBefore) or (Num = cAlreadySeen) then
|
|
begin
|
|
IF Num = cAlreadySeen then
|
|
dec(CycleLen);
|
|
IF MaxCycLen < cycleLen then
|
|
MaxCycLen := cycleLen;
|
|
Num := 0;
|
|
while (Num< PrisCount) AND (pVisited[Num] = cAlreadySeen) do
|
|
inc(Num);
|
|
//all cycles found
|
|
IF Num >= PrisCount then
|
|
BREAK;
|
|
cycleLen :=0;
|
|
end;
|
|
until false;
|
|
GetMaxCycleLen := MaxCycLen-1;
|
|
end;
|
|
|
|
procedure CheckOptimized(testCount : NativeUint);
|
|
var
|
|
factor: extended;
|
|
i,sum,digit,delta : NativeInt;
|
|
Begin
|
|
For i := 1 to rounds do
|
|
begin
|
|
shuffle(drawers);
|
|
inc(CntToPardoned[GetMaxCycleLen]);
|
|
end;
|
|
|
|
digit := 0;
|
|
sum := rounds;
|
|
while sum > 100 do
|
|
Begin
|
|
inc(digit);
|
|
sum := sum DIV 10;
|
|
end;
|
|
factor := 100.0/rounds;
|
|
|
|
delta :=0;
|
|
sum := 0;
|
|
For i := 0 to High(drawers) do
|
|
Begin
|
|
inc(sum,CntToPardoned[i]);
|
|
dec(delta);
|
|
IF delta <= 0 then
|
|
Begin
|
|
writeln(sum*factor:Digit+5:Digit,'% get pardoned checking max ',i+1);
|
|
delta := delta+Length(drawers) DIV 10;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure OneCompareRun(PrisCnt:NativeInt);
|
|
var
|
|
i,lmt :nativeInt;
|
|
begin
|
|
PrisCount := PrisCnt;
|
|
setlength(drawers,PrisCnt);
|
|
For i := 0 to PrisCnt-1 do
|
|
drawers[i] := i;
|
|
setlength(Visited,PrisCnt);
|
|
setlength(CntToPardoned,PrisCnt);
|
|
//test
|
|
writeln('Checking ',PrisCnt,' prisoners for ',rounds,' rounds');
|
|
lmt := PrisCnt;
|
|
CheckOptimized(lmt);
|
|
writeln;
|
|
|
|
setlength(CntToPardoned,0);
|
|
setlength(Visited,0);
|
|
setlength(drawers,0);
|
|
end;
|
|
|
|
Begin
|
|
randomize;
|
|
OneCompareRun(10);
|
|
OneCompareRun(100);
|
|
OneCompareRun(1000);
|
|
end.
|