Cod sursa(job #1634260)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 6 martie 2016 13:36:30
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 kb
program heapsort;
var f,g:text;
    bufin,bufout:array [1..1 shl 16] of char;
    v:array of longint;
    i,n,c,limita,nod:longint;
  procedure interschimbare(var a,b:longint);
  var aux:longint;
  begin
    aux:=a;
    a:=b;
    b:=aux;
  end;
begin
  assign(f,'algsort.in');reset(f);
  assign(g,'algsort.out');rewrite(g);
  settextbuf(f,bufin);settextbuf(g,bufout);
  readln(f,n); setlength(v,n+1);
  for c:=1 to n do //construiesc minheapul
    begin
      read(f,v[c]);
      nod:=c;
      while (nod div 2>0)and(v[nod]>v[nod div 2]) do
        begin
          interschimbare(v[nod],v[nod div 2]);
          nod:=nod div 2;
        end;
    end;
  for i:=n downto 2 do
    begin
      interschimbare(v[i],v[1]);
      nod:=1;
      while (nod*2<=i-1)and(v[nod]<v[nod*2]) do
        begin
          if (nod*2+1<=i-1)and(v[nod*2+1]>v[nod*2]) then
            begin
              interschimbare(v[nod],v[nod*2+1]);
              nod:=nod*2+1;
            end
          else
            begin
              interschimbare(v[nod],v[nod*2]);
              nod:=nod*2;
            end;
        end;
    end;
  for i:=1 to n do
    write(g,v[i],' ');
  close(f);
  close(g);
end.