diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/bundles.adb | 146 | ||||
| -rw-r--r-- | src/bundles.ads | 53 | ||||
| -rw-r--r-- | src/candidates.ads | 7 | ||||
| -rw-r--r-- | src/preferences.adb | 8 | ||||
| -rw-r--r-- | src/preferences.ads | 23 | ||||
| -rw-r--r-- | src/stv.adb | 2 |
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; |