summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-02-08 11:25:34 +1100
committerJed Barber <jjbarber@y7mail.com>2017-02-08 11:25:34 +1100
commit964a28e91593c4bf1e1c132536828d87f8d12c84 (patch)
treea386b12bdca1a18de5d09d80111facb0eaf6979b
parentf0a4bac4bde861bc639c8eca48682f96d7a751be (diff)
Bundles mostly done, still need to adapt Preferences and Candidates packages
-rw-r--r--src/bundles.adb146
-rw-r--r--src/bundles.ads53
-rw-r--r--src/candidates.ads7
-rw-r--r--src/preferences.adb8
-rw-r--r--src/preferences.ads23
-rw-r--r--src/stv.adb2
6 files changed, 228 insertions, 11 deletions
diff --git a/src/bundles.adb b/src/bundles.adb
index 6a2d71d..3902971 100644
--- a/src/bundles.adb
+++ b/src/bundles.adb
@@ -1,8 +1,154 @@
+with Ada.Text_IO;
+with CSV;
+
+
package body Bundles is
+ procedure Add_To_Map
+ (BMap : in out Bundle_Maps.Map;
+ Item : in Given_Prefs.Preference_Array)
+ is
+ procedure Update_Bundle
+ (B : in out Bundle) is
+ begin
+ Add (B, Item);
+ end Update_Bundle;
+
+ procedure Update_Vector
+ (C : Candidates.CandidateID;
+ V : Bundle_Vectors.Vector) is
+ begin
+ V.Update_Element (V.First_Index, Update_Bundle'Access);
+ end Update_Vector;
+
+ Place : Candidates.CandidateID := Item (Given_Prefs.Preference_Range'First);
+ Current_Cursor : Bundle_Maps.Cursor := Result.Find (Place);
+ begin
+ if Current_Cursor /= Bundle_Maps.No_Element then
+ BMap.Update_Element (Current_Cursor, Update_Vector'Access);
+ else
+ declare
+ New_Bundle : Bundle := Empty_Bundle;
+ begin
+ Add (New_Bundle, Item);
+ BMap.Insert (Place, Bundle_Vectors.Empty_Vector & New_Bundle);
+ end;
+ end if;
+ end Add_To_Map;
+
+
+
+
+ procedure Read_Bundles
+ (Filename : in String;
+ Result : out Bundle_Maps.Map)
+ is
+ package My_CSV is new CSV;
+ use Ada.Text_IO;
+
+ Input_File : File_Type;
+ Current_Record : My_CSV.CSV_Record;
+ Current_Prefs : Given_Prefs.Preference_Array;
+ begin
+ Open (Input_File, In_File, Filename);
+
+ Result := Bundle_Maps.Empty_Map;
+ while not End_Of_File (Input_File) loop
+ Current_Record := My_CSV.Parse_Line (Get_Line (Input_File));
+ if Current_Record.Length > 0 then
+ Current_Prefs := Given_Prefs.Parse_Preferences (Current_Record.Last_Element);
+ if Current_Prefs (Given_Prefs.Preference_Range'First) /= Candidates.No_Candidate then
+ Add_To_Map (Result, Current_Prefs);
+ end if;
+ end if;
+ end loop;
+
+ Close (Input_File);
+ end Read_Bundles;
+
+
+
+
+ procedure Add
+ (This : in out Bundle;
+ Item : in Given_Prefs.Preference_Array) is
+ begin
+ for P of This.Papers loop
+ if P.Prefs = Item then
+ P.How_Many := P.How_Many + 1;
+ return;
+ end if;
+ end if;
+ This.Papers.Append ( (How_Many => 1, Prefs => Item) );
+ end Add;
+
+
+
+
+ procedure Transfer
+ (This : in out Bundle;
+ From, To : in Candidates.CandidateID;
+ Excluded : in Candidates.CandidateID_Vector;
+ Value : in Rationals.Fraction;
+ Result : out Bundle)
+ is
+ Position : Positive;
+ begin
+ Result := Empty_Bundle;
+ Result.Worth := This.Worth * Value;
+ for P of This.Papers loop
+ Position := Given_Prefs.Preference_Range'First;
+
+ while Position <= Given_Prefs.Preference_Range'Last and then
+ P.Prefs (Position) /= From
+ loop
+ Position := Position + 1;
+ end loop;
+ Position := Position + 1;
+
+ while Position <= Given_Prefs.Preference_Range'Last and then
+ Excluded.Contains (P.Prefs (Position))
+ loop
+ Position := Position + 1;
+ end loop;
+
+ if Position <= Given_Prefs.Preference_Range'Last and then
+ P.Prefs (Position) = To
+ then
+ Result.Papers.Append (P);
+ end if;
+ end loop;
+ end Transfer;
+
+
+
+
+ function Count_Votes
+ (This : in Bundle)
+ return Natural is
+ begin
+ return Rationals.Floor (Count_Papers (This) * This.Worth);
+ end Count_Votes;
+
+
+
+
+ function Count_Papers
+ (This : in Bundle)
+ return Natural
+ is
+ Result : Natural := 0;
+ begin
+ for P of This.Papers loop
+ Result := Result + P.How_Many;
+ end loop;
+ return Result;
+ end Count_Papers;
+
+
end Bundles;
diff --git a/src/bundles.ads b/src/bundles.ads
index aa0b0d6..db6565d 100644
--- a/src/bundles.ads
+++ b/src/bundles.ads
@@ -1,33 +1,57 @@
+with Preferences;
with Candidates;
with Rationals;
-private with Ada.Containers.Vectors;
+with Ada.Containers.Ordered_Maps;
+with Ada.Containers.Vectors;
generic
- Number_Of_Candidates : Positive;
+ with package Given_Prefs is new Preferences (<>);
package Bundles is
type Bundle is private;
- subtype Preference_Array is array (1 .. Number_Of_Candidates) of Candidates.CandidateID;
Empty_Bundle : constant Bundle;
+ package Bundle_Vectors is new Ada.Containers.Vectors with
+ (Index_Type => Positive,
+ Element_Type => Bundle);
+
+
+ package Bundle_Maps is new Ada.Containers.Ordered_Maps
+ (Key_Type => Candidates.CandidateID,
+ Element_Type => Bundle_Vectors.Vector);
+
+
+ procedure Read_Bundles
+ (Filename : in String;
+ Result : out Bundle_Maps.Map);
+
+
procedure Add
(To : in out Bundle;
- Item : in Preference_Array);
+ Item : in Given_Prefs.Preference_Array);
procedure Transfer
- (From, To : in out Bundle;
- Value : in Rationals.Fraction);
+ (This : in out Bundle;
+ From, To : in Candidates.CandidateID;
+ Excluded : in Candidates.CandidateID_Vector;
+ Value : in Rationals.Fraction;
+ Result : out Bundle);
- function Count
+ function Count_Votes
+ (This : in Bundle)
+ return Natural;
+
+
+ function Count_Papers
(This : in Bundle)
return Natural;
@@ -35,17 +59,24 @@ package Bundles is
private
+ use type Rationals.Fraction;
+
+
type Paper_Lot is record
How_Many : Positive := 1;
- Prefs : Preference_Array;
+ Prefs : Given_Prefs.Preference_Array;
end record;
- type Bundle is record
-
+ package Paper_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Paper_Lot);
- Empty_Bundle :=
+ type Bundle is record
+ Papers : Paper_Vectors.Vector := Paper_Vectors.Empty_Vector;
+ Worth : Rationals.Fraction := 1 / 1;
+ end record;
end Bundles;
diff --git a/src/candidates.ads b/src/candidates.ads
index 8b76707..fe25228 100644
--- a/src/candidates.ads
+++ b/src/candidates.ads
@@ -14,6 +14,13 @@ package Candidates is
type CandidateID is new Positive;
+ subtype Extended_CandidateID is CandidateID'Base
+ range CandidateID'First - 1 .. CandidateID'Last;
+
+
+ No_Candidate : constant Extended_CandidateID := Extended_CandidateID'First;
+
+
function To_String
(Input_Candidate : in Candidate;
Delimiter : in Character := ',')
diff --git a/src/preferences.adb b/src/preferences.adb
new file mode 100644
index 0000000..d2f743b
--- /dev/null
+++ b/src/preferences.adb
@@ -0,0 +1,8 @@
+
+
+package body Preferences is
+
+
+end Preferences;
+
+
diff --git a/src/preferences.ads b/src/preferences.ads
new file mode 100644
index 0000000..7913019
--- /dev/null
+++ b/src/preferences.ads
@@ -0,0 +1,23 @@
+
+
+with Candidates;
+
+
+generic
+ Number_Of_Candidates : Positive;
+package Preferences is
+
+
+ subtype Preference_Range is range 1 .. Number_Of_Candidates;
+
+
+ type Preference_Array is array Preference_Range
+ of Candidates.Extended_CandidateID;
+
+
+private
+
+
+end Preferences;
+
+
diff --git a/src/stv.adb b/src/stv.adb
index 4d2691a..65537c7 100644
--- a/src/stv.adb
+++ b/src/stv.adb
@@ -211,6 +211,8 @@ begin
end if;
Candidates.Read_Candidates (Candidate_File.all, State, Candidate_List);
Candidates.Generate_Ballots (Candidate_List, Above_Ballot, Below_Ballot);
+
+
if Verbose then
Put_Line (Standard_Error, "Reading preference data...");
end if;