unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TForm1 =
class(TForm)
ListBox1: TListBox;
btmischen: TButton;
btauswahl: TButton;
btende: TButton;
btaustausch: TButton;
bteinf: TButton;
btzerlege: TButton;
lauswahl: TLabel;
laustausch: TLabel;
leinfuege: TLabel;
ListBox2: TListBox;
btquicksort: TButton;
btgeben: TButton;
lquick: TLabel;
btmemory: TButton;
btwiederh: TButton;
StringGrid1: TStringGrid;
emax: TEdit;
btmax: TButton;
lmax: TLabel;
btzerlege2: TButton;
lzereinf: TLabel;
lzeraus: TLabel;
procedure FormCreate(Sender: TObject);
procedure btmischenClick(Sender: TObject);
procedure btendeClick(Sender: TObject);
procedure btaustauschClick(Sender: TObject);
procedure btauswahlClick(Sender: TObject);
procedure bteinfClick(Sender: TObject);
procedure btquicksortClick(Sender: TObject);
procedure btgebenClick(Sender: TObject);
procedure btmemoryClick(Sender: TObject);
procedure btwiederhClick(Sender: TObject);
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure btmaxClick(Sender: TObject);
procedure btzerlege2Click(Sender: TObject);
procedure btzerlegeClick(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure schreibediebox;
procedure zeitmessung(w,s:integer);
procedure Quick_Sort;
procedure wimageload;
procedure maxan(w:integer);
procedure zerlegesort(ws:integer);
procedure zMischen;
procedure zMinimum;
procedure zeinfuegesort(w,s:integer);
procedure zauswahlsort(w,s:integer);
{ Public-Deklarationen }
end;
var
Form1: TForm1;
mPunkt, hilfsliste, nummern,nummernsave:
array of Integer;
karten:
array of TBitmap;
max,AnzahlTeillisten,ss,lt,
// für zerlegesort (lt=Länge der Teillisten
hi,lu,x :integer;
//für squicksort
a,b1,c,b2:int64;
implementation
{$R *.dfm}
procedure tForm1.wimageload;
var w:integer;
begin
for w:=1
to 33
do begin
karten[w-1]:=TBitmap.Create;
karten[w-1].LoadFromFile(IntToStr(w)+'
.bmp');
end;
end;
procedure TForm1.zeitmessung(w,s:integer);
begin
if w=0
then begin
QueryPerformanceFrequency(a);
//Start
QueryPerformanceCounter(b1);
end;
if w=1
then begin
QueryPerformanceCounter(b2);
if s=1
then lauswahl.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=2
then laustausch.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=3
then leinfuege.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=4
then lzereinf.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=5
then lauswahl.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=6
then lquick.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
if s=7
then lzeraus.Caption:=format('
Zeit: %g s',[(b2-b1)/a]);
end;
end;
procedure TForm1.schreibediebox;
var w:integer;
begin
form1.listbox1.Clear;
for w:=0
to max-1
do form1.ListBox1.Items.Add(inttostr(nummern[w]));
stringgrid1.Refresh;
end;
procedure TForm1.maxan(w:integer);
begin
max:=w;
Setlength(nummern,max+1);
SetLength(nummernsave,max);
SetLength(mPunkt,max);
SetLength(hilfsliste,max);
SetLength(karten,max+1);
for w:=1
to max
do
nummern[w-1]:=w;
schreibediebox;
listbox2.Clear;
form1.btwiederh.Enabled:=false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
maxan(32);
form1.wimageload;
end;
procedure TForm1.btmischenClick(Sender: TObject);
var w,x,j:integer;
begin
for w:=0
to max-1
do begin
j:=Random(max);
X:=nummern[w];
nummern[w]:=nummern[j];
nummern[j]:=x;
end;
schreibediebox;
form1.listbox2.Clear;
for w:=0
to max-1
do form1.ListBox2.Items.Add(inttostr(nummern[w]));
end;
procedure TForm1.btendeClick(Sender: TObject);
begin
close;
end;
procedure TForm1.btaustauschClick(Sender: TObject);
var
ws,i:integer;
tt: boolean;
begin
// bubble sort
// Das Feld wird von vorne durchgegangen, die Elemente werden bei Größenunterschied getauscht.
// Dieses wird solange durchgeführt, bis kein Feld -2 vom Ende aus mehr zu tauschen ist.
zeitmessung(0,2);
repeat
tt:=true;
for i:=0
to max-2
do begin
if nummern[i]>nummern[i+1]
then begin
ws:=nummern[i];
nummern[i]:=nummern[i+1];
nummern[i+1]:=ws;
tt:=false;
end;
end;
until tt;
zeitmessung(1,2);
schreibediebox;;
end;
procedure TForm1.btauswahlClick(Sender: TObject);
var ws,i,q,a:integer;
begin
//Auswahlsort.
//Hier wird, vom Anfang des arrays aus, das jeweils kleinste Element herausgesucht und der unsor-
//tierten Teilliste hinzugefügt. Dieses wird für jedes Feld bis zum -2. vom Ende aus durchgeführt.
zeitmessung(0,1);
for i:=0
to max-2
do begin
q:=i;
for ws:=i+1
to max-1
do
if nummern[ws]<nummern[q]
then
q:=ws;
a:=nummern[i];
nummern[i]:=nummern[q];
nummern[q]:=a;
end;
zeitmessung(1,1);
schreibediebox;
end;
procedure TForm1.bteinfClick(Sender: TObject);
var i,j,x:integer;
begin
//Einfügesort.
//Dem sortierten Bereich wird jeweils das 1. Element aus dem unsortierten Teil an der
//richtigen Stelle hinzugefügt.
zeitmessung(0,3);
for i:=1
to max-1
do begin
x:=nummern[i];
j:=i-1;
while (x<nummern[j])
and (j>(-1))
do begin
nummern[j+1]:=nummern[j];
dec(j);
end;
nummern[j+1]:=x;
zeitmessung(1,3);
end;
schreibediebox;
end;
procedure tForm1.Quick_Sort;
// Quicksort
//Das vornehmlich mittlere Feld wird als Referenzwert des unsort. Feldes herausgesucht,
// suchen uns in Feld links von Referenzwert das erste größere von links aus,
//entsprechend wird auf der anderen seite verfahren. Dieses Teilen des Feldes wird solange
//durchgeführt, bis alle Teilfelder "1" lang sind.
procedure QuickSort(iLo, iHi: Integer);
var
Lo, Hi, Mid, T: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := nummern[(Lo + Hi)
div 2];
repeat
while nummern[Lo] < Mid
do Inc(Lo);
while nummern[Hi] > Mid
do Dec(Hi);
if Lo <= Hi
then
begin
T := nummern[Lo];
nummern[Lo] := nummern[Hi];
nummern[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo
then QuickSort( iLo, Hi);
if Lo < iHi
then QuickSort( Lo, iHi);
end;
begin
QuickSort(Low(nummern), High(nummern));
end;
procedure TForm1.zeinfuegesort(w,s:integer);
var i,x,j:integer;
begin
for i:=w+1
to s
do begin
x:=nummern[i];
j:=i-1;
while (x<nummern[j])
and (j>(w-1))
do begin
nummern[j+1]:=nummern[j];
dec(j);
end;
nummern[j+1]:=x;
end;
end;
procedure TForm1.zauswahlsort(w,s:integer);
var ws,i,q,a:integer;
begin
for i:=w
to s-1
do begin
q:=i;
for ws:=i+1
to s
do
if nummern[ws]<nummern[q]
then
q:=ws;
a:=nummern[i];
nummern[i]:=nummern[q];
nummern[q]:=a;
end;
end;
procedure TForm1.zerlegesort(ws:integer);
var k,i,NeuAnzahl:integer;
begin
zeitmessung(0,4);
lt:=Trunc(2*sqRt(max));
// LÄNGE DER TEILLISTEN bei 1000 = 63
AnzahlTeillisten:=Trunc(max
div lt);
//bei 1000 = 15
if AnzahlTeillisten*lt<max
then // 945<1000
AnzahlTeillisten:=AnzahlTeillisten+1;
// 15->16
NeuAnzahl:=AnzahlTeillisten*lt;
// 1008
for i:=max
to NeuAnzahl-1
do // 1000-1007
nummern[i]:=MaxInt;
k:=1;
repeat
if ws=0
then zeinfuegesort(k-1,k+lt-2);
// 1.: 0-62 2.: 63-125 letzter: -1008
if ws=1
then zauswahlsort(k-1,k+lt-2);
k:=k+lt;
until k>=(NeuAnzahl+1);
zmischen;
if ws=0
then zeitmessung(1,4);
if ws=1
then zeitmessung(1,7);
for i:=0
to max-1
do
nummern[i]:=hilfsliste[i];
schreibediebox;
end;
procedure TForm1.zMischen;
var i:integer;
begin
for i:=0
to AnzahlTeillisten-1
{bei 1000= 0 bis 15} do //Startpositionen für'n Zeiger festlegen
mPunkt[i]:=i*lt;
// an d. erste stelle des jew. teilelementes setzen
for i:=0
to max-1
do begin
zminimum;
hilfsliste[i]:=nummern[mPunkt[ss]];
mPunkt[ss]:=mPunkt[ss]+1;
end;
end;
procedure TForm1.zMinimum;
var min,i:integer;
begin
min:=MaxInt;
ss:=0;
for i:=0
to AnzahlTeillisten-1
do
if mPunkt[i]<=((i+1)*lt-1)
then // wenn jeder zeiger noch am Startpunkt ist
if nummern[mPunkt[i]]<Min
then begin // wenn außerdem das an der jeweiligen ersten stelle
//liegende Element kleineer als min ist
min:=nummern[mPunkt[i]];
ss:=i;
end;
end;
procedure TForm1.btquicksortClick(Sender: TObject);
begin
zeitmessung(0,6);
Quick_Sort;
zeitmessung(1,6);
schreibediebox;
//stringgrid1.Refresh;
end;
procedure TForm1.btgebenClick(Sender: TObject);
var w:integer;
begin
for w:=1
to max
do begin
nummern[w-1]:=w;
end;
schreibediebox;
end;
procedure TForm1.btmemoryClick(Sender: TObject);
var w:integer;
begin
for w:=0
to max-1
do nummernsave[w]:=nummern[w];
form1.btwiederh.Enabled:=true;
end;
procedure TForm1.btwiederhClick(Sender: TObject);
var w:integer;
begin
for w:=0
to max-1
do nummern[w]:=nummernsave[w];
schreibediebox;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var w:integer;
begin
if max=32
then
for w:=0
to 31
do
if nummern[Acol]=(w+1)
then stringgrid1.Canvas.Draw(rect.left, rect.top, Karten[w]);
end;
procedure TForm1.btmaxClick(Sender: TObject);
begin
if not (emax.Text='
')
then begin
maxan(StrToInt(emax.Text));
lmax.Caption:=('
max= '+(emax.Text));
end else
showmessage('
Nö! Geben Sie einen gültigen Integerwert ein!');
end;
procedure TForm1.btzerlege2Click(Sender: TObject);
begin
zerlegesort(1);
end;
procedure TForm1.btzerlegeClick(Sender: TObject);
begin
zerlegesort(0);
end;
end.
fürs Zerlegesort:
Länge der liste: n (4/n soll "glatt" möglich sein) bei mir zur besseren ÜPbersichtlichkeit max
Anzhl Teillisten: t:=4 bei mir zur besseren ÜPbersichtlichkeit "anzahlteillisten"
Länge der Teillisten: lt
Hilfsliste: (sortierte Liste)
Zeigerstellungsarray: mPunkt:
array