Пирамидальная сортировка

Алгоритм пирамидальной сортировки (heapsort) - один из самых быстрых алгоритмов сортировки.

Program heapsort;

{$APPTYPE CONSOLE}

type
tkey = integer;
int = integer;

const N = 10;

var a,b : array [0..N+1] of tkey;

function parent(x : int) : int;
begin
result:=x shr 1;
end;

function left(x : int) : int;
begin
result := x shl 1;
if result > a[0] then result := N+1;
end;

function right(x:int):int;
begin
result := x shl 1 + 1;
if result > a[0] then result := N+1;
end;

procedure swap(i,j : int);
var temp : tkey;
begin
temp := a[i];
a[i] := a[j];
a[j] := temp;
end;

procedure moveup(x : int);
begin
while (a[x] > a[parent(x)]) and (parent(x) > 0) do begin
swap(x, parent(x));
x := parent(x);
end;
end;

procedure movedown(x : int);
var max : integer;
begin
if a[left(x)] > a[right(x)] then max := left(x)
else max := right(x);
while (a[max] > a[x]) and (max <= a[0]) do begin
swap(max, x);
x := max;
if a[left(x)] > a[right(x)] then max := left(x)
else max := right(x);
end;
end;

procedure update(x : int; k : tkey);
begin
a[x] := k;
moveup(x);
movedown(x);
end;

procedure add(k : tkey);
begin
inc(a[0]);
update(a[0], k);
end;

procedure delete(x : int);
begin
swap(x, a[0]);
dec(a[0]);
update(x, a[x]);
end;

procedure hsort;
var i:int;
begin
a[0] := 1;
a[1] := b[1];
for i := 2 to N do
add(b[i]);
for i := 1 to N do
delete(1);
end;

var i : int;
begin
randomize;
fillchar(a, sizeof(a), 0);
fillchar(b, sizeof(b), 0);

for i := 1 to N do
b[i] := random(10);

writeln(’Non-sorted elements’);
for i := 1 to N do
write(b[i], ‘ ‘);
writeln;

hsort;

writeln(’Sorted elements’);
for i := 1 to N do
write(a[i], ‘ ‘);
readln;
end.

Май 19, 2008 — Рубрика: Delphi
Метки: