Delphi-PRAXiS
Seite 1 von 3  1 23      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Quicksort-Rätsel (https://www.delphipraxis.net/182707-quicksort-raetsel.html)

striderx 12. Nov 2014 14:16

Delphi-Version: XE5

Quicksort-Rätsel
 
Hallo zusammen,

seit nicht wenigen Jahren setze ich Quicksort zum sortieren von Daten ein - alles problemlos. Jetzt habe ich aber einen Fall, in dem das Sortier-Ergebnis nicht korrekt ist. Wenn ich dann noch einmal sortiere stimmt es. Auch wenn ich alternativ einen Insertion-Sort nehme, klappt es - d. h. an der Vergleichsfunktion ('Less', s. u.) scheint es also nicht zu liegen.

Kann mir bitte jemand das Brett vor em Kopf wegnehmen?



Hier der Source Code:

procedure tdlgMain.SortData;

begin
DataSort(1, TotalRecs);
end;

procedure tdlgMain.DataSort(Start, Stop: Word);

var
tStart: Word;
tStop: Word;
pTemp: rCompRec;

begin
tStart := Start;
tStop := Stop;
aData[0] := aData[(tStart + tStop) DIV 2];
repeat
while Less(tStart, 0) do Inc(tStart);
while Less(0, tStop) do Dec(tStop);
if tStart <= tStop then begin
pTemp := aData[tStart];
aData[tStart] := aData[tStop];
aData[tStop] := pTemp;
Inc(tStart);
Dec(tStop);
end;
until tStart > tStop;
if Start < tStop then DataSort(Start, tStop);
if tStart < Stop then DataSort(tStart, Stop);
end;

Sir Rufo 12. Nov 2014 14:25

AW: Quicksort-Rätsel
 
Warum keine Delphi-Tags um den Code und warum nicht die eingebaute Sortierfunktion? :gruebel:

striderx 12. Nov 2014 14:32

AW: Quicksort-Rätsel
 
>>Warum keine Delphi-Tags<<

Und was wäre das genau?

>>warum nicht die eingebaute Sortierfunktion<<

Weil es das Problem dort nicht zu liegen scheint - denn beim Insertion-Sort gibt es damit kein Problem. Aber wenn ich weiß, was die Delphi-Tags sind, liefere ich die gerne nach.

Sir Rufo 12. Nov 2014 14:48

AW: Quicksort-Rätsel
 
Die Delphi-Tags sind dazu da, dass wir hier keinen Augenkrebs bekommen, wenn wir uns Delphi-Code ansehen müssen.

Statt

procedure foo( bar : string );
begin
writeln( bar );
end;

schreibt man in den Editor
Code:
[DELPHI]
procedure foo( bar : string );
begin
  writeln( bar );
end;
[/DELPHI]
und heraus kommt
Delphi-Quellcode:
procedure foo( bar : string );
begin
  writeln( bar );
end;

p80286 12. Nov 2014 15:31

AW: Quicksort-Rätsel
 
Zitat:

Zitat von striderx (Beitrag 1279482)
>>Warum keine Delphi-Tags<<

Und was wäre das genau?

Nimm den "GriechenHelm"

>>warum nicht die eingebaute Sortierfunktion<<

Zitat:

Zitat von striderx (Beitrag 1279482)
Weil es das Problem dort nicht zu liegen scheint - denn beim Insertion-Sort gibt es damit kein Problem.

Die Logik versteh ich jetzt nicht!
Was heißt eigentlich "korrekt"? Dir ist schon klar, daß Quicksort kein stabiles Verfahren ist?

Gruß
K-H

striderx 12. Nov 2014 15:36

AW: Quicksort-Rätsel
 
Dann auf ein Neues:

Delphi-Quellcode:
procedure tdlgMain.SortData;

begin
  DataSort(1, TotalRecs);
end;

procedure tdlgMain.DataSort(Start, Stop: Word);

var
  pTemp:  rCompRec;
  tStart: Word;
  tStop:  Word;

begin
  tStart  := Start;
  tStop   := Stop;
  aData[0] := aData[(tStart + tStop) DIV 2];
  repeat
    while Less(tStart, 0) do Inc(tStart);
    while Less(0, tStop) do Dec(tStop);
    if tStart <= tStop then begin
       pTemp        := aData[tStart];
       aData[tStart] := aData[tStop];
       aData[tStop] := pTemp;
       Inc(tStart);
       Dec(tStop);
    end;
  until tStart > tStop;
  if Start < tStop then DataSort(Start, tStop);
  if tStart < Stop then DataSort(tStart, Stop);
end;

function tdlgMain.Less(X, Y: Word): Boolean;

var
  R:  Integer;
  S1: String;
  S2: String;

begin
  if (aData[X].Deleted = False) and (aData[Y].Deleted = True) then begin
     Result := True;
     Exit;
  end
  else if (aData[X].Deleted = True) and (aData[Y].Deleted = False) then begin
     Result := False;
     Exit;
  end;
  if (aData[X].RecType) < (aData[Y].RecType) then begin
     Result := True;
     Exit;
  end
  else if (aData[X].RecType) > (aData[Y].RecType) then begin
     Result := False;
     Exit;
  end;
  Result := False;
  case aData[X].RecType of
     1: begin                                                                  
          S1 := GetArtistSurname(aData[X].wlIndexArtist);
          S2 := GetArtistSurname(aData[Y].wlIndexArtist);
          R := AnsiCompareText(S1, S2);
          if R < 0 then Result := True
          else if R = 0 then begin
             S1 := GetArtistFirstName(aData[X].wlIndexArtist);
             S2 := GetArtistFirstName(aData[Y].wlIndexArtist);
             R := AnsiCompareText(S1, S2);
             if R < 0 then Result := True
             else if R = 0 then begin
                S1 := aData[X].wlNameofWork;
                S2 := aData[Y].wlNameofWork;
                if AnsiCompareText(S1, S2) < 0 then Result := True
             end;
          end;
        end;
     2: begin                                                                  
          S1 := aData[X].arSurname;
          S2 := aData[Y].arSurname;
          R := AnsiCompareText(S1, S2);
          if R < 0 then Result := True
          else if R = 0 then begin
             S1 := aData[X].arFirstName;
             S2 := aData[Y].arFirstName;
             if AnsiCompareText(S1, S2) < 0 then Result := True
          end;
        end;
     3: begin                                                                  
          if (aData[X].hoDate <> 0) and (aData[Y].hoDate = 0)
             then Result := True
          else if (aData[X].hoDate = 0) and (aData[Y].hoDate <> 0)
             then Result := False
          else if (aData[X].hoDate = 0) and (aData[Y].hoDate = 0)then begin
                if aData[X].hoIndexHolidays < aData[Y].hoIndexHolidays
                   then result := True;
          end
          else if aData[X].hoDate < aData[Y].hoDate then Result := True;
        end;
     4: begin                                                                  
          S1 := aData[X].cuSurname;
          S2 := aData[Y].cuSurname;
          R := AnsiCompareText(S1, S2);
          if R < 0 then Result := True
          else if R = 0 then begin
             S1 := aData[X].cuFirstName;
             S2 := aData[Y].cuFirstName;
             if AnsiCompareText(S1, S2) < 0 then Result := True
          end;
        end;
     5: begin                                                                  
          S1 := aData[X].saArticle;
          S2 := aData[Y].saArticle;
          if AnsiCompareText(S1, S2) < 0 then Result := True
        end;
     6: if aData[X].prIndexPrices < aData[Y].prIndexPrices then Result := True;
     7: begin                                                                  
          S1 := aData[X].emSurname;
          S2 := aData[Y].emSurname;
          R := AnsiCompareText(S1, S2);
          if R < 0 then Result := True
          else if R = 0 then begin
             S1 := aData[X].emFirstName;
             S2 := aData[Y].emFirstName;
             if AnsiCompareText(S1, S2) < 0 then Result := True
          end;
        end;
  end;
end;

Sir Rufo 12. Nov 2014 15:49

AW: Quicksort-Rätsel
 
Also ich weiß ja nicht was du da wirklich produzieren und du dich so quälen möchtest, denn eigentlich brauchst du dir nur ein paar Comparer zu erzeugen und jagst diese dann über das Array TArray.Sort<T> oder über eine Liste TList<T>.Sort.

Als Sortier-Algorithmus wird dort ein QuickSort verwendet, du kannst, wenn du möchtest auch einen eigenen Sortier-Algorithmus verwenden, allerdings würde ich dazu auch immer den IComparer<T> verwenden.

striderx 12. Nov 2014 17:25

AW: Quicksort-Rätsel
 
Hallo Sir Rufo,

danke für Deine Hinweise. Meine Anwendung nutzt ein Datenmodell mit varianten Records - deswegen die Unterscheidung per Record-Typ. Und je nach Typ wird nach unterschiedlichen Feldern sortiert. Ich kenne mich mit IComparer jetzt nicht aus, aber so auf den ersten Blick scheint mir das auf diese Situation nicht zu passen.

Wie dem auch sei: Meine Frage ist nach wie vor, warum der bewährte Quicksort-Algorhythmus hier nicht funktioniert bzw. erst nach dem zweiten Sortierlauf. Derzeit helfe ich mir mit einem Insertion-Sort, der es beim ersten Mal richtig macht und hier auch nicht zu langsam ist, weil die Daten schon weitgehend vorsortiert sind.

striderx 12. Nov 2014 18:00

AW: Quicksort-Rätsel
 
@p80286

sorry, habe Deine Antwort erst jetzt gesehen.

>>Die Logik versteh ich jetzt nicht!<<

Die Vergleichsfunktion produziert beim Insertion-Sort das korrekte Ergebnis. Korrekt bedeutet, dass die Reihenfolge alphabetisch aufsteigend ist.

>>Dir ist schon klar, daß Quicksort kein stabiles Verfahren ist?<<

Ich habe instabil bislang so verstanden, dass Elemente mit selbem SortierSchlüssel ihre Originalreihenfolge nicht behalten. Bei mir steht aber z. B. Meier vor Ahlenfeld.

Namenloser 12. Nov 2014 21:49

AW: Quicksort-Rätsel
 
Zitat:

Zitat von striderx (Beitrag 1279498)
Delphi-Quellcode:
case aData[X].RecType of

Bist du sicher, dass RecType einen der Werte hat, die du im Case behandelst? Möglicherweise tritt keiner der Fälle dort ein, sodass für alle Vergleiche False zurückgeliefert wird. Da QuickSort kein stabiles Verfahren ist, werden dabei die Einträge durcheinandergewirbelt.


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:22 Uhr.
Seite 1 von 3  1 23      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz