blob: 39029718658e97a9b09eac4682fe7425e1ee8fbd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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;
|
