Cod sursa(job #555502)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 15 martie 2011 16:03:59
Problema Sortare prin comparare Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 0.88 kb
var v:array [0..1, 1..500000] of int64;
    i, n, k, l:longint;
    x:int64;
    buf1, buf2:array [1..500000] of char;
    a:array [0..3] of longint;
    f, g:text;

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

read (f, n);
for i := 1 to n do read (f, v[0, i]);

k:=0;
while k <32 do
  begin
  for i := 0 to 3 do a[i]:=0;
  for i := 1 to n do
    begin
    x:=v[l mod 2, i];
    x:=x shr k;
    a[x mod 4] := a[x mod 4]+1;
    end;
for i := 1 to 3 do a[i]:=a[i]+a[i-1];
  for i := n downto 1 do
    begin
    x:=v[l mod 2, i];
    x:=x shr k;
    v[(l+1) mod 2, a[x mod 4]] := v[l mod 2, i];
    a[x mod 4]:=a[x mod 4]-1
    end;
  for i := 1 to n do v[l mod 2, i]:=0;
  l:=l+1;
  k:=k+2;
  end;

for i := 1 to n do write (g, v[l mod 2, i], ' ');

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