Re: Ada2005 random

["Robert I. Eachus" <rieachus@attbi.com>]

Dale Stanbrough wrote:
> Randy Brukardt wrote:
> 
> 
>>I needed that for a 'choosing' algorithm, say drawing balls one by one
>>out of a bowl. If you have 8 balls originally, you're choosing 1 out of
>>7, then 1 out of 6, etc. If you try to use 1 out of 8 the whole time and
>>discarding the useless ones, the second last draw can take a very long
>>time (only 2 out of 8 choices are meaningful). I'm pretty sure that this
>>is a valid technique; certainly the underlying float generator is still
>>random (at least as much as it ever was!), and the use of that result is
>>unbiased.
>>
>>While it would be nice if Ada supported this directly, it's easy enough
>>to write it yourself.

If you need a permutation, the best way to do it is to generate a set of 
random (float) values, associate them with the data to be permuted and 
the sort on this key.  I have seen a lot of code that attempts to 
permute a list by going through the list and exchanging elements.  For 
lists of length greater than two this can easily be shown to be biased.

For example there are 3! = 6 possible permutions of a list of three 
elements, the usual version of the swapping algorithm has 3^3 = 27 
possible outcomes, another (worse) variation has 2^3 = 8 different 
outcomes.  In either case the number of outcomes is not evenly divisible 
by the number of different permutations.

Even if you do this, there is another potential problem.  For a set of 
size N, there are N! possible permutations.  For example for a deck of 
cards, there are 52! possible permutations.  If you are generating 
bridge hands, there are 52!/(13!)^4 different possible deals.  Now if 
you are taking the (pseudo-)random sequence from a single generator, 
there will be at most as many different possible hands as there are 
possible starting seeds for the generator.  For the generator that I 
wrote, which AFAIK is still used by GNAT, if you use the time based 
version of Reset, there are more than 2^32 possible starting values, but 
of course, they won't all occur in a particular year.

If you really, really care about making it possible to generate a large 
fraction of all possible permutations, the way to do it is to take 
several generators with seeds generated based on different random data, 
then shuffle the deck more than once.

This program should serve as an example of how to do this.  (Note, I 
don't claim this is "right" since I don't use two generators, and 
shuffle twice.)

with Ada.Numerics.Float_Random;
package Statistics is

    subtype Generator is Ada.Numerics.Float_Random.Generator;

    type Direction is (Ascending, Descending);

    generic
      type Element_Type is private;
      type Index_Type is (<>);
      type List_Type is array (Index_Type range <>) of Element_Type;
      with function "<" (L, R : Element_Type) return Boolean is <>;
    procedure Sorting (List : in out List_Type);
    --  General-purpose sorting procedure

    generic
      type Element_Type is private;
      type Index_Type is (<>);
      type List_Type is array (Index_Type range <>) of Element_Type;
    procedure Shuffling (List : in out List_Type;
                         Gen  : in     Generator);
    --  Permute the contents of List randomly

end Statistics;
------------------------------------------------------------------------
with Ada.Numerics.Float_Random;
package body Statistics is

    package NFR renames Ada.Numerics.Float_Random;

