From d1d6ff0de6894b1066e3e09f67eb4a6de4d3753b Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 7 Jul 2017 20:42:34 +1000 Subject: Non-specialised tiebreaker handling added, but not tested --- src/election.adb | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 102 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/election.adb b/src/election.adb index ddbdb26..797c117 100644 --- a/src/election.adb +++ b/src/election.adb @@ -499,6 +499,95 @@ package body Election is + function Choose_Tie_Exclusion + (From_Vector : in Position_Vectors.Vector; + Min, Max : in Position_Vectors.Extended_Index) + return Position_Vectors.Extended_Index + is + subtype Valid_Response is Position_Vectors.Extended_Index range Min .. Max; + package PV_IO is new Ada.Text_IO.Integer_IO (Valid_Response); + + Log_Msg : SU.Unbounded_String; + Indent : String := " "; + + CurrentID : Candidates.CandidateID; + Result : Valid_Response; + begin + Put_Line ("Tiebreaker required. Choose one to eliminate:"); + for V in Valid_Response loop + CurrentID := Entries.Reference (From_Vector.Element (V).Index).ID; + Put_Line (Indent & Valid_Response'Image (V) & ": " & + Candidates.Name_And_Party (Cand_Data (CurrentID))); + end loop; + + loop + Put ("Enter selection: "); + begin + PV_IO.Get (Result); + exit; + exception + when others => null; + end; + end loop; + + -- This log message isn't ever Put to Standard_Error since user input + -- is already required to break the tie in the first place. + Log_Msg := SU.To_Unbounded_String ("Exclusion tiebreaker at logfile #" & + Int_Image (Next_Log_Num) & " between candidates: "); + for V in Valid_Response loop + CurrentID := Entries.Reference (From_Vector.Element (V).Index).ID; + SU.Append (Log_Msg, ASCII.LF & Indent & + Candidates.Name_And_Party (Cand_Data (CurrentID))); + end loop; + CurrentID := Entries.Reference (From_Vector.Element (Result).Index).ID; + SU.Append (Log_Msg, ASCII.LF & Candidates.Name_And_Party (Cand_Data (CurrentID)) & + " was selected to be excluded."); + Put_Line (Main_Log, SU.To_String (Log_Msg)); + + return Result; + end Choose_Tie_Exclusion; + + + + + -- The Position_Vector input is assumed to be sorted. + -- It's also assumed to have at least one element. + procedure Resolve_Ties + (Select_From : in out Position_Vectors.Vector; + Chosen : out Entry_Position; + Breakpoint : in Integer := -1) + is + Min_Equal, Max_Equal, Tie_Winner : Position_Vectors.Extended_Index; + Tie_Breakpoint : Natural; + begin + Min_Equal := Select_From.First_Index; + for P in Select_From.Iterate loop + if Select_From.Reference (P).Total_Votes = + Select_From.Reference (Min_Equal).Total_Votes + then + Max_Equal := Position_Vectors.To_Index (P); + else + exit; + end if; + end loop; + + -- The breakpoint is to allow bulk exclusions to not + -- worry about ties when they don't matter. + Tie_Breakpoint := (Max_Equal - Min_Equal + 1) * + Select_From.Reference (Min_Equal).Total_Votes; + if Min_Equal = Max_Equal or Tie_Breakpoint <= Breakpoint then + Tie_Winner := Min_Equal; + else + Tie_Winner := Choose_Tie_Exclusion (Select_From, Min_Equal, Max_Equal); + end if; + + Chosen := Select_From.Element (Tie_Winner); + Select_From.Delete (Tie_Winner); + end Resolve_Ties; + + + + -- 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. @@ -507,6 +596,7 @@ package body Election is is Running : Position_Vectors.Vector := Get_Running_Entry_Positions; + Not_Elected : Entry_Position; Working_Position : Positive; Working_ID : Candidates.CandidateID; begin @@ -516,8 +606,11 @@ package body Election is Position_Sorting.Sort (Running); - for R in reverse Running.Iterate loop - exit when Vacancies = 0; + if Integer (Running.Length) > Vacancies then + Resolve_Ties (Running, Not_Elected); + end if; + + for R in Running.Iterate loop Working_Position := Position_Vectors.Element (R).Index; Working_ID := Entries.Reference (Working_Position).ID; Elect (Working_Position, Working_ID); @@ -542,6 +635,7 @@ package body Election is Running : Position_Vectors.Vector := Get_Running_Entry_Positions; Log_Msg : SU.Unbounded_String; + Not_Elected : Entry_Position; Working_ID : Candidates.CandidateID; Working_Position : Positive; @@ -554,12 +648,13 @@ package body Election is 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 Integer (Running.Length) - Number_Excluded <= Vacancies + 1 or - (Number_Excluded > 0 and Votes_Excluded + Votes_To_Be_Excluded > Applied_Breakpoint); + while Integer (Running.Length) > Vacancies + 1 loop + Votes_To_Be_Excluded := Running.Reference (Running.First_Index).Total_Votes; + exit when Number_Excluded > 0 and + Votes_Excluded + Votes_To_Be_Excluded > Applied_Breakpoint; - Working_Position := Running.Reference (R).Index; + Resolve_Ties (Running, Not_Elected, Applied_Breakpoint - Votes_Excluded); + Working_Position := Not_Elected.Index; Working_ID := Entries.Reference (Working_Position).ID; Entries.Reference (Working_Position).Status := Excluded; -- cgit