path: root/src/election.adb

with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
use Ada.Text_IO;
with Rationals;


--  This source is licensed under Creative Commons CC0 v1.0.
--
--  To read the full text, see license.txt in the main directory of this repository
--  or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt
--
--  For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/


package body Election is


    package SU renames Ada.Strings.Unbounded;




    Cand_Data  : Candidates.Containers.Candidate_Map;
    Pref_Data  : Bundle_Containers.Bundle_Map;
    Entries    : Entry_Vectors.Vector;
    Exhausted  : Extra_Data;
    Fractional : Extra_Data;
    Transfers  : Transfer_Vectors.Vector;


    Out_Dir      : SU.Unbounded_String;
    Next_Log_Num : Positive;
    Main_Log     : File_Type;
    Seats        : Natural;
    Vacancies    : Natural;
    Total_Papers : Natural;
    Quota        : Natural;
    Verbose      : Boolean;


    Work_To_Do : Boolean := False;




    function Droop_Quota
           (Votes : in Natural;
            Seats : in Natural)
        return Natural is
    begin
        return Votes / (Seats + 1) + 1;
    end Droop_Quota;




    --  needs to be refactored due to length
    procedure Setup
           (Candidate_Data           : in Candidates.Containers.Candidate_Map;
            Preference_File          : in String;
            Output_Dir, Main_Logfile : in String;
            Number_To_Elect          : in Natural;
            Is_Verbose               : in Boolean := False) is
    begin
        Verbose := Is_Verbose;

        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;

        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;
        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
            Put_Line (Standard_Error, "Done." & ASCII.LF);
        end if;
    end Setup;




    procedure Write_Log
    is
        use Ada.Strings;
        use Ada.Strings.Fixed;

        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";

        Change_Str, Order_Str : SU.Unbounded_String;

        Logfile : File_Type;
    begin
        Create (Logfile, Out_File, Logname);

        Put_Line (Logfile, Header);
        for E of Entries loop
            if E.Changed then
                Change_Str := SU.To_Unbounded_String ("True");
            else
                Change_Str := SU.To_Unbounded_String (0);
            end if;

            if E.Order_Elected > 0 then
                Order_Str := SU.To_Unbounded_String (Trim (Integer'Image (E.Order_Elected), Both));
            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));
        end loop;
        Put_Line (Logfile,
                ",,,,,,Fractional Loss,,," &
                Trim (Integer'Image (Fractional.Total_Papers), Both) & "," &
                Trim (Integer'Image (Fractional.Paper_Change), Both) & "," &
                ",,,,");
        Put_Line (Logfile,
                ",,,,,,Exhausted,,," &
                Trim (Integer'Image (Exhausted.Total_Papers), Both) & "," &
                Trim (Integer'Image (Exhausted.Paper_Change), Both) & "," &
                ",,,,");

        Close (Logfile);
    end Write_Log;




    type Entry_Position is record
        Index       : Positive;
        Total_Votes : Natural;
    end record;


    package Position_Vectors is new Ada.Containers.Vectors
           (Index_Type   => Positive,
            Element_Type => Entry_Position);


    function "<"
           (Left, Right : in Entry_Position)
        return Boolean is
    begin
        if Left.Total_Votes = Right.Total_Votes then
            return Left.Index < Right.Index;
        else
            return Left.Total_Votes < Right.Total_Votes;
        end if;
    end "<";


    package Position_Sorting is new Position_Vectors.Generic_Sorting;


    function Extract_Running_Entries
        return Position_Vectors.Vector
    is
        Result : Position_Vectors.Vector := Position_Vectors.Empty_Vector;
    begin
        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));
            end if;
        end loop;
        return Result;
    end Extract_Running_Entries;




    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));
        Put_Line (Main_Log, SU.To_String (Log_Msg));
        if Verbose then
            Put_Line (Standard_Error, SU.To_String (Log_Msg));
        end if;

        Entries.Reference (Index).Status := Elected;
        Entries.Reference (Index).Changed := True;
        Entries.Reference (Index).Order_Elected := Seats - Vacancies + 1;

        Vacancies := Vacancies - 1;
    end Elect;




    function Elect_Candidates
        return Boolean
    is
        Running : Position_Vectors.Vector := Extract_Running_Entries;

        Working_Position : Positive;
        Working_ID : Candidates.CandidateID;

        Number_Elected : Natural := 0;
    begin
        Position_Sorting.Sort (Running);

        for R in reverse Running.Iterate loop
            exit when Running.Reference (R).Total_Votes < Quota;
            Working_Position := Position_Vectors.Element (R).Index;
            Working_ID := Entries.Reference (Working_Position).ID;

            Elect (Working_Position, Working_ID);

            Number_Elected := Number_Elected + 1;
            Transfers.Append ( (From => Working_ID, Position => Working_Position) );
        end loop;

        return Number_Elected > 0;
    end Elect_Candidates;




    function Check_If_Done
        return Boolean
    is
        Total_Still_Running : Natural := 0;
    begin
        for E of Entries loop
            if E.Status = Running then
                Total_Still_Running := Total_Still_Running + 1;
            end if;
        end loop;
        if Vacancies = 0 or Total_Still_Running = 0 then
            Close (Main_Log);
            Work_To_Do := False;
            return True;
        else
            return False;
        end if;
    end Check_If_Done;




    --  need to refactor this due to length
    function Transfer_Votes
        return Boolean
    is
        use type Ada.Containers.Count_Type;
        use type Rationals.Fraction;

        Still_Running : Position_Vectors.Vector;
        Not_Considered : Candidates.Containers.CandidateID_Set;

        Working_Transfer : Pending_Transfer;
        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;

        for R in Still_Running.Iterate loop
            Working_Position := Still_Running.Reference (R).Index;
            Working_ID := Entries.Reference (Working_Position).ID;

            for B in Pref_Data.Reference (Working_Transfer.From).Iterate loop
                Given_Bundles.Transfer
                       (This     => Pref_Data.Reference (Working_Transfer.From).Reference (B),
                        From     => Working_Transfer.From,
                        To       => Working_ID,
                        Excluded => Not_Considered,
                        Value    => Working_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;
                elsif Papers_In > 0 then
                    Fractional.Paper_Change := Fractional.Paper_Change + Papers_In;
                    Exhausted.Paper_Change := Exhausted.Paper_Change - 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;
        end loop;

        Pref_Data.Replace (Working_Transfer.From, Bundle_Containers.Bundle_Vectors.Empty_Vector);

        Fractional.Total_Papers := Fractional.Total_Papers + Fractional.Paper_Change;
        Exhausted.Total_Papers := Exhausted.Total_Papers + Exhausted.Paper_Change;

        return True;
    end Transfer_Votes;




    function Check_No_Quota
        return Boolean
    is
        Running : Position_Vectors.Vector := Extract_Running_Entries;

        Working_Position : Positive;
        Working_ID : Candidates.CandidateID;
    begin
        if Integer (Running.Length) > Vacancies + 1 then
            return False;
        end if;

        Position_Sorting.Sort (Running);

        for R in reverse Running.Iterate loop
            exit when Vacancies = 0;
            Working_Position := Position_Vectors.Element (R).Index;
            Working_ID := Entries.Reference (Working_Position).ID;
            Elect (Working_Position, Working_ID);
        end loop;

        return True;
    end Check_No_Quota;




    function Exclude_Candidates
        return Boolean
    is
        use Ada.Strings;
        use Ada.Strings.Fixed;

        Running : Position_Vectors.Vector := Extract_Running_Entries;
        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);
        Applied_Breakpoint := Quota - Running.Reference (Running.Last_Index).Total_Votes;

        for R in Running.Iterate loop
            Votes_To_Be_Excluded := Running.Reference (R).Total_Votes;
            exit when Number_Excluded > 0 and Votes_Excluded + Votes_To_Be_Excluded > Applied_Breakpoint;

            Working_Position := Running.Reference (R).Index;
            Working_ID := Entries.Reference (Working_Position).ID;

            Entries.Reference (Working_Position).Status := Excluded;
            Entries.Reference (Working_Position).Changed := True;
            Transfers.Append ( (From => Working_ID, Position => Working_Position) );
            Votes_Excluded := Votes_Excluded + Votes_To_Be_Excluded;
            Number_Excluded := Number_Excluded + 1;
        end loop;

        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));
            Put_Line (Main_Log, SU.To_String (Log_Msg));
            if Verbose then
                Put_Line (Standard_Error, SU.To_String (Log_Msg));
            end if;
        end if;

        return Number_Excluded > 0;
    end Exclude_Candidates;




    procedure Run is
    begin
        while Work_To_Do loop
            Write_Log;
            Next_Log_Num := Next_Log_Num + 1;

            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;

            if  not Elect_Candidates and then
                not Check_If_Done and then
                not Transfer_Votes and then
                not Check_No_Quota and then
                not Exclude_Candidates
            then
                --  if all of the above procedures can't do
                --  anything then something is wrong
                raise Program_Error;
            end if;
        end loop;
    end Run;




    function Is_Properly_Setup
        return Boolean is
    begin
        return Work_To_Do;
    end Is_Properly_Setup;


end Election;