|
Registriert seit: 18. Sep 2004 Ort: Wentorf 87 Beiträge Delphi 7 Personal |
#1
Moin!
Mein Sortieren einer Liste mit dem sogenannten "Zerlege-Sortieren" funktioniert ab bestimmten Längen (ca. >320) nicht mehr. Warum, weiß ich leider nicht. Um allerdings weiterarbeiten zu können (Auswertung der Suchverfahren) bitte ich hier um Hilfe der dp-Comunity. Der Quellcode:
Delphi-Quellcode:
mfg
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 Wieland Sommer
Wieland S.
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |