heapsort.p

   1 const max=100;
   2
   3 var A:array [1..max] of integer;
   4     i,N:integer;
   5
   6 procedure bubbledown(n,i:integer);
   7 var j,x:integer;
   8 begin
   9    while 2*i <= n do begin
  10       j := 2*i;
  11       if (j<n) and (A[j+1] > A[j]) then inc(j);
  12       if A[i] >= A[j] then break;
  13       x := A[i];
  14       A[i] := A[j];
  15       A[j] := x;
  16       i := j;
  17    end;
  18 end;
  19
  20 procedure heapsort;
  21 var i,x:integer;
  22 begin
  23    for i:=N div 2 downto 1 do
  24       bubbledown(N,i);
  25    for i:=N downto 2 do begin
  26       x := A[1];
  27       A[1] := A[i];
  28       A[i] := x;
  29       bubbledown(i-1,1);
  30    end;
  31 end;
  32
  33 begin
  34    read(N);
  35    for i:=1 to N do read(A[i]);
  36    heapsort;
  37    for i:=1 to N do write(A[i], ' ');
  38    writeln;
  39 end.