1:
2:
3:

for i := 123456789 to 987654321 do
   if (keine ziffer doppelt) then
       speichern                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

Type
  TCharSet = Set Of Char;

Procedure TForm1.Permutation(Const aString, aResult : String; anIndex : Integer; aUsedChars : TCharSet);
Var
  i : Integer;

Begin
  For i:=1 to Length (aString) Do
    If Not (aString[i] in aUsedChars) Then
      If anIndex = Length (aString) Then
        Memo1.lines.add(aResult+aString[i])
      Else
        Permutation (aString, aResult + aString[i], anIndex + 1, aUsedChars + [aString[i]]);
End;                    

1:

Permutation ('1234567', '' ,1 , [])                    

1:
2:
3:
4:
5:
6:
7:
8:
9:

For i:=1 to Length(ZahlenString)-1 do
begin
  For J :=i+1 to Length(ZahlenString) do
  begin
    Merker:=ZahlenString[i];
    ZahlenString[i]:=ZahlenString[J];
    ZahlenString[J]:=Merker;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:

program PermuteString;
{$Apptype console}
uses
  sysutils,classes;
const
  nmax = 9;
Type
  TCharSet = Set Of Char;

var
  sl : TStringlist;
  PermString : string;
  T0,T1 : TdateTime;
  j  : INt64;
  i,
  n : integer;
  Zeichen : char;


function Next(var a:string): Boolean;
var
   k,j,r,s : integer;
   temp    : char;
   procedure swap(i,j :integer);
   begin
     temp := a[i];
     a[i] := a[j];
     a[j] := temp;
   end;

begin
   k := n-1;
   while a[k] > a[k+1] do
      k:=k-1;
   if k <> 0 then
   begin
      j := n;
      while a[k] > a[j] do
          j:=j-1;
      swap(j,k);
      r:=n;
      s:=k+1;
      while r>s do
      begin
         swap(r,s);
         r:=r-1;
         s:=s+1;
      end;
      Next:= true;
   end
   else
   {Reverse order reached -> end}
      Next := false
end;

Procedure Permutation(Const aString, aResult : String; anIndex : Integer; aUsedChars : TCharSet);
Var
  i : Integer;

Begin
  For i:=1 to Length (aString) Do
    If Not (aString[i] in aUsedChars) Then
      If anIndex = Length (aString) Then
        SL.add(aResult+aString[i])
      Else
        Permutation (aString, aResult + aString[i], anIndex + 1, aUsedChars + [aString[i]]);
End;

Function NthPermutation (const aString : AnsiString; aCount : Int64) : AnsiString;
Var
  pos, i, n : Cardinal;
  chTemp : char;
Begin
  n := Length(aString);
  result := aString;
  for i := n downto 2 do
    begin
    pos := acount mod i +1;
    //switch
    chTemp := result[i];
    result[i] := result[Pos];
    result[Pos] := chTemp;

    acount :=  acount div i;
    End;
End;


begin
 setlength(PermString,nmax);

 For i := 1 to nmax do
    PermString[i] := chr(i+ord('0'));

 n := nmax;
 j := 1;
 For i := 2 to n do
   j := i*j;
 writeln(PermString,j:10);
 readln;
try
 sl := TStringlist.create;
 sl.capacity:= j;

 t0 := time;
 Permutation (PermString, '' ,1 , []);
 t1:= time;

 WriteLn('ALZ',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));

 sl.clear;
 sl.capacity:= j;

 t0 := time;
 repeat
   sl.add(nthpermutation(permstring,j));
   dec(j);
 until j=0;
 t1:= time;

 WriteLn('HOR',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));

 sl.clear;
 sl.capacity:= j;

 For i := 1 to nmax do
    PermString[i] := chr(i+ord('0'));

 t0 := time;
 repeat
   sl.add(PermString);
 until NOT(Next(PermString));
 t1:= time;

 WriteLn('PermLex',sl.count:8,FormatDateTime(' hh:mm:ss.zzz',T1-t0));

{//Test, ob alles stimmig ist
 sl.sort;
 t1:= time;
 WriteLn(FormatDateTime(' hh:mm:ss.zzz',T1-t0));

 For i := 2 to sl.count do
   IF sl[i-2]= sl[i-1] then
     writeln(i);
 t1:= time;
 WriteLn(FormatDateTime(' hh:mm:ss.zzz',T1-t0));

 writeln(sl.count);

}
finally
 sl.free;
end;

 Readln;
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

type
  TModZaehl = array[1..nmax] of integer;
..
var 
  ModZaehl : TModZaehl;
..
function NextPermutation(const aString: AnsiString; var ModZaehl: TModZaehl): AnsiString;
var
  pos, i, n: Cardinal;
  chTemp: char;

begin
  n := Length(aString);

  result := aString;

  for i := 1 to n-1 do
  begin
    pos := n-ModZaehl[i];

    //switch
//    Form1.memo1.lines.add(Format('~Tausche %2d mit %2d ',[i,pos]));

    chTemp := result[i];
    result[i] := result[Pos];
    result[Pos] := chTemp;
  end;

  i := n;
  pos := 1;
  inc(ModZaehl[pos]);
  while ModZaehl[pos] >= i do
  begin
    ModZaehl[pos] := 0;
    inc(pos);
    dec(i);
    if i < 2 then
      break;
    inc(ModZaehl[pos]);
  end;

