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/preferences.adb | 281 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 281 insertions(+) (limited to 'src/preferences.adb') diff --git a/src/preferences.adb b/src/preferences.adb index d2f743b..9b64a89 100644 --- a/src/preferences.adb +++ b/src/preferences.adb @@ -1,8 +1,289 @@ +with Ada.Strings.Unbounded; +with Ada.Strings.Maps; + + package body Preferences is + package S renames Ada.Strings; + package SU renames Ada.Strings.Unbounded; + package SM renames Ada.Strings.Maps; + + + + + generic + type Range_Type is range <>; + type Array_Type is array (Range_Type) of Natural; + procedure Index_And_Count + (Input : in Array_Type; + Value : in Natural; + Index : out Range_Type; + Count : out Natural); + + + procedure Index_And_Count + (Input : in Array_Type; + Value : in Natural; + Index : out Range_Type; + Count : out Natural) is + begin + Count := 0; + for I in Range_Type loop + if Input (I) = Value then + Index := I; + Count := Count + 1; + end if; + end loop; + end Index_And_Count; + + + + + function Extract_Formal + (Above_Input : in Above_Pref_Array; + Formal_Prefs : out Preference_Array) + return Boolean + is + procedure Above_IC is new Index_And_Count + (Above_Range, Above_Pref_Array); + + Extracted : Natural := 0; + Working_Index : Above_Range; + Working_Count : Natural; + Formal_Index : Preference_Range := Preference_Range'First; + begin + Formal_Prefs := (others => Candidates.No_Candidate); + Pref_Loop : + for I in Above_Range loop + Above_IC (Above_Input, Integer (I), Working_Index, Working_Count); + exit when Working_Count /= 1; + Extracted := Extracted + 1; + for C of Above_Ballot.Element (Integer (Working_Index)) loop + exit Pref_Loop when Formal_Index > Preference_Range'Last; + Formal_Prefs (Formal_Index) := C; + Formal_Index := Formal_Index + 1; + end loop; + end loop Pref_Loop; + return Extracted >= Min_Above_Line; + end Extract_Formal; + + + + + function Extract_Formal + (Below_Input : in Below_Pref_Array; + Formal_Prefs : out Preference_Array) + return Boolean + is + procedure Below_IC is new Index_And_Count + (Below_Range, Below_Pref_Array); + + Extracted : Natural := 0; + Working_Index : Below_Range; + Working_Count : Natural; + Formal_Index : Preference_Range := Preference_Range'First; + begin + Formal_Prefs := (others => Candidates.No_Candidate); + if Formal_Index > Preference_Range'Last then + return Extracted >= Min_Below_Line; + end if; + for I in Below_Range loop + Below_IC (Below_Input, Integer (I), Working_Index, Working_Count); + exit when Working_Count /= 1; + Formal_Prefs (Formal_Index) := Below_Ballot.Element (Integer (Working_Index)); + Extracted := Extracted + 1; + exit when Formal_Index = Preference_Range'Last; + Formal_Index := Formal_Index + 1; + end loop; + return Extracted >= Min_Below_Line; + end Extract_Formal; + + + + + function Mark + (Input : in SU.Unbounded_String; + Output : out Natural; + Remaining : out SU.Unbounded_String) + return Boolean is + begin + if SU.Length (Input) > 0 and then + (SU.Element (Input, 1) = '/' or else + SU.Element (Input, 1) = '*') + then + Output := 1; + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + return True; + else + return False; + end if; + end Mark; + + + + + function Number + (Input : in SU.Unbounded_String; + Output : out Natural; + Remaining : out SU.Unbounded_String) + return Boolean + is + First, Last : Natural; + begin + SU.Find_Token (Input, SM.To_Set ("1234567890"), S.Inside, First, Last); + if First = 1 and Last > 0 then + Output := Integer'Value (SU.Slice (Input, First, Last)); + Remaining := SU.Unbounded_Slice (Input, Last + 1, SU.Length (Input)); + return True; + else + return False; + end if; + end Number; + + + + + function Comma + (Input : in SU.Unbounded_String; + Remaining : out SU.Unbounded_String) + return Boolean is + begin + if SU.Length (Input) > 0 and then + SU.Element (Input, 1) = ',' + then + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + return True; + else + return False; + end if; + end Comma; + + + + + generic + type Range_Type is range <>; + type Array_Type is array (Range_Type) of Natural; + function Raw_Prefs + (Input : in SU.Unbounded_String; + Output : out Array_Type; + Remaining : out SU.Unbounded_String) + return Boolean; + + + function Raw_Prefs + (Input : in SU.Unbounded_String; + Output : out Array_Type; + Remaining : out SU.Unbounded_String) + return Boolean + is + Working_Num : Natural; + Index : Range_Type := Range_Type'First; + This_In, This_Remaining : SU.Unbounded_String; + begin + Output := (others => 0); + if Index > Range_Type'Last then + Remaining := Input; + return True; + end if; + This_In := Input; + + loop + if Number (This_In, Working_Num, This_Remaining) or else + Mark (This_In, Working_Num, This_Remaining) + then + Output (Index) := Working_Num; + else + This_Remaining := This_In; + end if; + exit when Index = Range_Type'Last; + Index := Index + 1; + if not Comma (This_Remaining, This_In) then + return False; + end if; + end loop; + + Remaining := This_Remaining; + return True; + end Raw_Prefs; + + + + + procedure Optional_Line_Ending + (Input : in SU.Unbounded_String; + Remaining : out SU.Unbounded_String) is + begin + if SU.Length (Input) > 1 and then + SU.Slice (Input, 1, 2) = Character'Val (13) & Character'Val (10) + then + Remaining := SU.Tail (Input, SU.Length (Input) - 2); + elsif + SU.Length (Input) > 0 and then + (SU.Element (Input, 1) = Character'Val (13) or else + SU.Element (Input, 1) = Character'Val (10)) + then + Remaining := SU.Tail (Input, SU.Length (Input) - 1); + else + Remaining := Input; + end if; + end Optional_Line_Ending; + + + + + function Parse_Preferences + (Input : in String) + return Preference_Array + is + use type SU.Unbounded_String; + + Above_Line : Above_Pref_Array; + Below_Line : Below_Pref_Array; + + function Parse_Above_Line is new Raw_Prefs + (Above_Range, Above_Pref_Array); + + function Parse_Below_Line is new Raw_Prefs + (Below_Range, Below_Pref_Array); + + Result : Preference_Array; + + This_In, This_Remaining : SU.Unbounded_String; + begin + This_In := SU.To_Unbounded_String (Input); + + if not Parse_Above_Line (This_In, Above_Line, This_Remaining) then + return Empty_Array; + end if; + + if not Comma (This_Remaining, This_In) then + return Empty_Array; + end if; + + if not Parse_Below_Line (This_In, Below_Line, This_Remaining) then + return Empty_Array; + end if; + + Optional_Line_Ending (This_Remaining, This_In); + + if SU.Length (This_In) > 0 then + return Empty_Array; + end if; + + if Extract_Formal (Below_Line, Result) or else + Extract_Formal (Above_Line, Result) + then + return Result; + else + return Empty_Array; + end if; + end Parse_Preferences; + + end Preferences; -- cgit