From 11c699ee5285c11cfbde8862d9701f3a641d6114 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 12 May 2017 21:38:06 +1000
Subject: Refactored Transfer_Votes function
---
src/election.adb | 171 +++++++++++++++++++++++++------------------------------
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;
@@ -373,46 +380,17 @@ 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;
--
cgit