Shuffle Those Cards

A question has arisen about how to define a card shuffling
algorithm in Ada. Shuffling is somewhat more complicated
than simple random number generation because shuffling
requires the random generation of every value within a
specified range of values, with no duplication of values.

Shuffling also presents another problem. Random number
generation applies only to scalar values, not to compound
types such as Ada records.

The solution I have derived is simple, and is generically
useful. 

The list of values being shuffled can be represented by
an array of indices into that list. The list may be represented
in any manner, so long as elements can be accessed by a discrete
index value. Arrays are the simplest example, but other
list structures are just as applicable to this approach.

The shuffling algorithm simply randomly arranges the array
of indices. The list referenced by the array of indices is
never altered by the shuffling sequence, and my in fact
be defined as a constant entity.

The following three files show how this method can be applied.

-----------------------------------------------------------------------
-- Cards.ads
-- Package implementing a standard deck of playing cards
-----------------------------------------------------------------------

   package Cards is
   
      type Card is private;
   
      -- Print the value of a card
      procedure Print(Item : in Card);
   
      type Deck is private;
   
      -- Create an initial deck (open a new deck of cards)
      function Fill_Deck return Deck;
   
      -- Print all the cards remaining in a deck
      procedure Print(Item : in Deck);
   
      -- Shuffle the deck (randomize the order of the cards in the deck)
      procedure Shuffle(The_Deck : in out Deck);

      -- Deal the next card from the deck
procedure Deal(The_Card : out Card; From : in out Deck);

      -- Return the number of cards left in the deck
function Cards_Left(In_Deck : Deck) return Natural;

      -- Deck_Empty exception raised when trying to deal from an 
      -- empty deck.
Deck_Empty : Exception;
   
   private
   
      -- Define the face values of the cards
      type Pips is (Two, Three, Four, Five, Six, Seven, Eight, Nine,
Ten,
      Jack, Queen, King, Ace);
      
      -- Define the card suits
      type Suits is (Hearts, Spades, Clubs, Diamonds);
   
      -- A card is defined by its combination of face value
      -- and suit.
      type Card is record
            Pip  : Pips;
            Suit : Suits;
         end record;
   
      -- Define the number of cards in a standard deck.
      subtype Deck_Index is integer range 1..52;
   
      -- Cards in the deck are accessed through an order list.
      -- The values in the order list are sorted to create a
      -- shuffled deck.
      type Order_List is array(Deck_Index) of Deck_Index;
   
      -- A deck is an order list, an index into the order list
      -- indicating the next card to deal, and a count of the
      -- number of cards left (not yeat dealt) in the deck.
      type Deck is record
            This_Order : Order_List;
            Deal_Next  : Deck_Index := Deck_Index'First;
            Num_Left   : Natural := 0;
         end record;
   end Cards;

-----------------------------------------------------------------------
-- Cards.adb
-- Implementation of the Cards package
-----------------------------------------------------------------------

   with Ada.Numerics.Float_Random;
   with Ada.Text_Io;

   package body Cards is
   
      type Card_Deck is array(Deck_Index) of Card;
   
   --------------
   -- Internal Function: Initialize
   -- Purpose: Initialize the value of the common Card_Deck
   --------------
      function Initialize return Card_Deck is
         Result : Card_Deck;
         Temp_Index : Integer := Deck_Index'First;
      begin
         for The_Suit in Suits loop
            for The_Pip in Pips loop
               Result(Temp_Index) := (The_Pip, The_Suit);
               Temp_Index := Temp_Index + 1;
            end loop;
         end loop;
         return Result;
      end Initialize;
   
      All_Decks : constant Card_Deck := Initialize;
   
   -----------
   -- Procedure: Print
   -- Purpose: Print the value of a card on standard output
   -----------
      procedure Print(Item : in Card) is
         package Pip_Io is new Ada.Text_Io.Enumeration_IO(Pips);
         package Suit_Io is new Ada.Text_Io.Enumeration_Io(Suits);
      begin
         Pip_Io.Put(Item => Item.Pip);
         Ada.Text_Io.Put(Item => " of ");
         Suit_Io.Put(Item => Item.Suit);
         Ada.Text_Io.New_Line;
      end Print;
   
   -----------------
   -- Function: Fill_Deck
   -- Purpose: Create a new card deck with all cards in order
   ----------------
      function Fill_Deck return Deck is
         Result : Deck;
         Temp_Index : Integer := Deck_Index'First;
      begin
         for Temp_Index in Deck_Index'Range loop
            Result.This_Order(Temp_Index) := Temp_Index;
         end loop;
         Result.Num_Left := Deck_Index'Last;
         return Result;
      end Fill_Deck;
   
   ---------
   -- Procedure: Print
   -- Purpose: Print all the cards remaining in the deck
   ---------
   
      procedure Print(Item : in Deck) is
      begin
         if Item.Num_Left > 0 then
            for Temp_Index in Item.Deal_Next..Deck_Index'Last loop
               print(All_Decks(Item.This_Order(Temp_Index)));
            end loop;
         else
            Ada.Text_Io.Put_Line("The deck is empty.");
         end if;
      end Print;
   
   ------------
   -- Procedure Swap
   -- Exchange two Deck_Index values
   --------------
      procedure Swap(Left, Right : in out Deck_Index) is
         Temp : Deck_Index := Left;
      begin
         Left := Right;
         Right := Temp;
      end Swap;
   
   -------------
   -- Procedure: Shuffle
   -- Purpose: Randomize the This_Order array for a deck to force
   --          random access to the deck of cards
   -- 
   --  This algorithm is order O(n) and will work with any discrete
   --  index type.
   --  The Ada.Numerics.Float_Random routine is used so that the
   --  random number generator is reset only once per shuffle. This
   --  produces more random results than can be achieved by
   --  resetting the generator for each iteration as would be needed
   --  if the Ada.Numerics.Discrete_Random package had been used.
   ------------
   
      procedure Shuffle(The_Deck : in out Deck) is
