Generischer Quicksort (ein Beispiel)

[corpsman]

Servus zusammen,

ich weis gar nicht wie oft ich mein Quicksort Example schon für die diversen Usecases von mir angepasst habe, heute dachte ich mir mal, es reicht, nur noch 1 mal und die reicht dann für immer .
Heraus gekommen ist diese Funktion (die zugegeben etwas sehr an C erinnert, aber sie sollte ja generisch sein..)

Code: Alles auswählen

Type
  TCompareFunction = Function(a, b: Pointer): Integer;  
 
Procedure GenQuickSort(FirstElement: Pointer; ElementCount: integer; ElementSize: QWord; CompareFunction: TCompareFunction);
Var
  PivotElement, Buffer: Array Of Byte;

  Procedure Quick(li, re: Pointer);
  Var
    lp, rp, pp: Pointer;
    LeftSize, RightSize: PtrInt;
  Begin
    While li < re Do Begin
      // Create a Copy of the Pivo element for comparing during sorting..
      pp := pointer(
        PtrUInt(li) +
        (((PtrUInt(re) - PtrUInt(li)) Div ElementSize) Shr 1) * ElementSize
        );
      move(pp^, PivotElement[0], ElementSize);
      lp := li;
      rp := re;
      Repeat
        While CompareFunction(lp, @PivotElement[0]) < 0 Do Begin
          inc(lp, ElementSize);
        End;
        While CompareFunction(rp, @PivotElement[0]) > 0 Do Begin
          dec(rp, ElementSize);
        End;
        If Lp <= Rp Then Begin
          // Swap L and R elements using Buffer
          move(lp^, Buffer[0], ElementSize);
          move(rp^, lp^, ElementSize);
          move(Buffer[0], rp^, ElementSize);
          inc(lp, ElementSize);
          dec(rp, ElementSize);
        End;
      Until lp > rp;
      // Recursive call for the "smaller" part of the unsorted array
      LeftSize := PtrInt(rp) - PtrInt(li);
      RightSize := PtrInt(re) - PtrInt(lp);
      If LeftSize < RightSize Then Begin
        Quick(li, rp);
        li := lp;
      End
      Else Begin
        Quick(lp, re);
        re := rp;
      End;
    End;
  End;
Begin
  If ElementCount <= 1 Then exit;
  If (ElementSize <= 0) Or (Not assigned(CompareFunction)) Then Begin
    Raise exception.Create('GenQuickSort: Error, invalid configuration.');
  End;
  // Preallocate Buffers
  buffer := Nil;
  PivotElement := Nil;
  setlength(buffer, ElementSize);
  setlength(PivotElement, ElementSize);
  // The Real Sorting
  Quick(FirstElement, FirstElement + ElementSize * (ElementCount - 1));
  // Teardown
  setlength(buffer, 0);
  setlength(PivotElement, 0);
End;        

Das Sortieren wird damit dann zu folgendem Aufruf:

Code: Alles auswählen

  Function CompIntegers(Elem1, Elem2: Pointer): integer;
  Begin
    result := Integer(Elem1^) - Integer(Elem2^);
  End;

Procedure TForm1.Button1Click(Sender: TObject);
Var
  i: Integer;
Begin
  RandSeed := 42;
  a := Nil;
  setlength(a, 10);
  Memo1.Clear;
  For i := 0 To high(a) Do Begin
    a[i] := Random(255);
    Memo1.Append(inttostr(a[i]));
  End;
  Memo1.Append('');

  GenQuickSort(@a[0], length(a), sizeof(Integer), @CompIntegers);

  For i := 0 To high(a) Do Begin
    Memo1.Append(inttostr(a[i]));
  End;
End;

Da hier mit Pointern gearbeitet wird, müssen Länge und Elementgröße mit übergeben werden.

Nun bin ich mal gespannt, wer mir als erstes schreibt, dass ich mal wieder das Rad neu erfunden habe und wo mehr oder minder genau meine Implementierung bereits in der FCL verfügbar ist

[af0815]

Erinnert mich an die Sort Routinen in den Objekten der fgl. So allgemein habe ich es noch nicht gesehen.

[theo]

Nun bin ich mal gespannt, wer mir als erstes schreibt, dass ich mal wieder das Rad neu erfunden habe und wo mehr oder minder genau meine Implementierung bereits in der FCL verfügbar ist

Hier geht es um etwas ähnliches: https://wiki.freepascal.org/Array_sort

[Mathias]

Spannend, das die geht:

Code: Alles auswählen

  Function CompIntegers(Elem1, Elem2: Pointer): integer;
  Begin
    result := Integer(Elem1^) - Integer(Elem2^);
  End;

Ich hätte es so gemacht:

Code: Alles auswählen

  result := PInteger(Elem1)^ - PInteger(Elem2)^;

Oder noch eleganter:

Code: Alles auswählen

  function CompIntegers(Elem1, Elem2: Pointer): integer;
  var
    i1: PInteger absolute Elem1;
    i2: PInteger absolute Elem2;
  begin
    result := i1^ - i2^;
  end;

Vielfach werden mit CTR+Shift+C bei C -Bindungen callproc erzeugt, welche user_data:Pointer haben, da ist das mit absolute die sauberste Sache.