end;
...
  t0 := time;
  for i := 1 to j do
    NextPermutation(PermString, ModZaehl);
  t1 := time;
..                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

const n=5;

label 2,4,6,8;

var a:string;
temp:char;
c,r,m:array[1..n] of integer;
i,k:byte;

begin
for i:=1 to n do
  begin
  c[i]:=0;
  r[i]:=1;
  m[i]:=n-i
  end;
a:='ABCDE';

2:i:=1;k:=1;

showmessage(a); //Hier der Abruf (beispielhaft die Ausgabe) der originalen und jeder permutierten Zeichenfolge zu weiteren "Verarbeitung"

4:if c[i]=m[i] then goto 6;
temp:=a[c[i]+k];
a[c[i]+k]:=a[c[i]+k+r[i]];
a[c[i]+k+r[i]]:=temp;
inc(c[i],r[i]);
goto 2;

6:if c[succ(i)]=m[succ(i)] then goto 8;
temp:=a[k];
a[k]:=a[succ(n-k)];
a[succ(n-k)]:=temp;
c[i]:=n-i-m[i];
inc(c[succ(i)],r[succ(i)]);
goto 2;

8:r[i]:=-r[i];
m[i]:=n-i-m[i];
r[succ(i)]:=-r[succ(i)];
m[succ(i)]:=pred(n-i-m[succ(i)]);
inc(i,2);
inc(k);
if i<n then goto 4                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:

procedure GetPermutations(A: String; Callback: TPermutationCallback);
var
    temp:char;
    c,r,m:array of integer;
    i,k,n:Integer;
    p:Boolean;
begin
    n := Length(A);

    //Succ because I'm too lazy for the index transformation in the rest of the source.
    SetLength(c,succ(n));
    SetLength(r,succ(n));
    SetLength(m,succ(n));

    for i:=1 to n do
    begin
        c[i]:=0;
        r[i]:=1;
        m[i]:=n-i
    end;

    p := True; //False if no interest in original, don't forget to init i and k to 1

    repeat
        if p Then
        begin
            Callback(a); //Hier der Abruf (an dieser Stelle die Ausgabe) der originalen und jeder permutierten Zeichenfolge

            i := 1;
            k := 1;

            p := false;
        end;

        if c[i] <> m[i] then
        Begin
            temp := a[c[i]+k];
            a[c[i]+k] := a[c[i]+k+r[i]];
            a[c[i]+k+r[i]] := temp;
            inc(c[i], r[i]);

            p = true;
            continue;
        end;

        if c[succ(i)] <> m[succ(i)] then
        begin
            temp := a[k];
            a[k] := a[succ(n-k)];
            a[succ(n-k)] := temp;
            c[i] := n-i-m[i];
            inc(c[succ(i)],r[succ(i)]);

            p = true;
            continue;
        end;

        r[i] := -r[i];
        m[i] := n-i-m[i];
        r[succ(i)] := -r[succ(i)];
        m[succ(i)] := pred(n-i-m[succ(i)]);
        inc(i, 2);
        inc(k);
    until not p and (i >= n);

end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure generate(n:word);
var c,t:byte;

begin

if n=1 then
  begin
  //Hier der Abruf bzw. die weitere Verarbeitung der jeweiligen Permutation, z.B. die Ausgabe
  end;

for c:=1 to n do
  begin
  if odd(n) then 
    begin t:=a[c];a[c]:=a[n];a[n]:=t end
    else begin t:=a[1];a[1]:=a[n];a[n]:=t
    end
  end

end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:

unit NDamen2009;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Spin, Grids, ExtCtrls, DBCtrls;

  type
   TBrett=Array of Integer;
   TNDamen = class(TForm)
    Anzahl: TSpinEdit;
    StaticText1: TStaticText;
    Start: TButton;
    StellungsAusgabe: TListBox;
    Zeigen: TCheckBox;
    StaticTextN: TStaticText;
    LabelN: TLabel;
    StaticTextTime: TStaticText;
    FeldAusgabe: TStringGrid;
    LabelZeit: TLabel;
    procedure StartClick(Sender: TObject);
    procedure StellungsAusgabeClick(Sender: TObject);
  private
     Brett:TBrett;
     BrettGroesse:Integer;
     Stellungen:Integer;
     function TimeSekunden:extended;
     procedure Ausgabe(NR:Integer;Brett:TBrett);
     function Erlaubt(x:Integer):Boolean;
     procedure Setz(x:Integer);
     procedure Fuellen(Nr:Integer);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var NDamen: TNDamen;

implementation

