From 60b2207a469a5a1e7a7e5619a8eb1b01c67f314a Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 10 Feb 2017 18:41:36 +1100 Subject: Preference data reads into Bundles properly, with packed memory and a few fixed bugs --- src/candidates.adb | 263 ----------------------------------------------------- 1 file changed, 263 deletions(-) (limited to 'src/candidates.adb') diff --git a/src/candidates.adb b/src/candidates.adb index 33d3901..5d10ce1 100644 --- a/src/candidates.adb +++ b/src/candidates.adb @@ -1,6 +1,5 @@ -with Ada.Text_IO; with CSV; @@ -28,268 +27,6 @@ package body Candidates is end To_String; - - - procedure Read_Candidates - (Filename : in String; - State : in State_Name; - Candidate_List : out Candidate_Vector) - is - package My_CSV is new CSV; - use Ada.Text_IO; - use type Ada.Containers.Count_Type; - use type SU.Unbounded_String; - - Input_File : File_Type; - Current_Record : My_CSV.CSV_Record; - Current_Candidate : Candidate; - begin - Open (Input_File, In_File, Filename); - Candidate_List := (Vec => Candidate_Vectors.Empty_Vector); - - while not End_Of_File (Input_File) loop - Current_Record := My_CSV.Parse_Line (Get_Line (Input_File)); - - -- all the field numbers here correspond to how - -- AEC Senate candidate data is arranged in csv format - if Current_Record.Length = 25 and then - Current_Record.Element (2) = "S" and then - Current_Record.Element (3) = State_Name'Image (State) - then - Current_Candidate := - (First_Name => Current_Record.Element (8), - Last_Name => Current_Record.Element (7), - Group => Current_Record.Element (5), - Group_Rank => Current_Record.Element (6), - Party => Current_Record.Element (9)); - Candidate_List.Vec.Append (Current_Candidate); - end if; - end loop; - - Close (Input_File); - end Read_Candidates; - - - - - function First - (Candidate_List : in Candidate_Vector) - return CandidateID is - begin - return Candidate_List.Vec.First_Index; - end First; - - - - - function Last - (Candidate_List : in Candidate_Vector) - return CandidateID is - begin - return Candidate_List.Vec.Last_Index; - end Last; - - - - - function Lookup - (Candidate_List : in Candidate_Vector; - Index : in CandidateID) - return Candidate is - begin - return Candidate_List.Vec.Element (Index); - end Lookup; - - - - - function First - (CandidateID_List : in CandidateID_Vector) - return Positive is - begin - return CandidateID_List.Vec.First_Index; - end First; - - - - - function Last - (CandidateID_List : in CandidateID_Vector) - return Positive is - begin - return CandidateID_List.Vec.Last_Index; - end Last; - - - - - function Lookup - (CandidateID_List : in CandidateID_Vector; - Index : in Positive) - return CandidateID is - begin - return CandidateID_List.Vec.Element (Index); - end Lookup; - - - - - function "<" - (Left, Right : Candidate) - return Boolean - is - use type SU.Unbounded_String; - begin - if SU.Length (Left.Group) = SU.Length (Right.Group) then - if Left.Group = Right.Group then - return Left.Group_Rank < Right.Group_Rank; - else - return Left.Group < Right.Group; - end if; - else - return SU.Length (Left.Group) < SU.Length (Right.Group); - end if; - end "<"; - - - - - function Generate_Above - (Candidate_List : in Candidate_Vector) - return Above_Line_Ballot - is - use type Ada.Containers.Count_Type; - use type SU.Unbounded_String; - - Result : Above_Line_Ballot; - Working_Vector : CandidateID_Vector; - Current_Group : SU.Unbounded_String; - Current_Index : CandidateID; - begin - Result := (Vec => Above_Line_Ballots.Empty_Vector); - - if Candidate_List.Vec.Length = 0 then - return Result; - end if; - - Current_Index := Candidate_List.Vec.First_Index; - while Current_Index <= Candidate_List.Vec.Last_Index loop - Current_Group := Candidate_List.Vec.Element (Current_Index).Group; - - -- the assumption is that the "UG" group is always last - -- a fairly safe assumption given alphabetical group order - exit when Current_Group = "UG"; - - Working_Vector := (Vec => CandidateID_Vectors.Empty_Vector); - loop - Working_Vector.Vec.Append (Current_Index); - Current_Index := Current_Index + 1; - exit when Current_Index > Candidate_List.Vec.Last_Index or else - Current_Group /= Candidate_List.Vec.Element (Current_Index).Group; - end loop; - Result.Vec.Append (Working_Vector); - end loop; - - return Result; - end Generate_Above; - - - - - function Generate_Below - (Candidate_List : in Candidate_Vector) - return Below_Line_Ballot - is - Result : Below_Line_Ballot; - begin - Result := (Vec => CandidateID_Vectors.Empty_Vector); - for ID in CandidateID range Candidate_List.Vec.First_Index .. Candidate_List.Vec.Last_Index loop - Result.Vec.Append (ID); - end loop; - return Result; - end Generate_Below; - - - - - procedure Generate_Ballots - (Candidate_List : in Candidate_Vector; - Above_Ballot : out Above_Line_Ballot; - Below_Ballot : out Below_Line_Ballot) - is - package Sorting is new Candidate_Vectors.Generic_Sorting; - - My_Candidate_List : Candidate_Vector; - begin - My_Candidate_List := Candidate_List; - Sorting.Sort (My_Candidate_List.Vec); - Above_Ballot := Generate_Above (My_Candidate_List); - Below_Ballot := Generate_Below (My_Candidate_List); - end Generate_Ballots; - - - - - function First - (Above_Ballot : in Above_Line_Ballot) - return Positive is - begin - return Above_Ballot.Vec.First_Index; - end First; - - - - - function Last - (Above_Ballot : in Above_Line_Ballot) - return Positive is - begin - return Above_Ballot.Vec.Last_Index; - end Last; - - - - - function Lookup - (Above_Ballot : in Above_Line_Ballot; - Index : in Positive) - return CandidateID_Vector is - begin - return Above_Ballot.Vec.Element (Index); - end Lookup; - - - - - function First - (Below_Ballot : in Below_Line_Ballot) - return Positive is - begin - return Below_Ballot.Vec.First_Index; - end First; - - - - - function Last - (Below_Ballot : in Below_Line_Ballot) - return Positive is - begin - return Below_Ballot.Vec.Last_Index; - end Last; - - - - - function Lookup - (Below_Ballot : in Below_Line_Ballot; - Index : in Positive) - return CandidateID is - begin - return Below_Ballot.Vec.Element (Index); - end Lookup; - - end Candidates; -- cgit