Cod sursa(job #1041997)

Utilizator andrei31Andrei Datcu andrei31 Data 26 noiembrie 2013 13:58:15
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.87 kb
var a: array[1..500000] of longint;
    i: longint;
    var n: longint;

procedure swap(i,j:longint);
var aux:longint;
begin
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
end;

procedure comb(i,n:longint);
var go:longint;
begin
go:=i;
if (2 * i <= n) then
            if a[2*i]>a[i] then go:=2*i;
            
if (2*i+1<=n) then
          if a[2*i+1] >a[go] then go:=2*i+1;

if go<>i then
   begin
   swap(go,i);
   comb(go,n);
   end;
end;
 
procedure formheap;
 var i:longint;
begin
for i:=n div 2 downto 1 do
comb(i,n)
end;
 
procedure heapsort;
var i:longint;
begin
    formheap;
for i:=n downto 2 do
 begin
 swap(1,i);
 comb(1,i-1);
 end;
end;

begin
 assign(input, 'algsort.in');reset(input);
 
 readln(n);
 
 for i := 1 to n do
   read(a[i]);
  
 close(input);
 
 heapsort;
 
 assign(output, 'algsort.out');rewrite(output);
 
 for i := 1 to n do
   write(a[i],' ');
 
 writeln;
 close(output);
end.