Cod sursa(job #1637873)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 7 martie 2016 19:45:40
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.11 kb
program mire;
var v:array[1..500000] of longint;
    f,g:text;
    n,i:longint;
    bufin,bufout:array[1..1 shl 16] of byte;
procedure swap(var a,b:longint);
var aux:longint;
begin
  aux:=a ;
  a:=b;
  b:=aux;
end;
procedure down(n,k:longint);
var l,r,son:longint;
begin
repeat
   son:=0;
   l:=2*k;
   r:=2*k+1;
   if l<=n then
   begin
      son:=l;
    if (r<=n) and (v[r]>v[l] )  then
       son:=r;
    if v[son]<=v[k] then
      son:=0;
   end;
   if son<>0 then
    begin
       swap(v[son],v[k]);
       k:=son;
    end;
until son=0;
end;
procedure built(n:longint);
var i:longint;
begin
  for i:=n div 2 downto 1 do
      down(n,i);
end;
procedure sortare(n:longint);
var i:longint;
begin
        built(n);
  for i:= n downto 2 do
    begin
      swap(v[i],v[1]);
      down(i-1,1);
    end;
end;
begin
  assign(f,'algsort.in'); reset(f);
  assign(g,'algsort.out'); rewrite(g);
  settextbuf(f,bufin); settextbuf(g,bufout);
  readln(f,n);
  for i:=1 to n do
     read(f,v[i])   ;
   sortare(n);
 for i:=1 to n do
     write(g,v[i],' ');
  close(f);
  close(g);
end.