{$R *.DFM}
{$R+,Q+}

 function TNDamen.TimeSekunden:extended;
  var H,M,S,MS:Word;
  begin
   DecodeTime(Now,H,M,S,MS);
   TimeSekunden:=3600.0*H+60.0*M+S+MS/1000
  end;

 procedure TNDamen.Ausgabe(NR:Integer;Brett:TBrett);
  var x,y:Integer;
      Zeile:String;
  begin
   IF NDamen.Zeigen.Checked then
    begin
     Zeile:='';
     StellungsAusgabe.Items.Add(IntToStr(Nr)+'-te Stellung');
     for x:=1 to BrettGroesse do
      for y:=1 to BrettGroesse do
       IF Brett[x]=y then Zeile:=Zeile+char(x+64)+IntToStr(y)+' ';
     StellungsAusgabe.Items.Add(Zeile);
     StellungsAusgabe.Items.Add('');
    end
  end;

 function TNDamen.Erlaubt(x:Integer):Boolean;
  var K:Integer;
  begin
   Erlaubt:=True;
   // waagerechter Test
   for K:=1 to x-1 do
    if Brett[x]=Brett[K] then begin Erlaubt:=False;exit end;
   [b]// Diagonaltest, entfällt beim Turmproblem[/b]
   for K:=1 to x-1 do
    if Abs(Brett[x]-Brett[K])=x-K then begin Erlaubt:=False;exit end;
  end;

 procedure TNDamen.Setz(x:Integer);
  var y:Integer;
  begin
   for y:=1 to BrettGroesse do
    begin
     Brett[x]:=y;
     if Erlaubt(x) then
      if x<BrettGroesse then Setz(x+1)
      else begin Inc(Stellungen);Ausgabe(Stellungen,Brett) end;
    end
  end;

 procedure TNDamen.Fuellen(nr:Integer);
  var x,y:Integer;
      Teil,Zeile:String;
  begin
   for x:=1 to BrettGroesse do
    FeldAusgabe.Cells[x,0]:=char(64+x);
   for y:=1 to BrettGroesse do
    FeldAusgabe.Cells[0,BrettGroesse+1-y]:=IntToStr(y);
   for y:=1 to BrettGroesse do
    for x:=1 to BrettGroesse do
     FeldAusgabe.Cells[x,y]:=' ';
   Zeile:=StellungsAusgabe.Items[Nr];x:=0;
   while Zeile<>'' do
    begin
     Teil:=Copy(Zeile,1,Pos(' ',Zeile)-1);Inc(x);
     y:=StrToInt(Copy(Teil,2,Length(Teil)-1));
     FeldAusgabe.Cells[x,BrettGroesse+1-y]:='D';
     Delete(Zeile,1,Pos(' ',Zeile));
    end;
  end;

 procedure TNDamen.StartClick(Sender: TObject);
  var x,y:Integer;
      TSek:Extended;
  begin
   BrettGroesse:=StrToInt(Anzahl.Text);
   SetLength(Brett,BrettGroesse+1);
   StellungsAusgabe.Clear;
   StellungsAusgabe.Width:=160;
   FeldAusgabe.Width:=25*(BrettGroesse+1);
   FeldAusgabe.Height:=25*(BrettGroesse+1);
   FeldAusgabe.ColCount:=BrettGroesse+1;
   FeldAusgabe.RowCount:=BrettGroesse+1;
   FeldAusgabe.Visible:=False;
   if BrettGroesse>4 then StellungsAusgabe.Width:=120+(BrettGroesse-4)*30;
   if BrettGroesse>11 then Zeigen.Checked:=False;
   if Not Zeigen.Checked then
    begin
     StellungsAusgabe.Visible:=False;
     FeldAusgabe.Visible:=False
    end
   else
    begin
     StellungsAusgabe.Visible:=True;
     FeldAusgabe.Visible:=True;
    end;
   Stellungen:=0;
   Screen.Cursor:=crHourGlass;
   TSek:=TimeSekunden;Setz(1);TSek:=TimeSekunden-TSek;
   Screen.Cursor:=crDefault;
   LabelZeit.Caption:=Format('%0.2f',[TSek])+' sek.';
   LabelN.Caption:=IntToStr(Stellungen);
   for x:=1 to BrettGroesse do
    FeldAusgabe.Cells[x,0]:=char(64+x);
   for y:=1 to BrettGroesse do
    FeldAusgabe.Cells[0,BrettGroesse+1-y]:=IntToStr(y);
   for y:=1 to BrettGroesse do
    for x:=1 to BrettGroesse do
     FeldAusgabe.Cells[y,BrettGroesse+1-x]:=' ';
  end;

 procedure TNDamen.StellungsAusgabeClick(Sender: TObject);
  var Nr:Integer;
  begin
   Nr:=StellungsAusgabe.ItemIndex;
   if (NR+2)mod 3=0 then Fuellen(Nr);
  end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

1  2  3  4            
2  3  4  1             
3  4  1  2            
4  1  2  3            
1  2  3  4    T[4]=L, also dec(L)        
2  3  1  4    es werden nur die ersten drei rotiert        
3  1  4  2            
1  4  2  3            
4  2  3  1            
2  3  1  4    T[4]=L, also dec(L)        
3  1  2  4    es werden nur die ersten drei rotiert        
1  2  4  3            
2  4  3  1            
4  3  1  2            
3  1  2  4    T[4]=L, also dec(L)
1  2  3  4    es werden nur die ersten drei rotiert
          T[3]=L, also dec(L)
