Шпоры по МПиПА / Массивы / Сортировка / Пирамидальная сортировка / Pascal / Исходник / heapsort

Program _heapsort;
const
max = 10000;
type myArray = array[0..max] of integer;
var dimension, i : integer;
arr, sortArray : myArray;

procedure sift( var arr : myArray; L, R : integer );
var i, j : integer;
item : integer;
begin
i := L;
j := 2*L;
item := arr[L];
if ( j < R ) and ( arr[j] < arr[j + 1] ) then begin j := j + 1; end;
while ( j <= R ) and ( item < arr[j] ) do begin
arr[i] := arr[j];
i := j;
j := 2*j;
if ( j < R ) and ( arr[j] < arr[j + 1] ) then begin j := j + 1; end;
end;
arr[i] := item;
end;

function heapsort( arr : myArray; size : integer ) : myArray;
var i, L, R : integer;
item : integer;
begin
L := ( size div 2 );
R := size - 1 ;
while L > 0 do begin
L := L - 1;
sift( arr, L, R );
end;
while R > 0 do begin
item := arr[0];
arr[0] := arr[R];
arr[R] := item;
R := R - 1;
sift( arr, L, R );
end;
heapsort := arr;
end;

begin
writeln('Heapsort.');
write('Enter array dimension: '); readln( dimension );
write('Enter '); write( dimension ); write(' elements: ');
for i := 0 to dimension-1 do
read(arr[i]);
sortArray := heapsort( arr, dimension );
write('Sorting array: ');
for i := 0 to dimension-1 do begin
write( sortArray[i] ); write(' '); end;
writeln;
writeln('Press "Enter" to continue...');
readln;
readln;
end.