unit USort;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
mZahlenGeneriert: TMemo;
mBubbleSort: TMemo;
mInsertionSort: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
btnBubbleSort: TButton;
btnInsertionSort: TButton;
edZeitBubble: TEdit;
Label4: TLabel;
Label5: TLabel;
edZeitInsert: TEdit;
Label6: TLabel;
edDurchgaengeBubble: TEdit;
edDurchgaengeInsert: TEdit;
Label7: TLabel;
Label8: TLabel;
Panel1: TPanel;
btnZahlengenerieren: TButton;
edAnzahl: TEdit;
Label9: TLabel;
Label10: TLabel;
Panel2: TPanel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Button1: TButton;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
mQuickSort: TMemo;
Label25: TLabel;
mHeapSort: TMemo;
Label26: TLabel;
btnHeapSort: TButton;
Label27: TLabel;
Label28: TLabel;
edZeitQuick: TEdit;
Label29: TLabel;
Label30: TLabel;
edDurchgaengeQuick: TEdit;
Label31: TLabel;
edZeitHeap: TEdit;
Label32: TLabel;
Label33: TLabel;
edDurchgaengeHeap: TEdit;
btnQuickSort: TButton;
procedure btnZahlengenerierenClick(Sender: TObject);
procedure btnBubbleSortClick(Sender: TObject);
procedure btnInsertionSortClick(Sender: TObject);
procedure btnQuickSortClick(Sender: TObject);
procedure btnHeapSortClick(Sender: TObject);
procedure edAnzahlChange(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure HeapSort(
var A:
array of Integer);
procedure QuickSort(
var A:
array of Integer);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
a:
array[1..1000]
of integer;
b:
array[1..1000]
of integer;
c:
array[1..1000]
of integer;
d:
array[1..1000]
of integer;
Zahl:integer;
implementation
{$R *.dfm}
procedure TForm1.btnZahlengenerierenClick(Sender: TObject);
var i: integer;
begin
mBubbleSort.Clear;
mInsertionSort.Clear;
mQuickSort.Clear;
mHeapSort.Clear;
mZahlenGeneriert.Clear;
Zahl:=strtoint(edAnzahl.text);
randomize();
for i := 1
to 1000
do
begin
a[i]:=random(Zahl+1);
b[i]:=a[i];
c[i]:=a[i];
d[i]:=a[i];
mZahlenGeneriert.lines.Add(inttostr(a[i]));
btnBubbleSort.Enabled:=true;
btnInsertionSort.Enabled:=true;
btnQuickSort.Enabled:=true;
btnHeapSort.Enabled:=true;
end;
end;
procedure TForm1.btnBubbleSortClick(Sender: TObject);
var d,n,k,i, speicher : integer;
ZeitBubble: Cardinal;
begin
ZeitBubble:= GetTickCount;
d:= 0;
for k := 1
to 1000
do
begin
for n := 1
to 999
do
begin
if a[n] > a[n+1]
then
begin
speicher:= a[n+1];
a[n+1]:= a[n];
a[n]:= speicher;
d:=d+1;
end;
end;
end;
for i:= 1
to 1000
do mBubbleSort.Lines.Add(inttostr(a[i]));
edZeitBubble.text:= IntToStr(GetTickCount - ZeitBubble);
edDurchgaengeBubble.text:=IntToStr(d);
btnBubbleSort.Enabled:= false;
end;
procedure TForm1.btnInsertionSortClick(Sender: TObject);
var e,i,j,v, p : Integer;
ZeitInsert: Cardinal;
begin
ZeitInsert:= GetTickCount;
e:=0;
for i:= 1
to 1000
do begin
if a[i] < a[i-1]
then begin
j := i;
v := a[i];
while (v < a[j-1])
AND (j > 0)
do begin
a[j] := a[j-1];
dec(j);
end;
a[j] := v;
e:=+1;
end;
edZeitInsert.text:= IntToStr(GetTickCount - ZeitInsert);
end;
for p:=1
to 1000
do mInsertionSort.Lines.Add(IntToStr(a[p]));
edDurchgaengeInsert.Text:=InttoStr(e);
btnInsertionSort.Enabled:= false;
end;
procedure TForm1.btnQuickSortClick(Sender: TObject);
procedure QSort(LoIndex, HiIndex: Integer);
var
Lo, Hi: Integer;
Pivot: Integer;
Swap: Integer;
begin
// Wähle stets das mittlere Element als Pivot-Element
Pivot := d[(LoIndex + HiIndex)
div 2];
// Stelle die Ordnung bzgl. des Pivot-Elements her
Lo := LoIndex;
Hi := HiIndex;
repeat
while d[Lo] < Pivot
do Inc(Lo);
while d[Hi] > Pivot
do Dec(Hi);
if Lo <= Hi
then
begin
Swap := d[Lo];
d[Lo] := d[Hi];
d[Hi] := Swap;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
// ggf. linke Teilliste sortieren
if LoIndex < Hi
then QSort(LoIndex, Hi);
// ggf. rechte Teilliste sortieren
if Lo < HiIndex
then QSort(Lo, HiIndex);
end;
begin
QSort(Low(d), High(d));
end;
procedure TForm1.btnHeapSortClick(Sender: TObject);
procedure HeapSort(
var A:
array of Integer);
procedure Swap(
var X, Y: Integer);
var
Swp: Integer;
begin
Swp := X;
X := Y;
Y := Swp;
end;
procedure SiftDown(Current, MaxIndex: Integer);
var
Left, Right, Largest: Integer;
begin
Left := Low(A) + (2 * (Current - Low(A))) + 1;
Right := Low(A) + (2 * (Current - Low(A))) + 2;
Largest := Current;
if (Left <= MaxIndex)
and (A[Left] > A[Largest])
then Largest := Left;
if (Right <= MaxIndex)
and (A[Right] > A[Largest])
then Largest := Right;
if (Largest <> Current)
then
begin
Swap(A[Current], A[Largest]);
SiftDown(Largest, MaxIndex);
end;
end;
procedure Heapify();
var
Middle: Integer;
i: Integer;
begin
Middle := ((Low(A) + High(A) + 1)
div 2) - 1;
for i := Middle
downto Low(A)
do // Nur die Knoten, die Söhne haben!
SiftDown(i, High(A));
end;
var
i: Integer;
begin
Heapify();
for i := High(A)
downto Low(A) + 1
do
begin
Swap(A[i], A[Low(A)]);
SiftDown(Low(A), i - 1);
end;
end;
procedure TForm1.edAnzahlChange(Sender: TObject);
begin
if edAnzahl.text='
'
then
begin
MessageDlg('
Bitte tragen Sie einen Höchstzahlenwert für die Zufallszahlen ein!',
mtError, [mbOK], 0);
edAnzahl.text:='
1';
end;
if ((strtoint(edAnzahl.text) < 1)
or (strtoint(edAnzahl.text) > 1000))
then
begin
MessageDlg('
Die Werte müssen zwischen "1" und "1000" liegen!',
mtError, [mbOK], 0);
edAnzahl.text :='
1'
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x: TForm;
begin
x:= Dialogs.CreateMessageDialog('
Möchten Sie das Programm wirklich beenden?', dialogs.mtConfirmation,
dialogs.mbOKCancel);
if x.ShowModal = mrOK
then
close;
end;
end.