|
Registriert seit: 19. Apr 2004 Ort: Berlin 8 Beiträge Delphi 7 Professional |
#1
Hmmm bin mir zwar nicht sicher ob das hier hinpasst aber naja...
Habe ein Programm zum Vergleichen von Sortieralgorithmen geschrieben und nun ergibt sich für den Vergleich ein Problem... Um eine Vergleichbarkeit zu erreichen werden mehrere Listen angelegt ... (eine für Zufallszahlen, eine mit sortierten Zahlen und eine mit umgekehrt sortierten Zahlen)... diese werden dann in die Liste eingetragen und irgendwie überschreiben sie sich gegenseitig oO ![]() Naja am besten ich pack mal den Code hier rein... Edit: Entschlackter Code: So hab es nochmal entschlackt und übersichtlicher gemacht, aber immer noch das selbe Problem mit dem Array ...
Delphi-Quellcode:
Die Unit USort:
unit Uhaupt;
interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, Grids, USort, ExtCtrls, Buttons; type TFAnwendung = class(TForm) MAnwendung: TMainMenu; MDatei: TMenuItem; MBeenden: TMenuItem; SGAusgabe: TStringGrid; Start: TBitBtn; procedure MBeendenClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure StartClick(Sender: TObject); private procedure Listengenerierung; procedure Sort(i, fall : integer; locliste:tliste); public { Public-Deklarationen } end; var FAnwendung : TFAnwendung; implementation {$R *.DFM} procedure TFAnwendung.FormCreate(Sender: TObject); begin SGAusgabe.Cells[0,0]:='Nr'; SGAusgabe.Cells[1,0]:='Zufall'; SGausgabe.Cells[2,0]:='BestCase'; SGausgabe.Cells[3,0]:='WorstCase'; SGausgabe.Cells[0,1]:='Bubble'; SGausgabe.Cells[0,2]:='Choice'; SGausgabe.Cells[0,3]:='Insert'; SGausgabe.Cells[0,4]:='Shaker'; SGausgabe.Cells[0,5]:='Mischen'; SGausgabe.Cells[0,6]:='Heap'; SGausgabe.Cells[0,7]:='Quick'; end; procedure TFanwendung.Sort(i, fall:integer; locliste:Tliste); Var c, t1, t2 : int64; t : integer; begin QueryPerformanceFrequency(c); QueryPerformanceCounter(t1); case i of 1 : LocListe.SortierenBubble; 2 : LocListe.SortierenChoice; 3 : LocListe.SortierenInsert; 4 : LocListe.SortierenShake; 5 : LocListe.SortierenMisch(0,Maxzahl); 6 : LocListe.SortierenHeap; 7 : LocListe.SortierenQuick(0,MaxZahl); end; QueryPerformanceCounter(t2); t := 1000000 *(t2 -t1) div c; SGausgabe.Cells[fall,i]:=IntToStr(t) +'mys'; end; procedure TFAnwendung.Listengenerierung; var zahl, i : integer; globleast, globbest, globrandom : tliste; begin globbest := Tliste.Create; globrandom := Tliste.Create; globleast := Tliste.Create; randomize; for i := maxzahl downto 1 do begin globleast.speichern(i); end; for i := 1 to maxzahl do begin globbest.speichern(i); end; for i := 1 to maxzahl do begin zahl:= random(60000); Globrandom.speichern(zahl); end; for i := 1 to 7 do begin Sort(i, 1, globrandom); <<< Hier ist das Problem... irgendwie wird die Random Liste überschrieben, obwohl das garnet möglich ist.... :(((( end; for i := 1 to 7 do begin Sort(i, 2, globbest); end; for i := 1 to 7 do begin Sort(i, 3, globleast); end; end; procedure TFAnwendung.StartClick(Sender: TObject); begin Listengenerierung; end; procedure TFAnwendung.MBeendenClick(Sender: TObject); begin Close; end; end. // of TFAnwendung
Delphi-Quellcode:
Irgendwie überschreiben sich die arrays gegenseitig...
unit usort;
interface const MaxZahl=1000; type TInhalt = word; TFeld = array[0..MaxZahl] of TInhalt; TListe = class(TObject) private wAnzahl : word; {Anzahl der Listeneinträge} f : TFeld; {Feld zum Speichern der Daten} procedure versickern(n: integer; var f : tfeld; knot: integer); procedure Tauschen(var a,b:word); procedure Mischen(links,mitte,rechts : word); public constructor Create; function Anzahl:word; {gibt die Anzahl der Listeneinträge zurück} procedure Leeren; {löscht alle Listeneinträge} procedure SortierenBubble; procedure SortierenInsert; procedure SortierenChoice; procedure SortierenQuick(links,rechts: integer); procedure SortierenHeap; procedure SortierenShake; procedure SortierenMisch(links, rechts : word); function Holen(wNr:word):TInhalt; procedure Speichern(sName:TInhalt); end; implementation constructor TListe.Create; begin wAnzahl:=0; end; function TListe.Anzahl:word; begin Anzahl:=wAnzahl end; procedure TListe.Leeren; var i : word; begin wAnzahl:=0; for i:=1 to MaxZahl do f[i]:=0; end; function TListe.Holen(wNr:word):TInhalt; begin Holen:=f[wNr]; end; procedure TListe.Speichern(sName:TInhalt); begin f[wAnzahl]:=sName; inc(wAnzahl); end; procedure TListe.SortierenBubble; var hilf : word; i,j : integer; begin for i := 1 to Anzahl - 1 do for j := 1 to Anzahl - i do if f[j] > f[j+1] then begin hilf := f[j]; f[j] := f[j+1]; f[j+1]:=hilf; end; end; procedure TListe.SortierenInsert; var i,j,v : Integer; Begin for i:= 2 to Anzahl do begin v:= f[i]; j:= i; while (j > 1) and (f[j-1] > v) Do begin f[j]:= f[j-1]; dec(j); end; f[j]:= v; end; end; procedure TListe.SortierenChoice; var i,j,minimum : integer; hilf : word; begin for i := 1 to Anzahl do begin minimum := i; for j := i+1 to Anzahl do if f[minimum] > f[j] then begin minimum := j; end; hilf := f[i]; f[i] := f[minimum]; f[minimum]:=hilf; end; end; procedure TListe.SortierenQuick(links,rechts: integer); var li,re,test,hilf: integer; begin li:=links;re:=rechts; (* Initialisierung der Marken *) test:=f[(li+re)div 2]; (* Festlegung des Testwerts *) while (li<=re) do begin while (f[li]<test) do li:=li+1;(* linke Marke wandert nach rechts, bis ...*) while (f[re]>test) do re:=re-1;(* rechte Marke wandert nach links, bis ...*) (* Fehlstellung suchen *) if (li<=re)then (* zur Speicherbelegungstabelle *) begin hilf:=f[li];f[li]:=f[re];f[re]:=hilf;(* Vertauschen der Werte *) li:= li+1; re:= re-1; (* Verschieben der Marken um eine Stelle *) end; end; if (links<re) then SortierenQuick(links,re); {linkes Teilfeld} { die Prozedur ruft sich selbst mit neuer linker Grenze wieder auf. -> Rekursion} if (li<rechts) then SortierenQuick(li,rechts); {rechtes Teilfeld} (* vorsortierte Teilfelder weiter sortieren *) end; procedure Tliste.Versickern(n: integer; var f : tfeld; knot: integer); var temp_knot_value, subknot: integer; begin temp_knot_value := f[knot]; while knot < n div 2 do begin subknot := 2*knot+1; if (subknot < n - 1) and (f[subknot] < f[subknot + 1]) then Inc(subknot); if temp_knot_value >= f[subknot] then break; f[knot] := f[subknot]; knot := subknot; end; f[knot] := temp_knot_value; end; {eigentlich Prozedur} procedure Tliste.SortierenHeap; var knot, temp, i: integer; begin i := Anzahl; knot := i div 2; while knot > 0 do begin Dec(knot); versickern(i, f, knot); end; while i >= 0 do begin temp := f[0]; f[0] := f[i]; f[i] := temp; versickern(i, f, 0); Dec(i); end; end; procedure TListe.SortierenMisch(links,rechts:word); var mitte : word; begin if links < rechts then begin mitte :=(links+rechts) div 2; // Trennelement ermitteln SortierenMisch(links,mitte); // rekursiver Aufruf (linke Liste) SortierenMisch(mitte+1,rechts); // rekursiver Aufruf (rechte Liste) Mischen(links,mitte,rechts); end; //of then end; //MischSort procedure TListe.Mischen(links,mitte,rechts : word); var hilf : TFeld; anf1,end1 : word; anf2,end2 : word; i : word; begin anf1:=links; end1:=mitte; //Grenzen der Teilfelder anf2:=mitte+1; end2:=rechts; i:=anf1; //Indexvariable für das Hilfsfeld while (anf1<=end1) and (anf2<=end2) do //Solange Teilliste > 1 Element begin if f[anf1]<f[anf2] then begin hilf[i]:=f[anf1];inc(anf1);inc(i); end else begin hilf[i]:=f[anf2];inc(anf2);inc(i); end; end; while (anf1 <= end1) do begin hilf[i]:=f[anf1];inc(anf1);inc(i); end; while (anf2 <= end2) do begin hilf[i]:=f[anf2];inc(anf2);inc(i); end; for i:=links to rechts do f[i]:=hilf[i]; //sortierte Liste zurückschreiben end; procedure TListe.SortierenShake; var j,l,stopper,i :integer; begin l:=1; stopper:=Maxzahl; repeat for i:=stopper downto (l+1) do if f[i-1]>f[i] then tauschen(f[i-1],f[i]); l := l + 1; stopper:=stopper-1; for j:=l to stopper do if f[j-1]>f[j] then tauschen(f[j-1],f[j]); until l>stopper; end; procedure TListe.Tauschen(var a, b: word); var temp : word; begin temp := a; a := b; b := temp; end; end. ![]() MFG
Sebastian
Wer Pfehler ![]() |
![]() |
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 |
![]() |
![]() |