Cod sursa(job #1629284)

Utilizator robertadRoxana Rodile robertad Data 4 martie 2016 13:59:08
Problema Heapuri Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.93 kb
program heapuri;
var h:array[1..1000] of longint;
    nr,n,i:integer;
    f,g:text;
function tata(x:integer):integer;
  begin
    tata:=x div 2;
  end;
function leftson(x:integer):integer;
  begin
    leftson:=x*2;
  end;
function rightson(x:integer):integer;
  begin
    rightson:=x*2+1;
  end;
{procedure sift(n,k:integer);
var son:integer;
  begin
    son:=
  end;}
procedure percolate(k:integer);
var key:integer;
  begin
    key:=h[k];
    while (k>1) and (key>h[tata(k)]) do
      begin
        h[k]:=h[tata(k)];
        k:=tata(k);
      end;
     h[k]:=key;
  end;
procedure insert(n,k:integer);
  begin
    h[n]:=k;
    percolate(n);
  end;
begin
  assign(f,'heap.in');
  assign(g,'heap.out');
  reset(f);
  rewrite(g);
  n:=0;
  while not seekeof(f) do
    begin
      n:=n+1;
      read(f,nr);
      insert(n,nr);
    end;
  for i:=1 to n do
    write(g,h[i],' ');
  close(f);
  close(g);
end.