Sortierung unwirksam

[Neutral General]

Hi,

Ich hab eine Liste abgeleitet von TList mit Items die je zwei Integerwerte enthalten.
Ich hab mal was vereinfachtes nachprogrammiert. Angenommen wir haben eine TPointList mit Items vom Typ PPoint. Jetzt will ich diese Liste nach den y-Werten der Punkte sortieren. Dazu benutze ich Quicksort.
Hier erstmal der Quelltext:

Delphi-Quellcode:

interface

type
  PPoint = ^TPoint;

  TPointList = class(TList)
  private
    function GetItem(Index: Integer): PPoint;
    procedure SetItem(Index: Integer; const Value: PPoint)
  public
    function Add(APoint: PPoint): Integer;
    property Items[Index: Integer]: PPoint read GetItem write SetItem; default;
  end;

Implementation der Liste:

Delphi-Quellcode:

{ TPointList }

function TPointList.Add(APoint: PPoint): Integer;
begin
  Result := inherited Add(APoint);
end;

function TPointList.GetItem(Index: Integer): PPoint;
begin
  Result := PPoint(inherited Items[Index]);
end;

procedure TPointList.SetItem(Index: Integer; const Value: PPoint);
begin
  inherited Items[Index] := Value;
end;

Eigentlicher Quellcode:

Delphi-Quellcode:

var list: TPointList;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  tmp: PPoint;
begin
  List := TPointList.Create; 
  for i := 1 to 30 do  // Liste mit zufälligen Punkten füllen
  begin
    New(tmp);
    tmp^.X := random(256);
    tmp^.Y := random(256);
    List.Add(tmp);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
begin  
  // Unsortiert anzeigen
  for i:=0 to List.Count-1 do
    Listbox1.Items.Add('(' + IntToStr(List[i]^.X) + '|' + IntToStr(List[i]^.Y) + ')');
  // Sortieren
  SortList(list,0,List.Count-1); 
  // Sortiert anzeigen
  for I := 0 to List.Count - 1 do
    Listbox2.Items.Add('(' + IntToStr(List[i]^.X) + '|' + IntToStr(List[i]^.Y) + ')');
end;

// Quicksort
procedure SortList(var AList: TPointlist; l,r: Integer);

  function Divide(s,t: Integer): Integer;
  var i,j: Integer;
      pivot: Integer;
      tmp: PPoint;
  begin
    i := s-1;
    j := t+1;
    pivot := AList[t]^.Y;
    repeat
      repeat
        inc(i)
      until AList[i]^.Y >= pivot;

      repeat
        dec(j);
      until AList[j]^.y <= pivot;

      tmp := AList[i];
      AList[i] := AList[j];
      AList[j] := tmp;
    until i <= j;
    tmp := AList[i];
    AList[i] := AList[j];
    AList[j] := tmp;

    Result := i;
  end;

var m: Integer;
begin
  if l < r then
  begin
    m := Divide(l,r);
    SortList(AList,l,m-1);
    SortList(AList,m+1,r);
  end;
end;

Dummerweise stehn in beiden Listboxen das gleiche. Die Liste wird einfach nicht sortiert. Habe mal mit Breakpoints in der Quicksort procedure geguckt und da wird alles Ordnungsgemäß ausgetauscht. Ach ja: Es ist wichtig das die Pointer ausgetauscht werden und nicht nur die Werte selbst!

Ich versteh jetzt nicht was da schief läuft...

Gruß
Neutral General

[RavenIV]

Soweit ich weiss, geht das einfacher.

Zitat:

Zitat von Delphi-7-Hilfe

Mit Sort wird für die Liste ein QuickSort-Algorithmus gestartet, der auf der Vergleichsfunktion Compare basiert.

Delphi-Syntax:

procedure Sort(Compare: TListSortCompare);

C++ Syntax:

void __fastcall Sort(TListSortCompare Compare);

Beschreibung

Mit Sort können die Elemente des Arrays Items sortiert werden. Compare ist eine Vergleichsfunktion, die anzeigt, wie die Elemente sortiert sind.

Zitat:

Zitat von Delphi-7-Hilfe

Der Typ TListSortCompare wird für Callback-Routinen verwendet, die zwei Listeneinträge miteinander vergleichen.

Unit

Classes

Delphi-Syntax:

type TListSortCompare = function (Item1, Item2: Pointer): Integer;

C++ Syntax:

typedef int __fastcall (*TListSortCompare)(void * Item1, void * Item2);

Beschreibung

TListSortCompare ist eine Vergleichsfunktion, die einen positiven Wert zurückgibt, wenn Item1 kleiner als Item2 ist. Der Rückgabewert ist Null, wenn beide Einträge gleich sind. Wenn Item1 größer als Item2 ist, ist der Rückgabewert negativ.

Wert Beschreibung

