Cod sursa(job #693468)

Utilizator promix2012petruta andrei promix2012 Data 27 februarie 2012 12:52:39
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.33 kb
program heapsort;
uses math;
const fi='algsort.in';
      fo='algsort.out';
var bufin,bufout:array[1..65000] of char;
 f,g:text;
v:array[1..500000] of longint;
par,el,i,aux,n:longint;
function indm(el:longint):longint;
begin
if (el*2+1)<i-1 then
    indm:=el*2
    else
      if v[el*2]>v[el*2+1] then
          indm:=el*2 else
          indm:=el*2+1;
end;
procedure sort;
begin
for i:=n downto 1 do
   begin
   aux:=v[i];
   v[i]:=v[1];
   v[1]:=aux;
   el:=1;
   while (el*2<i-1)and(v[indm(el)]>v[el]) do
      begin
      if (v[el*2]>v[el*2+1])or(el*2+1>i-1) then
         begin
         aux:=v[el];
         v[el]:=v[el*2];
         v[el*2]:=aux;
         el:=el*2;
         end
         else
         begin

          aux:=v[el];
         v[el]:=v[el*2+1];
         v[el*2+1]:=aux;
          el:=el*2+1;
         end


      end;



end;
end;
procedure heap(k:longint);
begin
par:=k div 2;
el:=k;
while (par<>0)and(v[par]<v[el]) do
   begin
   aux:=v[par];
   v[par]:=v[el];
   v[el]:=aux;
   el:=par;
   par:=par div 2;
   end;
end;

begin
assign(f,fi);
reset(f);
settextbuf(f,bufin);
assign(g,fo);
rewrite(g);
settextbuf(g,bufout);
read(f,n);
for i:=1 to n do
begin
read(f,v[i]);
heap(i);
end;
sort;
for i:=1 to n do
   write(g,v[i],' ');



close(f);
close(g);
end.