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
|
{-|
Budget planning in the Kingdom of Malodivo.
-}
module Malodivo.Budget
( DistrictFunds
, 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.
type DistrictFunds = HM.HashMap D.District Integer
{-|
Trivial case: many districts, one bill, no contraints (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 funds (B.amount bill)
{-|
Districts funding multiple bills. No contraints.
>>> :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 = fundRaising funds <$> amountsAllocated
where
fundsTotal = sum $ HM.elems funds
billsTotal = sum $ B.amount <$> bills
requestTotal = min billsTotal fundsTotal
allocale bill = requestTotal * B.amount bill `div` billsTotal
amountsAllocated = allocale <$> bills
-- | Helper function to maintain DRY and backward compatibility.
fundRaising ::
DistrictFunds -- ^ Amounts of available funds per district.
-> Integer -- ^ Amount to be raised.
-> DistrictFunds -- ^ Contribution of each district.
fundRaising funds needed = HM.map takeMoney funds
where
available = sum $ HM.elems funds
request = min needed available
takeMoney m = request * m `div` available
|
