Шпоры по МПиПА / Массивы / Сортировка / Пирамидальная сортировка / 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.