Cod sursa(job #590733)

Utilizator promix2012petruta andrei promix2012 Data 19 mai 2011 19:54:22
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 kb
program heapsort;
const fi='algsort.in';
      fo='algsort.out';

var f,g:text;
 v:array[1..500000] of longint;
 bufin,bufout:array[1..65000] of byte;
 i,n:longint;
  function indvalmin(i,n:longint):longint;
  begin
  if (2*i+1)<=n then
       if v[2*i]>=v[2*i+1] then
          indvalmin:=2*i
          else
          indvalmin:=2*i+1 else
          indvalmin:=2*i;
          end;
  procedure combinare(i,n:longint);
  var ind,man:longint;
  begin
  if i<=n div 2 then
     begin
     ind:=indvalmin(i,n);
     if v[i]<v[ind] then
     begin
     man:=v[i];
     v[i]:=v[ind];
     v[ind]:=man;
     combinare(ind,n);
     end
     end
     end;
procedure minheap;
begin
for i:=n div 2 downto 1 do
combinare(i,n);
end;
procedure heapsort;
var man:longint;
begin
minheap;
for i:=n downto 1 do
  begin
  man:=v[i];
  v[i]:=v[1];
  v[1]:=man;
  combinare(1,i-1);
  end
  end;
begin
assign(f,fi);
reset(f);
assign(g,fo);
rewrite(g);
settextbuf(f,bufin);
settextbuf(g,bufout);
read(f,n);

for i:=1 to n do
   begin
   read(f,v[i]);
   end;
   heapsort;
for i:=1 to n do
   write(g,v[i],' ');
   close(f);
   close(g);
   end.