Cod sursa(job #404401)

Utilizator mimarcelMoldovan Marcel mimarcel Data 26 februarie 2010 09:00:06
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 kb
const maxn=500000;
type heap=array[1..maxn]of longint;
var h:heap;
    n,i:longint;

procedure jos(var h:heap;n:longint;a:longint);
var k,f:longint;
begin
k:=h[a];
repeat
if a shl 1>n then break
             else
  begin
  f:=a shl 1;
  if(f<n)and(h[f+1]>h[f])then f:=f+1;
  end;
if h[f]>k then begin
               h[a]:=h[f];
               a:=f;
               end
          else break;
until false;
h[a]:=k;
end;

procedure build_heap(var h:heap;n:longint);
var i:longint;
begin
for i:=n shr 1 downto 1 do jos(h,n,i);
end;

procedure interschimba(var a,b:longint);
begin
a:=a xor b;
b:=b xor a;
a:=a xor b;
end;

procedure heapsort(var h:heap;n:longint);
var i:longint;
begin
build_heap(h,n);
for i:=n downto 2 do
  begin
  interschimba(h[1],h[i]);
  jos(h,i-1,1);
  end;
end;

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