Cod sursa(job #678336)

Utilizator oancea_horatiuOancea Horatiu oancea_horatiu Data 11 februarie 2012 15:07:14
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.6 kb
var h,s:array[0..1000001] of longint;
    i,n,j,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],' ');j:=1;
    while (h[j*2]<>0)or(h[j*2+1]<>0) do
      begin
        if (h[j*2]=0)and(h[j*2+1]<>0) then
          begin swap(h[j],h[j*2+1]);h[j*2+1]:=0;j:=j*2+1;continue; end;
        if (h[j*2+1]=0)and(h[j*2]<>0) then
          begin swap(h[j],h[j*2]);h[j*2]:=0;j:=j*2;continue; end;
        if h[j*2]<h[j*2+1]
         then begin swap(h[j],h[j*2]);h[j*2]:=0;j:=j*2; end
         else begin swap(h[j],h[j*2+1]);h[j*2+1]:=0;j:=j*2+1; end;
      end;
  end;
close(o);close(d);
end.