Ada Matchup Array

Question

I have a function in ada which has to check a large array of booleans to return a (sparse) value. It is difficult to explain in words, so here's an 'ideal' solution that doesn't work in ada (note that I have more than 3 challenger types and tougher logic):

type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
type Challengers is array (ChallengerType) of Boolean;
pragma Pack(Challengers);

-- NOT legal, challengers is not an enumeration type
matchups : array (Challengers) of ChallengerType := (
    -- Single challenger victories
    (Rock => True, others => False) => Rock,
    (Paper => True, others => False) => Paper,
    (Scissors => True, others => False) => Scissors,
    -- Double challenger victories
    (Rock => True, Paper => True, others => False) => Paper,
    (Rock => True, Scissors => True, others => False) => Rock,
    (Paper => True, Scissors => True, others => False) => Scissors,
    -- All the rest either are ambiguous (RPS) or suicided
    others => None)

This is not legal in Ada, so I went with the more c-style version where my array was of Integer range 0..2#11111# and wrote a converter. However the code becomes much less clean (EG: (2#00101# => Scissors) is not as clear).

What would be the 'best' way to implement such a matchup array?

Summary: I want a mapping from the power set of an enumeration type to one of its values. IE: if my enumeration was {A,B,C} I would want a mapping from {{},{A},{B},{C},{A,B},{A,C},{B,C},{A,B,C}} to {A,B,C}. I also know in advance that most of the values in the mapping will be the same type, so the others keyword would be very nice to use. Currently I use binary indexing with '1' meaning that the specified enum element is present, but I wish I could be more explicit.

Answer 1

A somewhat simpler answer uses the Vector type from the Ada.Containers.Vectors package:

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
use Type Ada.Containers.Count_Type;

procedure Mapping_Vector is
   type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
   type Challengers is array (ChallengerType) of Boolean with Pack;
   package Challenge_Vect is new Ada.Containers.Vectors(Positive, ChallengerType);
   use Challenge_Vect;

   function Map_Challengers(Item : in Challengers) return Vector is
      Result : Vector := Empty_Vector;
   begin
      for I in Item'Range loop
         if Item(I) then 
            Result.Append(I);
         end if;
      end loop;
      return Result;
   end Map_Challengers;

   Foo : Challengers := (Rock..Scissors => True, Others => False);
   Mapped_Challengers : Vector := Map_Challengers(Foo);
