Cod sursa(job #1631844)

Utilizator Stefan.Andras Stefan Stefan. Data 5 martie 2016 19:24:50
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.01 kb
program heaps;
const Nmax = 500005;
var f, g:text;
    v:array[1..Nmax] of longint;
    i, n, aux:longint;
    bufin, bufout:array[1..1 shl 16] of byte;

procedure interschimb(a, b:longint);
var aux:longint;
begin
   aux := a; a := b; b := aux;
end;
function father(nod:longint):longint;
begin
   father := nod div 2;
end;

function left(nod:longint):longint;
begin
   left := nod * 2;
end;

function right(nod:longint):longint;
begin
   right := nod * 2 + 1;
end;

procedure down(n,k:longint);
var son, aux:longint;
begin
   repeat
      son := 0;
      //fiu > tata
      if (left(k) <= n) then
         begin
            son := left(k);  //stanga, daca e mai mare ramane, altfel dreapta.
            if (right(k) <= n) and (v[right(k)] > v[left(k)]) then son := right(k);
            if v[son] <= v[k] then son := 0; //cond de oprire
         end;
      //interschimb
      if (son <> 0) then
         begin
            aux := v[k];
            v[k] := v[son];
            v[son] := aux;
            k := son;         //trec la urm
         end;
   until son = 0;
end;

procedure down2(n, fiu:longint);
var tata:longint;
begin
   tata := 0;
   while tata <> fiu do
      begin
         tata := fiu;
         if (left(tata) < n) and (v[left(tata)] > v[right(tata)]) then fiu := left(tata);
         if (right(tata) < n) and (v[left(tata)] < v[right(tata)]) then fiu := right(tata);
         interschimb(v[tata], v[fiu]);
      end;
end;

procedure build;
var i:longint;
begin
   for i := n div 2 downto 1 do
      down2(n, i);
end;

begin
   assign(f, 'algsort.in'); reset(f);
   assign(g, 'algsort.out'); rewrite(g);
   settextbuf(f, bufin); settextbuf(g, bufout);
   readln(f, n);
   for i := 1 to n do read(f, v[i]);
   build();
   //sortare in sine
   for i := n downto 2 do
      begin
         aux := v[1];
         v[1] := v[i];
         v[i] := aux;
         down2(i - 1, 1);
      end;
   for i := 1 to n do write(g, v[i],' ');
   close(f); close(g);
end.