Cod sursa(job #1520557)

Utilizator ili226Vlad Ilie ili226 Data 9 noiembrie 2015 00:46:09
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
type sir=array[1..500000]of longint;
var f:text;
    i,n,n2:longint;
    heap:sir;
    aux:integer;
procedure sift(var h:sir;n,x:longint);
var j,st,dr,max:longint;
    destul:boolean;
    aux:longint;
begin
j:=x;destul:=false;
repeat
max:=j;
if (h[2*j]>h[max])and(2*j<=n)then max:=2*j;
if (h[2*j+1]>h[max])and(2*j+1<=n)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.