begin
   If Mapped_Challengers.Length > 0 then
      for C of Mapped_Challengers loop
         Put_Line(ChallengerType'Image(C));
      end loop;
   else
      Put_Line("No challengers were TRUE");
   end if;
end Mapping_Vector;

Answer 2

This is not a purely static solution, but it makes it possible to configure the mapping elegantly in terms of enumeration values, even if the mapping array in reality is indexed by a modular type:

Specification:

with Ada.Text_IO;
with Ada.Unchecked_Conversion;

generic
   type Element_Type is (<>);
   type Numeric_Type is mod <>;
package Set_With_Modular_Representation is
   type Instance is array (Element_Type) of Boolean with Pack;

   Empty_Set : constant Numeric_Type := 0;
   E         : Numeric_Type renames Empty_Set; --  Got a request not to use Ø.

   function "&" (Left  : in Instance;
                 Right : in Instance) return Numeric_Type;
   function "&" (Left  : in Numeric_Type;
                 Right : in Instance) return Numeric_Type;

   function "&" (Left  : in Element_Type;
                 Right : in Element_Type) return Numeric_Type;
   function "&" (Left  : in Numeric_Type;
                 Right : in Element_Type) return Numeric_Type;
private
   pragma Assert (Numeric_Type'Modulus = 2 ** Instance'Size);
   pragma Assert (Numeric_Type'Size = Instance'Size);

   function Numeric is
     new Ada.Unchecked_Conversion (Source => Instance,
                                   Target => Numeric_Type);
   function Numeric (Item : in Element_Type) return Numeric_Type;
end Set_With_Modular_Representation;

Implementation:

package body Set_With_Modular_Representation is
   function "&" (Left  : in Instance;
                 Right : in Instance) return Numeric_Type is
   begin
      return Numeric (Left) or Numeric (Right);
   end "&";

   function "&" (Left  : in Numeric_Type;
                 Right : in Instance) return Numeric_Type is
   begin
      return Left or Numeric (Right);
   end "&";

   function "&" (Left  : in Element_Type;
                 Right : in Element_Type) return Numeric_Type is
   begin
      return Numeric (Left) or Numeric (Right);
   end "&";

   function "&" (Left  : in Numeric_Type;
                 Right : in Element_Type) return Numeric_Type is
   begin
      return Left or Numeric (Right);
   end "&";

   function Numeric (Item : in Element_Type) return Numeric_Type is
      Buffer : Instance := (others => False);
   begin
      Buffer (Item) := True;
      return Numeric (Buffer);
   end Numeric;
end Set_With_Modular_Representation;

Demonstration:

with Ada.Command_Line;
with Ada.Text_IO;

with Set_With_Modular_Representation;

procedure Set_With_Modular_Representation_Demo is
   type Outcomes is (Paper, Rock, Scissors, Suicide, None);
   subtype Choices is Outcomes range Paper .. Scissors;

   type Numeric_Choices is mod 2 ** 3;
   package Choice_Set is
     new Set_With_Modular_Representation (Element_Type => Choices,
                                          Numeric_Type => Numeric_Choices);
   use Choice_Set;

   Mapping : array (Numeric_Choices) of Outcomes := (others => None);
begin
   Set_Up_Mapping :
   begin
      --  Single challenger victories
      Mapping (E     & Rock)     := Rock;
      Mapping (E     & Paper)    := Paper;
      Mapping (E     & Scissors) := Scissors;

      --  Double challenger victories
      Mapping (Rock  & Paper)    := Paper;
      Mapping (Rock  & Scissors) := Rock;
      Mapping (Paper & Scissors) := Scissors;
   end Set_Up_Mapping;

   Test :
   declare
      package Outcome_Text_IO is
        new Ada.Text_IO.Enumeration_IO (Outcomes);
      use Ada.Command_Line, Ada.Text_IO, Outcome_Text_IO;

      Chosen : Numeric_Choices := E;
   begin
      for Index in 1 .. Argument_Count loop
         Chosen := Chosen & Choices'Value (Argument (Index)); --  '
      end loop;

      Put ("Outcome: ");
      Put (Mapping (Chosen));
      New_Line;
   end Test;
end Set_With_Modular_Representation_Demo;

Answer 3

NOT an answer... posting in case it helps someone see a way forward.

This expands on my comment above : as far as generating a discrete type from an array goes, it appears to work...

with Ada.Unchecked_Conversion;

package RPS is

type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
for ChallengerType use (Rock => 1, Paper => 2,Scissors => 4,Suicide => 8,None => 16);

type Challengers is array (ChallengerType) of Boolean with Pack;
type Challengers_int is range 0 .. 31;
function IDX is new Ada.Unchecked_Conversion(Challengers, Challengers_int);

Rock_Only : constant Challengers := (Rock => True, others => False);
Rock_IDX : constant Challengers_int := IDX(Rock_Only);

matchups : constant array (Challengers_int) of ChallengerType := (
    -- Single challenger victories
    -- Rock_IDX => Rock, -- fails
    1 => Rock,
    IDX((Paper => True, others => False)) => Paper, -- fails
    IDX((Scissors => True, others => False)) => Scissors,
    -- Double challenger victories
    IDX((Rock => True, Paper => True, others => False)) => Paper,
    IDX((Rock => True, Scissors => True, others => False)) => Rock,
    IDX((Paper => True, Scissors => True, others => False)) => Scissors,
    -- All the rest either are ambiguous (RPS) or suicided
    others => None);

end RPS;

However, it fails to compile, dynamic or empty choice in aggregate must be the only choice at either of the commented lines in the array - even if the index is a constant rather than an expression.

A Case statement fails similarly :

case IDX(C) is 
when Rock_IDX => return Rock;
when IDX((Paper => True, others => False)) => return Paper;
...

compiler reports:

rps.adb:11:10: choice given in case statement is not static
rps.adb:11:10: "Rock_IDX" is not a static constant (RM 4.9(5))
rps.adb:12:10: choice given in case statement is not static
rps.adb:12:10: non-static function call (RM 4.9(6,18)) rps.adb:12:14:
static expression must have scalar or string type (RM 4.9(2))

Answer 4

Here is one solution:

with Ada.Text_IO; use Ada.text_IO;

procedure Mapping_Question is
   type ChallengerType is (Rock,Paper,Scissors,Suicide,None);
   type Challengers is array (ChallengerType range <>) of Boolean with Pack;
   Type Mapped_Challenges is array(Positive range <>) of ChallengerType;

   function Map_Challengers(Item : Challengers) return Mapped_Challenges is
      function Mapper(Item : Challengers) return Mapped_Challenges is
         Single : Mapped_Challenges(1..1);
      begin
         for I in Item'Range loop
            if Item(I) then
               if I < Item'Last then
                  return I & Mapper(Item(ChallengerType'Succ(I)..Item'Last));
               else
                  Single(Single'First) := I;
                  return Single;
               end if;
            end if;
         end loop;
         Single(Single'First) := None;
         return Single;
      end Mapper;
   begin
      return Mapper(Item);
   end Map_Challengers;

   procedure Print_Challenges(Item : Mapped_Challenges) is
   begin
      for I in Item'Range loop
         Put_Line(ChallengerType'Image(Item(I)));
      end loop;
   end Print_Challenges;

   Foo : Challengers(Rock..None) := (Rock..Scissors => True, Others => False);
begin
   declare
      Mapping : Mapped_Challenges := Map_Challengers(Foo);
   begin
      if Mapping'Length > 1 then
         Print_Challenges(Mapping(Mapping'First..Mapping'Last - 1));
      else
         Print_challenges(Mapping);
      end if;
   end;

end Mapping_Question;

Answer 5

The following approach uses currying of sorts. To further simplify the example, I have shortened the enumeration type to three values. The solution is static, but the “elegance” of using the enumeration values directly is gone. If a static constant is not needed, then, as other approaches show, constant function tables F and T from ChallengerType into Boolean will be a possibility, the named components then appearing as T (Paper) => ... etc.

pragma Pure (Rps);

type ChallengerType is (Rock,Paper,None);

type Challengers1 is array (Boolean) of Challengertype;
type Challengers2 is array (Boolean) of Challengers1;
type Challengers3 is array (Boolean) of Challengers2;

Matchups : constant Challengers3 :=
  -- Rock:
  (True => --> Paper:
      (True => --> None:
          (False => Paper,
           True => None),
       False => --> None:
         (others => Rock)),

   -- Rock:
   False => --> Paper:
     (True => --> None:
         (False => Paper,
          True => None),
      False =>
        (others => None))

  );

Answer 6

Solution using constants

This is not an elegant solution but it may help as a part of a better solution.

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with System;
with System.Unsigned_Types;

procedure Main is
   subtype S is System.Unsigned_Types.Unsigned range 0 .. 31;
   use type S;
   function Shift_Left (Value : S; Amount : Natural) return S renames System.Unsigned_Types.Shift_Left;
   Rock : constant S := Shift_Left (1, 0);
   Paper : constant S := Shift_Left (1, 1);
   Scissors : constant S := Shift_Left (1, 2);
   Suicide : constant S := Shift_Left (1, 3);
   None : constant S := Shift_Left (1, 4);
   P : array (S) of S := (others => None);
begin
   P (Rock or Paper) := Paper;
   P (Rock or Scissors) := Rock;
   P (Paper or Scissors) := Scissors;
   Put_Line ("P(Paper or Scissors) = Scissors");
   Put ("P(");
   Put (Integer (Paper), 0, 2);
   Put (" or ");
   Put (Integer (Scissors), 0, 2);
   Put (") = P(");
   Put (Integer (Paper or Scissors), 0, 2);
   Put (") = ");
   Put (Integer (P (Paper or Scissors)), 0, 2);
   Put ("");
end;

Result

P(Paper or Scissors) = Scissors
P(2#10# or 2#100#) = P(2#110#) = 2#100#

---

Solution using enumeration

with Ada.Text_IO; use Ada.Text_IO;
with System;
with System.Unsigned_Types;

procedure Main is
   type T is (Rock, Paper, Scissors, Suicide, None);
   subtype S is System.Unsigned_Types.Unsigned range 0 .. 31;
   use type S;
   function B (Value : T) return S is (System.Unsigned_Types.Shift_Left (1, T'Pos (Value)));
   function "&" (Left : T; Right : T) return S is (System.Unsigned_Types."or" (B (Left), B (Right)));
   P : array (S) of T := (others => None);
begin
   P (Rock & Paper) := Paper;
   P (Rock & Scissors) := Rock;
   P (Paper & Scissors) := Scissors;
   Put_Line (T'Image (P (Rock & Paper)));
   Put_Line (T'Image (P (Rock & Scissors)));
   Put_Line (T'Image (P (Paper & Scissors)));
end;

Result

PAPER
ROCK
SCISSORS