const
  n = 15;

type
  myarray = array[1..n] of integer;

var
  x: myarray;
  i: byte;

procedure HeapSort(var m: myarray; N: integer);
var
  i: integer;

  procedure Swap(var a, b: integer);
  var
    tmp: integer;
  begin
    tmp := a;
    a := b;
    b := tmp;
  end;

  procedure Sort(Ns: integer);
  var
    i, tmp, pos, mid: integer;
  begin
    mid := Ns div 2;
    for i := mid downto 1 do
    begin
      pos := i;
      while pos <= mid do
      begin
        tmp := pos * 2;
        if tmp < Ns then
        begin
          if m[tmp + 1] < m[tmp] then
            tmp := tmp + 1;
          if m[pos] > m[tmp] then
          begin
            Swap(m[pos], m[tmp]);
            pos := tmp;
          end
          else
            pos := Ns;
        end
        else
        if m[pos] > m[tmp] then
        begin
          Swap(m[pos], m[tmp]);
          pos := Ns;
        end
        else
          pos := Ns;
      end;
    end;
  end;

begin
  for i := N downto 2 do
  begin
    Sort(i);
    Swap(m[1], m[i]);
  end;
end;

begin
  Writeln('Исходный массив:');
  for i := 1 to n do
  begin
    X[i] := Random(501) - 190;
    Write(X[i]:5);
  end;
  Writeln;

  HeapSort(x, n);

  Writeln('Сортированный массив:');
  for i := 1 to n do Write(X[i]:5);
  Writeln;
end.