summaryrefslogtreecommitdiff
path: root/src/preferences.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/preferences.adb')
-rw-r--r--src/preferences.adb281
1 files changed, 281 insertions, 0 deletions
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;
generated by cgit (git 2.30.0) at 2024-05-05 15:09:53 +0000