vunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PermuteList = ^OpenArr;
OpenArr =
Record
Elem :
String;
Next : PermuteList;
end;
TForm1 =
class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
Function Permute(N: Integer):PermuteList;
Procedure DeleteList(Liste: PermuteList);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure TForm1.DeleteList(Liste: PermuteList);
var HilfsZeiger: PermuteList;
begin
if Liste<>
nil then
begin
HilfsZeiger:=Liste;
while HilfsZeiger^.Next<>
Nil do
begin
Liste:=HilfsZeiger^.Next;
HilfsZeiger^.Next:=nil;
dispose(HilfsZeiger);
HilfsZeiger:=Liste;
end;
Liste:=nil;
dispose(Hilfszeiger);
HilfsZeiger:=nil;
end;
end;
Function TForm1.Permute(N: Integer):PermuteList;
Function GetElems(Wert :
String;Start,Stop : integer):
String;
var Rueckgabe :
string;
begin
Rueckgabe:='
';
GetElems:='
';
if (Start<=Stop)
and (Start>0)
then
begin
while (Start>1)
and (Pos('
,',Wert)>0)
do
begin
Delete(Wert,1,Pos('
,',Wert));
Dec(Start);
Dec(Stop);
end;
if Start=1
then
begin
while (Stop>=1)
and (Wert<>'
')
do
begin
if Pos('
,',Wert)>0
then
begin
Rueckgabe:=Rueckgabe+'
,'+Copy(Wert,1,Pos('
,',Wert)-1);
Delete(Wert,1,Pos('
,',Wert));
Dec(Stop)
end else
begin
Rueckgabe:=Rueckgabe+'
,'+Wert;
Wert:='
';
Dec(Stop);
end;
end;
end;
end;
Delete(Rueckgabe,1,1);
GetElems:=Rueckgabe;
end;
Var I,K: integer;
N_As_String,Element :
String;
OLD_InternList, OLD_LaufList : PermuteList;
NEW_InternList, NEW_LaufList : PermuteList;
begin
Permute:=Nil;
New_InternList:=Nil;
IF N<=2
then
begin
If N=2
then
begin
new(New_InternList);
NEW_InternList^.Elem:='
1,2';
new(NEW_InternList^.Next);
NEW_InternList^.Next^.Elem:='
2,1';
NEW_InternList^.Next^.Next:=nil;
Permute:=NEW_InternList;
NEW_InternList:=Nil;
end else
if N=1
then
begin
new(NEW_InternList);
NEW_InternList^.Elem:='
1';
NEW_InternList^.Next:=Nil;
Permute:=NEW_InternList;
NEW_InternList:=Nil;
end else
begin
Permute:=nil;
end;
end else
begin
STR(N,N_As_String);
OLD_InternList:=Permute(N-1);
If OLD_InternList<>
Nil then
begin
OLD_LaufList:=OLD_InternList;
while OLD_LaufList^.Next<>
Nil do
begin
if NEW_InternList=Nil
then
begin
new(NEW_InternList);
NEW_InternList^.Elem:=N_As_String+'
,'+OLD_LaufList^.Elem;
OLD_LaufList:=OLD_LaufList^.Next;
NEW_InternList^.next:=Nil;
NEW_LaufList:=NEW_InternList;
end else
begin
new(NEW_LaufList^.Next);
New_LaufList:=New_LaufList^.Next;
New_LaufList^.Elem:=N_As_String+'
,'+OLD_LaufList^.Elem;
OLD_LaufList:=OLD_LaufList^.Next;
NEW_LaufList^.Next:=Nil;
end;
end;
{ fr letztes Element in Old_LaufList }
if NEW_InternList=Nil
then
begin
new(NEW_InternList);
NEW_InternList^.Elem:=N_As_String+'
,'+OLD_LaufList^.Elem;
NEW_InternList^.next:=Nil;
NEW_LaufList:=NEW_InternList;
end else
begin
new(NEW_LaufList^.Next);
New_LaufList:=New_LaufList^.Next;
New_LaufList^.Next:=nil;
New_LaufList^.Elem:=N_As_String+'
,'+OLD_LaufList^.Elem;
end;
For I:=2
to N
do
begin
OLD_LaufList:=OLD_InternList;
while OLD_Lauflist^.Next<>
Nil do
begin
new(New_LaufList^.Next);
New_LaufList:=New_LaufList^.Next;
New_LaufList^.Elem:=#13#10;
New_LaufList^.Elem:=GetElems(OLD_Lauflist^.Elem,1,i-1)+'
,'+N_As_STRING+'
,'+GETElems(Old_Lauflist^.Elem,i,N);
if Copy(New_LaufList^.Elem,1,1)='
,'
then Delete(New_LaufList^.Elem,1,1);
if Copy(New_LaufList^.Elem,Length(New_LaufList^.Elem),1)='
,'
then
Delete(New_LaufList^.Elem,Length(New_LaufList^.Elem),1);
Old_Lauflist:=Old_LaufList^.Next;
end;
new(New_LaufList^.Next);
New_LaufList:=New_LaufList^.Next;
New_LaufList^.Elem:=GetElems(OLD_Lauflist^.Elem,1,i-1)+'
,'+N_As_STRING+'
,'+GETElems(Old_Lauflist^.Elem,i,N);
if Copy(New_LaufList^.Elem,1,1)='
,'
then Delete(New_LaufList^.Elem,1,1);
if Copy(New_LaufList^.Elem,Length(New_LaufList^.Elem),1)='
,'
then
Delete(New_LaufList^.Elem,Length(New_LaufList^.Elem),1);
end;
NEW_LaufList^.Next:=nil;
OLD_LaufList^.Next:=nil;
Permute:=NEW_InternList;
NEW_LaufList:=Nil;
Old_LaufList:=Nil;
DeleteList(Old_InternList);
end;
end;
end;
{Hauptprogramm}
procedure TForm1.Button1Click(Sender: TObject);
var AusgabeListe,LaufListe : PermuteList;
i : integer;
n : integer;
begin
ListBox1.Clear;
AusgabeListe:=nil;
n:=StrToInt(Edit1.Text);
AusgabeListe:=Permute(n);
i:=0;
if Ausgabeliste<>
nil then
begin
LaufListe:=AusgabeListe;
while LaufListe^.Next<>
nil do
begin
// Writeln('['+LaufListe^.Elem+']');
ListBox1.Items.Add(laufliste^.Elem);
Laufliste:=LaufListe^.Next;
inc(i);
end;
// writeln('['+LaufListe^.Elem+']');
ListBox1.Items.Add(laufliste^.Elem);
inc(i);
LaufListe:=nil;
DeleteList(AusgabeListe);
end;
ShowMessage(inttostr(i) + '
Permutationen gefunden !!!');
end;
end.