diff options
| -rw-r--r-- | src/bundles-containers.adb | 86 | ||||
| -rw-r--r-- | src/bundles-containers.ads | 30 | ||||
| -rw-r--r-- | src/bundles.adb | 93 | ||||
| -rw-r--r-- | src/bundles.ads | 35 | ||||
| -rw-r--r-- | src/candidates-containers.adb | 219 | ||||
| -rw-r--r-- | src/candidates-containers.ads | 71 | ||||
| -rw-r--r-- | src/candidates.adb | 263 | ||||
| -rw-r--r-- | src/candidates.ads | 123 | ||||
| -rw-r--r-- | src/csv.adb | 11 | ||||
| -rw-r--r-- | src/csv.ads | 2 | ||||
| -rw-r--r-- | src/preferences.adb | 281 | ||||
| -rw-r--r-- | src/preferences.ads | 33 | ||||
| -rw-r--r-- | src/stv.adb | 77 |
13 files changed, 811 insertions, 513 deletions
diff --git a/src/bundles-containers.adb b/src/bundles-containers.adb new file mode 100644 index 0000000..8ba0d30 --- /dev/null +++ b/src/bundles-containers.adb @@ -0,0 +1,86 @@ + + +with Ada.Strings.Unbounded; +with Ada.Text_IO; +with CSV; + + +package body Bundles.Containers is + + + package SU renames Ada.Strings.Unbounded; + + + + + procedure Add_To_Map + (BMap : in out Bundle_Maps.Map; + Item : in Given_Prefs.Preference_Array) + is + use type Bundle_Maps.Cursor; + use type Bundle_Vectors.Vector; + + procedure Update_Bundle + (B : in out Bundle) is + begin + Add (B, Item); + end Update_Bundle; + + procedure Update_Vector + (C : in Candidates.CandidateID; + V : in out 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 := BMap.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; + use type Ada.Containers.Count_Type; + use type Candidates.CandidateID; + + 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 (SU.To_String (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; + + +end Bundles.Containers; + + diff --git a/src/bundles-containers.ads b/src/bundles-containers.ads new file mode 100644 index 0000000..d405e7e --- /dev/null +++ b/src/bundles-containers.ads @@ -0,0 +1,30 @@ + + +with Ada.Containers.Ordered_Maps; +with Ada.Containers.Vectors; + + +generic +package Bundles.Containers is + + + package Bundle_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Bundle); + + + package Bundle_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Candidates.CandidateID, + Element_Type => Bundle_Vectors.Vector, + "<" => Candidates."<", + "=" => Bundle_Vectors."="); + + + procedure Read_Bundles + (Filename : in String; + Result : out Bundle_Maps.Map); + + +end Bundles.Containers; + + diff --git a/src/bundles.adb b/src/bundles.adb index 3902971..9701c40 100644 --- a/src/bundles.adb +++ b/src/bundles.adb @@ -1,88 +1,21 @@ -with Ada.Text_IO; -with CSV; - - package body Bundles is - procedure Add_To_Map - (BMap : in out Bundle_Maps.Map; + procedure Add + (To : in out Bundle; 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; + use type 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 + for P of To.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 loop; + To.Papers.Append ( (How_Many => 1, Prefs => Item) ); end Add; @@ -91,10 +24,12 @@ package body Bundles is procedure Transfer (This : in out Bundle; From, To : in Candidates.CandidateID; - Excluded : in Candidates.CandidateID_Vector; + Excluded : in Candidates.Containers.CandidateID_Set; Value : in Rationals.Fraction; Result : out Bundle) is + use type Candidates.CandidateID; + Position : Positive; begin Result := Empty_Bundle; @@ -149,6 +84,16 @@ package body Bundles is end Count_Papers; + + + function "<" + (Left, Right : in Bundle) + return Boolean is + begin + return Left.Worth < Right.Worth; + end "<"; + + end Bundles; diff --git a/src/bundles.ads b/src/bundles.ads index db6565d..a58a232 100644 --- a/src/bundles.ads +++ b/src/bundles.ads @@ -1,10 +1,9 @@ with Preferences; -with Candidates; +with Candidates.Containers; with Rationals; -with Ada.Containers.Ordered_Maps; -with Ada.Containers.Vectors; +private with Ada.Containers.Vectors; generic @@ -18,21 +17,6 @@ package Bundles is 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 Given_Prefs.Preference_Array); @@ -41,7 +25,7 @@ package Bundles is procedure Transfer (This : in out Bundle; From, To : in Candidates.CandidateID; - Excluded : in Candidates.CandidateID_Vector; + Excluded : in Candidates.Containers.CandidateID_Set; Value : in Rationals.Fraction; Result : out Bundle); @@ -56,6 +40,11 @@ package Bundles is return Natural; + function "<" + (Left, Right : in Bundle) + return Boolean; + + private @@ -73,12 +62,20 @@ private Element_Type => Paper_Lot); + use type Paper_Vectors.Vector; + + type Bundle is record Papers : Paper_Vectors.Vector := Paper_Vectors.Empty_Vector; Worth : Rationals.Fraction := 1 / 1; end record; + Empty_Bundle : constant Bundle := + (Papers => Paper_Vectors.Empty_Vector, + Worth => 1 / 1); + + end Bundles; diff --git a/src/candidates-containers.adb b/src/candidates-containers.adb new file mode 100644 index 0000000..64a03ca --- /dev/null +++ b/src/candidates-containers.adb @@ -0,0 +1,219 @@ + + +with Ada.Containers.Vectors; +with Ada.Text_IO; +with CSV; + + +package body Candidates.Containers is + + + procedure Read_Candidates + (Filename : in String; + State : in State_Name; + Candidate_Data : out Candidate_Map) + is + package My_CSV is new CSV; + use Ada.Text_IO; + use type Ada.Containers.Count_Type; + use type SU.Unbounded_String; + + Input_File : File_Type; + Current_Record : My_CSV.CSV_Record; + Current_Candidate : Candidate; + + Next_ID : CandidateID := CandidateID'First; + begin + Open (Input_File, In_File, Filename); + Candidate_Data := Candidate_Maps.Empty_Map; + + while not End_Of_File (Input_File) loop + Current_Record := My_CSV.Parse_Line (Get_Line (Input_File)); + + -- all the field numbers here correspond to how + -- AEC Senate candidate data is arranged in csv format + if Current_Record.Length = 25 and then + Current_Record.Element (2) = "S" and then + Current_Record.Element (3) = State_Name'Image (State) + then + Current_Candidate := + (First_Name => Current_Record.Element (8), + Last_Name => Current_Record.Element (7), + Group => Current_Record.Element (5), + Group_Rank => Current_Record.Element (6), + Party => Current_Record.Element (9)); + Candidate_Data.Insert (Next_ID, Current_Candidate); + Next_ID := Next_ID + 1; + end if; + end loop; + + Close (Input_File); + end Read_Candidates; + + + + + -- these two types exist because I can't think of an easier + -- way to sort a Candidate_Map into the appropriate order at + -- the moment + + type Cand_Sort_Data is record + Cand_ID : CandidateID; + Group : SU.Unbounded_String; + Group_Rank : SU.Unbounded_String; + end record; + + package Cand_Sort_Data_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Cand_Sort_Data); + + + + + function "<" + (Left, Right : Cand_Sort_Data) + return Boolean + is + use type SU.Unbounded_String; + begin + if SU.Length (Left.Group) = SU.Length (Right.Group) then + if Left.Group = Right.Group then + return Left.Group_Rank < Right.Group_Rank; + else + return Left.Group < Right.Group; + end if; + else + return SU.Length (Left.Group) < SU.Length (Right.Group); + end if; + end "<"; + + + + + function Generate_Above + (Candidate_Data : in Cand_Sort_Data_Vectors.Vector) + return Above_Line_Ballot + is + use type Ada.Containers.Count_Type; + use type SU.Unbounded_String; + + Result : Above_Line_Ballot := CandidateID_Map_Maps.Empty_Map; + Working_Map : CandidateID_Maps.Map; + Current_Group : SU.Unbounded_String; + Current_Index : Positive; + Next_ID, Working_ID : Positive; + begin + if Candidate_Data.Length = 0 then + return Result; + end if; + + Next_ID := 1; + Current_Index := Candidate_Data.First_Index; + while Current_Index <= Candidate_Data.Last_Index loop + Current_Group := Candidate_Data.Element (Current_Index).Group; + + -- the assumption is that the "UG" group is always last + -- a fairly safe assumption given alphabetical group order + -- but will break down should there be more than... 553 grouped candidates + exit when Current_Group = "UG"; + + Working_Map := CandidateID_Maps.Empty_Map; + Working_ID := 1; + loop + Working_Map.Insert (Working_ID, Candidate_Data.Element (Current_Index).Cand_ID); + Working_ID := Working_ID + 1; + Current_Index := Current_Index + 1; + exit when Current_Index > Candidate_Data.Last_Index or else + Current_Group /= Candidate_Data.Element (Current_Index).Group; + end loop; + Result.Insert (Next_ID, Working_Map); + Next_ID := Next_ID + 1; + end loop; + + return Result; + end Generate_Above; + + + + + function Generate_Below + (Candidate_Data : in Cand_Sort_Data_Vectors.Vector) + return Below_Line_Ballot + is + Result : Below_Line_Ballot := CandidateID_Maps.Empty_Map; + Next_ID : Positive := 1; + begin + for Item of Candidate_Data loop + Result.Insert (Next_ID, Item.Cand_ID); + Next_ID := Next_ID + 1; + end loop; + return Result; + end Generate_Below; + + + + + procedure Generate_Ballots + (Candidate_Data : in Candidate_Map; + Above_Ballot : out Above_Line_Ballot; + Below_Ballot : out Below_Line_Ballot) + is + package Sorting is new Cand_Sort_Data_Vectors.Generic_Sorting; + + My_Candidate_Data : Cand_Sort_Data_Vectors.Vector; + Working_Candidate : Candidate; + begin + My_Candidate_Data := Cand_Sort_Data_Vectors.Empty_Vector; + + for Cursor in Candidate_Data.Iterate loop + Working_Candidate := Candidate_Maps.Element (Cursor); + My_Candidate_Data.Append + ((Cand_ID => Candidate_Maps.Key (Cursor), + Group => Working_Candidate.Group, + Group_Rank => Working_Candidate.Group_Rank)); + end loop; + + Sorting.Sort (My_Candidate_Data); + + Above_Ballot := Generate_Above (My_Candidate_Data); + Below_Ballot := Generate_Below (My_Candidate_Data); + end Generate_Ballots; + + + + + function To_String + (Above_Ballot : in Above_Line_Ballot) + return String + is + Result : SU.Unbounded_String := SU.To_Unbounded_String (0); + begin + for Group_Cursor in Above_Ballot.Iterate loop + SU.Append (Result, Integer'Image (CandidateID_Map_Maps.Key (Group_Cursor)) & ": "); + for Box of CandidateID_Map_Maps.Element (Group_Cursor) loop + SU.Append (Result, CandidateID'Image (Box) & " "); + end loop; + SU.Append (Result, ASCII.LF); + end loop; + return SU.To_String (Result); + end To_String; + + + + + function To_String + (Below_Ballot : in Below_Line_Ballot) + return String + is + Result : SU.Unbounded_String := SU.To_Unbounded_String (0); + begin + for Box of Below_Ballot loop + SU.Append (Result, CandidateID'Image (Box) & " "); + end loop; + return SU.To_String (Result); + end To_String; + + +end Candidates.Containers; + + diff --git a/src/candidates-containers.ads b/src/candidates-containers.ads new file mode 100644 index 0000000..60fe4cb --- /dev/null +++ b/src/candidates-containers.ads @@ -0,0 +1,71 @@ + + +with Ada.Containers.Ordered_Maps; +with Ada.Containers.Ordered_Sets; + + +package Candidates.Containers is + + + package Candidate_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => CandidateID, + Element_Type => Candidate); + + + subtype Candidate_Map is Candidate_Maps.Map; + + + procedure Read_Candidates + (Filename : in String; + State : in State_Name; + Candidate_Data : out Candidate_Map); + + + + + package CandidateID_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Positive, + Element_Type => CandidateID); + use type CandidateID_Maps.Map; + + + package CandidateID_Map_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Positive, + Element_Type => CandidateID_Maps.Map); + + + -- possibly put some aspects here to ensure the types are as expected? + subtype Above_Line_Ballot is CandidateID_Map_Maps.Map; + subtype Below_Line_Ballot is CandidateID_Maps.Map; + + + procedure Generate_Ballots + (Candidate_Data : in Candidate_Map; + Above_Ballot : out Above_Line_Ballot; + Below_Ballot : out Below_Line_Ballot); + + + -- debugging function + function To_String + (Above_Ballot : in Above_Line_Ballot) + return String; + + + -- debugging function + function To_String + (Below_Ballot : in Below_Line_Ballot) + return String; + + + + + package CandidateID_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => CandidateID); + + + subtype CandidateID_Set is CandidateID_Sets.Set; + + +end Candidates.Containers; + + diff --git a/src/candidates.adb b/src/candidates.adb index 33d3901..5d10ce1 100644 --- a/src/candidates.adb +++ b/src/candidates.adb @@ -1,6 +1,5 @@ -with Ada.Text_IO; with CSV; @@ -28,268 +27,6 @@ package body Candidates is end To_String; - - - procedure Read_Candidates - (Filename : in String; - State : in State_Name; - Candidate_List : out Candidate_Vector) - is - package My_CSV is new CSV; - use Ada.Text_IO; - use type Ada.Containers.Count_Type; - use type SU.Unbounded_String; - - Input_File : File_Type; - Current_Record : My_CSV.CSV_Record; - Current_Candidate : Candidate; - begin - Open (Input_File, In_File, Filename); - Candidate_List := (Vec => Candidate_Vectors.Empty_Vector); - - while not End_Of_File (Input_File) loop - Current_Record := My_CSV.Parse_Line (Get_Line (Input_File)); - - -- all the field numbers here correspond to how - -- AEC Senate candidate data is arranged in csv format - if Current_Record.Length = 25 and then - Current_Record.Element (2) = "S" and then - Current_Record.Element (3) = State_Name'Image (State) - then - Current_Candidate := - (First_Name => Current_Record.Element (8), - Last_Name => Current_Record.Element (7), - Group => Current_Record.Element (5), - Group_Rank => Current_Record.Element (6), - Party => Current_Record.Element (9)); - Candidate_List.Vec.Append (Current_Candidate); - end if; - end loop; - - Close (Input_File); - end Read_Candidates; - - - - - function First - (Candidate_List : in Candidate_Vector) - return CandidateID is - begin - return Candidate_List.Vec.First_Index; - end First; - - - - - function Last - (Candidate_List : in Candidate_Vector) - return CandidateID is - begin - return Candidate_List.Vec.Last_Index; - end Last; - - - - - function Lookup - (Candidate_List : in Candidate_Vector; - Index : in CandidateID) - return Candidate is - begin - return Candidate_List.Vec.Element (Index); - end Lookup; - - - - - function First - (CandidateID_List : in CandidateID_Vector) - return Positive is - begin - return CandidateID_List.Vec.First_Index; - end First; - - - - - function Last - (CandidateID_List : in CandidateID_Vector) - return Positive is - begin - return CandidateID_List.Vec.Last_Index; - end Last; - - - - - function Lookup - (CandidateID_List : in CandidateID_Vector; - Index : in Positive) - return CandidateID is - begin - return CandidateID_List.Vec.Element (Index); - end Lookup; - - - - - function "<" - (Left, Right : Candidate) - return Boolean - is - use type SU.Unbounded_String; - begin - if SU.Length (Left.Group) = SU.Length (Right.Group) then - if Left.Group = Right.Group then - return Left.Group_Rank < Right.Group_Rank; - else - return Left.Group < Right.Group; - end if; - else - return SU.Length (Left.Group) < SU.Length (Right.Group); - end if; - end "<"; - - - - - function Generate_Above - (Candidate_List : in Candidate_Vector) - return Above_Line_Ballot - is - use type Ada.Containers.Count_Type; - use type SU.Unbounded_String; - - Result : Above_Line_Ballot; - Working_Vector : CandidateID_Vector; - Current_Group : SU.Unbounded_String; - Current_Index : CandidateID; - begin - Result := (Vec => Above_Line_Ballots.Empty_Vector); - - if Candidate_List.Vec.Length = 0 then - return Result; - end if; - - Current_Index := Candidate_List.Vec.First_Index; - while Current_Index <= Candidate_List.Vec.Last_Index loop - Current_Group := Candidate_List.Vec.Element (Current_Index).Group; - - -- the assumption is that the "UG" group is always last - -- a fairly safe assumption given alphabetical group order - exit when Current_Group = "UG"; - - Working_Vector := (Vec => CandidateID_Vectors.Empty_Vector); - loop - Working_Vector.Vec.Append (Current_Index); - Current_Index := Current_Index + 1; - exit when Current_Index > Candidate_List.Vec.Last_Index or else - Current_Group /= Candidate_List.Vec.Element (Current_Index).Group; - end loop; - Result.Vec.Append (Working_Vector); - end loop; - - return Result; - end Generate_Above; - - - - - function Generate_Below - (Candidate_List : in Candidate_Vector) - return Below_Line_Ballot - is - Result : Below_Line_Ballot; - begin - Result := (Vec => CandidateID_Vectors.Empty_Vector); - for ID in CandidateID range Candidate_List.Vec.First_Index .. Candidate_List.Vec.Last_Index loop - Result.Vec.Append (ID); - end loop; - return Result; - end Generate_Below; - - - - - procedure Generate_Ballots - (Candidate_List : in Candidate_Vector; - Above_Ballot : out Above_Line_Ballot; - Below_Ballot : out Below_Line_Ballot) - is - package Sorting is new Candidate_Vectors.Generic_Sorting; - - My_Candidate_List : Candidate_Vector; - begin - My_Candidate_List := Candidate_List; - Sorting.Sort (My_Candidate_List.Vec); - Above_Ballot := Generate_Above (My_Candidate_List); - Below_Ballot := Generate_Below (My_Candidate_List); - end Generate_Ballots; - - - - - function First - (Above_Ballot : in Above_Line_Ballot) - return Positive is - begin - return Above_Ballot.Vec.First_Index; - end First; - - - - - function Last - (Above_Ballot : in Above_Line_Ballot) - return Positive is - begin - return Above_Ballot.Vec.Last_Index; - end Last; - - - - - function Lookup - (Above_Ballot : in Above_Line_Ballot; - Index : in Positive) - return CandidateID_Vector is - begin - return Above_Ballot.Vec.Element (Index); - end Lookup; - - - - - function First - (Below_Ballot : in Below_Line_Ballot) - return Positive is - begin - return Below_Ballot.Vec.First_Index; - end First; - - - - - function Last - (Below_Ballot : in Below_Line_Ballot) - return Positive is - begin - return Below_Ballot.Vec.Last_Index; - end Last; - - - - - function Lookup - (Below_Ballot : in Below_Line_Ballot; - Index : in Positive) - return CandidateID is - begin - return Below_Ballot.Vec.Element (Index); - end Lookup; - - end Candidates; diff --git a/src/candidates.ads b/src/candidates.ads index fe25228..fef8d4c 100644 --- a/src/candidates.ads +++ b/src/candidates.ads @@ -1,7 +1,6 @@ private with Ada.Strings.Unbounded; -private with Ada.Containers.Vectors; package Candidates is @@ -11,7 +10,10 @@ package Candidates is type Candidate is private; - type CandidateID is new Positive; + + + -- this is restricted to 255 values for memory conservation reasons + type CandidateID is new Positive range 1 .. 255; subtype Extended_CandidateID is CandidateID'Base @@ -27,94 +29,6 @@ package Candidates is return String; - - - type Candidate_Vector is private; - type CandidateID_Vector is private; - - - procedure Read_Candidates - (Filename : in String; - State : in State_Name; - Candidate_List : out Candidate_Vector); - - - function First - (Candidate_List : in Candidate_Vector) - return CandidateID; - - - function Last - (Candidate_List : in Candidate_Vector) - return CandidateID; - - - function Lookup - (Candidate_List : in Candidate_Vector; - Index : in CandidateID) - return Candidate; - - - function First - (CandidateID_List : in CandidateID_Vector) - return Positive; - - - function Last - (CandidateID_List : in CandidateID_Vector) - return Positive; - - - function Lookup - (CandidateID_List : in CandidateID_Vector; - Index : in Positive) - return CandidateID; - - - - - type Above_Line_Ballot is private; - type Below_Line_Ballot is private; - - - procedure Generate_Ballots - (Candidate_List : in Candidate_Vector; - Above_Ballot : out Above_Line_Ballot; - Below_Ballot : out Below_Line_Ballot); - - - function First - (Above_Ballot : in Above_Line_Ballot) - return Positive; - - - function Last - (Above_Ballot : in Above_Line_Ballot) - return Positive; - - - function Lookup - (Above_Ballot : in Above_Line_Ballot; - Index : in Positive) - return CandidateID_Vector; - - - function First - (Below_Ballot : in Below_Line_Ballot) - return Positive; - - - function Last - (Below_Ballot : in Below_Line_Ballot) - return Positive; - - - function Lookup - (Below_Ballot : in Below_Line_Ballot; - Index : in Positive) - return CandidateID; - - private @@ -130,35 +44,6 @@ private end record; - package Candidate_Vectors is new Ada.Containers.Vectors - (Index_Type => CandidateID, - Element_Type => Candidate); - type Candidate_Vector is record - Vec : Candidate_Vectors.Vector; - end record; - - - package CandidateID_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => CandidateID); - type CandidateID_Vector is record - Vec : CandidateID_Vectors.Vector; - end record; - - - package Above_Line_Ballots is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => CandidateID_Vector); - type Above_Line_Ballot is record - Vec : Above_Line_Ballots.Vector; - end record; - - - type Below_Line_Ballot is record - Vec : CandidateID_Vectors.Vector; - end record; - - end Candidates; diff --git a/src/csv.adb b/src/csv.adb index 1b8fd7f..6bc5880 100644 --- a/src/csv.adb +++ b/src/csv.adb @@ -22,10 +22,11 @@ package body CSV is then Result := SU.To_Unbounded_String (0); This_In := SU.Tail (Input, SU.Length (Input) - 1); - while SU.Length (This_In) > 0 loop + while SU.Length (This_In) > 0 and then + SU.Element (This_In, 1) /= Quote + loop SU.Append (Result, SU.Head (This_In, 1)); This_In := SU.Tail (This_In, SU.Length (This_In) - 1); - exit when SU.Length (This_In) > 0 and then SU.Element (This_In, 1) = Quote; end loop; Output := Result; if SU.Length (This_In) > 0 then @@ -111,14 +112,12 @@ package body CSV is function Separator (Input : in SU.Unbounded_String; - Output : out SU.Unbounded_String; Remaining : out SU.Unbounded_String) return Boolean is begin if SU.Length (Input) > 0 and then SU.Element (Input, 1) = Delimiter then - Output := SU.Head (Input, 1); Remaining := SU.Tail (Input, SU.Length (Input) - 1); return True; else @@ -140,9 +139,7 @@ package body CSV is loop Field (This_In, This_Out, This_Remaining); Result.Append (This_Out); - This_In := This_Remaining; - exit when not Separator (This_In, This_Out, This_Remaining); - This_In := This_Remaining; + exit when not Separator (This_Remaining, This_In); end loop; return Result; end Parse_Line; diff --git a/src/csv.ads b/src/csv.ads index a8273f5..74c2971 100644 --- a/src/csv.ads +++ b/src/csv.ads @@ -13,7 +13,7 @@ package CSV is package String_Vectors is new Ada.Containers.Vectors - (Index_Type => Natural, + (Index_Type => Positive, Element_Type => Ada.Strings.Unbounded.Unbounded_String); diff --git a/src/preferences.adb b/src/preferences.adb index d2f743b..9b64a89 100644 --- a/src/preferences.adb +++ b/src/preferences.adb @@ -1,8 +1,289 @@ +with Ada.Strings.Unbounded; +with Ada.Strings.Maps; + + package body Preferences is + package S renames Ada.Strings; + package SU renames Ada.Strings.Unbounded; + package SM renames Ada.Strings.Maps; + + + + + generic + type Range_Type is range <>; + type Array_Type is array (Range_Type) of Natural; + procedure Index_And_Count + (Input : in Array_Type; + Value : in Natural; + Index : out Range_Type; + Count : out Natural); + + + procedure Index_And_Count + (Input : in Array_Type; + Value : in Natural; + Index : out Range_Type; + Count : out Natural) is + begin + Count := 0; + for I in Range_Type loop + if Input (I) = Value then + Index := I; + Count := Count + 1; + end if; + end loop; + end Index_And_Count; + + + + + function Extract_Formal + (Above_Input : in Above_Pref_Array; + Formal_Prefs : out Preference_Array) + return Boolean + is + procedure Above_IC is new Index_And_Count + (Above_Range, Above_Pref_Array); + + Extracted : Natural := 0; + Working_Index : Above_Range; + Working_Count : Natural; + Formal_Index : Preference_Range := Preference_Range'First; + begin + Formal_Prefs := (others => Candidates.No_Candidate); + Pref_Loop : + for I in Above_Range loop + Above_IC (Above_Input, Integer (I), Working_Index, Working_Count); + exit when Working_Count /= 1; + Extracted := Extracted + 1; + for C of Above_Ballot.Element (Integer (Working_Index)) loop + exit Pref_Loop when Formal_Index > Preference_Range'Last; + Formal_Prefs (Formal_Index) := C; + Formal_Index := Formal_Index + 1; + end loop; + end loop Pref_Loop; + return Extracted >= Min_Above_Line; + end Extract_Formal; + + + + + function Extract_Formal + (Below_Input : in Below_Pref_Array; + Formal_Prefs : out Preference_Array) + return Boolean + is + procedure Below_IC is new Index_And_Count + (Below_Range, Below_Pref_Array); + + Extracted : Natural := 0; + Working_Index : Below_Range; + Working_Count : Natural; + Formal_Index : Preference_Range := Preference_Range'First; + begin + Formal_Prefs := (others => Candidates.No_Candidate); + if Formal_Index > Preference_Range'Last then + return Extracted >= Min_Below_Line; + end if; + for I in Below_Range loop + Below_IC (Below_Input, Integer (I), Working_Index, Working_Count); + exit when Working_Count /= 1; + Formal_Prefs (Formal_Index) := Below_Ballot.Element (Integer (Working_Index)); + Extracted := Extracted + 1; + exit when Formal_Index = Preference_Range'Last; + Formal_Index := Formal_Index + 1; + end loop; + return Extracted >= Min_Below_Line; + end Extract_Formal; + + + + + function Mark + (Input : in SU.Unbounded_String; + Output : out Natural; + Remaining : out SU.Unbounded_String) + return Boolean is + begin + if SU.Length (Input) > 0 and then + (SU.Element (Input, 1) = '/' or else + SU.Element (Input, 1) = '*') + then + Output := 1; + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + return True; + else + return False; + end if; + end Mark; + + + + + function Number + (Input : in SU.Unbounded_String; + Output : out Natural; + Remaining : out SU.Unbounded_String) + return Boolean + is + First, Last : Natural; + begin + SU.Find_Token (Input, SM.To_Set ("1234567890"), S.Inside, First, Last); + if First = 1 and Last > 0 then + Output := Integer'Value (SU.Slice (Input, First, Last)); + Remaining := SU.Unbounded_Slice (Input, Last + 1, SU.Length (Input)); + return True; + else + return False; + end if; + end Number; + + + + + function Comma + (Input : in SU.Unbounded_String; + Remaining : out SU.Unbounded_String) + return Boolean is + begin + if SU.Length (Input) > 0 and then + SU.Element (Input, 1) = ',' + then + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + return True; + else + return False; + end if; + end Comma; + + + + + generic + type Range_Type is range <>; + type Array_Type is array (Range_Type) of Natural; + function Raw_Prefs + (Input : in SU.Unbounded_String; + Output : out Array_Type; + Remaining : out SU.Unbounded_String) + return Boolean; + + + function Raw_Prefs + (Input : in SU.Unbounded_String; + Output : out Array_Type; + Remaining : out SU.Unbounded_String) + return Boolean + is + Working_Num : Natural; + Index : Range_Type := Range_Type'First; + This_In, This_Remaining : SU.Unbounded_String; + begin + Output := (others => 0); + if Index > Range_Type'Last then + Remaining := Input; + return True; + end if; + This_In := Input; + + loop + if Number (This_In, Working_Num, This_Remaining) or else + Mark (This_In, Working_Num, This_Remaining) + then + Output (Index) := Working_Num; + else + This_Remaining := This_In; + end if; + exit when Index = Range_Type'Last; + Index := Index + 1; + if not Comma (This_Remaining, This_In) then + return False; + end if; + end loop; + + Remaining := This_Remaining; + return True; + end Raw_Prefs; + + + + + procedure Optional_Line_Ending + (Input : in SU.Unbounded_String; + Remaining : out SU.Unbounded_String) is + begin + if SU.Length (Input) > 1 and then + SU.Slice (Input, 1, 2) = Character'Val (13) & Character'Val (10) + then + Remaining := SU.Tail (Input, SU.Length (Input) - 2); + elsif + SU.Length (Input) > 0 and then + (SU.Element (Input, 1) = Character'Val (13) or else + SU.Element (Input, 1) = Character'Val (10)) + then + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + else + Remaining := Input; + end if; + end Optional_Line_Ending; + + + + + function Parse_Preferences + (Input : in String) + return Preference_Array + is + use type SU.Unbounded_String; + + Above_Line : Above_Pref_Array; + Below_Line : Below_Pref_Array; + + function Parse_Above_Line is new Raw_Prefs + (Above_Range, Above_Pref_Array); + + function Parse_Below_Line is new Raw_Prefs + (Below_Range, Below_Pref_Array); + + Result : Preference_Array; + + This_In, This_Remaining : SU.Unbounded_String; + begin + This_In := SU.To_Unbounded_String (Input); + + if not Parse_Above_Line (This_In, Above_Line, This_Remaining) then + return Empty_Array; + end if; + + if not Comma (This_Remaining, This_In) then + return Empty_Array; + end if; + + if not Parse_Below_Line (This_In, Below_Line, This_Remaining) then + return Empty_Array; + end if; + + Optional_Line_Ending (This_Remaining, This_In); + + if SU.Length (This_In) > 0 then + return Empty_Array; + end if; + + if Extract_Formal (Below_Line, Result) or else + Extract_Formal (Above_Line, Result) + then + return Result; + else + return Empty_Array; + end if; + end Parse_Preferences; + + end Preferences; diff --git a/src/preferences.ads b/src/preferences.ads index 7913019..d13b0c9 100644 --- a/src/preferences.ads +++ b/src/preferences.ads @@ -1,23 +1,48 @@ -with Candidates; +with Candidates.Containers; +private with Ada.Containers; generic - Number_Of_Candidates : Positive; + Pref_Size : Positive; + Above_Ballot : Candidates.Containers.Above_Line_Ballot; + Below_Ballot : Candidates.Containers.Below_Line_Ballot; package Preferences is - subtype Preference_Range is range 1 .. Number_Of_Candidates; + subtype Preference_Range is Positive range 1 .. Pref_Size; - type Preference_Array is array Preference_Range + type Preference_Array is array (Preference_Range) of Candidates.Extended_CandidateID; + pragma Pack (Preference_Array); + + + Empty_Array : constant Preference_Array := + (others => Candidates.No_Candidate); + + + function Parse_Preferences + (Input : in String) + return Preference_Array; private + Min_Above_Line : constant Positive := 1; + Min_Below_Line : constant Positive := 6; + + + subtype Above_Range is Ada.Containers.Count_Type range 1 .. Above_Ballot.Length; + type Above_Pref_Array is array (Above_Range) of Natural; + + + subtype Below_Range is Ada.Containers.Count_Type range 1 .. Below_Ballot.Length; + type Below_Pref_Array is array (Below_Range) of Natural; + + end Preferences; diff --git a/src/stv.adb b/src/stv.adb index 65537c7..e6df17e 100644 --- a/src/stv.adb +++ b/src/stv.adb @@ -8,7 +8,9 @@ with Ada.Directories; with Ada.Strings.Unbounded; with Simple_Time; with CSV; -with Candidates; +with Candidates.Containers; +with Preferences; +with Bundles.Containers; procedure STV is @@ -53,9 +55,9 @@ procedure STV is Log_File : File_Type; - Candidate_List : Candidates.Candidate_Vector; - Above_Ballot : Candidates.Above_Line_Ballot; - Below_Ballot : Candidates.Below_Line_Ballot; + Candidate_Data : Candidates.Containers.Candidate_Map; + Above_Ballot : Candidates.Containers.Above_Line_Ballot; + Below_Ballot : Candidates.Containers.Below_Line_Ballot; begin @@ -209,32 +211,55 @@ begin if Verbose then Put_Line (Standard_Error, "Reading candidate data..."); end if; - Candidates.Read_Candidates (Candidate_File.all, State, Candidate_List); - Candidates.Generate_Ballots (Candidate_List, Above_Ballot, Below_Ballot); + Candidates.Containers.Read_Candidates (Candidate_File.all, State, Candidate_Data); + Candidates.Containers.Generate_Ballots (Candidate_Data, Above_Ballot, Below_Ballot); - if Verbose then - Put_Line (Standard_Error, "Reading preference data..."); - end if; - -- read in preference data here - if Verbose then - Put_Line (Standard_Error, "Done." & ASCII.LF); - Put_Line (Standard_Error, "Setting up election..."); - end if; - -- set up election here - if Verbose then - Put_Line (Standard_Error, "Done." & ASCII.LF); - end if; + declare + package Given_Prefs is new Preferences + (Pref_Size => Integer (Below_Ballot.Length), + Above_Ballot => Above_Ballot, + Below_Ballot => Below_Ballot); + package Vote_Bundles is new Bundles + (Given_Prefs => Given_Prefs); - -- run the show - if Verbose then - Put_Line (Standard_Error, "Running..." & ASCII.LF); - end if; - -- run election here - if Verbose then - New_Line (Standard_Error); - end if; + package Vote_Bundle_Containers is new Vote_Bundles.Containers; + + Initial_Bundles : Vote_Bundle_Containers.Bundle_Maps.Map; + begin + if Verbose then + Put_Line (Standard_Error, "Reading preference data..."); + end if; + Vote_Bundle_Containers.Read_Bundles (Preference_File.all, Initial_Bundles); + if Verbose then + Put_Line (Standard_Error, "Done." & ASCII.LF); + Put_Line (Standard_Error, "Setting up election..."); + end if; + -- set up election here + if Verbose then + Put_Line (Standard_Error, "Done." & ASCII.LF); + end if; + + + -- test output to check that votes were parsed correctly + for Cursor in Initial_Bundles.Iterate loop + Put_Line + (Candidates.CandidateID'Image (Vote_Bundle_Containers.Bundle_Maps.Key (Cursor)) & + " " & + Integer'Image (Vote_Bundles.Count_Votes (Vote_Bundle_Containers.Bundle_Maps.Element (Cursor).Element (1)))); + end loop; + + + -- run the show + if Verbose then + Put_Line (Standard_Error, "Running..." & ASCII.LF); + end if; + -- run election here + if Verbose then + New_Line (Standard_Error); + end if; + end; -- finish up logging |