Zerlegesortieren - Probleme (ungültige Zeigeroperation)

[tankm26]

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:

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

mfg


Wieland Sommer