Program SortRadix;



Uses Crt, Dos;



Type

    AType = Array [1..400] of Integer;

    Ptr   = ^Node;

    Node  = Record

          Info : Integer;

          Link : Ptr;

        end;

    LType = Array [0..9] of Ptr;



Var

   Ran     : AType;

   MaxData : Integer;



Procedure ReadData (Var A : AType; Var MaxData : Integer);



Var I : Integer;



begin

     MaxData := 10;

     For I := 1 to MaxData do read(A [I]);

end;



Procedure WriteArray (A : AType; MaxData : Integer);



Var I : Integer;



begin

  For I := 1 to MaxData do

    Write (A [I] : 7);

  Writeln;

end;



Procedure Insert (Var L : LType; Number, LN : Integer);



Var

  P, Q : Ptr;



begin

  New (P);

  P^.Info := Number;

  P^.Link := Nil;

  Q := L [LN];

  if Q = Nil then

    L [LN] := P

  else

  begin

    While Q^.Link <> Nil do

      Q := Q^.Link;

    Q^.Link := P;

  end;

end;





Procedure Refill (Var A : AType; Var L : LType);

Var

  I, J : Integer;

  P    : Ptr;

begin

  J := 1;

  For I := 0 to 9 do

  begin

    P := L [I];

    While P <> Nil do

    begin

      A [J] := P^.Info;

      P := P^.Link;

      J := J + 1;

    end;

  end;

  For I := 0 to 9 do

    L [I] := Nil;

end;



Procedure RadixSort (Var A : AType; MaxData : Integer);

Var

  L        : LType;

  I,

  divisor,

  ListNo,

  Number   : Integer;

begin

  For I := 0 to 9 do L [I] := Nil;

  divisor := 1;

  While divisor <= 1000 do

  begin

    I := 1;

    While I <= MaxData do

    begin

      Number := A [I];

      ListNo := Number div divisor MOD 10;

      Insert (L, Number, ListNo);

      I := I + 1;

    end;

    Refill (A, L);

    divisor := 10 * divisor;

  end;

end;



begin

    clrscr;

    writeln;

    Writeln('    Put the numbers to sort: ');

    ReadData (Ran, MaxData);

    Writeln ('   Unsorted : ');

    WriteArray (Ran, MaxData);

     writeln;

     writeln('   Start sorting! ');

     writeln;

     Delay(500);



    RadixSort (Ran, MaxData);

    Writeln ('   Sorted   : ');

    WriteArray (Ran, MaxData);

    Writeln;

    writeln;

     writeln('   Press the spacebar to exit the program ');

    repeat until keypressed;

end.