Cod sursa(job #1520568)

Utilizator ili226Vlad Ilie ili226 Data 9 noiembrie 2015 01:01:34
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
type sir=array[1..500003]of longint;
var f:text;
    i,n,n2:longint;
    heap:sir;
    aux:longint;
procedure sift(var h:sir;n,x:longint);
var j,max:longint;
    destul:boolean;
    aux:longint;
begin
j:=x;destul:=false;
repeat
max:=j;
if 2*j<=n then
 if (h[2*j]>h[max])then max:=2*j;
if 2*j+1<=n then
 if (h[2*j+1]>h[max])then max:=2*j+1;
if max=j then destul:=true
         else
          begin
           aux:=h[j];
           h[j]:=h[max];
           h[max]:=aux;
           j:=max;
          end;
until destul;
end;

begin
assign(f,'algsort.in');
reset(f);
readln(f,n);
for i:=1 to n do
 read(f,heap[i]);
close(f);
for i:=n div 2 downto 1 do
 sift(heap,n,i);
n2:=n;
repeat
 aux:=heap[1];
 heap[1]:=heap[n];
 heap[n]:=aux;
 dec(n);
 sift(heap,n,1)
until n=1;
assign(f,'algsort.out');
rewrite(f);
for i:=1 to n2 do
 write(f,heap[i],' ');
close(f);
end.