Initial Commit

GOETZ.pas

@@ -0,0 +1,263 @@
+unit Unit1;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ComCtrls, Spin, ExtCtrls;
+
+type
+  SortElement = record
+    Text: string;
+    Hoehe: integer;
+  end;
+
+type
+  TForm1 = class(TForm)
+    munsorted: TMemo;
+    msorted: TMemo;
+    GroupBox1: TGroupBox;
+    bBubble: TButton;
+    blinear: TButton;
+    bquick: TButton;
+    GroupBox2: TGroupBox;
+    lTime: TLabel;
+    lRounds: TLabel;
+    lChanges: TLabel;
+    GroupBox3: TGroupBox;
+    bfortune: TButton;
+    bloadfile: TButton;
+    bclear: TButton;
+    OpenDialog1: TOpenDialog;
+    Animate1: TAnimate;
+    lSort: TLabel;
+    litemcount: TLabel;
+    sfortune: TSpinEdit;
+    ladded: TLabel;
+    pb: TPaintBox;
+    procedure bBubbleClick(Sender: TObject);
+    procedure bquickClick(Sender: TObject);
+    procedure BubbleSort;
+    procedure Quicksort(links,rechts : integer);
+    function  Divide(links, rechts:integer) : integer;
+    procedure Change(a, b:integer);
+    procedure bfortuneClick(Sender: TObject);
+    procedure bloadfileClick(Sender: TObject);
+    procedure bclearClick(Sender: TObject);
+
+  private
+    { Private-Deklarationen }
+    //SortArray : array of string;
+    SortArray: array of SortElement; 
+    Changes,Round, AnzeigeRatio : integer;
+    function SucheMaximum: integer;
+  public
+    { Public-Deklarationen }
+  end;
+
+var
+  Form1: TForm  ;
+
+implementation
+
+{$R *.dfm}
+
+{*************************************************
+ *************    Programmsteuerung  *************
+ *************************************************}
+
+//Bubblesort
+
+procedure TForm1.bBubbleClick(Sender: TObject);
+begin
+Animate1.Play(1,Animate1.FrameCount,0);
+lSort.Caption := 'Bubblesorting...';
+Form1.Refresh;
+BubbleSort;
+lSort.Caption := 'Bubblesort';
+Animate1.Stop;
+end;
+
+//Quicksort
+
+procedure TForm1.bquickClick(Sender: TObject);
+var Frequency,Time1,Time2 : int64;
+    StrCount,i : Integer;
+    buchstabe: char;
+begin
+lSort.Caption := 'Quicksorting...';
+Form1.Refresh;
+Animate1.Play(1,Animate1.FrameCount,0);
+QueryPerformanceFrequency(Frequency);
+QueryPerformanceCounter(Time1);
+Changes := 0;
+StrCount := mUnSorted.Lines.Count;
+SetLength(SortArray,StrCount);
+for i := 0 to StrCount - 1 do begin
+ SortArray[i].Text := mUnSorted.Lines[i];
+ SortArray[i].Hoehe := ord(SortArray[i].Text[1]) * 256 + ord(SortArray[i].Text[2]);
+end;
+AnzeigeRatio := SucheMaximum div pb.Height;
+with pb.Canvas do
+begin
+  Brush.Color := clWhite;
+  Brush.Style := bsSolid;
+  Pen.Style := psClear;
+  Rect(0, 0, pb.Height, pb.Width);
+end;
+Form1.Refresh;
+
+for i := 0 to Length(SortArray) - 1 do
+begin
+
+end;
+
+litemcount.Caption := 'Anzahl: ' + inttostr(StrCount);
+
+Quicksort(0,StrCount-1);
+mSorted.Clear;
+mSorted.Visible := false;
+for i := 0 to StrCount - 1 do begin
+  mSorted.lines.Add(SortArray[i].Text);
+end;
+mSorted.Visible := true;
+
+
+QueryPerformanceCounter(Time2);
+Animate1.Stop;
+lSort.Caption := 'Quicksort';
+lTime.Caption := 'Zeit: ' + floattostr((Time2-Time1) * 1000 div Frequency) + ' ms';
+lRounds.Caption := 'Durchläufe: --';
+lchanges.Caption := 'Tauschvorgänge: ' + inttostr(Changes);
+
+end;
+
+//Erstellen von zufälligen Buchstabenkombinationen
+
+procedure TForm1.bfortuneClick(Sender: TObject);
+var i : integer;
+begin
+randomize;
+mUnsorted.Visible := false;
+for i := 0 to sfortune.Value do begin
+ munsorted.Lines.Add(chr(65 + Random(27)) + chr(65 + Random(27)));
+end;
+mUnsorted.Visible := true;
+
+ladded.Caption := 'Hinzugefügt: ' + inttostr(i);
+
+//Liste aus Datei laden
+
+end;
+
+procedure TForm1.bloadfileClick(Sender: TObject);
+begin
+if Opendialog1.Execute then mUnSorted.Lines.LoadFromFile(Opendialog1.FileName);
+
+end;
+
+procedure TForm1.bclearClick(Sender: TObject);
+begin
+mSorted.Clear;
+mUnsorted.Clear;
+end;
+
+
+{*************************************************
+ ****************    Algorithmen    **************
+ *************************************************}
+
+procedure TForm1.BubbleSort;
+var changed :  boolean;
+    StrCount,i: integer;
+    Frequency,Time1,Time2 : int64;
+begin
+Changes := 0;
+Round := 0;
+
+QueryPerformanceFrequency(Frequency);
+QueryPerformanceCounter(Time1);
+
+StrCount := mUnSorted.Lines.Count;
+SetLength(SortArray,StrCount);
+for i := 0 to StrCount - 1 do begin
+ SortArray[i].Text := mUnSorted.Lines[i];
+end;
+litemcount.Caption := 'Anzahl: ' + inttostr(StrCount);
+
+repeat
+changed := false;
+for i := 0 to StrCount-2 do begin
+ if Sortarray[i].Text > Sortarray[i+1].Text then
+   begin
+    changed := true;
+    Change(i,i+1);
+   end;
+end;
+inc(Round);
+until not changed;
+
+mSorted.Visible := false;
+for i := 0 to StrCount - 1 do begin
+  mSorted.lines.Add(SortArray[i].Text);
+end;
+mSorted.Visible := true;
+
+QueryPerformanceCounter(Time2);
+
+lTime.Caption := 'Zeit: ' + inttostr((Time2-Time1) * 1000 div Frequency) + ' ms';
+lRounds.Caption := 'Durchläufe: ' + inttostr(round);
+lchanges.Caption := 'Tauschvorgänge: ' + inttostr(changes);
+
+end; //procedure
+
+procedure TForm1.Quicksort(links,rechts : integer);
+var teiler : integer;
+begin
+   if rechts > links then begin
+     teiler := Divide(links, rechts);
+     quicksort(links, teiler-1);
+     quicksort(teiler+1, rechts);
+   end;
+end;
+
+function TForm1.Divide(links, rechts : integer) : integer;
+var i,j,pivot: integer;
+begin
+   i := links-1;
+   j := rechts ;
+   pivot := rechts;
+   while true do begin
+     inc(i);
+     while SortArray[i].Text < SortArray[pivot].Text do inc(i);
+     dec(j);
+     while (SortArray[pivot].Text < SortArray[j].Text) and (j > links) do dec(j);
+     if i >= j then break;
+     Change(i, j);
+   end;
+   Change(i, pivot);
+   result :=  i;
+end;
+
+procedure TForm1.Change(a, b : integer);
+var Dummy : string;
+begin
+   Dummy := SortArray[a].Text;
+   SortArray[a] := SortArray[b];
+   SortArray[b].Text := Dummy;
+   inc(Changes);
+end;
+
+function TForm1.SucheMaximum: integer;
+var i, x: integer;
+begin
+  x := 0;
+  for i := 0 to Length(SortArray) - 1 do
+  begin
+    if SortArray[i].Hoehe > x then x := SortArray[i].Hoehe;
+  end;
+
+  result := x;
+end;
+
+end.

