Bundles mostly done, still need to adapt Preferences and Candidates packages

6 files changed, 228 insertions, 11 deletions

diff --git a/src/bundles.adb b/src/bundles.adb
index 6a2d71d..3902971 100644
--- a/src/bundles.adb
+++ b/src/bundles.adb
@@ -1,8 +1,154 @@
 
 
+with Ada.Text_IO;
+with CSV;
+
+
 package body Bundles is
 
 
+    procedure Add_To_Map
+           (BMap : in out Bundle_Maps.Map;
+            Item : in     Given_Prefs.Preference_Array)
+    is
+        procedure Update_Bundle
+               (B : in out Bundle) is
+        begin
+            Add (B, Item);
+        end Update_Bundle;
+
+        procedure Update_Vector
+               (C : Candidates.CandidateID;
+                V : Bundle_Vectors.Vector) is
+        begin
+            V.Update_Element (V.First_Index, Update_Bundle'Access);
+        end Update_Vector;
+
+        Place : Candidates.CandidateID := Item (Given_Prefs.Preference_Range'First);
+        Current_Cursor : Bundle_Maps.Cursor := Result.Find (Place);
+    begin
+        if Current_Cursor /= Bundle_Maps.No_Element then
+            BMap.Update_Element (Current_Cursor, Update_Vector'Access);
+        else
+            declare
+                New_Bundle : Bundle := Empty_Bundle;
+            begin
+                Add (New_Bundle, Item);
+                BMap.Insert (Place, Bundle_Vectors.Empty_Vector & New_Bundle);
+            end;
+        end if;
+    end Add_To_Map;
+
+
+
+
+    procedure Read_Bundles
+           (Filename : in     String;
+            Result   :    out Bundle_Maps.Map)
+    is
+        package My_CSV is new CSV;
+        use Ada.Text_IO;
+
+        Input_File : File_Type;
+        Current_Record : My_CSV.CSV_Record;
+        Current_Prefs : Given_Prefs.Preference_Array;
+    begin
+        Open (Input_File, In_File, Filename);
+
+        Result := Bundle_Maps.Empty_Map;
+        while not End_Of_File (Input_File) loop
+            Current_Record := My_CSV.Parse_Line (Get_Line (Input_File));
+            if Current_Record.Length > 0 then
+                Current_Prefs := Given_Prefs.Parse_Preferences (Current_Record.Last_Element);
+                if Current_Prefs (Given_Prefs.Preference_Range'First) /= Candidates.No_Candidate then
+                    Add_To_Map (Result, Current_Prefs);
+                end if;
+            end if;
+        end loop;
+
+        Close (Input_File);
+    end Read_Bundles;
+
+
+
+
+    procedure Add
+           (This : in out Bundle;
+            Item : in     Given_Prefs.Preference_Array) is
+    begin
+        for P of This.Papers loop
+            if P.Prefs = Item then
+                P.How_Many := P.How_Many + 1;
+                return;
+            end if;
+        end if;
+        This.Papers.Append ( (How_Many => 1, Prefs => Item) );
+    end Add;
+
+
+
+
+    procedure Transfer
+           (This     : in out Bundle;
+            From, To : in     Candidates.CandidateID;
+            Excluded : in     Candidates.CandidateID_Vector;
+            Value    : in     Rationals.Fraction;
+            Result   :    out Bundle)
+    is
+        Position : Positive;
+    begin
+        Result := Empty_Bundle;
+        Result.Worth := This.Worth * Value;
+        for P of This.Papers loop
+            Position := Given_Prefs.Preference_Range'First;
+
+            while Position <= Given_Prefs.Preference_Range'Last and then
+                  P.Prefs (Position) /= From
+            loop
+                Position := Position + 1;
+            end loop;
+            Position := Position + 1;
+
+            while Position <= Given_Prefs.Preference_Range'Last and then
+                  Excluded.Contains (P.Prefs (Position))
+            loop
+                Position := Position + 1;
+            end loop;
+
+            if Position <= Given_Prefs.Preference_Range'Last and then
+               P.Prefs (Position) = To
+            then
+                Result.Papers.Append (P);
+            end if;
+        end loop;
+    end Transfer;
+
+
+
+
+    function Count_Votes
+           (This : in Bundle)
+        return Natural is
+    begin
+        return Rationals.Floor (Count_Papers (This) * This.Worth);
+    end Count_Votes;
+
+
+
+
+    function Count_Papers
+           (This : in Bundle)
+        return Natural
+    is
+        Result : Natural := 0;
+    begin
+        for P of This.Papers loop
+            Result := Result + P.How_Many;
+        end loop;
+        return Result;
+    end Count_Papers;
+
+
 end Bundles;
 
 
diff --git a/src/bundles.ads b/src/bundles.ads
index aa0b0d6..db6565d 100644
--- a/src/bundles.ads
+++ b/src/bundles.ads
@@ -1,33 +1,57 @@
 
 
+with Preferences;
 with Candidates;
 with Rationals;
-private with Ada.Containers.Vectors;
+with Ada.Containers.Ordered_Maps;
+with Ada.Containers.Vectors;
 
 
 generic
-    Number_Of_Candidates : Positive;
+    with package Given_Prefs is new Preferences (<>);
 package Bundles is
 
 
     type Bundle is private;
-    subtype Preference_Array is array (1 .. Number_Of_Candidates) of Candidates.CandidateID;
 
 
     Empty_Bundle : constant Bundle;
 
 
+    package Bundle_Vectors is new Ada.Containers.Vectors with
+           (Index_Type   => Positive,
+            Element_Type => Bundle);
+
+
+    package Bundle_Maps is new Ada.Containers.Ordered_Maps
+           (Key_Type     => Candidates.CandidateID,
+            Element_Type => Bundle_Vectors.Vector);
+
+
+    procedure Read_Bundles
+           (Filename : in     String;
+            Result   :    out Bundle_Maps.Map);
+
+
     procedure Add
            (To   : in out Bundle;
-            Item : in     Preference_Array);
+            Item : in     Given_Prefs.Preference_Array);
 
 
     procedure Transfer
-           (From, To : in out Bundle;
-            Value    : in     Rationals.Fraction);
+           (This     : in out Bundle;
+            From, To : in     Candidates.CandidateID;
+            Excluded : in     Candidates.CandidateID_Vector;
+            Value    : in     Rationals.Fraction;
+            Result   :    out Bundle);
 
 
-    function Count
+    function Count_Votes
+           (This : in Bundle)
+        return Natural;
+
+
+    function Count_Papers
            (This : in Bundle)
         return Natural;
 
@@ -35,17 +59,24 @@ package Bundles is
 private
 
 
+    use type Rationals.Fraction;
+
+
     type Paper_Lot is record
         How_Many : Positive := 1;
-        Prefs    : Preference_Array;
+        Prefs    : Given_Prefs.Preference_Array;
     end record;
 
 
-    type Bundle is record
-        
+    package Paper_Vectors is new Ada.Containers.Vectors
+           (Index_Type   => Positive,
+            Element_Type => Paper_Lot);
 
 
-    Empty_Bundle :=
+    type Bundle is record
+        Papers : Paper_Vectors.Vector := Paper_Vectors.Empty_Vector;
+        Worth  : Rationals.Fraction := 1 / 1;
+    end record;
 
 
 end Bundles;
diff --git a/src/candidates.ads b/src/candidates.ads
index 8b76707..fe25228 100644
--- a/src/candidates.ads
+++ b/src/candidates.ads
@@ -14,6 +14,13 @@ package Candidates is
     type CandidateID is new Positive;
 
 
+    subtype Extended_CandidateID is CandidateID'Base
+        range CandidateID'First - 1 .. CandidateID'Last;
+
+
+    No_Candidate : constant Extended_CandidateID := Extended_CandidateID'First;
+
+
     function To_String
            (Input_Candidate : in Candidate;
             Delimiter       : in Character := ',')
diff --git a/src/preferences.adb b/src/preferences.adb
new file mode 100644
index 0000000..d2f743b
--- /dev/null
+++ b/src/preferences.adb
@@ -0,0 +1,8 @@
+
+
+package body Preferences is
+
+
+end Preferences;
+
+
diff --git a/src/preferences.ads b/src/preferences.ads
new file mode 100644
index 0000000..7913019
--- /dev/null
+++ b/src/preferences.ads
@@ -0,0 +1,23 @@
+
+
+with Candidates;
+
+
+generic
+    Number_Of_Candidates : Positive;
+package Preferences is
+
+
+    subtype Preference_Range is range 1 .. Number_Of_Candidates;
+
+
+    type Preference_Array is array Preference_Range
+        of Candidates.Extended_CandidateID;
+
+
+private
+
+
+end Preferences;
+
+
diff --git a/src/stv.adb b/src/stv.adb
index 4d2691a..65537c7 100644
--- a/src/stv.adb
+++ b/src/stv.adb
@@ -211,6 +211,8 @@ begin
     end if;
     Candidates.Read_Candidates (Candidate_File.all, State, Candidate_List);
     Candidates.Generate_Ballots (Candidate_List, Above_Ballot, Below_Ballot);
+
+
     if Verbose then
         Put_Line (Standard_Error, "Reading preference data...");
     end if;