Ada Matchup Array - arrays

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