Sort.cfg

@@ -0,0 +1,35 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-LE"c:\program files (x86)\delphi6\Projects\Bpl"
+-LN"c:\program files (x86)\delphi6\Projects\Bpl"

Sort.dpr

@@ -0,0 +1,14 @@
+program Sort;
+
+uses
+  Forms,
+  Unit1 in 'Unit1.pas' {Form1},
+  usort in 'usort.pas';
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

Unit1.pas

@@ -0,0 +1,215 @@
+unit Unit1;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, StdCtrls, ExtCtrls,sort;
+
+type
+  TForm1 = class(TForm)
+    Memo1: TMemo;
+    Panel1: TPanel;
+    Memo2: TMemo;
+    Button1: TButton;
+    Button2: TButton;
+    Button3: TButton;
+    Button4: TButton;
+    Button5: TButton;
+    Button6: TButton;
+    Button7: TButton;
+    Button8: TButton;
+    Button9: TButton;
+    Button10: TButton;
+    Button11: TButton;
+    procedure Button1Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure Button2Click(Sender: TObject);
+    procedure Button3Click(Sender: TObject);
+    procedure Button4Click(Sender: TObject);
+    procedure Button5Click(Sender: TObject);
+    procedure Button6Click(Sender: TObject);
+    procedure Button7Click(Sender: TObject);
+    procedure Button8Click(Sender: TObject);
+    procedure Button9Click(Sender: TObject);
+    procedure Button10Click(Sender: TObject);
+    procedure Button11Click(Sender: TObject);
+  private
+    { Private-Deklarationen }
+  public
+    { Public-Deklarationen }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.Button1Click(Sender: TObject);
+var i,m,n:integer;
+    k:array of boolean;
+begin
+
+  memo2.Clear;
+
+  setlength(k,memo1.lines.count);
+  for i:=0 to length(k)-1 do k[i]:=false;
+
+  m:=0;
+  while m<length(k) do
+    begin
+    n:=random(memo1.Lines.count);
+    if not k[n] then
+      begin
+      memo2.Lines.Add(memo1.Lines.Strings[n]);
+      k[n]:=true;
+      inc(m);
+      end;
+    end;
+
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+
+  randomize;
+
+end;
+
+procedure TForm1.Button2Click(Sender: TObject);
+var durchlaufe,tauschs,i:integer;
+    sortlist:TSortList;
+begin
+
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  BubbleDesc(tauschs,durchlaufe,sortlist);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button3Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  QuickSortDesc(0,length(sortlist)-1,sortlist);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button4Click(Sender: TObject);
+var i,tauschs,durchlaufe:integer;
+    sortlist:TSortList;
+begin
+
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  BubbleAsc(tauschs,durchlaufe,sortlist);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+  
+end;
+
+procedure TForm1.Button5Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  QuickSortAsc(0,length(sortlist)-1,sortlist);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button6Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  ShellSortAsc(sortList);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button7Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  ShellSortDesc(sortList);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button8Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  MinSortAsc(sortList);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button9Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  MinSortDesc(sortList);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button10Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  HeapSortAsc(sortList);
+
+  for i:=0 to length(sortlist)-1 do memo2.lines.Strings[i]:=sortlist[i];
+
+end;
+
+procedure TForm1.Button11Click(Sender: TObject);
+var i:integer;
+    sortlist:TSortList;
+begin
+  setlength(sortlist,memo2.Lines.Count);
+  for i:=0 to memo2.Lines.Count-1 do sortlist[i]:=memo2.lines.Strings[i];
+
+  HeapSortAsc(sortList);
+
+  for i:=length(sortlist)-1 downto 0 do memo2.lines.Strings[length(sortlist)-1-i]:=sortlist[i];
+
+end;
+
+end.