use Ada.Numerics.Float_Random;
         Seed       : Generator;
         Max_Search : Deck_Index := Deck_Index'Pred(Deck_Index'Last);
         Difference : Integer;
         Rand_Value : Integer;
         Swap_Value : Deck_Index;
      begin
         Reset(Seed);
The_Deck.Deal_Next := Deck_Index'First;
         The_Deck.Num_Left  := Deck_Index'Last;
         for Index in Deck_Index'First .. Max_Search loop
            Difference := Deck_Index'Pos(Deck_Index'Last) - 
                                      Deck_Index'Pos(Index);
            Rand_Value := Integer(Random(Seed) * Float(Difference))
                          + Deck_Index'Pos(Index);
            Swap_Val := Deck_Index'Val(Rand_Value);
            Swap(The_Deck.This_Order(Index), 
                 The_Deck.This_Order(Swap_Val)); 
         end loop;
         The_Deck.Num_Left := Deck_Index'Last;
         The_Deck.Deal_Next := Deck_Index'First;
      end Shuffle;
   
      procedure Deal(The_Card : out Card; From : in out Deck) is
      begin
         if From.Num_Left > 0 then
            The_Card := All_Decks(From.This_Order(From.Deal_Next));
            From.Num_Left := From.Num_Left - 1;
            if From.Deal_Next < Deck_Index'Last then
               From.Deal_Next := From.Deal_Next + 1;
            end if;
         else
            raise Deck_Empty;
         end if;
      end Deal;
   
      function Cards_Left(In_Deck : Deck) return Natural is
      begin
         return In_Deck.Num_Left;
      end Cards_Left;
   
   end Cards;

-----------------------------------------------------------------------
-- Card_Deck.adb
-- This procedure is a test driver for the Cards package
-----------------------------------------------------------------------

   with Ada.Text_Io;
   with Cards;

   procedure Card_Deck is
   
      My_Deck : Cards.Deck;
      This_Card : Cards.Card;
   
   begin
   
      -- Create a new deck of cards, like opening a new deck of
      -- cards. The deck returned is sorted by suit and value.
      My_Deck := Cards.Fill_Deck;
      Ada.Text_Io.Put_Line("Initial Deck:");
      Cards.Print(My_Deck);
      
      -- Shuffle the deck so that the cards are accessed in a
      -- random order.
      Cards.Shuffle(My_Deck);
      Ada.Text_Io.New_Line(2);
      Ada.Text_Io.Put_Line("Shuffled Deck:");
      Cards.Print(My_Deck);
      
   -- Deal out the cards, printing each dealt card.
      Ada.Text_Io.New_Line(2);
      Ada.Text_Io.Put_Line("Printing each card as it is dealt:");
      while Cards.Cards_Left(In_Deck => My_Deck) > 0 loop
         Cards.Deal(The_Card => This_Card, From => My_Deck);
         Cards.Print(This_Card);
      end loop;
   
   -- Attempt to deal one more card from the deck. This will raise
   -- the Deck_Empty exception.
      Ada.Text_Io.New_Line(2);
      Ada.Text_Io.Put_Line("Attempting to deal from an empty deck:");
   
      begin
         Cards.Deal(The_Card => This_Card, From => My_Deck);
         Cards.Print(This_Card);
         exception
            when Cards.Deck_Empty =>
               Ada.Text_Io.Put_Line(
"ERROR: You attempted to deal from an empty deck.");
      end;

-- Attempt to print an empty deck
Cards.Print(My_Deck);
   
   
   end Card_Deck;