> 0 (positiv) Item1 ist kleiner als Item2
0 Item1 ist gleich Item2
< 0 (negativ) Item1 ist größer alsItem2

Zitat:

Zitat von Delphi-7-Hilfe

Der folgende Code sortiert die Objekte einer Liste in alphabetischer Reihenfolge. Dabei wird vorausgesetzt, dass die Liste nur Komponentenreferenzen enthält.
Die Funktion CompareNames führt den Vergleich der Objekte durch. Wenn der Benutzer eine Schaltfläche anklickt, wird die Sortierung ausgeführt.

function CompareNames(Item1, Item2: Pointer): Integer;
begin
Result := CompareText((Item1 as TComponent).Name, (Item2 as TComponent).Name);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List1.Sort(@CompareNames);
end;

[Neutral General]

Ja theoretisch schon aber das Problem ist:

Ich will selbst sortieren. Vorallem weil wie gesagt nicht die Werte vertauscht werden sollen sondern die Pointer. Das ist wichtig!

[RavenIV]

Zitat:

Zitat von Neutral General

Ja theoretisch schon aber das Problem ist:

Ich will selbst sortieren. Vorallem weil wie gesagt nicht die Werte vertauscht werden sollen sondern die Pointer. Das ist wichtig!

Was macht denn CompareNames?
Es arbeitet ja auch mit Pointern.

Und TList-intern wird dann ja erst sortiert.

[Neutral General]

Ehm ich hab jetzt nochmal ein Quicksort geschrieben. Also ich glaube langsam da will mich was verarschen...

Hier nochmal als Beispiel: Ein Array of TList (bzw ein Nachfahre davon). Ich will das Array nach der Anzahl der Elemente in den Listen sortieren.

Delphi-Quellcode:

type
  TCombis = Array of Tlist;

  procedure SortArray(var CombiArray: TCombis; l,r: Integer);

    function Divide(l,r: Integer): Integer;
    
      procedure Exchange(s,t: Integer);
      var tmp: TList;
      begin
        tmp := CombiArray[s];
        CombiArray[s] := CombiArray[t];
        CombiArray[t] := tmp;
      end;

    var i,j: Integer;
        pivot: Integer;
    begin
      i := l-1;
      j := r+1;
      pivot := CombiArray[r].Count;
      repeat
        repeat
          inc(i);
        until CombiArray[i].Count >= pivot;
        repeat
          dec(j);
        until CombiArray[j].Count <= pivot;
        Exchange(i,j);
      until i <= j;
      Exchange(i,j);
      Result := i;
    end;

  var m: Integer;
  begin
    if r > l then
    begin
      m := Divide(l,r);
      SortArray(CombiArray,l,m-1);
      SortArray(CombiArray,m+1,r);
    end;
  end;

Da wird wieder nichts sortiert. Ich werd langsam verrückt -.-

Gruß
Neutral General

[Neutral General]

Hi,

Ich wollte das Thema nochmal aufgreifen.. *push*
Es wär nett wenn sich das jemand angucken könnte..

[grenzgaenger]

du solltest nicht eine komponente, selbst versuchen zu sortieren, da bringste nur alles durcheinander.. verwende dafür die methode sort, deiner klasse.

wenn du selbst sortieren willst, dann erstell dir deine eigene komponente/object, wo du den speicher selbst verwaltest... da kanntste dann den qSort aus TList nachprogrammieren :roll: :roteyes: :roteyes:

[Neutral General]

Zitat:

Zitat von grenzgaenger

du solltest nicht eine komponente, selbst versuchen zu sortieren, da bringste nur alles durcheinander.. verwende dafür die methode sort, deiner klasse.

wenn du selbst sortieren willst, dann erstell dir deine eigene komponente/object, wo du den speicher selbst verwaltest... da kanntste dann den qSort aus TList nachprogrammieren :roll: :roteyes: :roteyes:

Vielleicht ist dir aufgefallen das ich neuerdings keine TList mehr sortieren will sondern ein Array of TList ;)

[marabu]

Hallo Michael,

welchen Algorithmus implementierst du da?

Ich habe mal den hier genommen:

Delphi-Quellcode:

function Compare(item1, item2: TList): Integer;
begin
  Result := Math.CompareValue(item1.Count, item2.Count);
end;

procedure Exchange(var a: TCombis; index1, index2: Integer);
var
  tmp: TList;
begin
  tmp := a[index1];
  a[index1] := a[index2];
  a[index2] := tmp;
end;

procedure QuickSort(var a: TCombis; iLow, iHigh: Integer);
var
  iL, iH: Integer;
  pivot: TList;
