Cod sursa(job #677323)

Utilizator oancea_horatiuOancea Horatiu oancea_horatiu Data 10 februarie 2012 00:18:13
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.17 kb
var h,s:array[0..500001] of longint;
    i,n,nh:longint;
    o,d:text;
procedure swap(var v1,v2:longint);
var aux:longint;
  begin
    aux:=v1;
    v1:=v2;
    v2:=aux;
  end;
procedure resad(p:longint);
var i:longint;
  begin
    if h[p]<h[p div 2] then
      begin
        swap(h[p],h[p div 2]);
        resad(p div 2);
      end;
  end;
procedure ressub(j:longint);
var i:longint;
  begin
    if (j*2<=n)and(h[j*2]<>0)
      then begin if (j*2+1<=n)and(h[j*2+1]<>0)
             then begin if (h[j*2]<=h[j*2+1])
                    then begin swap(h[j*2],h[j]);h[j*2]:=0;ressub(j*2); end
                    else begin swap(h[j*2+1],h[j]);h[j*2+1]:=0;ressub(j*2+1); end; end
             else begin swap(h[j*2],h[j]);h[j*2]:=0;ressub(j*2); end; end
      else if (j*2>=n)and(h[j*2+1]<>0)and(j*2+1<=n)
             then begin swap(h[j*2+1],h[j]);h[j*2+1]:=0;ressub(j*2+1); end;
  end;
begin
assign(d,'algsort.in');reset(d);
assign(o,'algsort.out');rewrite(o);
readln(d,n);nh:=n;h[0]:=-1;
for i:=1 to n do
  begin
    read(d,h[i]);
    resad(i);
  end;
for i:=1 to n do
  begin
    write(o,h[1],' ');
    ressub(1);
  end;
close(o);close(d);
end.