Cod sursa(job #1133845)

Utilizator DjokValeriu Motroi Djok Data 5 martie 2014 18:35:37
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
var buf1,buf2:array[1..1 shl 17] of char;
    i,n,sf:longint;
    heap:array[1..500001]of int64;

    procedure swap(var x,y:int64);
     var aux:int64;
      begin
       aux:=x;
       x:=y;
       y:=aux;
      end;

   procedure add(nod:longint);
    begin
     if nod>1 then if heap[nod]>heap[nod div 2] then
                                                begin
                                                 swap(heap[nod],heap[nod div 2]);
                                                 add(nod div 2);
                                                end;
    end;

   procedure del(nod:longint);
    var max:longint;
    begin
     max:=nod;
      if (2*nod<=sf) and (heap[nod]<heap[2*nod]) then max:=2*nod;
      if (2*nod+1<=sf) and (heap[max]<heap[2*nod+1]) then max:=2*nod+1;
      if nod<>max then begin swap(heap[nod],heap[max]); del(max); end;
    end;


begin
assign(input,'algsort.in');
assign(output,'algosrt.out');
reset(input);
rewrite(output);
settextbuf(input,buf1);
settextbuf(output,buf2);

 readln(n);
  for i:=1 to n do
   read(heap[i]);
         sf:=1;
    for i:=1 to n do
     begin
      add(sf);
      inc(sf);
     end;

     dec(sf);

     for i:=1 to n do
      begin
       swap(heap[1],heap[sf]);
       dec(sf);
       del(1);
      end;

      for i:=1 to n do
       write(heap[i],' ');

close(input);
close(output);
{Totusi este trist in lume}
end.