55 lines
1.3 KiB
ObjectPascal
55 lines
1.3 KiB
ObjectPascal
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;
|