diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/bundles-containers.adb | 47 | ||||
| -rw-r--r-- | src/bundles-containers.ads | 12 | ||||
| -rw-r--r-- | src/election.adb | 26 | ||||
| -rw-r--r-- | src/preferences.ads | 3 | ||||
| -rw-r--r-- | src/stv.adb | 9 |
5 files changed, 38 insertions, 59 deletions
diff --git a/src/bundles-containers.adb b/src/bundles-containers.adb index a3e2ef0..a027727 100644 --- a/src/bundles-containers.adb +++ b/src/bundles-containers.adb @@ -15,53 +15,23 @@ package body Bundles.Containers is - 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; - - 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 - declare - Vec_Ref : Bundle_Maps.Reference_Type := - BMap.Reference (Current_Cursor); - Bundle_Ref : Bundle_Vectors.Reference_Type := - Vec_Ref.Reference (Vec_Ref.First_Index); - begin - Bundle_Ref.Papers.Append (Item); - end; - else - declare - New_Bundle : Bundle := Empty_Bundle; - begin - New_Bundle.Papers.Append (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) + Result : out Bundle_Collection) is package My_CSV is new CSV; use Ada.Text_IO; use type Candidates.CandidateID; + use type Bundle_Vectors.Vector; Input_File : File_Type; Current_Record : My_CSV.CSV_Record; Current_Prefs : Given_Prefs.Preference_Array; begin + Result := (others => Bundle_Vectors.Empty_Vector & Empty_Bundle); + 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 Integer (Current_Record.Length) > 0 then @@ -70,12 +40,19 @@ package body Bundles.Containers is if Current_Prefs (Given_Prefs.Preference_Range'First) /= Candidates.No_Candidate then - Add_To_Map (Result, Current_Prefs); + Result (Candidate_Range (Current_Prefs (Given_Prefs.Preference_Range'First))).Reference + (1).Papers.Append (Current_Prefs); end if; end if; end loop; Close (Input_File); + + for B of Result loop + if B.Reference (1) = Empty_Bundle then + B.Delete (1); + end if; + end loop; end Read_Bundles; diff --git a/src/bundles-containers.ads b/src/bundles-containers.ads index c12aa39..1982693 100644 --- a/src/bundles-containers.ads +++ b/src/bundles-containers.ads @@ -2,11 +2,11 @@ with - Ada.Containers.Ordered_Maps, Ada.Containers.Vectors; generic + type Candidate_Range is range <>; package Bundles.Containers is @@ -15,19 +15,15 @@ package Bundles.Containers is Element_Type => Bundle); - package Bundle_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Candidates.CandidateID, - Element_Type => Bundle_Vectors.Vector, - "<" => Candidates."<", - "=" => Bundle_Vectors."="); + subtype Bundle_Vector is Bundle_Vectors.Vector; - subtype Bundle_Map is Bundle_Maps.Map; + type Bundle_Collection is array (Candidate_Range) of Bundle_Vector; procedure Read_Bundles (Filename : in String; - Result : out Bundle_Map); + Result : out Bundle_Collection); end Bundles.Containers; diff --git a/src/election.adb b/src/election.adb index 80c846a..c7de32b 100644 --- a/src/election.adb +++ b/src/election.adb @@ -22,11 +22,17 @@ package body Election is package SU renames Ada.Strings.Unbounded; + -- These make converting back and forth easier. + -- Why are they distinct types? Because you can't pass a subtype to a generic. + subtype CanID is Candidates.CandidateID; + subtype CID_Range is Bundle_Containers.Candidate_Range; + + -- Candidate, preference data, and other information -- that's actively used by the main STV algorithm. - Pref_Data : Bundle_Containers.Bundle_Map; + Pref_Data : Bundle_Containers.Bundle_Collection; Cand_Data : Candidates.Containers.Candidate_Vector; Entries : Entry_Vectors.Vector; Exhausted : Extra_Data; @@ -73,11 +79,11 @@ package body Election is This : Entry_Data; begin Entries := Entry_Vectors.Empty_Vector; - for B in Pref_Data.Iterate loop + for CID in Bundle_Containers.Candidate_Range loop Given_Bundles.Count_Both - (Bundle_Containers.Bundle_Maps.Element (B).First_Element, Votes, Papers); + (Pref_Data (CID).First_Element, Votes, Papers); This := - (ID => Bundle_Containers.Bundle_Maps.Key (B), + (ID => CanID (CID), Vote_Change => Votes, Total_Votes => Votes, Paper_Change => Papers, @@ -415,7 +421,7 @@ package body Election is Given_Bundles.Count_Both (New_Bundle, Votes_In, Papers_In); if Votes_In > 0 then - Pref_Data.Reference (Working_ID).Append (New_Bundle); + Pref_Data (CID_Range (Working_ID)).Append (New_Bundle); declare Entry_Ref : Entry_Vectors.Reference_Type := Entries.Reference (Working_Position); @@ -457,24 +463,22 @@ package body Election is This_Transfer := Transfers.First_Element; - while Pref_Data.Reference (This_Transfer.From).Length > 0 loop + while Pref_Data (CID_Range (This_Transfer.From)).Length > 0 loop Redistribute_Papers (Still_Running => Running_Positions, Already_Excluded => Not_Considered, - Transfer_Bundle => Pref_Data.Reference (This_Transfer.From).Reference - (Pref_Data.Reference (This_Transfer.From).First_Index), + Transfer_Bundle => Pref_Data (CID_Range (This_Transfer.From)).Reference (1), Transfer => This_Transfer, Fractional_Loss => Fractional_Loss, Exhausted_Loss => Exhausted_Loss); - Pref_Data.Reference (This_Transfer.From).Delete - (Pref_Data.Reference (This_Transfer.From).First_Index); + Pref_Data (CID_Range (This_Transfer.From)).Delete (1); Fractional.Paper_Change := Fractional.Paper_Change + Fractional_Loss; Exhausted.Paper_Change := Exhausted.Paper_Change + Exhausted_Loss; end loop; - if Pref_Data.Reference (This_Transfer.From).Length = 0 then + if Pref_Data (CID_Range (This_Transfer.From)).Length = 0 then declare Entry_Ref : Entry_Vectors.Reference_Type := Entries.Reference (This_Transfer.Position); diff --git a/src/preferences.ads b/src/preferences.ads index d38b6ec..05ef3e1 100644 --- a/src/preferences.ads +++ b/src/preferences.ads @@ -10,13 +10,12 @@ private with generic - Pref_Size : Positive; Above_Ballot : Candidates.Containers.Above_Line_Ballot; Below_Ballot : Candidates.Containers.Below_Line_Ballot; package Preferences is - subtype Preference_Range is Positive range 1 .. Pref_Size; + subtype Preference_Range is Positive range 1 .. Integer (Below_Ballot.Length); type Preference_Array is array (Preference_Range) diff --git a/src/stv.adb b/src/stv.adb index eb132cc..29b18c9 100644 --- a/src/stv.adb +++ b/src/stv.adb @@ -237,15 +237,18 @@ begin -- Set up and run the election singleton declare + subtype Valid_CandidateID is Candidates.CandidateID + range Candidate_Data.First_Index .. Candidate_Data.Last_Index; + package Given_Prefs is new Preferences - (Pref_Size => Integer (Below_Ballot.Length), - Above_Ballot => Above_Ballot, + (Above_Ballot => Above_Ballot, Below_Ballot => Below_Ballot); package Vote_Bundles is new Bundles (Given_Prefs => Given_Prefs); - package Vote_Bundle_Containers is new Vote_Bundles.Containers; + package Vote_Bundle_Containers is new Vote_Bundles.Containers + (Candidate_Range => Valid_CandidateID); package This_Election is new Election (Given_Bundles => Vote_Bundles, |