Quick- und Zerlegedort - und beide funktionieren nicht

[tankm26]

Moin!

Im angehängten Programm habe ich Probleme, ein Zerlegesortieren sowie das Quicksort-Verfahren einzubauen.

Beim Zerlegeverfahren wird zunächst die Anzahl der Teilintervalle ermittelt, diese dann einzeln sortiert (und bis hier funktionierts!) und schließlich soll deplphi jeweils das erste besetzte Feld der Teilfelder miteinandervergleichen und das Feld mit dem kleinsten Inhalt ermitteln. Der Inhalt dieses Feldes wird dann an die erste freie Stelle der Hilfsliste geschrieben. So soll ein gesamtes array schneller sortiert werden.
Mein Programm hängt sich stets an der Stelle des Herauskopierens auf, was läuft da falsch?


Das Quicksortverfahren lässt stets einzelne Zahlen aus - was läuft da verkehrt?


Danke schonmal für eure Hilfe,

Wieland

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    btmischen: TButton;
    btauswahl: TButton;
    btende: TButton;
    btaustausch: TButton;
    bteinf: TButton;
    bteinf2: TButton;
    btzerlege: TButton;
    lauswahl: TLabel;
    laustausch: TLabel;
    leinfuege: TLabel;
    lw: TLabel;
    lzerlege: TLabel;
    ListBox2: TListBox;
    btquicksort: TButton;
    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 btzerlegeClick(Sender: TObject);
    procedure btquicksortClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    procedure schreibediebox;
    procedure zeitmessung(w,s:integer);
    procedure Quick_Sort;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  mPunkt, hilfsliste, nummern: array of Integer;
  max,t:integer;
  a,b1,c,b2:int64;

implementation

{$R *.dfm}

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 lzerlege.Caption:=format('Zeit: %g s',[(b2-b1)/a]);
    if s=5 then lauswahl.Caption:=format('Zeit: %g s',[(b2-b1)/a]);
  end;
end;

procedure TForm1.schreibediebox;
var w:integer;
begin
  form1.listbox1.Clear;
  form1.listbox2.Clear;
  for w:=0 to max-1 do form1.ListBox1.Items.Add(inttostr(nummern[w]));
  for w:=0 to max-1 do form1.ListBox2.Items.Add(inttostr(nummern[w]));
end;

procedure TForm1.FormCreate(Sender: TObject);
var w:integer;
begin
  max:=32;
  Setlength(nummern,max);
  SetLength(mPunkt,max);
  SetLength(hilfsliste,max);
  for w:=1 to max do begin
    nummern[w-1]:=w;
  end;
  schreibediebox;
end;

procedure TForm1.btmischenClick(Sender: TObject);
var w,x,j:integer;
begin
  Randomize;
  for w:=0 to max-1 do begin
    j:=Random(max)+1;
    X:=nummern[w-1];
    nummern[w-1]:=nummern[j-1];
    nummern[j-1]:=x;
  end;
  schreibediebox;
end;

procedure TForm1.btendeClick(Sender: TObject);
begin
  close;
end;

procedure TForm1.btaustauschClick(Sender: TObject);
var
  ws,i:integer;
  tt: boolean;
begin
  zeitmessung(0,2);
// bubble sort
   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
  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
  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;
 
 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.btzerlegeClick(Sender: TObject);
var d,a,ws,q,i,j,b:integer;
begin
  zeitmessung(0,4);
  if max mod 4 =0 then begin      // Feststellung der Anzalh der Teilintervalle
    t:=max div 4;
    lw.Caption:=IntToStr(t);
    for q:=0 to max-1 do begin        //Übertragung des 1.arrays in das "rechenfeld"
      mPunkt[q]:=nummern[q];
      nummern[q]:=0;
      Hilfsliste[q]:=0;
    end;

    for b:=0 to t-1 do begin   // Anzahl der Durchgänge festlegen
      j:=0+(b*4);       // Anzahl der Durchgänge festlegen
      for i:=j to j+2 do begin  // ab hier: Teilintervalle sortieren
        d:=i;
        for ws:=i+1 to j+3 do
        if mPunkt[ws]<mPunkt[d] then
         d:=ws;
        a:=mPunkt[i];
        mPunkt[i]:=mPunkt[d];
        mPunkt[d]:=a;
      end;
    end;
    
    ws:=0; // hier geht's weiter mit dem "Zusammenfügen"
    repeat
      for i:=0 to 3 do begin
        for a:=0 to t-1 do begin
          b:=nummern[a];
          if (b<(3-a))and((mPunkt[(b+a*4+i)])=(ws+1))and(ws<32)  then begin
            Hilfsliste[ws]:=ws+1;
            ws:=ws+1;
            lw.Caption:=IntToStr(ws);
            nummern[a]:=b+1;
            mPunkt[b+a*4+i]:=33;
          end;
        end;
      end;
    until ws=31;

  form1.listbox2.Clear;
  for q:=0 to max-1 do begin         // Zurückkopieren in das nummerarray
   //nummern[q]:=hilfsliste[q];
   form1.ListBox2.Items.Add(inttostr(hilfsliste[q]));
  end;
  zeitmessung(1,4);
  end else
  showmessage('Mit dem aktuellen "MAX" geht das nicht!');
end;

procedure TForm1.btquicksortClick(Sender: TObject);
var q:integer;
begin
  Quick_Sort;
  form1.listbox1.Clear;
  for q:=0 to max-1 do 
   form1.ListBox1.Items.Add(inttostr(nummern[q]));
end;

end.

fürs Zerlegesort:
Länge der liste: n (4/n soll "glatt" möglich sein)

Anzhl Teillisten: t:=4

(Länge der Teillisten: lt)

Hilfsliste: (sortierte Liste)

mPunkt: array

[H4ndy]

Wenn du Range-Checking angehabt hättest in deinem Projekt oder dir deinen Code
nochmal genau angesehen hättest, dass wärst du vielleicht über deine Misch-Funktion
gestolpert

Delphi-Quellcode:

procedure TForm1.btmischenClick(Sender: TObject);
var w,x,j:integer;
begin
  Randomize;
  for w:=0 to max-1 do begin
    j:=Random(max)+1;
    X:=nummern[w-1];
    nummern[w-1]:=nummern[j-1];
    nummern[j-1]:=x;
  end;
  schreibediebox;
end;

Durch w := 0 to machst du eine korrekte Schleife für dynamische Arrays.
Allerdings greifst du dann mit nummern[w-1] in ersten Durchlauf auf nummern[-1] zu,
was dein Array zerstört und z.B. auf 9 Elemente kürzen kann, da du die interne
Größen-Angabe überschreibst im Speicher.

Wenn du die Funktion so umschreibst funktioniert alles (hab zumindest QuickSort getestet):

Delphi-Quellcode:

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;
end;

Du musst bei dynamischen Arrays höllisch auf den Index achten ^^
(Zumal dein Code mit den vielen Ein-Buchstaben-Variablen glatt als C++-Code durchgehen würde )

Achso: Die vielen globalen Variablem machen deine Code sehr unübersichtlich und fehleranfällig.
Versuche mal mehr mit Parametern und eigenen Typen zu hantieren.

[tankm26]

Danke, H4ndy!

Mein Zerlegesort. funzt leider noch nicht.....muss ich mich wohl nochmal "ranmachen".

Aber es ist gut, dass Quicksortieren jetzt funktioniert!