diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/election.adb | 391 | ||||
| -rw-r--r-- | src/election.ads | 4 |
2 files changed, 258 insertions, 137 deletions
diff --git a/src/election.adb b/src/election.adb index 2cedb3e..c6b1431 100644 --- a/src/election.adb +++ b/src/election.adb @@ -23,24 +23,32 @@ package body Election is - Cand_Data : Candidates.Containers.Candidate_Map; + -- Candidate, preference data, and other information + -- that's actively used by the main STV algorithm. Pref_Data : Bundle_Containers.Bundle_Map; + Cand_Data : Candidates.Containers.Candidate_Map; Entries : Entry_Vectors.Vector; Exhausted : Extra_Data; Fractional : Extra_Data; Transfers : Transfer_Vectors.Vector; + -- Logging settings. Out_Dir : SU.Unbounded_String; Next_Log_Num : Positive; Main_Log : File_Type; + + + -- Static info about the election. + -- (Although Vacancies gets modified as seats are won.) Seats : Natural; Vacancies : Natural; Total_Papers : Natural; Quota : Natural; - Verbose : Boolean; + -- Administrative details of the program. + Verbose : Boolean; Work_To_Do : Boolean := False; @@ -57,7 +65,33 @@ package body Election is - -- needs to be refactored due to length + -- Extracts and sets up relevant entry metadata from the preference bundle map. + procedure Read_Entries + is + Votes, Papers : Integer; + This : Entry_Data; + begin + Entries := Entry_Vectors.Empty_Vector; + for B in Pref_Data.Iterate loop + Given_Bundles.Count_Both + (Bundle_Containers.Bundle_Maps.Element (B).First_Element, Votes, Papers); + This := + (ID => Bundle_Containers.Bundle_Maps.Key (B), + Vote_Change => Votes, + Total_Votes => Votes, + Paper_Change => Papers, + Total_Papers => Papers, + Status => Running, + Changed => False, + Order_Elected => 0); + Entries.Append (This); + end loop; + end Read_Entries; + + + + + -- This must be called before an election is run. procedure Setup (Candidate_Data : in Candidates.Containers.Candidate_Map; Preference_File : in String; @@ -70,52 +104,32 @@ package body Election is if Verbose then Put_Line (Standard_Error, "Reading preference data..."); end if; + Bundle_Containers.Read_Bundles (Preference_File, Pref_Data); + if Verbose then Put_Line (Standard_Error, "Done." & ASCII.LF); Put_Line (Standard_Error, "Setting up election..."); end if; - -- setup/extract relevant metadata from the vote bundle map - for B in Pref_Data.Iterate loop - declare - Votes, Papers : Integer; - This : Entry_Data; - begin - Given_Bundles.Count_Both - (Bundle_Containers.Bundle_Maps.Element (B).First_Element, Votes, Papers); - This := - (ID => Bundle_Containers.Bundle_Maps.Key (B), - Vote_Change => Votes, - Total_Votes => Votes, - Paper_Change => Papers, - Total_Papers => Papers, - Status => Running, - Changed => False, - Order_Elected => 0); - Entries.Append (This); - end; - end loop; - + Cand_Data := Candidate_Data; + Read_Entries; Exhausted := (others => 0); Fractional := (others => 0); - Transfers := Transfer_Vectors.Empty_Vector; - Cand_Data := Candidate_Data; Out_Dir := SU.To_Unbounded_String (Output_Dir); Next_Log_Num := 1; + Open (Main_Log, Append_File, Output_Dir & "/" & Main_Logfile); + Seats := Number_To_Elect; Vacancies := Number_To_Elect; - Total_Papers := 0; for E of Entries loop Total_Papers := Total_Papers + E.Total_Papers; end loop; Quota := Droop_Quota (Total_Papers, Seats); - Open (Main_Log, Append_File, Output_Dir & "/" & Main_Logfile); - Work_To_Do := True; if Verbose then @@ -126,18 +140,34 @@ package body Election is - procedure Write_Log + -- This is used because the 'Image attribute + -- puts unwanted padding either side of numbers. + function Int_Image + (Number : in Integer) + return String is use Ada.Strings; use Ada.Strings.Fixed; + Result : String := + Trim (Integer'Image (Number), Both); + begin + return Result; + end Int_Image; + + + + -- Outputs a new numbered csv logfile of the current status of the election. + -- Automatically increments the logfile number afterwards. + procedure Write_Log + is Header : String := "Seats,Vacancies,Total Papers,Quota," & Candidates.Candidate_Header & ",Papers,Change,Votes,Transfer,Status,Changed,Order Elected"; Logname : String := - SU.To_String (Out_Dir) & "/" & Trim (Integer'Image (Next_Log_Num), Both) & ".csv"; + SU.To_String (Out_Dir) & "/" & Int_Image (Next_Log_Num) & ".csv"; Change_Str, Order_Str : SU.Unbounded_String; @@ -154,36 +184,41 @@ package body Election is end if; if E.Order_Elected > 0 then - Order_Str := SU.To_Unbounded_String (Trim (Integer'Image (E.Order_Elected), Both)); + Order_Str := SU.To_Unbounded_String (Int_Image (E.Order_Elected)); else Order_Str := SU.To_Unbounded_String (0); end if; Put_Line (Logfile, - Trim (Integer'Image (Seats), Both) & "," & - Trim (Integer'Image (Vacancies), Both) & "," & - Trim (Integer'Image (Total_Papers), Both) & "," & - Trim (Integer'Image (Quota), Both) & "," & - Candidates.To_String (Cand_Data.Element (E.ID)) & "," & - Trim (Integer'Image (E.Total_Papers), Both) & "," & - Trim (Integer'Image (E.Paper_Change), Both) & "," & - Trim (Integer'Image (E.Total_Votes), Both) & "," & - Trim (Integer'Image (E.Vote_Change), Both) & "," & - Candidate_Status'Image (E.Status) & "," & - SU.To_String (Change_Str) & "," & SU.To_String (Order_Str)); + Int_Image (Seats) & "," & + Int_Image (Vacancies) & "," & + Int_Image (Total_Papers) & "," & + Int_Image (Quota) & "," & + Candidates.To_String (Cand_Data.Element (E.ID)) & "," & + Int_Image (E.Total_Papers) & "," & + Int_Image (E.Paper_Change) & "," & + Int_Image (E.Total_Votes) & "," & + Int_Image (E.Vote_Change) & "," & + Candidate_Status'Image (E.Status) & "," & + SU.To_String (Change_Str) & "," & + SU.To_String (Order_Str)); end loop; + + -- I don't really like how it's not obvious by looking at this + -- whether the correct number of commas is being used. Put_Line (Logfile, - ",,,,,,Fractional Loss,,," & - Trim (Integer'Image (Fractional.Total_Papers), Both) & "," & - Trim (Integer'Image (Fractional.Paper_Change), Both) & "," & - ",,,,"); + ",,,,,,Fractional Loss,,," & + Int_Image (Fractional.Total_Papers) & "," & + Int_Image (Fractional.Paper_Change) & "," & + ",,,,"); Put_Line (Logfile, - ",,,,,,Exhausted,,," & - Trim (Integer'Image (Exhausted.Total_Papers), Both) & "," & - Trim (Integer'Image (Exhausted.Paper_Change), Both) & "," & - ",,,,"); + ",,,,,,Exhausted,,," & + Int_Image (Exhausted.Total_Papers) & "," & + Int_Image (Exhausted.Paper_Change) & "," & + ",,,,"); Close (Logfile); + Next_Log_Num := Next_Log_Num + 1; end Write_Log; @@ -200,6 +235,8 @@ package body Election is Element_Type => Entry_Position); + -- Ordering is stable with respect to the original candidate + -- order in the event of multiple entries have equal votes. function "<" (Left, Right : in Entry_Position) return Boolean is @@ -215,7 +252,11 @@ package body Election is package Position_Sorting is new Position_Vectors.Generic_Sorting; - function Extract_Running_Entries + -- The above types and this function are used to be able to sort + -- still running entries by how many votes they have without + -- messing up their original order, since the order should be + -- consistent between numbered logfiles. + function Get_Running_Entry_Positions return Position_Vectors.Vector is Result : Position_Vectors.Vector := Position_Vectors.Empty_Vector; @@ -223,28 +264,45 @@ package body Election is for E in Entries.Iterate loop if Entry_Vectors.Element (E).Status = Running then Result.Append - ((Index => Entry_Vectors.To_Index (E), - Total_Votes => Entry_Vectors.Element (E).Total_Votes)); + ((Index => Entry_Vectors.To_Index (E), + Total_Votes => Entry_Vectors.Element (E).Total_Votes)); + end if; + end loop; + return Result; + end Get_Running_Entry_Positions; + + + + + -- Only used by the Transfer_Votes function. + function Get_Not_Running_IDs + return Candidates.Containers.CandidateID_Sets.Set + is + Result : Candidates.Containers.CandidateID_Sets.Set := + Candidates.Containers.CandidateID_Sets.Empty_Set; + begin + for E of Entries loop + if E.Status /= Running then + Result.Insert (E.ID); end if; end loop; return Result; - end Extract_Running_Entries; + end Get_Not_Running_IDs; + -- Helper function for Elect_Candidates and Check_No_Quota. + -- Performs the actual marking of Entries as being Elected. procedure Elect (Index : Positive; ID : Candidates.CandidateID) is - use Ada.Strings; - use Ada.Strings.Fixed; - Log_Msg : SU.Unbounded_String; begin Log_Msg := SU.To_Unbounded_String - (Candidates.Name_And_Party (Cand_Data.Reference (ID)) & - " elected at logfile #" & Trim (Integer'Image (Next_Log_Num), Both)); + (Candidates.Name_And_Party (Cand_Data.Reference (ID)) & + " elected at logfile #" & Int_Image (Next_Log_Num)); Put_Line (Main_Log, SU.To_String (Log_Msg)); if Verbose then Put_Line (Standard_Error, SU.To_String (Log_Msg)); @@ -260,10 +318,12 @@ package body Election is + -- Marks all the entries that have quota as elected, and adds a new + -- Transfer for each of them to the transfer queue. function Elect_Candidates return Boolean is - Running : Position_Vectors.Vector := Extract_Running_Entries; + Running : Position_Vectors.Vector := Get_Running_Entry_Positions; Working_Position : Positive; Working_ID : Candidates.CandidateID; @@ -289,6 +349,8 @@ package body Election is + -- This step finishes up election processing if all vacancies are filled + -- or if no further running Entries are available to fill them. function Check_If_Done return Boolean is @@ -311,94 +373,139 @@ package body Election is - -- need to refactor this due to length - function Transfer_Votes - return Boolean + -- Helper function for Transfer_Votes. + -- Sets the Total_Votes, Total_Papers, Vote_Change and Paper_Change for + -- the Entry being transferred from to the appropriate values, and generates + -- a Fraction to use as a transfer value in the actual redistribution. + procedure Adjust_Entry_Votes_And_Papers + (Position : in Positive; + New_Value : out Rationals.Fraction) is - use type Ada.Containers.Count_Type; use type Rationals.Fraction; + Entry_Ref : Entry_Vectors.Reference_Type := + Entries.Reference (Position); + begin + if Entry_Ref.Status = Excluded then + Entry_Ref.Vote_Change := - Entry_Ref.Total_Votes; + New_Value := 1 / 1; + Entry_Ref.Total_Votes := 0; + else + Entry_Ref.Vote_Change := Quota - Entry_Ref.Total_Votes; + New_Value := (Entry_Ref.Total_Votes - Quota) / Entry_Ref.Total_Votes; + Entry_Ref.Total_Votes := Quota; + end if; + Entry_Ref.Paper_Change := - Entry_Ref.Total_Papers; + Entry_Ref.Total_Papers := 0; + end Adjust_Entry_Votes_And_Papers; + + - Still_Running : Position_Vectors.Vector; - Not_Considered : Candidates.Containers.CandidateID_Set; - Working_Transfer : Pending_Transfer; + -- Helper function for Transfer_Votes. + -- Performs the actual redistribution of preferences, generating new vote Bundles + -- and adding them to the appropriate Entries. Also keeps a running total of how + -- many papers were lost to fractional losses, and how many papers were *NOT* + -- exhausted. + procedure Redistribute_Papers + (Still_Running : in Position_Vectors.Vector; + Already_Excluded : in Candidates.Containers.CandidateID_Set; + Transfer_From : in Candidates.CandidateID; + Transfer_Value : in Rationals.Fraction; + Fractional_Loss : out Natural; + Not_Exhausted : out Natural) + is Working_Position : Positive; Working_ID : Candidates.CandidateID; - Working_Value : Rationals.Fraction; - New_Bundle : Given_Bundles.Bundle; Votes_In, Papers_In : Natural; begin - if Transfers.Length = 0 then - return False; - end if; - - Still_Running := Extract_Running_Entries; - Not_Considered := Candidates.Containers.CandidateID_Sets.Empty_Set; - for E of Entries loop - if E.Status /= Running then - Not_Considered.Insert (E.ID); - end if; - end loop; - - Working_Transfer := Transfers.First_Element; - Transfers.Delete_First; - - Exhausted.Paper_Change := Entries.Reference (Working_Transfer.Position).Total_Papers; - - if Entries.Reference (Working_Transfer.Position).Status = Excluded then - Entries.Reference (Working_Transfer.Position).Vote_Change := - - Entries.Reference (Working_Transfer.Position).Total_Votes; - Working_Value := 1 / 1; - Entries.Reference (Working_Transfer.Position).Total_Votes := 0; - else - Entries.Reference (Working_Transfer.Position).Vote_Change := - Quota - Entries.Reference (Working_Transfer.Position).Total_Votes; - Working_Value := (Entries.Reference (Working_Transfer.Position).Total_Votes - Quota) / - Entries.Reference (Working_Transfer.Position).Total_Votes; - Entries.Reference (Working_Transfer.Position).Total_Votes := Quota; - end if; - Entries.Reference (Working_Transfer.Position).Paper_Change := - - Entries.Reference (Working_Transfer.Position).Total_Papers; - Entries.Reference (Working_Transfer.Position).Total_Papers := 0; + Fractional_Loss := 0; + Not_Exhausted := 0; for R in Still_Running.Iterate loop - Working_Position := Still_Running.Reference (R).Index; - Working_ID := Entries.Reference (Working_Position).ID; + Working_Position := Still_Running.Constant_Reference (R).Index; + Working_ID := Entries.Constant_Reference (Working_Position).ID; - for B in Pref_Data.Reference (Working_Transfer.From).Iterate loop + for B in Pref_Data.Reference (Transfer_From).Iterate loop Given_Bundles.Transfer - (This => Pref_Data.Reference (Working_Transfer.From).Reference (B), - From => Working_Transfer.From, + (This => Pref_Data.Reference (Transfer_From).Reference (B), + From => Transfer_From, To => Working_ID, - Excluded => Not_Considered, - Value => Working_Value, + Excluded => Already_Excluded, + Value => Transfer_Value, Result => New_Bundle); Given_Bundles.Count_Both (New_Bundle, Votes_In, Papers_In); if Votes_In > 0 then Pref_Data.Reference (Working_ID).Append (New_Bundle); - Entries.Reference (Working_Position).Vote_Change := - Entries.Reference (Working_Position).Vote_Change + Votes_In; - Entries.Reference (Working_Position).Paper_Change := - Entries.Reference (Working_Position).Paper_Change + Papers_In; - Exhausted.Paper_Change := Exhausted.Paper_Change - Papers_In; + declare + Entry_Ref : Entry_Vectors.Reference_Type := + Entries.Reference (Working_Position); + begin + Entry_Ref.Vote_Change := Entry_Ref.Vote_Change + Votes_In; + Entry_Ref.Paper_Change := Entry_Ref.Paper_Change + Papers_In; + end; + Not_Exhausted := Not_Exhausted + Papers_In; elsif Papers_In > 0 then - Fractional.Paper_Change := Fractional.Paper_Change + Papers_In; - Exhausted.Paper_Change := Exhausted.Paper_Change - Papers_In; + Fractional_Loss := Fractional_Loss + Papers_In; + Not_Exhausted := Not_Exhausted + Papers_In; end if; end loop; - Entries.Reference (Working_Position).Total_Votes := - Entries.Reference (Working_Position).Total_Votes + - Entries.Reference (Working_Position).Vote_Change; - Entries.Reference (Working_Position).Total_Papers := - Entries.Reference (Working_Position).Total_Papers + - Entries.Reference (Working_Position).Paper_Change; + declare + Entry_Ref : Entry_Vectors.Reference_Type := + Entries.Reference (Working_Position); + begin + Entry_Ref.Total_Votes := Entry_Ref.Total_Votes + Entry_Ref.Vote_Change; + Entry_Ref.Total_Papers := Entry_Ref.Total_Papers + Entry_Ref.Paper_Change; + end; end loop; - Pref_Data.Replace (Working_Transfer.From, Bundle_Containers.Bundle_Vectors.Empty_Vector); + Pref_Data.Replace (Transfer_From, Bundle_Containers.Bundle_Vectors.Empty_Vector); + end Redistribute_Papers; - Fractional.Total_Papers := Fractional.Total_Papers + Fractional.Paper_Change; + + + + -- Takes the oldest Transfer from the transfer queue and uses the above + -- helper functions to perform it. Only performs a single transfer per call. + function Transfer_Votes + return Boolean + is + Running_Positions : Position_Vectors.Vector; + Not_Considered : Candidates.Containers.CandidateID_Set; + + This_Transfer : Pending_Transfer; + This_Value : Rationals.Fraction; + + Fractional_Loss, Not_Exhausted : Natural; + begin + if Integer (Transfers.Length) = 0 then + return False; + end if; + + Running_Positions := Get_Running_Entry_Positions; + Not_Considered := Get_Not_Running_IDs; + + This_Transfer := Transfers.First_Element; + Transfers.Delete_First; + + Exhausted.Paper_Change := Entries.Reference (This_Transfer.Position).Total_Papers; + + Adjust_Entry_Votes_And_Papers + (Position => This_Transfer.Position, + New_Value => This_Value); + Redistribute_Papers + (Still_Running => Running_Positions, + Already_Excluded => Not_Considered, + Transfer_From => This_Transfer.From, + Transfer_Value => This_Value, + Fractional_Loss => Fractional_Loss, + Not_Exhausted => Not_Exhausted); + + Fractional.Paper_Change := Fractional_Loss; + Fractional.Total_Papers := Fractional.Total_Papers + Fractional_Loss; + + Exhausted.Paper_Change := Exhausted.Paper_Change - Not_Exhausted; Exhausted.Total_Papers := Exhausted.Total_Papers + Exhausted.Paper_Change; return True; @@ -407,10 +514,13 @@ package body Election is + -- If the number of running entries is only one more than the number of + -- vacancies remaining to be filled, the entries with the highest vote + -- totals can be elected without further vote transferral. function Check_No_Quota return Boolean is - Running : Position_Vectors.Vector := Extract_Running_Entries; + Running : Position_Vectors.Vector := Get_Running_Entry_Positions; Working_Position : Positive; Working_ID : Candidates.CandidateID; @@ -434,20 +544,26 @@ package body Election is + -- Implements bulk exclusions using applied breakpoints. Entries will be + -- excluded in order of least vote count until the running total of excluded + -- votes is as high as it can go without exceeding the difference between the + -- running entry with the highest vote total and the quota. A minimum of one entry + -- will always be excluded. A new Transfer for each excluded Entry is added + -- to the transfer queue. + -- (Note that this step does not yet implement proper tiebreaker handling.) function Exclude_Candidates return Boolean is - use Ada.Strings; - use Ada.Strings.Fixed; - - Running : Position_Vectors.Vector := Extract_Running_Entries; + Running : Position_Vectors.Vector := Get_Running_Entry_Positions; Log_Msg : SU.Unbounded_String; Working_ID : Candidates.CandidateID; Working_Position : Positive; + Number_Excluded : Natural := 0; Votes_Excluded : Natural := 0; Votes_To_Be_Excluded : Natural; + Applied_Breakpoint : Positive; begin Position_Sorting.Sort (Running); @@ -469,8 +585,8 @@ package body Election is if Number_Excluded > 1 then Log_Msg := SU.To_Unbounded_String - ("Bulk exclusion of " & Trim (Integer'Image (Number_Excluded), Both) & - " candidates at logfile #" & Trim (Integer'Image (Next_Log_Num), Both)); + ("Bulk exclusion of " & Int_Image (Number_Excluded) & + " candidates at logfile #" & Int_Image (Next_Log_Num)); Put_Line (Main_Log, SU.To_String (Log_Msg)); if Verbose then Put_Line (Standard_Error, SU.To_String (Log_Msg)); @@ -483,18 +599,21 @@ package body Election is + -- The main loop of election processing. Each individual step returns + -- a boolean value of whether or not it was applicable and did anything, + -- which allows the use of the if statement. procedure Run is begin while Work_To_Do loop Write_Log; - Next_Log_Num := Next_Log_Num + 1; + -- Clear marked changes in the entry list from + -- previous iterations. for E of Entries loop E.Vote_Change := 0; E.Paper_Change := 0; E.Changed := False; end loop; - Fractional.Paper_Change := 0; Exhausted.Paper_Change := 0; @@ -504,8 +623,8 @@ package body Election is not Check_No_Quota and then not Exclude_Candidates then - -- if all of the above procedures can't do - -- anything then something is wrong + -- If all of the above procedures can't do + -- anything then something is wrong. raise Program_Error; end if; end loop; @@ -514,6 +633,8 @@ package body Election is + -- A guard function to ensure nobody foolishly tries to run + -- an election before setting it up. function Is_Properly_Setup return Boolean is begin diff --git a/src/election.ads b/src/election.ads index f55637f..7d931bc 100644 --- a/src/election.ads +++ b/src/election.ads @@ -70,8 +70,8 @@ private Element_Type => Pending_Transfer); - -- this is used to keep track of exhausted and - -- fractional loss votes/papers + -- This is used to keep track of exhausted and + -- fractional loss papers. type Extra_Data is record Paper_Change : Integer; Total_Papers : Natural; |