Refactored Transfer_Votes function

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;