begin
  iL := iLow;
  iH := iHigh;
  pivot := a[(iLow + iHigh) shr 1];
  while iL <= iH do
  begin
    while Compare(a[iL], pivot) < 0 do Inc(iL);
    while Compare(a[iH], pivot) > 0 do Dec(iH);
    if iL <= iH then
    begin
      Exchange(a, iL, iH);
      Inc(iL);
      Dec(iH);
    end;
  end;
  if iLow < iH then QuickSort(a, iLow, iH);
  if iL < iHigh then QuickSort(a, iL, iHigh);
end;

Funktioniert. Vielleicht findest du deinen Fehler durch Vergleich - oder du schreibst dir eine Visualisierung.

Grüße vom marabu

[Neutral General]

Hi,

Hab mich hieran und an das Quicksort Verfahren das wir in der Schule benutzt haben orientiert. Und ich bin ja mit Breaktpoints durch... Und das vertauschen hat ja funktioniert... Und eigentlich war innerhalb der Quicksort Procedure auch soweit ich das jetzt überschauen konnte mit breaktpoints alles in Ordnung...

Gruß
Neutral General

[marabu]

Hi,

Zitat:

Zitat von Neutral General

... Hab mich hieran ... orientiert. ...

ich komme zu folgendem Ergebnis, wenn ich den Wikipedia-Algorithmus implementiere - ich habe versucht so viel wie möglich von deinem Code beizubehalten:

Delphi-Quellcode:

procedure SortArray(var CombiArray: TCombis; l, r: Integer);

  function Divide(l, r: Integer): Integer;

    procedure Exchange(s,t: Integer);
    var tmp: TList;
    begin
      tmp := CombiArray[s];
      CombiArray[s] := CombiArray[t];
      CombiArray[t] := tmp;
    end;

  var
    pivot: Integer;
  begin
    // Dec(l); // muss wech!
    pivot := r;
    while l < r do
    begin
      while CombiArray[l].Count < CombiArray[pivot].Count do
        Inc(l);
      while (l < r) and (CombiArray[r].Count > CombiArray[pivot].Count) do
        Dec(r);
      if l < r then
        Exchange(l, r);
    end;
    Exchange(l, pivot);
    Result := l;
  end;

Du hast dich offensichtlich von der visuellen Ähnlichkeit des Pseudo-Codes "wiederhole block solange bedingung" mit einer REPEAT-Schleife täuschen lassen. Tatsächlich ist es aber eine WHILE-Schleife.

Freundliche Grüße

[Neutral General]

Hi,

Danke. Aber das Problem ist: Das funktioniert auch nicht. Bekomme in der Zeile

Delphi-Quellcode:

while CombiArray[l].Count < CombiArray[Pivot].Count do

irgendwann ne AV. Ist eigentlich auch logisch bei ner while schleife weil da erst geprüft wird und dann ausgeführt.. d.h. man fängt mit CombiArray[-1] an, wohingegen man bei repeat bei 0 anfängt weil vorher geinct wird. Wenn ich das dec weglasse hab ich ne Endlosschleife.

Naja hab das gefunden was unser Info-Lehrer uns gegeben hat:

*klick*

da wirds auch mit repeat gemacht und mit <= und >= ...

Mein Quelltext sieht jetzt so aus:

Delphi-Quellcode:

procedure SortArray(var CombiArray: TCombis; l,r: Integer);

  function Divide(l,r: Integer): Integer;

    procedure Exchange(s,t: Integer);
    var tmp: TPriceList;
    begin
      tmp := CombiArray[s];
      CombiArray[s] := CombiArray[t];
      CombiArray[t] := tmp;
    end;

  var pivot: Integer;
      k: Integer;
  begin
    dec(l);
    pivot := r;
    while l < r do
    begin
      while CombiArray[l].Count < CombiArray[Pivot].Count do
        inc(l);
      while (l < r) and (CombiArray[r].Count > CombiArray[Pivot].Count) do
        dec(r);
      if l < r then
        Exchange(l,r);

      { Form1.ListBox1.Clear;
      for k := 0 to High(CombiArray) do
      begin
        Form1.ListBox1.Items.Add(IntToStr(CombiArray[k].Count));
        Application.ProcessMessages;
      end;
      sleep(10); }
    end;
    Exchange(l,pivot);
    Result := l;
  end;

var m: Integer;
begin
  if r > l then
  begin
    m := Divide(l,r);
    SortArray(CombiArray,l,m-1);
    SortArray(CombiArray,m+1,r);
  end;
end;

Gruß
Neutral General

[marabu]

Hi,

bei meinen drei Tests ist zwar der Fehler nicht aufgetreten, aber du hast Recht: Der Lower Bound Index darf beim Start von SortArray() nicht verringert werden.

Ob du nun REPEAT oder WHILE verwendest, dass ist gehoppt wie gesprungen, wenn du die Abbruchbedingungen und die Initialwerte richtig angepasst hast. Insofern ist der Wikipedia Pseudo-Code sowas wie "REPEAT Block WHILE Bedingung".

Freundliche Grüße