Cod sursa(job #551090)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 10 martie 2011 12:39:16
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 kb
var v:array [0..500000] of int64;
    aux, x:int64;
    i, j, n, k:longint;
    buf1, buf2:array [0..500000] of char;
    f, g:text;

begin
assign (f, 'algsort.in');
reset (f);
settextbuf (f, buf1);
assign (g, 'algsort.out');
rewrite (g);
settextbuf (g, buf2);

read (f, n);
for i := 1 to n do
  begin
  read (f, v[i]);
  j:= i;
  while v[j]<v[j div 2] do
    begin
    aux:= v[j]; v[j]:=v[j div 2]; v[j div 2]:=aux;
    j:= j div 2;
    end;
  end;

for i := 1 to n do
  begin
  write (g, v[1], ' ');
  v[1]:= v[n-i+1];
  j:=1;
  if (j*2=n-i) then k :=j*2;
  if (j*2>n-i) then k:=j;
  if (j*2<n-i) then
    begin
    if v[j*2] < v[j*2+1] then k:= j*2
                         else k:=j*2+1;
    end;
  while v[j] > v[k] do
    begin
    aux:=v[j]; v[j] := v[k]; v[k] := aux;
    j:=k;
    if (j*2<n-i) then
      begin
      if v[j*2] < v[j*2+1] then k:= j*2
                           else k:=j*2+1;
      end;
    if (j*2=n-i) then k :=j*2;
    if (j*2>n-i) then k:=j;
    end;
  end;

close (f);
close (g);
end.