Folgende Implementierung demonstriert einen IntroSort, der sich nötigenfalls mittels
HeapSort
behilft.
Die Bewertungsfunktion
UseQuickSort
ist der
3-Median-Methode
sehr ähnlich,
siehe
3-Median-Variante.
Das Herz des vorliegenden IntroSort ist die lokale Prozedur
ISort.
unit UIntroSort;
interface
procedure IntroSort(var A: array of Integer);
implementation
procedure IntroSort(var A: array of Integer);
(* "ISort" und "IQuickSort" sind in ihrer Rekursion verschränkt,
damit bei jedem Rekursionsaufruf anhand der Bewertungsfunktion
"UseQuickSort" entschieden werden kann, welches Sortierverfahren
zur jeweiligen Teilliste angewendet werden soll.
Aufgrund der verschränkten Rekursion muss zumindest eine
der beiden genannten Funktionen als forward deklariert werden. *)
procedure ISort(LoIndex, HiIndex: Integer); forward;
(* "HeapSort" als Alternative nur für den Notfall! *)
procedure HeapSort(LoIndex, HiIndex: Integer);
procedure SiftDown(Current, MaxIndex: Integer);
var
Left, Right, Largest, Swp: Integer;
begin
Left := LoIndex + (2 * (Current - LoIndex)) + 1;
Right := LoIndex + (2 * (Current - LoIndex)) + 2;
Largest := Current;
if (Left <= MaxIndex) and (A[Left] > A[Largest]) then Largest := Left;
if (Right <= MaxIndex) and (A[Right] > A[Largest]) then Largest := Right;
if (Largest <> Current) then
begin
Swp := A[Current];
A[Current] := A[Largest];
A[Largest] := Swp;
SiftDown(Largest, MaxIndex);
end;
end;
var Swp, i: Integer;
begin
for i := ((LoIndex + HiIndex + 1) div 2) - 1 downto LoIndex do
SiftDown(i, HiIndex);
for i := HiIndex downto LoIndex + 1 do
begin
Swp := A[i];
A[i] := A[LoIndex];
A[LoIndex] := Swp;
SiftDown(LoIndex, i - 1);
end;
end; // HeapSort
(* "IQuickSort" (indirekt rekursiv) ist ein modifizierter QuickSort. *)
procedure IQuickSort(LoIndex, HiIndex: Integer);
var Lo, Hi, Pivot, Swap: Integer;
begin
Lo := LoIndex;
Hi := HiIndex;
Pivot := A[Lo];
repeat
while A[Lo] < Pivot do Inc(Lo);
while A[Hi] > Pivot do Dec(Hi);
if Lo <= Hi then
begin
Swap := A[Lo];
A[Lo] := A[Hi];
A[Hi] := Swap;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if LoIndex < Hi then ISort(LoIndex, Hi); // keine direkte Rekursion!
if Lo < HiIndex then ISort(Lo, HiIndex); // keine direkte Rekursion!
end; // IQuickSort
(* "UseQuickSort" ist eine heuristische Bewertungsfunktion,
die den WorstCase O(n*n) ausschliessen muss
und selbst nur konstante Zeit O(1) benötigen darf.
Welcher Bewertungsstrategie sonst noch gefolgt werden soll,
bleibt noch offen,
sollte aber im Sinne der Gesamteffizienz des "IntroSort" erörtert werden!
Hier ganz simple:
Wenn nun Middle nicht der tatsächliche Median bzgl. der Grenzelemente
der jeweiligen Teilliste ist, dann darf der QuickSort angewendet werden. *)
function UseQuickSort(LoIndex, HiIndex: Integer): Boolean;
var Middle: Integer;
begin
Middle := A[(LoIndex + HiIndex) div 2];
Result := not (((A[LoIndex] < Middle) and (Middle < A[HiIndex]))
or ((A[HiIndex] < Middle) and (Middle < A[LoIndex])));
end;
(* Mit "ISort" wird in jedem Rekursionsschritt entschieden,
ob nun der QuickSort oder der HeapSort angewendet werden soll. *)
procedure ISort(LoIndex, HiIndex: Integer);
begin
if UseQuickSort(LoIndex, HiIndex)
then IQuickSort(LoIndex, HiIndex)
else HeapSort(LoIndex, HiIndex); // bzw. MergeSort(LoIndex, HiIndex)
end;
begin
ISort(Low(A), High(A)); // Der Anstoß, kick off!
end;
end.