Cod sursa(job #545021)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 2 martie 2011 16:49:43
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.98 kb
program pheap;
type
        hp = array[1..500000] of longint;
var
        h : hp;
        n : longint;

procedure ins(x : longint);
var
        d, p : longint;
begin
 inc(n); p := n;
 d := n div 2;
 while (d > 0) and (h[d] > x) do
 begin
  h[p] := h[d];
  p := d;
  d := p div 2;
 end;
 h[p] := x;
end;

procedure del;
var
       d, p ,x : longint;
begin
 x := h[n]; d := 1;
 dec(n); p := 2 * d;
 if (p + 1 <= n) and (h[p + 1] < h[p]) then inc(p);
 while (p <= n) and (h[p] < x) do
 begin
  h[d] := h[p];
  d := p;
  p := 2 * d;
  if (p + 1 <= n) and (h[p + 1] < h[p]) then inc(p);
 end;
 h[d] := x;
end;

procedure rd;
var
        f : text;
        m ,i ,x : longint;
begin
        assign(f,'algsort.in'); reset(f);
 readln(f,m);
 for i := 1 to m do
 begin
  read(f,x);
  ins(x);
 end;
 close(f);
        assign(f,'algsort.out'); rewrite(f);
 for i := 1 to m do
 begin
  write(f,h[1],' ');
  del;
 end;
 close(f);
end;

begin
rd;
end.