Cod sursa(job #1210391)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 19 iulie 2014 20:25:49
Problema Sortare prin comparare Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.95 kb
program heapsort;
  var a:array [1..500000] of longint;
      heapsize,u,n,i:longint;
      bufin,bufout:array [1..100000] of byte;

procedure heapify(x:longint);
  var max:longint;
  begin
    max:=x;
    if 2*x<=heapsize then
      if a[2*x]>a[max] then max:=2*x;
    if 2*x+1<=heapsize then
      if a[2*x+1]>a[max] then max:=2*x+1;
    if max<>x then
      begin
        u:=a[max];
        a[max]:=a[x];
        a[x]:=u;
        heapify(max);
      end;
  end;

begin
  assign(input,'algsort.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'algsort.out');
  rewrite(output);
  settextbuf(output,bufout);
  readln(n);    heapsize:=n;
  for i:=1 to n do read(a[i]);
  for i:=n div 2  downto 1 do heapify(i);
  while heapsize>1 do
    begin
      u:=a[1];
      a[1]:=a[heapsize];
      a[heapsize]:=u;
      dec(heapsize);
      heapify(1);
    end;
  for i:=1 to n do write(a[i],' ');
  close(output);
end.