QuickSort spinnt

[Opa]

Nachfolgen Sortier Routine benutze ich, geht auch sehr gut, aber nur wenn nicht mehr als zwei mal der gleiche Name, bez. Dateilänge auftritt. Ich wollte nicht unbedingt auf Bubbelsort zurückgreifen. Ich kann keinen Fehler erkennen.

Code:

procedure _QuickSort(AHandle:THandle;TL:TList;Index:integer;SortStyle:TCustomSortStyle;SortOrder:boolean);
var
  S1, S2    : string;
  I1,I2     : int64;

  procedure QSort(L,R,Typ:integer;Liste:TList);
  var
    I,J,M :longInt;
     function Verg(P1,P2:integer):shortint;
     begin
       result := 0;
       case SortStyle of
         cssAlphaNum : begin
                         case Index of
                           1 : begin
                                 S1 := AnsiLowerCase(PDateiRec(Liste[P1])^._FileName);
                                 S2 := AnsiLowerCase(PDateiRec(Liste[P2])^._FileName);
                               end;
                           2 : begin
                                 S1 := AnsiLowerCase(PDateiRec(Liste[P1])^._Erw0);
                                 S2 := AnsiLowerCase(PDateiRec(Liste[P2])^._Erw0);
                               end;
                         end;//case Index

                         if not SortOrder then
                         begin
                           if S1 > S2 then result :=  1;
                           if S1 < S2 then result := -1;
                           end else begin
                                      if S1 > S2 then result := -1;
                                      if S1 < S2 then result :=  1;
                         end;
                      end;//cssAlphaNum
         cssNumeric : begin
                         case Index of
                           3 : begin
                                 I1 := PDateiRec(Liste[P1])^._Size;
                                 I2 := PDateiRec(Liste[P2])^._Size;
                               end;
                           4 : begin
                                 I1 := PDateiRec(Liste[P1])^._CRC64Calc;
                                 I2 := PDateiRec(Liste[P2])^._CRC64Calc;
                               end;
                         end;//case Index
                         if not SortOrder then
                         begin
                           if I1 > I2 then result :=  1;
                           if I1 < I2 then result := -1;
                           end else begin
                                      if I1 > I2 then result := -1;
                                      if I1 < I2 then result :=  1;
                                    end;
                      end;//cssNumeric
       end;//SortStyle
     end;//Verg
  begin//QSort;
    try
      repeat
        I:=L;
        J:=R;
        M:=(L + R) shr 1;
        repeat
          while Verg(I,M) < 0  do inc(I);
          while Verg(J,M) > 0  do dec(J);
          if I <= J then
          begin
            _PListSwap(Liste,I,J);
            inc(I);
            dec(J);
          end;
          if GetAsyncKeystate(VK_ESCAPE) <> 0 then exit;
        until I > J;
        if L < J then QSort(L, J,Typ,Liste);
        L := I;
      until I >= R;
    except
    end;
  end;
begin//_QuickSort
  SendMessage(AHandle,WM_QSORT_BEGIN,0,13);
  if TL.Count -1 < 0  then exit;
  QSort(0,TL.Count-1,Index,TL);
  SendMessage(AHandle,WM_QSORT_END,0,13);
end;

MFG

[gammatester]

Zitat:

Zitat von Opa

Nachfolgen Sortier Routine benutze ich, geht auch sehr gut, aber nur wenn nicht mehr als zwei mal der gleiche Name, bez. Dateilänge auftritt. Ich wollte nicht unbedingt auf Bubbelsort zurückgreifen. Ich kann keinen Fehler erkennen.

Code:

procedure _QuickSort(AHandle:THandle;TL:TList;Index:integer;SortStyle:TCustomSortStyle;SortOrder:boolean);
var
  S1, S2    : string;
  I1,I2     : int64;
...
        M:=(L + R) shr 1;
        repeat
          while Verg(I,M) < 0  do inc(I);
          while Verg(J,M) > 0  do dec(J);
          if I <= J then
          begin
            _PListSwap(Liste,I,J);
            {m muss weiter auf Pivot zeigen} {*}
            if i=m then m:=j                 {*}
            else if j=m then m:=i;           {*}
            inc(I);
            dec(J);
          end;
...

Spinnt's auch dann noch wenn Du nach _PListSwap die mit {*} markierten Zeilen einfügst? Hat mich in einer ähnlichen Situation vor Jahren auch zur Verzweiflung gebracht.

Gruß Gammatester

[Opa]

Ja jetzt geht das.
Was mich wundert ist das ich deine Ergänzung auch in QSort Routinen von Borland nicht gefunden habe. Daraus habe ich mein QSort abgekupfert. Ich habe QAort noch nie verstanden, mußte ich auch nie als Hobby-Progger. :gruebel:

Danke!
MFG