2  1  3  4    es werden nur die ersten zwei rotiert
1  3  4  2    
3  4  2  1    
4  2  1  3    
2  1  3  4    T[4]=L, also dec(L)
1  3  2  4    es werden nur die ersten drei rotiert
3  2  4  1    
2  4  1  3    
4  1  3  2    
1  3  2  4    T[4]=L, also dec(L)
3  2  1  4    es werden nur die ersten drei rotiert
2  1  4  3    
1  4  3  2    
4  3  2  1    
3  2  1  4    T[4]=L, also dec(L)
          es werden nur die ersten drei rotiert
2  1  3  4    T[3]=L, also dec(L)
          es werden nur die ersten zwei rotiert
1  2  3  4    T[2]=L, also dec(L)
          L hat den Wert 1 ==> Schluß                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:

unit Perm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin;

type
  TPermutationen = class(TForm)
    SpinEditN: TSpinEdit;
    LabelN: TLabel;
    ButtonWeiter: TButton;
    ButtonAlle: TButton;
    Ausgabe: TMemo;
    ButtonStart: TButton;
    procedure ButtonWeiterClick(Sender: TObject);
    procedure ButtonStartClick(Sender: TObject);
    procedure ButtonAlleClick(Sender: TObject);
  private
    { Private-Deklarationen }
    Perm:Array[1..10]of Byte;
    N,Index:Byte;
    Anzahl:Integer;

    procedure Anzeigen;
  public
    { Public-Deklarationen }
  end;

var
  Permutationen: TPermutationen;

implementation

{$R *.dfm}

 procedure TPermutationen.ButtonWeiterClick(Sender: TObject);
  var Tausch,K:Byte;
  begin
   if Index>1 then
    begin
     Tausch:=Perm[1];
     for K:=2 to Index do Perm[K-1]:=Perm[K];
     Perm[Index]:=Tausch;
     if Perm[Index]=Index then dec(Index) else Anzeigen
    end
   else
    begin
     Ausgabe.Lines.Add('Anzahl der Permutationen: '+IntToStr(Anzahl));
     ButtonWeiter.Enabled:=False;
     ButtonAlle.Enabled:=False;
    end;
  end;

 procedure TPermutationen.ButtonStartClick(Sender: TObject);
  var K:Byte;
  begin
   N:=SpinEditN.Value;Ausgabe.Clear;
   for K:=1 to N do Perm[K]:=K;
   Anzahl:=0;Anzeigen;
   ButtonWeiter.Enabled:=True;
   ButtonAlle.Enabled:=True;
  end;

 procedure TPermutationen.Anzeigen;
  var K:Byte;
      Zeile:String;
  begin
   Zeile:='';
   for K:=1 to N do Zeile:=Zeile+Char(ord('@')+Perm[K])+' ';;
   Ausgabe.Lines.Add(Zeile);
   inc(Anzahl);Index:=N;
  end;

 procedure TPermutationen.ButtonAlleClick(Sender: TObject);
  var Tausch,K:Byte;
  begin
   N:=SpinEditN.Value;
   if N>8 then
    if MessageDlg('Bist du dir sicher',mtConfirmation,[mbYes,mbNo],0)=mrNo then exit;
   Ausgabe.Clear;
   for K:=1 to N do Perm[K]:=K;
   Anzahl:=0;Anzeigen;
   while Index>1 do
    begin
     Tausch:=Perm[1];
     for K:=2 to Index do Perm[K-1]:=Perm[K];
     Perm[Index]:=Tausch;
     if Perm[Index]=Index then dec(Index) else begin Index:=N;Anzeigen end;
    end;
   Ausgabe.Lines.Add('Anzahl der Permutationen: '+IntToStr(Anzahl));
   ButtonWeiter.Enabled:=False;
   ButtonAlle.Enabled:=False;
  end;

end.                    

1:
2:
3:

     Tausch:=Perm[1];
     for K:=2 to Index do Perm[K-1]:=Perm[K];
     Perm[Index]:=Tausch;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:

Program PermSteinJohnsTrott;
//Permutationsenumeration nach Steinhaus-Johnson-Trotter
//aLa Delphi-Laie
{$IFDEF FPC}
  {$MODE DELPHI}
  {$Optimization ON}
  {$Optimization RegVar}
  {$Optimization PEEPHOLE}
  {$Optimization CSE}
  {$Optimization ASMCSE}
  //{$CODEALIGN Loop=1}(* <-Spasseshalber *) {$CODEALIGN proc=32}
{$Else}
  {$APPTYPE console}
{$Endif}

uses
  sysutils,classes;
type
  tFeld= array[0..19] of Integer;
var
  T1,T0: TDateTime;
  sl : TStringlist;
  zaehler:cardinal;

procedure GetPermutations(x:string);
var
  p,d : tFeld;
  Nr : longint;

  i,
  k,l,n:integer;
  first:boolean;

  h:char;
{$IFDEF AUSGABE}
  InvCnt_alt,InvCnt_neu,
  sAusgabe : String;
  function InvCnt:word;
  var
    k,l:word;
  begin
  result:=0;
  for k:=1 to pred(length(x)) do
    for l:=k to length(x) do
      if x[k]>x[l] then
        inc(result);
  end;
{$ENDIF}
  function Init(j: integer): boolean;
  begin
    writeln('Init ');
    for j := j downto 2 do Begin
      p[j]:=0;
      d[j]:=1
      end;
    result :=false
    end;

begin
{$IFDEF AUSGABE}
InvCnt_alt:=1;
Nr := 1;
For i := n downto 2 do
  Nr := Nr*i;
