Cod sursa(job #244302)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 14 ianuarie 2009 21:16:36
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.14 kb
type tip=0..2147483648;
var  a:array[1..500005] of tip;
     m,n,i:longint;
     aux:tip;

function parinte(i:longint):longint; begin parinte:=i div 2; end;
function fiud(i:longint):longint; begin fiud:=2*i+1; end;
function fius(i:longint):longint; begin fius:=2*i; end;

procedure reconstituire_heap(i:longint);
   var s,d,max:longint;
   begin
     s:=fius(i); d:=fiud(i);
     max:=i;
     if (s<=n)and(a[s]>a[i]) then max:=s;
     if (d<=n)and(a[d]>a[max]) then max:=d;
     if max<>i then
        begin
          aux:=a[i]; a[i]:=a[max]; a[max]:=aux;
          reconstituire_heap(max);
        end;
   end;
procedure creare_heap;
   begin
     for i:=n div 2 downto 1 do reconstituire_heap(i);
   end;
procedure heap_sort;
   begin
     creare_heap; m:=n;
     for i:=m downto 2 do
       begin
         aux:=a[1]; a[1]:=a[i]; a[i]:=aux;
         dec(n);
         reconstituire_heap(1);
       end;
   end;
begin
assign(input,'algsort.in'); reset(input);
readln(n); for i:=1 to n do read(a[i]);
close(input);
heap_sort;
assign(output,'algsort.out'); rewrite(output);
for i:=1 to m do write(a[i],' ');
close(output);
end.