Cod sursa(job #946040)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 3 mai 2013 18:05:57
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.12 kb
program heap_sort;
  uses dos;
  var n,i,sizeheap:longint;
      a:array [1..1000000] of longint;
      bufin,bufout:array[1..100000] of byte;

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

procedure buildheap;
  begin
    sizeheap:=n;
    for i:=n div 2 downto 1 do heapify(i);
  end;

procedure heapsort;
  var x:longint;
  begin
    buildheap;
    for i:=n downto 2 do
      begin
        x:=a[1];
        a[1]:=a[sizeheap];
        a[sizeheap]:=x;
        dec(sizeheap);
        heapify(1);
      end;
  end;

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