Data update

Task/Josephus-problem/Delphi/josephus-problem-1.pas

@@ -0,0 +1,54 @@
+type TIntArray = array of integer;
+
+procedure GetJosephusSequence(N,K: integer; var IA: TIntArray);
+{Analyze sequence of deleting every K of N numbers}
+{Retrun result in Integer Array}
+var LS: TList;
+var I,J: integer;
+begin
+SetLength(IA,N);
+LS:=TList.Create;
+try
+{Store number 0..N-1 in list}
+for I:=0 to N-1 do LS.Add(Pointer(I));
+J:=0;
+for I:=0 to N-1 do
+	begin
+	{Advance J by K-1 because iterms are deleted}
+	{And wrapping around if it J exceed the count }
+        J:=(J+K-1) mod LS.Count;
+        {Caption the sequence}
+        IA[I]:=Integer(LS[J]);
+        {Delete (kill) one item}
+        LS.Delete(J);
+	end;
+finally LS.Free; end;
+end;
+
+procedure ShowJosephusProblem(Memo: TMemo; N,K: integer);
+{Analyze and display one Josephus Problem}
+var IA: TIntArray;
+var I: integer;
+var S: string;
+const CRLF = #$0D#$0A;
+begin
+GetJosephusSequence(N,K,IA);
+S:='';
+for I:=0 to High(IA) do
+	begin
+	if I>0 then S:=S+',';
+	if (I mod 12)=11 then S:=S+CRLF+'           ';
+	S:=S+IntToStr(IA[I]);
+	end;
+Memo.Lines.Add('N='+IntToStr(N)+' K='+IntToStr(K));
+Memo.Lines.Add('Sequence: ['+S+']');
+Memo.Lines.Add('Survivor: '+IntToStr(IA[High(IA)]));
+Memo.Lines.Add('');
+end;
+
+procedure TestJosephusProblem(Memo: TMemo);
+{Test suite of Josephus Problems}
+begin
+ShowJosephusProblem(Memo,5,2);
+ShowJosephusProblem(Memo,41,3);
+end;