diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2017-02-18 10:59:45 +1100 | 
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2017-02-18 10:59:45 +1100 | 
| commit | 7e030b0b119fb116586937ab35c7d1f936fba92f (patch) | |
| tree | aece5598d85497ee3f8fb071929dd69c62e42c3b /src | |
| parent | d4e1589d9768b4224e861f3a3e30689c64e7832a (diff) | |
Refactored long functions and commented election.adb and election.ads
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; | 