usort.pas

@@ -0,0 +1,281 @@
+unit usort;
+
+interface
+
+uses forms;
+
+type TSortList = array of string;
+
+procedure BubbleAsc(var tauschs,durchlaufe:integer;var SortList:TSortList);
+procedure BubbleDesc(var tauschs,durchlaufe:integer;var SortList:TSortList);
+procedure QuickSortAsc(erstes,letztes : integer;var SortList:TSortList);
+procedure QuickSortDesc(erstes,letztes : integer;var SortList:TSortList);
+procedure ShellSortAsc(var SortList:array of string);
+procedure ShellSortDesc(var SortList:array of string);
+procedure MinSortAsc(var SortList: array of string);
+procedure MinSortDesc(var SortList: array of string);
+procedure HeapSortAsc(var SortList:array of string);
+
+implementation
+
+procedure BubbleAsc(var tauschs,durchlaufe:integer;var SortList:TSortList);
+var i,j:integer;
+    zwischen:string;
+begin
+  durchlaufe:=0;
+  tauschs:=0;
+  for i := length(SortList)-1 downto 1 do
+    begin
+    for j := 0 to i-1 do
+      begin
+      if (SortList[j]) >(SortList[j+1]) then
+        begin
+        zwischen := SortList[j];
+        SortList[j] := SortList[j+1];
+        SortList[j+1] := zwischen;
+        inc(tauschs);
+        Application.ProcessMessages;
+        end;
+      end;
+    inc(durchlaufe);
+    Application.ProcessMessages;
+    end;
+
+end;
+
+procedure BubbleDesc(var tauschs,durchlaufe:integer;var SortList:TSortList);
+var i,j:integer;
+    zwischen:string;
+begin
+  durchlaufe:=0;
+  tauschs:=0;
+  for i := length(SortList)-1 downto 1 do
+    begin
+    for j := 0 to i-1 do
+      begin
+      if (SortList[j]) < (SortList[j+1]) then
+        begin
+        zwischen := SortList[j];
+        SortList[j] := SortList[j+1];
+        SortList[j+1] := zwischen;
+        inc(tauschs);
+        Application.ProcessMessages;
+        end;
+      end;
+    inc(durchlaufe);
+    Application.ProcessMessages;
+    end;
+
+end;
+
+procedure QuickSortDesc(erstes,letztes : integer;var SortList:TSortList);
+function Divide(erstes, letztes : integer;var SortList:TSortList) : integer;
+procedure Change(a, b : integer;var SortList:TSortList);
+var Dummy : string;
+begin
+   Dummy := SortList[a];
+   SortList[a] := SortList[b];
+   SortList[b] := Dummy;
+//   inc(Changes);
+end;
+var i,j,pivot: integer;
+begin
+   i := erstes-1;
+   j := letztes ;
+   pivot := letztes;
+   while true do begin
+     inc(i);
+     while SortList[i] > SortList[pivot] do inc(i);
+     dec(j);
+     while (SortList[pivot] > SortList[j]) and (j > erstes) do dec(j);
+     if i >= j then break;
+     Change(i, j,sortlist);
+   end;
+   Change(i, pivot,sortlist);
+   result :=  i;
+end;
+
+var teiler : integer;
+begin
+
+   if letztes > erstes then
+     begin
+     teiler := Divide(erstes, letztes,SortList);
+     quicksortdesc(erstes, teiler-1,SortList);
+     quicksortdesc(teiler+1, letztes,SortList);
+     end;
+
+end;
+
+procedure QuickSortAsc(erstes,letztes : integer;var SortList:TSortList);
+function Divide(erstes, letztes : integer;var SortList:TSortList) : integer;
+procedure Change(a, b : integer;var SortList:TSortList);
+var Dummy : string;
+begin
+   Dummy := SortList[a];
+   SortList[a] := SortList[b];
+   SortList[b] := Dummy;
+//   inc(Changes);
+end;
+var i,j,pivot: integer;
+begin
+   i := erstes-1;
+   j := letztes ;
+   pivot := letztes;
+   while true do begin
+     inc(i);
+     while SortList[i] < SortList[pivot] do inc(i);
+     dec(j);
+     while (SortList[pivot] < SortList[j]) and (j > erstes) do dec(j);
+     if i >= j then break;
+     Change(i, j,sortlist);
+   end;
+   Change(i, pivot,sortlist);
+   result :=  i;
+end;
+
+var teiler : integer;
+begin
+
+   if letztes > erstes then
+     begin
+     teiler := Divide(erstes, letztes,SortList);
+     quicksortasc(erstes, teiler-1,SortList);
+     quicksortasc(teiler+1, letztes,SortList);
+     end;
+
+end;
+
+procedure ShellSortAsc(var SortList:array of string);
+var
+  i, j, h, N: integer;
+  v: string;
+begin
+  N := length(SortList)-1;
+  h := 0;
+  repeat
+    h := ( 3 * h ) + 1;
+  until h > N;
+  repeat
+    h := ( h div 3 );
+    for i := ( h + 1) to N do begin
+      v := SortList[i];
+      j := i;
+      while ( ( j >= h ) and ( SortList[j-h] > v ) ) do begin
+        SortList[j] := SortList[j - h];
+        dec( j, h );
+      end;
+      SortList[j] := v;
+    end;
+  until
+    h = 1;
+end;
+
+procedure ShellSortDesc(var SortList:array of string);
+var
+  i, j, h, N: integer;
+  v: string;
+begin
+  N := length(SortList)-1;
+  h := 0;
+  repeat
+    h := ( 3 * h ) + 1;
+  until h > N;
+  repeat
+    h := ( h div 3 );
+    for i := ( h + 1 ) to N do begin
+      v := SortList[i];
+      j := i;
+      while ( ( j >=     h ) and ( SortList[j-h] < v ) ) do begin
+        SortList[j] := SortList[j - h];
+        dec( j, h );
+      end;
+      SortList[j] := v;
+    end;
+  until
+    h = 1;
+end;
+
+procedure MinSortAsc(var SortList: array of string);
+var
+  i, j     : LongInt;  { Zaehlvariablen }
+  Min: LongInt;  { Zwischenspeicher, Minimum }
+  Temp:string;
+begin
+  for i := 0 to High(SortList) - 1 do
+    begin
+    Min := i;
+    for j := i + 1 to High(SortList) do
+      if SortList[j] < SortList[Min] then Min := j;
+    Temp := SortList[Min];
+    SortList[Min] := SortList[i];
+    SortList[i] := Temp;
+    end;
+end;
+
+procedure MinSortDesc(var SortList: array of string);
+var
+  i, j     : LongInt;  { Zaehlvariablen }
+  Min: LongInt;  { Zwischenspeicher, Minimum }
+  Temp:string;
+begin
+  for i := 0 to High(SortList) - 1 do
+    begin
+    Min := i;
+    for j := i + 1 to High(SortList) do
+      if SortList[j] > SortList[Min] then Min := j;
+    Temp := SortList[Min];
+    SortList[Min] := SortList[i];
+    SortList[i] := Temp;
+    end;
+end;
+
+procedure HeapSortAsc(var SortList:array of string);
+
+    procedure genheap(var f:array of string; var heapsize:integer);             { Heap (mit linearem Aufwand) aufbauen }
+    var i,j,max:integer;
+    var temp:String;
+    begin
+        for i := (heapsize div 2) downto 0 do begin   { zweite Hälfte des Feldes braucht nicht betrachtet werden }
+            j:=i;
+            while j <= (heapsize div 2) do begin
+                max := j * 2 + 1;               { finde Maximum der (beiden) Söhne }
+                if max > heapsize then dec(max)
+                else if f[max-1] > f[max] then dec(max);
+                if f[j] < f[max] then begin     { ggf. tauschen }
+                    temp := f[j];
+                    f[j] := f[max];
+                    f[max] := temp;
+                end;
+                j := max;
+            end;
+        end;
+    end;
+
+    function popmax(var f:array of string;heapsize:integer):String;
+    var i,max:integer;
+    var temp:String;
+    begin
+        popmax := f[1];
+        f[1] := f[heapsize];
+        i := 1;
+        while i <= (heapsize div 2) do begin { letztes Element an Anfang setzen und versickern lassen }
+            max := i * 2 + 1;               { finde Maximum der (beiden) Söhne }
+            if max > heapsize then dec(max)
+            else if f[max-1] > f[max] then dec(max);
+            if f[i] < f[max] then begin     { ggf. tauschen }
+                temp := f[i];
+                f[i] := f[max];
+                f[max] := temp;
+            end;
+            i := max;
+        end;
+    end;
+   var i,SIZE:integer;
+begin
+    SIZE := Length(SortList)-1;
+    genheap(SortList,SIZE);
+    for i:=SIZE downto 0 do SortList[i] := popmax(SortList,i);
+end;
+
+end.