Data commit

Task/100-prisoners/Pascal/100-prisoners-1.pas

@@ -0,0 +1,159 @@
+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.

Task/100-prisoners/Pascal/100-prisoners-2.pas

@@ -0,0 +1,138 @@
+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.