summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/election.adb109
1 files changed, 102 insertions, 7 deletions
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;