program heapsort;
 
const n=40;
 
var a: array [1..n] of integer;
 
procedure swap (var a, b: integer);
var t : integer;
begin
     t := a;
     a := b;
     b := t;
end;
 
procedure heapify (i, k : integer);
var j: integer;
begin
  while 2*i<=k do begin
    j:=2*i;
    if j+1<=k then
       if a[j]<a[j+1] then j:=j+1;
    if a[i]<a[j] then begin
       swap (a[i], a[j]);
       i:=j;
    end
    else i:=k+1;
  end;
end;
 
procedure show ;
var  i, j, k, step, width: integer;
begin
     i := 1;
     step := 1;
     width := 64;
 
     writeln;
     while i <= n do begin
        for k := 1 to step do begin
          j := i + k -1;
          if j <= n then
             write (a[j] : width div 2, ' ' : width - width div 2);
        end;
        writeln;
        width := width div 2;
        i := i + step;
        step := 2 * step;
     end;
     writeln;
end;
 
procedure sort;
var i:integer;
begin
    for i := n div 2 downto 1 do heapify (i, n);
    show;   
    for i := n downto 2 do begin
      swap (a[1], a[i]);
      heapify (1, i-1);
   end;
end;
 
procedure fill;
var i: integer;
begin
  randomize;
  for i:= 1 to n do
    a[i]:= random(100);
end;
 
procedure print;
var i: integer;
begin
  for i:= 1 to n do
    write(a[i],' ');
  writeln;
end;
 
procedure check;
var i:integer;
  ok: boolean;
  begin
    ok:=true;
    for i:=1 to n-1 do
      if a[i] > a[i+1]then
         ok:=false;
    if not ok then
         writeln('Chyba');
 
  end;
 
begin
     fill;
     print;
     sort;
     print;
     check;
     readln;
end.