package body Bundles is procedure Add (To : in out Bundle; Item : in Given_Prefs.Preference_Array) is use type Given_Prefs.Preference_Array; begin for P of To.Papers loop if P.Prefs = Item then P.How_Many := P.How_Many + 1; return; end if; end loop; To.Papers.Append ( (How_Many => 1, Prefs => Item) ); end Add; procedure Transfer (This : in out Bundle; From, To : in Candidates.CandidateID; Excluded : in Candidates.Containers.CandidateID_Set; Value : in Rationals.Fraction; Result : out Bundle) is use type Candidates.CandidateID; 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; function "<" (Left, Right : in Bundle) return Boolean is begin return Left.Worth < Right.Worth; end "<"; end Bundles;