Cod sursa(job #408941)

Utilizator skullLepadat Mihai-Alexandru skull Data 3 martie 2010 12:49:35
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
var h:array [1..500000] of longint;
    n,k,i,x:longint;
    f,g:text;

procedure inv(var x,y:longint);
var aux:longint;
          begin
          aux:=x;
          x:=y;
          y:=aux;
          end;

procedure siftup(i:longint);
          begin
          if i<>1 then
             if h[i]>h[i div 2] then
                begin
                inv(h[i],h[i div 2]);
                siftup(i div 2);
                end;
          end;

procedure addheap(x,i:longint);
          begin
          h[i]:=x;
          siftup(i);
          end;

procedure siftdown(i,k:longint);
var fiu:longint;
          begin
          fiu:=i;
          if i*2<=k then
             if h[i]<h[i*2] then
                fiu:=2*i;
          if i*2+1<=k then
             if h[fiu]<h[2*i+1] then
                fiu:=2*i+1;
          if fiu<>i then
             begin
             inv(h[i],h[fiu]);
             siftdown(fiu,k);
             end;
          end;

begin
assign(f,'algsort.in');reset(f);
readln(f,n);
for i:=1 to n do
    begin
    read(f,x);
    addheap(x,i);
    end;
close(f);
k:=n;
for i:=1 to n do
    begin
    inv(h[1],h[k]);
    siftdown(1,k-1);
    k:=k-1;
    end;
assign(g,'algsort.out');rewrite(g);
for i:=1 to n do
    write(g,h[i],' ');
close(g);
end.