Cod sursa(job #552705)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 12 martie 2011 18:54:38
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.01 kb
var v:array [0..500000] of longint;
    aux, x:longint;
    i, j, n, k:longint;
    buf1, buf2:array [1..500000] of char;
    ok:boolean;
    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 v[j*2] < v[j*2+1] then k:= j*2
                       else k:=j*2+1;
  if ((j*2<=n-i) and (j*2+1>n-1)) then k :=j*2;
  if (j*2>n-i) then k:=j;
  while v[j] > v[k] do
    begin
    aux:=v[j]; v[j] := v[k]; v[k] := aux;
    j:=k;
    if v[j*2] < v[j*2+1] then k:= j*2
                         else k:=j*2+1;
    if ((j*2<=n-i) and (j*2+1>n-1)) then k :=j*2;
    if (j*2>n-i) then k:=j;
    end;
  end;

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