From 02ac913f3264d1b1c94a7fd769cc5d844962be6d Mon Sep 17 00:00:00 2001 From: Ulf Gebhardt Date: Sat, 17 Feb 2018 14:34:31 +0100 Subject: [PATCH] Initial Commit --- GOETZ.pas | 263 ++++++ Sort.cfg | 35 + Sort.dpr | 14 + Sort.res | Bin 0 -> 876 bytes Unit1.dfm | 2655 +++++++++++++++++++++++++++++++++++++++++++++++++++++ Unit1.pas | 215 +++++ usort.pas | 281 ++++++ 7 files changed, 3463 insertions(+) create mode 100644 GOETZ.pas create mode 100644 Sort.cfg create mode 100644 Sort.dpr create mode 100644 Sort.res create mode 100644 Unit1.dfm create mode 100644 Unit1.pas create mode 100644 usort.pas diff --git a/GOETZ.pas b/GOETZ.pas new file mode 100644 index 0000000..6dac81f --- /dev/null +++ b/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. diff --git a/Sort.cfg b/Sort.cfg new file mode 100644 index 0000000..d42bcd6 --- /dev/null +++ b/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" diff --git a/Sort.dpr b/Sort.dpr new file mode 100644 index 0000000..3f63b3a --- /dev/null +++ b/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. diff --git a/Sort.res b/Sort.res new file mode 100644 index 0000000000000000000000000000000000000000..b111060100a5f025f8352346a52aa105dda315dc GIT binary patch literal 876 zcmaJ=Jxc>Y5Pj=~+s-6tVP#TUMl38+L=gfOYT+L^n{Cnvf+wW#s%rxNnLu)|%~k%6 zl$I$|i0j+gyL{lskhe2$=FRS8xdnhO;amX29sAg;>k&0dYOR)T)S?pxUE+dJsM75D z-7YQoTL`ZNskJunM9$J{ZiL4pI|=o`jj8rCvcaP(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.