sl.capacity := Nr;
{$EndIF}
n := length(x);
zaehler:=0;
Nr := 0;

first:= true;
IF first then
  first := Init(length(x));

repeat
  n:=length(x);
  For i := n-1 downto 0 do Begin
    k:=0;
    repeat
      l:=p[n]+d[n];
      inc(zaehler);
      p[n]:=l;
      if l=n then begin
        d[n]:=-1;
        if n>2 then begin
          dec(n);
          continue
          end
        else
          break;
        end;
      if l<>0 then
        break;
      d[n]:=1;
      inc(k);

      if n>2 then
        dec(n);
      until false;

      IF L= n then // L , n = 2
        begin
        l:=1;
        first:=true;
        end;

  {3:}inc(Nr);
{$IFDEF AUSGABE}
      InvCnt_neu:=InvCnt;
      sAusgabe := Format('%s %5d InvZahl %3d  DiffInvZahl %3d',[x,Nr,InvCnt_neu,InvCnt_neu-InvCnt_alt]));
      sl.add(sAusgabe);
      InvCnt_alt:=InvCnt_neu;
{$ENDIF}

      l:=l+k;//nächster Tausch
      h:=x[l];
      x[l]:=x[succ(l)];
      x[succ(l)]:=h;
      //oder Ausgabe des Arrays / Strings erst hier, dann ist die letzte ausgegebene Permutation die Nullpermutation (bzw. das Einserelement)
      {Form1.ListBox1.Items.Add(inttostr(zaehler)+': '+x+', InvCnt: '+inttostr(InvCnt));
      Form1.ListBox1.Refresh;
      Form1.ListBox1.TopIndex:=pred(Form1.ListBox1.Items.Count);}
    end;
  until first;
  Writeln(Nr);
end;

procedure FormCreate(s : string);

begin
 T0 := now;
 GetPermutations(s);
 T1 := now;
end;

var
  i : integer;
  s : String;
Begin
 // Cpu aufwecken..
 formcreate( '123456789');
{$IFNDEF AUSGABE}
    s := '123456789ABC';
    FormCreate(s);
{$ELSE}
  s := '12345';
  sl := TStringlist.create;
  FormCreate(s);
  i:= sl.count;
  writeln(i);
  sl.sorted := true;
  sl.sorted := false;
  sl.add('');
  sl.add('Anzahl Permutationnen '+IntToStr(i));
  sl.add('');
  sl.add('Aufrufe zur Bestimmung der Tauschstelle '+InttoStr(Zaehler));
  sl.add('');
  sl.add(Format('Relation %5.3f',[Zaehler/i]));
  writeln(sl.text);
  sl.free;
{$ENDIF}
  writeln(FormatdateTime('HH:NN:SS.zzz',T1-T0));
end.                    

1:
2:
3:

first:= true;
IF first then
  first := Init(length(x));                    

1:
2:
3:
4:
5:
6:

for j:=2 to length(x) do
  begin
  p[j]:=0;
  d[j]:=1
  end;
first:=false;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:

procedure TForm1.BerechnenClick(Sender: TObject);
var n,k,anz,h,i,m:integer;
    x,y:array[1..20] of integer;
    t1:int64;
    liste:tstringlist;
procedure ausgabe;
var i:integer;
    kk:string;
begin
    kk:='';
    for i:=1 to k do kk:=kk+inttostr(x[i])+' ';
    liste.add(kk);
    application.processmessages;
end;
begin
    listbox1.clear;
    liste:=tstringlist.create;
    n:=updown1.position;
    k:=updown2.position;
    if k>n then k:=n;
    anz:=0;
    if k=n then m:=k-1
           else m:=k;
    for i:=1 to n do x[i]:=i;
    for i:=1 to m do y[i]:=i;

    t1:=gettickcount;
    i:=m;
    inc(anz);
{$IFDEF Ausgabe}
    ausgabe;
{$ENDIF}
    repeat
      if y[i]<n then
      begin
        inc(y[i]);
        h:=x[i];
        x[i]:=x[y[i]];
        x[y[i]]:=h;
        i:=m;
        inc(anz);
{$IFDEF Ausgabe}
        ausgabe
{$ENDIF}
      end
      else
      begin
        repeat
          h:=x[i];
          x[i]:=x[y[i]];
          x[y[i]]:=h;
          dec(y[i]);
        until y[i]<=i;
        dec(i);
      end;
      if anz mod 100000 = 0 then
      begin
        label3.caption:=inttostr(x[1]);
        application.processmessages;
      end;
    until (i=0);
    liste.add(inttostr(anz));
    liste.add(inttostr(gettickcount-t1)+' ms');
    listbox1.items:=liste;
    liste.free;
end;                    

1:
2:
3:
4:
5:

  
# ./Perm
n=12,k=12
479001600
00:00:04.704                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:

program Kombination;
{In einem Feld Komb werden die Indizes gespeichert.
Für jeden Index wird die vorhandene Anzahl angegeben und
daraus alle Anordnungen bestimmt.
k aus n mit mehrfachen.

Wenn Index 0 die kleinste Ziffer sei und Index n-1 die groesste Ziffer sei,
dann sind die Kombinationen aufsteigend sortiert.

Zu verwenden, wie auch immer, ohne Anspruch auf Korrektheit.}