--  generic
--    type Element_Type is private;
--    type Index_Type is (<>);
--    type List_Type is array (Index_Type range <>) of Element_Type;
--    with function "<" (L, R : Element_Type) return Boolean is <>;
    procedure Sorting (List : in out List_Type) is
       --  Quicksort
       Part  : Element_Type;
       First : Index_Type;
       Last  : Index_Type;
    begin
      --  Don't break on short lists;
       if List'Length <= 1
       then return;
       elsif List'Length = 2 then
          if List(List'Last) < List(List'First)
          then
             Part := List(List'First);
             List(List'First) := List(List'Last);
             List(List'Last) := Part;
          end if;
          return;
       end if;

       --  now it is safe to assume that List'First and List'Last
       --  are in range.

       First := List'First;
       Last  := List'Last;

       -- choose partition value
       Part := List(First);

       -- partition list
    Main_Loop:
       loop
          if Part < List(Last) then
             Last := Index_Type'PRED(Last);
             exit Main_Loop when Last=First;
          else
             List(First) := List(Last);
             First := Index_Type'SUCC(First);
             exit Main_Loop when Last=First;
             while List(First) < Part loop
                First := Index_Type'SUCC(First);
                exit Main_Loop when Last=First;
             end loop;
             List(Last) := List(First);
             Last := Index_Type'PRED(Last);
             exit Main_Loop when Last=First;
          end if;
       end loop Main_Loop;

       List(First) := Part; -- at this point First = Last.
       Sorting(List(List'First..Index_Type'PRED(Last)));
       Sorting(List(Index_Type'SUCC(Last)..List'Last));
    end Sorting;


    --  generic
    --   type Element_Type is private;
    --   type Index_Type is (<>);
    --   type List_Type is array (Index_Type range <>) of Element_Type;
    procedure Shuffling (List : in out List_Type;
                         Gen  : in     Generator) is
       List_Copy : constant List_Type := List;

       type Rec is
          record
             Index : Index_Type;
             Rand  : Float;
          end record;

       type Rec_Array is array (Index_Type range <>) of Rec;

       Temp : Rec_Array(List'Range);

       function "<" (L, R: Rec) return Boolean is
       begin return L.Rand < R.Rand; end "<";

       procedure Sort is new Sorting(Rec, Index_Type, Rec_Array, "<");

     begin
        for I in Temp'Range loop
           Temp(I) := (I, NFR.Random(Gen));
        end loop;

        Sort(Temp);  --  Sort based on value of random number

        --  Now rearrange List based on the order of indices in Temp
        for I in List'Range loop
           List(I) := List_Copy(Temp(I).Index);
        end loop;
     end Shuffling;

end Statistics;
---------------------------------------------------------------------------
with Ada.Numerics.Float_Random;
with Statistics;
with Text_IO; use Text_IO;
procedure Bridge_Hands is
-- a procedure to produce random (but sorted) bridge hands for duplicate.

   package NFR        renames Ada.Numerics.Float_Random;

   Gen: NFR.Generator;
   function Rand(G: in NFR.Generator := Gen) return Float renames 
NFR.Random;

   type Direction is (North, East, South, West);
   type Suits is (Spades, Hearts, Diamonds, Clubs);
   type Ranks is (Ace, King, Queen, Jack, Ten, Nine, Eight, Seven,
                 Six, Five, Four, Three, Deuce);

   Display_Suit: constant array(Suits) of Character := "SHDC";
   Display_Rank: constant array(Ranks) of Character := "AKQJT98765432";

   subtype Dealer_Name is String(1..5);
   Display_Dealers: constant array(0..3) of Dealer_Name :=
      ("North", "East ", "South", "West ");
   subtype Vulnerability is String(1..11);
   Display_Vulnerability: constant array(0..3) of Vulnerability :=
      ("None       ","North/South","East/West  ","Both       ");
   package Int_IO is new Text_IO.Integer_IO(Integer);
   Number_of_Hands: Integer;

   type Card is record
     Suit: Suits;
     Rank: Ranks;
   end record;

   type Card_Array is array (Natural range <>) of Card;

   Deck: Card_Array(0..51);

   subtype Hand is Card_Array(0..12);
   Hands: array(Direction) of Hand;


   function By_Rank(L,R: Card) return Boolean is
   begin return L.Rank < R.Rank; end By_Rank;
   pragma INLINE(By_Rank);

   procedure Sort_Hand is
     new Statistics.Sorting(Card, Natural, Card_Array, By_Rank);

   procedure Shuffle is
     new Statistics.Shuffling(Card, Natural, Card_Array);

   procedure Deal is
   begin
     for I in Hand'Range loop
       for J in Hands'Range loop
         Hands(J)(I) := Deck(I*4 + Direction'POS(J));
       end loop;
     end loop;
     for I in Hands'Range loop
       Sort_Hand(Hands(I));
       -- sort cards by rank, but not by suit.
     end loop;
   end Deal;

   function Cards(D: in Direction; S: in Suits) return String is
     Temp: String(1..26) := (others => ' ');
     Index: Natural := 3;
   begin
     Temp(1) := Display_Suit(S);
     for I in Hand'Range loop
       if Hands(D)(I).Suit = S
       then
         Temp(Index) := Display_Rank(Hands(D)(I).Rank);
         Index := Index + 2;
       end if;
     end loop;
     if Index = 3 then Temp(3..5) := "---"; end if;
     return Temp;
   end Cards;

begin

   -- Use time-dependant random numbers:

   NFR.Reset(Gen);

   -- Initialize deck.

   for I in Deck'Range loop
     Deck(I) := (Suits'VAL(I/13), Ranks'VAL(I mod 13));
   end loop;

   Text_IO.Put_Line("Enter number of hands, default is 32:");

   begin
     Int_IO.Get(Number_of_Hands);
   exception when others =>
     Number_of_Hands := 32;
   end;

   for I in 0..Number_of_Hands - 1 loop
     Text_IO.New_Page;
     Text_IO.New_Line(3);
     Text_IO.Put_Line("                                Board:        "
         & Integer'IMAGE(I+1));
     Text_IO.Put_Line("                                Dealer:        "
       & Display_Dealers(I mod 4));
     Text_IO.Put_Line("                                Vulnerability: "
       & Display_Vulnerability((I + I/4) mod 4));
     New_Line(3);

     Shuffle(Deck, Gen);

     Deal;

     Text_IO.Put_Line("                                NORTH");
     Text_IO.New_Line;
     Text_IO.Put_Line("                              " &
                      Cards(North,Spades));
     Text_IO.Put_Line("                              " &
                      Cards(North,Hearts));
     Text_IO.Put_Line("                              " &
                      Cards(North,Diamonds));
     Text_IO.Put_Line("                              " &
                      Cards(North,Clubs));
     New_Line(2);
     Text_IO.Put_Line("       WEST                                  " &
                      "          EAST");
     Text_IO.New_Line;
     Text_IO.Put_Line("     " & Cards(West,Spades) &
                      "                      " & Cards(East,Spades));
     Text_IO.Put_Line("     " & Cards(West,Hearts) &
                      "                      " & Cards(East,Hearts));
     Text_IO.Put_Line("     " & Cards(West,Diamonds) &
                      "                      " & Cards(East,Diamonds));
     Text_IO.Put_Line("     " & Cards(West,Clubs) &
                      "                      " & Cards(East,Clubs));
     New_Line(2);
     Text_IO.Put_Line("                                SOUTH");
     Text_IO.New_Line;
     Text_IO.Put_Line("                              " &
                      Cards(South,Spades));
     Text_IO.Put_Line("                              " &
                      Cards(South,Hearts));
     Text_IO.Put_Line("                              " &
                      Cards(South,Diamonds));
     Text_IO.Put_Line("                              " &
                      Cards(South,Clubs));
   end loop;

end Bridge_Hands;