diff options
| -rw-r--r-- | src/election.adb | 171 | ||||
| -rw-r--r-- | src/election.ads | 2 |
2 files changed, 80 insertions, 93 deletions
diff --git a/src/election.adb b/src/election.adb index c6b1431..298c82b 100644 --- a/src/election.adb +++ b/src/election.adb @@ -2,9 +2,9 @@ with Ada.Strings.Fixed; with Ada.Strings.Unbounded; -with Ada.Text_IO; -use Ada.Text_IO; +with Ada.Text_IO; use Ada.Text_IO; with Rationals; +use type Rationals.Fraction; -- This source is licensed under Creative Commons CC0 v1.0. @@ -326,7 +326,8 @@ package body Election is Running : Position_Vectors.Vector := Get_Running_Entry_Positions; Working_Position : Positive; - Working_ID : Candidates.CandidateID; + Working_ID : Candidates.CandidateID; + Transfer_Value : Rationals.Fraction; Number_Elected : Natural := 0; begin @@ -339,8 +340,14 @@ package body Election is Elect (Working_Position, Working_ID); + Transfer_Value := (Entries.Reference (Working_Position).Total_Votes - Quota) / + Entries.Reference (Working_Position).Total_Votes; + Number_Elected := Number_Elected + 1; - Transfers.Append ( (From => Working_ID, Position => Working_Position) ); + Transfers.Append + ((From => Working_ID, + Position => Working_Position, + Value => Transfer_Value)); end loop; return Number_Elected > 0; @@ -374,45 +381,16 @@ package body Election is -- 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 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; - - - - - -- 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. + -- many papers were lost to fractional losses, and how many papers were 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; + Transfer_Bundle : in out Given_Bundles.Bundle; + Transfer : in Pending_Transfer; Fractional_Loss : out Natural; - Not_Exhausted : out Natural) + Exhausted_Loss : out Natural) is Working_Position : Positive; Working_ID : Candidates.CandidateID; @@ -420,64 +398,54 @@ package body Election is Votes_In, Papers_In : Natural; begin Fractional_Loss := 0; - Not_Exhausted := 0; + Exhausted_Loss := Given_Bundles.Count_Papers (Transfer_Bundle); for R in Still_Running.Iterate loop Working_Position := Still_Running.Constant_Reference (R).Index; Working_ID := Entries.Constant_Reference (Working_Position).ID; - for B in Pref_Data.Reference (Transfer_From).Iterate loop - Given_Bundles.Transfer - (This => Pref_Data.Reference (Transfer_From).Reference (B), - From => Transfer_From, - To => Working_ID, - 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); - 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_Loss := Fractional_Loss + Papers_In; - Not_Exhausted := Not_Exhausted + Papers_In; - end if; - end loop; - - 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; + Given_Bundles.Transfer + (This => Transfer_Bundle, + From => Transfer.From, + To => Working_ID, + 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); + 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; + Entry_Ref.Total_Votes := Entry_Ref.Total_Votes + Votes_In; + Entry_Ref.Total_Papers := Entry_Ref.Total_Papers + Papers_In; + end; + Exhausted_Loss := Exhausted_Loss - Papers_In; + elsif Papers_In > 0 then + Fractional_Loss := Fractional_Loss + Papers_In; + Exhausted_Loss := Exhausted_Loss - Papers_In; + end if; end loop; - - Pref_Data.Replace (Transfer_From, Bundle_Containers.Bundle_Vectors.Empty_Vector); end Redistribute_Papers; -- Takes the oldest Transfer from the transfer queue and uses the above - -- helper functions to perform it. Only performs a single transfer per call. + -- helper function to perform it. Only performs a single transfer per call. function Transfer_Votes return Boolean is + use type Ada.Containers.Count_Type; + Running_Positions : Position_Vectors.Vector; Not_Considered : Candidates.Containers.CandidateID_Set; - This_Transfer : Pending_Transfer; - This_Value : Rationals.Fraction; - - Fractional_Loss, Not_Exhausted : Natural; + Fractional_Loss, Exhausted_Loss : Natural; begin if Integer (Transfers.Length) = 0 then return False; @@ -487,25 +455,42 @@ package body Election is Not_Considered := Get_Not_Running_IDs; This_Transfer := Transfers.First_Element; - Transfers.Delete_First; - Exhausted.Paper_Change := Entries.Reference (This_Transfer.Position).Total_Papers; + while Pref_Data.Reference (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 => This_Transfer, + Fractional_Loss => Fractional_Loss, + Exhausted_Loss => Exhausted_Loss); - 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); + Pref_Data.Reference (This_Transfer.From).Delete (Pref_Data.Reference (This_Transfer.From).First_Index); - Fractional.Paper_Change := Fractional_Loss; - Fractional.Total_Papers := Fractional.Total_Papers + Fractional_Loss; + 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 + declare + Entry_Ref : Entry_Vectors.Reference_Type := + Entries.Reference (This_Transfer.Position); + begin + Entry_Ref.Paper_Change := - Entry_Ref.Total_Papers; + Entry_Ref.Total_Papers := 0; + if Entry_Ref.Status = Elected then + Entry_Ref.Vote_Change := Quota - Entry_Ref.Total_Votes; + Entry_Ref.Total_Votes := Quota; + else + Entry_Ref.Vote_Change := - Entry_Ref.Total_Votes; + Entry_Ref.Total_Votes := 0; + end if; + end; + Transfers.Delete_First; + end if; - Exhausted.Paper_Change := Exhausted.Paper_Change - Not_Exhausted; + Fractional.Total_Papers := Fractional.Total_Papers + Fractional.Paper_Change; Exhausted.Total_Papers := Exhausted.Total_Papers + Exhausted.Paper_Change; return True; @@ -578,7 +563,7 @@ package body Election is Entries.Reference (Working_Position).Status := Excluded; Entries.Reference (Working_Position).Changed := True; - Transfers.Append ( (From => Working_ID, Position => Working_Position) ); + Transfers.Append ( (From => Working_ID, Position => Working_Position, Value => 1 / 1) ); Votes_Excluded := Votes_Excluded + Votes_To_Be_Excluded; Number_Excluded := Number_Excluded + 1; end loop; diff --git a/src/election.ads b/src/election.ads index 7d931bc..3da5e5a 100644 --- a/src/election.ads +++ b/src/election.ads @@ -3,6 +3,7 @@ with Candidates.Containers; with Bundles.Containers; private with Ada.Containers.Vectors; +private with Rationals; -- This source is licensed under Creative Commons CC0 v1.0. @@ -62,6 +63,7 @@ private type Pending_Transfer is record From : Candidates.CandidateID; Position : Positive; + Value : Rationals.Fraction; end record; |