program RadixsortInt;

const MAXTAM = 40000000;
      M      = 8;  { Numero de bits a considerar a cada passada }
      NBITS  = 32; { Numero de bits da Chave }
      BASE   = 256; 

type TipoChave    = integer;
     TipoItem     = record 
                      Chave: TipoChave;
                      { outros componentes }
                    end;
     TipoIndice   = 0..MAXTAM;
     TipoVetor    = array [TipoIndice] of TipoItem;
     TipoContador = array[0..BASE-1] of integer;

var A: TipoVetor;
    B: TipoVetor;    { Vetor auxiliar usado dentro do procedimento Contagem }
    C: TipoContador; { Arranjo auxiliar usado dentro do procedimento Contagem }
    i: TipoIndice;
    n: TipoIndice;

procedure ContagemInt (var A   : TipoVetor; 
                       var n   : TipoIndice; 
                       var Pass: integer);
var i, j: integer;

  function GetBits (x: integer; k: integer; j: integer): integer;
  begin
    GetBits := (x shr k) and not (not 0 shl j);
  end;

begin
  for i:=0 to BASE - 1 do C[i] := 0;
  for i:=1 to n do 
    begin j := GetBits(A[i].Chave, Pass*M, M); C[j] := C[j]+1; end;
  if C[0] < n 
  then begin
       for i := 1 to BASE - 1 do C[i] := C[i]+C[i-1];
       for i := n downto 1 do
         begin
         j := GetBits(A[i].Chave, Pass*M, M);
         B[C[j]] := A[i];
         C[j] := C[j] - 1;
         end;
       end;
  for i := 1 to n do A[i] := B[i];
end; { ContagemInt }

procedure RadixsortInt (var A: TipoVetor; n: TipoIndice); 
var 
  i, Pass: integer;
begin
  for i := 0 to (NBITS div M) - 1 do 
    begin
    Pass := i;
    ContagemInt (A, n, Pass);
    end;
end;

procedure Imprime (var V: TipoVetor; var n: TipoIndice);
begin
  for i := 1 to n do write (V[i].Chave,' ');
  writeln;
end;

procedure Testa (var V: TipoVetor; var n: TipoIndice);
begin
  for i := 2 to n do
    begin
    if V[i].Chave < V[i-1].Chave
    then begin
         write ('ERRO: ');
         Imprime (V, n);
         halt;
         return;
         end;
    end;
  write ('OK: ');
  Imprime (V, n);
end;

begin
  n := 10; 
  randomize;
  for i := 1 to n do
    begin
    A[i].Chave := 1 + random (MaxInt);
    end;
  
  write ('Desordenado : ');
  Imprime (A, n);

  write ('Radixsort  ');
  RadixsortInt (A, n);
  Testa (A, n); 
end.

