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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
{-|
Budget planning in the Kingdom of Malodivo.
-}
module Malodivo.Budget
( DistrictFunds
, normalizeDown
, manyToOne
, manyToMany
) where
import qualified Data.HashMap.Strict as HM
import qualified Malodivo.Types.Bill as B
import qualified Malodivo.Types.District as D
-- | Convenient type. Describes available or allocated funds per 'District'.
type DistrictFunds = HM.HashMap D.District Integer
{-|
Normalize list of integers, i. e. proportionally decrease each list element
so that the sum of all elements does not exceed given limit.
>>> normalizeDown 10 [10, 20, 30, 40]
[1,2,3,4]
>>> normalizeDown 9 [11]
[9]
If requested maximum sum is larger or equal to the sum of input list, the
list is not changed:
>>> normalizeDown 101 [10, 20, 30, 40]
[10,20,30,40]
__TODO__ It /should/ be generalized to
<https://en.wikipedia.org/wiki/Partition_(number_theory) integer partition>
so that the sums of input and output lists are equal to each other. Currently
it is not guaranteed and the numbers are rounded down if necessary.
-}
normalizeDown ::
Integer -- ^ Maximum sum of all list items.
-> [Integer] -- ^ Initial list.
-> [Integer] -- ^ Normalized list.
normalizeDown maxSum inList
| inSum <= maxSum = inList
| otherwise = norm <$> inList
where
inSum = sum inList
norm i = maxSum * i `div` inSum
{-|
Trivial case: many districts, one bill, no constraints (wishes,
limits). We assume that, with no explicit wishes, each district
wants to contribute all its funds.
>>> :set -XOverloadedStrings
>>> import qualified Data.HashMap.Strict as HM
>>> import qualified Malodivo.Types.Bill as B
>>> import qualified Malodivo.Types.District as D
>>> import qualified Malodivo.Types.Ministry as M
>>> let medium = B.Bill { B.amount = 30, B.name = "A medium bill", B.ministry = M.Science }
>>> let one = B.Bill { B.amount = 1, B.name = "A trivial bill", B.ministry = M.Welfare }
If any district can pay the bill, take funds in proportion. We use
'HM.lookup', because 'show' of 'HM.HashMap' is not determinate,
and the test can occasionally fail:
>>> let funds = HM.fromList [(D.Palolene, 100), (D.Lakos, 200)]
>>> let contribution = manyToOne funds medium
>>> HM.lookup D.Palolene contribution
Just 10
>>> HM.lookup D.Lakos contribution
Just 20
>>> let funds = HM.fromList [(D.Palolene, 30), (D.Lakos, 30)]
>>> HM.elems $ manyToOne funds medium
[15,15]
It works with a single district:
>>> let funds = HM.fromList [(D.SouthernPalolene, 500)]
>>> HM.elems $ manyToOne funds medium
[30]
>>> HM.elems $ manyToOne funds one
[1]
__TODO__ It /should/ not have rounding issues. In particular,
when the bill's amount is bigger than the number of districts,
/each/ district would contribute some. This problem is known as
<https://en.wikipedia.org/wiki/Partition_(number_theory) integer partition>.
>>> let funds = HM.fromList [(D.Palolene, 10000), (D.Lakos, 1)]
>>> B.amount medium > fromIntegral (HM.size funds)
True
>>> let contribution = manyToOne funds medium
>>> let taken = HM.foldl' (+) 0 contribution
But at the moment we make use of some freedom coming from the fact
that it is possible that a bill will receive less funds than the
Parliament decides, and round down contribution of each district.
/Thus these two tests show 'False', while should show 'True':/
>>> HM.null $ HM.filter (== 0) contribution
False
>>> taken == B.amount medium
False
If all districts together can't pay the bill, take all their money.
Note that due to the principle of proportionality it is impossible
that some districts can pay their shares and others can't:
>>> let low = HM.fromList [(D.Palolene, 10), (D.Lakos, 15)]
>>> manyToOne low medium == low
True
-}
manyToOne ::
DistrictFunds -- ^ Amounts of available funds per district.
-> B.Bill -- ^ A bill requiring funding.
-> DistrictFunds -- ^ Contribution of each district.
manyToOne funds bill = fundRaising (B.amount bill) funds
{-|
Districts funding multiple bills. No constraints.
>>> :set -XOverloadedStrings
>>> import Data.Maybe (fromJust)
>>> import qualified Data.HashMap.Strict as HM
>>> import qualified Malodivo.Types.Bill as B
>>> import qualified Malodivo.Types.District as D
>>> import qualified Malodivo.Types.Ministry as M
>>> let billA = B.Bill { B.amount = 30, B.name = "Bill A", B.ministry = M.Science }
>>> let billB = B.Bill { B.amount = 10, B.name = "Bill B", B.ministry = M.Welfare }
>>> let equalAmountBills = take 3 (repeat billB)
>>> let nonEqualAmountBills = [billA, billB]
If all bills requires the same amount, funds of a single district are
allocated evenly:
>>> let funds = HM.fromList [(D.Palolene, 100)]
>>> let contribution = manyToMany funds equalAmountBills
>>> all (== B.amount (head equalAmountBills)) (fromJust . HM.lookup D.Palolene <$> contribution)
True
-}
manyToMany ::
DistrictFunds -- ^ Amounts of available funds per district.
-> [B.Bill] -- ^ Bills requiring funding.
-> [DistrictFunds] -- ^ Contribution of each district to each bill.
manyToMany funds bills =
flip fundRaising funds <$> normalizeDown fundsTotal billAmounts
where
billAmounts = B.amount <$> bills
fundsTotal = sum $ HM.elems funds
-- | Helper function to maintain DRY and backward compatibility.
fundRaising ::
Integer -- ^ Amount to be raised.
-> DistrictFunds -- ^ Amounts of available funds per district.
-> DistrictFunds -- ^ Contribution of each district.
fundRaising needed df = HM.fromList $ zip districts funds'
where
(districts, funds) = unzip $ HM.toList df
funds' = normalizeDown needed funds
|
