unit heapsort;
interface
procedure HeapSort(
var A:
array of PChar; Len: Integer);
implementation
procedure HeapSort(
var A:
array of PChar; Len: Integer);
var
I: Integer;
procedure Swap(
var X, Y: PChar);
var
Swp: PChar;
begin
Swp := X;
X := Y;
Y := Swp;
end;
function Comp(
const A, B: PChar): Boolean;
var
I: Integer;
begin
for I := 0
to Len - 1
do
if A[I] <> B[I]
then
begin
Result := Byte(A[I]) > Byte(B[I]);
Exit;
end;
Result := False;
end;
procedure SiftDown(Current, MaxIndex: Integer);
var
Left, Right, Largest: Integer;
begin
Left := Low(A) + (2 * (Current - Low(A))) + 1;
Right := Low(A) + (2 * (Current - Low(A))) + 2;
Largest := Current;
if (Left <= MaxIndex)
and Comp(A[Left], A[Largest])
then
Largest := Left;
if (Right <= MaxIndex)
and Comp(A[Right], A[Largest])
then
Largest := Right;
if Largest <> Current
then
begin
Swap(A[Current], A[Largest]);
SiftDown(Largest, MaxIndex);
end;
end;
procedure Heapify;
var
Middle: Integer;
I: Integer;
begin
Middle := ((Low(A) + High(A) + 1)
div 2) - 1;
for I := Middle
downto Low(A)
do // Nur die Knoten, die Söhne haben!
SiftDown(I, High(A));
end;
begin
Heapify;
for I := High(A)
downto Low(A) + 1
do
begin
Swap(A[I], A[Low(A)]);
SiftDown(Low(A), I - 1);
end;
end;
end.