{$IFDEF FPC}
  {$mode Delphi}
  {$DEBUGINFO-}
  {$R- $V- $O-}
  {$Optimization ON}
  {$Optimization regvar}
  {$Optimization PEEPHOLE}
  {$Optimization CSE}
  {$Optimization ASMCSE}
  {$CODEALIGN proc=32}
  {$ASMMODE INTEL}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}

uses
   sysutils;
type
  nativeinteger = longInt;//Int64;
const
  KombLaenge =3 ;//k
  KL_1 = KombLaenge-1;
  n = KombLaenge+2;// 3 aus 5

var
  PermCount: Int64;
  T1,T0 : int64;
  FeldAnzahl : array[0..n-1] of LongInt;
  Komb : array[0..KL_1] of byte;


function GetCPU_Time: int64;
type
  TCpu = record
            HiCpu,
            LoCpu : Dword;
         end;
var
  Cput : TCpu;
begin
  asm
  RDTSC;
  MOV Dword Ptr [CpuT.LoCpu],EAX;  MOV Dword Ptr [CpuT.HiCpu],EDX
  end;
  with Cput do  result := int64(HiCPU) shl 32 + LoCpu;
end;

procedure VerarbeitungKomb; //inline;
var
  I : nativeinteger;
Begin
  INC(PermCount);

  For i := Low(Komb) to High(Komb) do
    write(Komb[i]:2);
  writeln;
end;

procedure VerarbeitungKombZaehl; inline;

Begin
  INC(PermCount);
end;

procedure permute(depth:nativeinteger);
var
  i: nativeinteger;
Begin
  IF depth > KL_1 THEN Begin
//    VerarbeitungKombZaehl;
    VerarbeitungKomb;
    EXIT;
    end;

  i := Low(FeldAnzahl);
  repeat
    IF FeldAnzahl[i] >0 then begin
      dec(FeldAnzahl[i]);
      Komb[depth] := i;
      permute(depth+1);
      Komb[depth] := 0;// muesste nicht sein
      inc(FeldAnzahl[i]);
      end;
    inc(i);
  until i > High(FeldAnzahl);
end;

procedure Init;
var
  i: integer;
  sum: longint;
begin
  randomize;
  repeat
    sum := 0;
    For i := Low(FeldAnzahl) to High(FeldAnzahl) do Begin
      FeldAnzahl[i] := random(3);// KombLaenge;//-> PermCount = n^k
      inc(Sum,FeldAnzahl[i]);
      end;
  until Sum >= KombLaenge;

  write('  Index: ');
  For i := Low(FeldAnzahl) to High(FeldAnzahl) do
     write(i:2);
  writeln;
  write(' Anzahl: ');
  For i := Low(FeldAnzahl) to High(FeldAnzahl) do
     write(FeldAnzahl[i]:2);
  writeln;
  writeln('Weiter mit <ENTER>') ;
  ReadlN;
end;

var
  Time1,Time0: TDateTime;
  I: nativeinteger;

Begin
  Init;

  Time0 := Time;T0 := GetCPU_Time;
  permute(0);
  T1 := GetCPU_Time;Time1 := Time;

  writeln(PermCount:12,' Anzahl der Kombinationen');
  writeln((T1-T0)/PermCount:12:5,' CPU-Takte pro Durchgang');
  IF Time1-Time0 > 0 then
  Writeln((Time1-Time0)*(86000.0*1e9)/PermCount:12:6,' ns');
  writeln(FormatDateTime('HH:NN:SS.ZZZ',Time1-Time0));
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

  Index:  0 1 2 3 4
 Anzahl:  0 1 2 0 0
Weiter mit <ENTER>

 1 2 2
 2 1 2
 2 2 1
           3 Anzahl der Kombinationen
oder 
nur Zählen mit 7 aus 10 wobei alle 7 fach vorhanden:
  Index:  0 1 2 3 4 5 6 7 8 9
 Anzahl:  7 7 7 7 7 7 7 7 7 7
Weiter mit <ENTER>

    10000000 Anzahl der Kombinationen
    27.40196 CPU-Takte pro Durchgang
    7.763889 ns
00:00:00.078                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure GetPermutations(x:string);
var zaehler:cardinal;
  i,inversionsanzahl_alt,inversionsanzahl_neu:byte;
  h:char;
  d:array of integer;
  p:array of byte;
  j,k,l,n:byte;
  first:boolean;

  function inversionsanzahl:word;
  var k,l:word;
  begin
    result:=0;
    for k:=1 to pred(length(x)) do
      for l:=k to length(x) do
        if x[k]>x[l] then
          inc(result);
  end;
  
  procedure Ausgabe;
  Begin
    inversionsanzahl_neu:=inversionsanzahl;
    Form1.ListBox1.Items.Add(inttostr(zaehler)+': '+x+', Inversionsanzahl: '+inttostr(inversionsanzahl_neu)+', Differenz: '+inttostr(inversionsanzahl_neu-inversionsanzahl_alt));
    Form1.ListBox1.Refresh;
    Form1.ListBox1.TopIndex:=pred(Form1.ListBox1.Items.Count);
    inversionsanzahl_alt:=inversionsanzahl_neu;
  end;  

  procedure step1;forward;

  procedure step2;
  begin
  if n>2 then
    begin
    dec(n);
    step1
    end
  else
    begin
    l:=1;
    first:=true
    end
  end;

  procedure step1;
  begin
  l:=p[n]+d[n];
  p[n]:=l;
  if l=n then
    begin
    d[n]:=-1;
    step2
    end
  else if l=0 then
    begin
    d[n]:=1;
    inc(k);
    step2
    end
  end;


