Permutations by swapping: Difference between revisions

=={{header|Delphi}}==

{{works with|Delphi|6.0}}

{{libheader|SysUtils,StdCtrls}}

<syntaxhighlight lang="Delphi">

{These routines would normally be in a separate library; they are presented here for clarity}

{Permutator based on the Johnson and Trotter algorithm.}

{Which only permutates by swapping a pair of elements at a time}

{object steps through all permutation of array items}

{Zero-Based = True = 0..Permutions-1 False = 1..Permutaions}

{Permutation set on "Create(Size)" or by "Permutations" property}

{Permutation are contained in the array "Indices"}

type TDirection = (drLeftToRight,drRightToLeft);

type TDirArray = array of TDirection;

type TJTPermutator = class(TObject)

private

Dir: TDirArray;

FZeroBased: boolean;

FBase: integer;

FPermutations: integer;

procedure SetZeroBased(const Value: boolean);

procedure SetPermutations(const Value: integer);

protected

FMax: integer;

public

NextCount: Integer;

Indices: TIntegerDynArray;

constructor Create(Size: integer);

procedure Reset;

function Next: boolean;

property ZeroBased: boolean read FZeroBased write SetZeroBased;

property Permutations: integer read FPermutations write SetPermutations;

end;

{==============================================================================}

function Fact(N: integer): integer;

{Get factorial of N}

var I: integer;

begin

Result:=1;

for I:=1 to N do Result:=Result * I;

end;

procedure SwapIntegers(var A1,A2: integer);

{Swap integer arguments}

var T: integer;

begin

T:=A1; A1:=A2; A2:=T;

end;

procedure TJTPermutator.Reset;

var I: integer;

begin

{ Preset items 0..n-1 or 1..n depending on base}

for I:=0 to High(Indices) do Indices[I]:=I + FBase;

{ initially all directions are set to RIGHT TO LEFT }

for I:=0 to High(Indices) do Dir[I]:=drRightToLeft;

NextCount:=0;

end;

procedure TJTPermutator.SetPermutations(const Value: integer);

begin

if FPermutations<>Value then

begin

FPermutations := Value;

SetLength(Indices,Value);

SetLength(Dir,Value);

Reset;

end;

end;

constructor TJTPermutator.Create(Size: integer);

begin

ZeroBased:=True;

Permutations:=Size;

Reset;

end;

procedure TJTPermutator.SetZeroBased(const Value: boolean);

begin

if FZeroBased<>Value then

begin

FZeroBased := Value;

if Value then FBase:=0

else FBase:=1;

Reset;

end;

end;

function TJTPermutator.Next: boolean;

{Step to next permutation}

{Returns true when sequence completed}

var Mobile,Pos,I: integer;

var S: string;

function FindLargestMoble(Mobile: integer): integer;

{Find position of largest mobile integer in A}

var I: integer;

begin

for I:=0 to High(Indices) do

if Indices[I] = Mobile then

begin

Result:=I + 1;

exit;

end;

Result:=-1;

end;

function GetMobile: integer;

{ find the largest mobile integer.}

var LastMobile, Mobile: integer;

var I: integer;

begin

LastMobile:= 0; Mobile:= 0;

for I:=0 to High(Indices) do

begin

{ direction 0 represents RIGHT TO LEFT.}

if (Dir[Indices[I] - 1] = drRightToLeft) and (I<>0) then

begin

if (Indices[I] > Indices[I - 1]) and (Indices[I] > LastMobile) then

begin

Mobile:=Indices[I];

LastMobile:=Mobile;

end;

end;

{ direction 1 represents LEFT TO RIGHT.}

if (dir[Indices[I] - 1] = drLeftToRight) and (i<>(Length(Indices) - 1)) then

begin

if (Indices[I] > Indices[I + 1]) and (Indices[I] > LastMobile) then

begin

Mobile:=Indices[I];

LastMobile:=Mobile;

end;

end;

end;

if (Mobile = 0) and (LastMobile = 0) then Result:=0

else Result:=Mobile;

end;

begin

Inc(NextCount);

Result:=NextCount>=Fact(Length(Indices));

if Result then

begin

Reset;

exit;

end;

Mobile:=GetMobile;

Pos:=FindLargestMoble(Mobile);

{ Swap elements according to the direction in Dir}

if (Dir[Indices[pos - 1] - 1] = drRightToLeft) then SwapIntegers(Indices[Pos - 1], Indices[Pos - 2])

else if (dir[Indices[pos - 1] - 1] = drLeftToRight) then SwapIntegers(Indices[Pos], Indices[Pos - 1]);

{ changing the directions for elements}

{ greater than largest Mobile integer.}

for I:=0 to High(Indices) do

if Indices[I] > Mobile then

begin

if Dir[Indices[I] - 1] = drLeftToRight then Dir[Indices[I] - 1]:=drRightToLeft

else if (Dir[Indices[i] - 1] = drRightToLeft) then Dir[Indices[I] - 1]:=drLeftToRight;

end;

end;

{==============================================================================}

function GetPermutationStr(PM: TJTPermutator): string;

var I: integer;

begin

Result:=Format('%2d - [',[PM.NextCount+1]);

for I:=0 to High(PM.Indices) do Result:=Result+IntToStr(PM.Indices[I]);

Result:=Result+'] Sign: ';

if (PM.NextCount and 1)=0 then Result:=Result+'+1'

else Result:=Result+'-1';

end;

procedure SwapPermutations(Memo: TMemo);

var PM: TJTPermutator;

begin

PM:=TJTPermutator.Create(3);

try

repeat Memo.Lines.Add(GetPermutationStr(PM))

until PM.Next;

Memo.Lines.Add('');

PM.Permutations:=4;

repeat Memo.Lines.Add(GetPermutationStr(PM))

until PM.Next;

finally PM.Free; end;

end;

</syntaxhighlight>

{{out}}

<pre>

1 - [012] Sign: +1

2 - [021] Sign: -1

3 - [201] Sign: +1

4 - [210] Sign: -1

5 - [120] Sign: +1

6 - [102] Sign: -1

1 - [0123] Sign: +1

2 - [0132] Sign: -1

3 - [0312] Sign: +1

4 - [3012] Sign: -1

5 - [3021] Sign: +1

6 - [0321] Sign: -1

7 - [0231] Sign: +1

8 - [0213] Sign: -1

9 - [2013] Sign: +1

10 - [2031] Sign: -1

11 - [2301] Sign: +1

12 - [3201] Sign: -1

13 - [3210] Sign: +1

14 - [2310] Sign: -1

15 - [2130] Sign: +1

16 - [2103] Sign: -1

17 - [1203] Sign: +1

18 - [1230] Sign: -1

19 - [1320] Sign: +1

20 - [3120] Sign: -1

21 - [3102] Sign: +1

22 - [1302] Sign: -1

23 - [1032] Sign: +1

24 - [1023] Sign: -1

Elapsed Time: 60.734 ms.

</pre>