begin
inversionsanzahl_alt:=1;
setlength(d,succ(length(x)));
setlength(p,succ(length(x)));
zaehler:=0;
for j:=1 to n do begin
  p[j]:=0;
  d[j]:=1
  end;
first:=false;

// Hier passiert es
repeat
  n:=length(x);
  for i:=1 to length(x){n} do Begin
    k:=0;

    step1;
    inc(zaehler);

    Ausgabe;

    l:=l+k;//nächster Tausch
    h:=x[l];
    x[l]:=x[succ(l)];
    x[succ(l)]:=h;
    end
  until first
end;

procedure TForm1.FormCreate(Sender: TObject);
var s:string;
begin
Form1.Show;
s:=Inputbox('Zu permutierenden String eingeben','String?',s);
GetPermutations(s)
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

Mit tDat = Byte:
Permute_i
   479001600 Anzahl der Kombinationen
    35.39909 CPU-Takte pro Durchgang
   11.009300 ns
00:00:05.298
Permute_Move
   479001600 Anzahl der Kombinationen
    23.70283 CPU-Takte pro Durchgang
    7.370703 ns
00:00:03.547
Permute_s
   479001600 Anzahl der Kombinationen
    10.78625 CPU-Takte pro Durchgang
    3.353909 ns
00:00:01.614                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

tDat = LongInt
Permute_i
   479001600 Anzahl der Kombinationen
    24.81255 CPU-Takte pro Durchgang
    7.715653 ns
00:00:03.713
Permute_Move
   479001600 Anzahl der Kombinationen
    36.27229 CPU-Takte pro Durchgang
   11.279441 ns
00:00:05.428                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:

program Variation;
{In einem Feld Komb werden die Indizes gespeichert.
Für jeden Index wird die vorhandene Anzahl angegeben und
daraus alle Kombinationen bestimmt.
k aus n mit doppelten

Zu verwenden, wie auch immer, ohne Anspruch auf Korrektheit.}

{$IFDEF FPC}
  {$mode Delphi}
  {$DEBUGINFO-}
  {$R- $V- $O-}
  {$Optimization ON}
  {$Optimization regvar}
  {$Optimization PEEPHOLE}
  {$Optimization CSE}
  {$Optimization ASMCSE}
  {$CODEALIGN proc=32}
  {$ASMMODE INTEL}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}

uses
   sysutils;
const
  k =10;  //k
  KL_1 = k-1;
  n = k+3;// k aus n

type
//nativeInt = Longint;// Int64;
  tDat = Byte;
  tKombIndex = 0..KL_1;
  tKomb = array[tKombIndex] of tDat;

  tCallBack = function (const Komb:tKomb;depth:longInt): boolean;
  tPerm = procedure (depth:nativeint);
var
  T1,T0 : int64;
  PermCount: LongWord;//Int64;
  FeldAnzahl : array[0..k-1] of LongInt;
  Komb : tKomb;

  verarbeite: tCallBack;

  s: string;
  sKomb: pChar;
  Index : tDat;


function Check(const Komb:tKomb;depth:longInt): boolean;
begin
  //result := Komb[3]<>3;
  result := true;//false;
end;

function Check_Ausg(const Komb:tKomb;depth:longInt): boolean;
var
  i : integer;
  t: string[3];// 4 Byte = integer
  s: string[2*k+1];
begin
  i:= 0;
  s:='';
  repeat
    str(Komb[i]:2,T);
    s := s+t;
    inc(i);
  until i>depth;
  writeln(s);

  result := false;
end;

procedure PermMove;
  var
    Tausch:tDat;
  begin
  inc(PermCount);
  Index:=K;
  while Index>0 do
    begin
    Tausch:=Komb[0];
//    for K:=1 to Index-1 do
//      Perm[K-1]:=Perm[K];
    MOVE(Komb[1],Komb[0],(Index-1)*SizeOf(Komb[0]));
    Komb[Index-1]:=Tausch;
    if Tausch{Komb[Index]}=Index then
      dec(Index)
    else
      begin
      inc(PermCount);
      Index:=K;
      end;
    end;
  end;

function GetCPU_Time: int64;
type
  TCpu = record
            HiCpu,
            LoCpu : Dword;
         end;
var
  Cput : TCpu;
begin
  asm
  RDTSC;
  MOV Dword Ptr [CpuT.LoCpu],EAX;
  MOV Dword Ptr [CpuT.HiCpu],EDX
  end;
  with Cput do  result := int64(HiCPU) shl 32 + LoCpu;
end;


procedure Permute(depth:nativeint);
var
  i: nativeint;
Begin
  IF depth >= K THEN Begin
    inc(PermCOunt);
    EXIT;
    end;
  i := Low(FeldAnzahl);
  repeat
    IF FeldAnzahl[i] >0 then begin
      dec(FeldAnzahl[i]);
      Komb[depth] := i;
//      IF Verarbeite(Komb,depth) then
        permute(depth+1);
      inc(FeldAnzahl[i]);
      Komb[depth] := 0;
      end;
    inc(i);
  until i > High(FeldAnzahl);
end;

procedure Init;
var
  i,j: integer;
  sum: longint;
begin

  setlength(s,n);
  sKomb := @s[1];
  //For i := Low(Komb) to High(Komb)
  For i in tKombIndex  do Begin
    Komb[i] := i+1;
    sKomb[i] := chr(65+i);
    end;


  randomize;
  repeat
    sum := 0;
    For i := Low(FeldAnzahl) to High(FeldAnzahl) do Begin
      j := random(3);
      FeldAnzahl[i] := j;
      inc(Sum,j);
      end;
  until Sum >= n;

  write('  Index: ');
  For i := Low(FeldAnzahl) to High(FeldAnzahl) do
     write(i:2);
  writeln;
  write(' Anzahl: ');
  For i := Low(FeldAnzahl) to High(FeldAnzahl) do
     write(FeldAnzahl[i]:2);
  writeln;
  {
  write(' Anzahl: ');
  For i := Low(tKombAnzFeld) to High(tKombAnzFeld) do
     write(KombAnzFeld[i]:2);
  writeln;}


  PERMcount:=0;
  //ReadLn;
end;

procedure Permute_i(depth:nativeInt);
var
  i: nativeInt;
  tmp : tDat;
begin
  IF depth <= 0 then
    begin
//    Verarbeite(Komb,KL_1);
    inc(PermCOunt);
    EXIT;
    end;
  i := depth+1;
  repeat
    dec(i);
    tmp:= Komb[depth];
    Komb[depth]:=Komb[i];
    Komb[i] := tmp;
//    IF Verarbeite(Komb,depth) then
       Permute_i(depth-1);
    Komb[i] := Komb[depth];
    Komb[depth]:=tmp;
  until i<= 0;
end;

procedure Permute_s_3;
var
  stmp : array[0..3] of char;// koennte auch permut_s_4
  s : pChar;
begin
{theoretisch:
 1 2 3
 2 1 3
 1 3 2
 3 1 2
 3 2 1
 2 3 1}
  s:= sKomb;
  //Werte zwischenspeichern
  stmp[0] :=s[0];stmp[1] :=s[1];    //1 2 3
  {writeln(s);}inc(PermCount);
                                stmp[2] :=s[2];
  s[0]:= sTmp[1];s[1]:= sTmp[0];                   //2 1 3
  {writeln(s);}inc(PermCount);
                 s[1]:= sTmp[2];s[2]:= sTmp[0];    //2 3 1
  {writeln(s);}inc(PermCount);
  s[0]:= sTmp[2];s[1]:= sTmp[1];                   //3 2 1
  {writeln(s);}inc(PermCount);
                 s[1]:= sTmp[0];s[2]:= sTmp[1];    //3 1 2
  {writeln(s);}inc(PermCount);
  s[0]:= sTmp[0];s[1]:= sTmp[2];                   //1 3 2
  {writeln(s);}inc(PermCount);
  //Wieder herstellen
                  s[1]:=stmp[1];s[2]:= stmp[2];    //1 2 3
end;

procedure Permute_s(depth:nativeint);
var
  i: nativeInt;
  tmp : char;
begin
  IF depth<3 then begin
    Permute_s_3;
    EXIT;
    end;
  i := depth;
  repeat
    tmp:= sKomb[depth];
    sKomb[depth]:=sKomb[i];
    sKomb[i] := tmp;
    Permute_s(depth-1);
    sKomb[i] := sKomb[depth];
    sKomb[depth]:=tmp;
    dec(i);
  until i< 0;
end;

procedure Testlauf(proc:tPerm;depth:nativeInt);
var
  Time1,Time0: TDateTime;
begin
  PermCount:= 0;
  Time0 := Time;T0 := GetCPU_Time;
  proc(depth);
  T1 := GetCPU_Time;Time1 := Time;
  writeln(PermCount:12,' Anzahl der Kombinationen');
  IF PermCOunt>0 then begin
    writeln((T1-T0)/PermCount:12:5,' CPU-Takte pro Durchgang');
    IF Time1-Time0 > 0 then
      Writeln((Time1-Time0)*(86000.0*1e9)/PermCount:12:6,' ns');
    end;
  writeln(FormatDateTime('HH:NN:SS.ZZZ',Time1-Time0));
end;

var

  I: nativeint;
Begin
  Init;
  IF k < 11 then
    Testlauf(@permute,0);

  For i := Low(Komb) to High(Komb) do
    Komb[i] := i+1;
  Verarbeite := @Check;//_Ausg;
  writeln('Permute_i');
  Testlauf(@Permute_i,k-1);

  writeln('Permute_Move');
  For i := Low(Komb) to High(Komb) do
    Komb[i] := i+1;
  Testlauf(@PermMove,k);

  writeln('Permute_s');
  Testlauf(@Permute_s,k-1);
  writeln('Weiter mit <ENTER>') ;
  ReadLn;
end.