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
|
{-|
Budget planning in the Kingdom of Malodivo.
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
module Malodivo.Budget
( BillBudget
, manyToMany
, manyToOne
, normalizeDown
) where
import GHC.Generics (Generic)
import Data.Aeson (ToJSON)
import qualified Data.HashMap.Strict as HM
import qualified Malodivo.Types.Bill as B
import qualified Malodivo.Types.District as D
-- | This is output type. It describes contribution of each district into a bill.
data BillBudget = BillBudget
{ bill :: B.Bill
, districts :: [D.DistrictInfo]
} deriving (Generic, ToJSON)
zipBills :: [B.Bill] -> [D.DistrictFunds] -> [BillBudget]
zipBills = zipWith $ \b df -> BillBudget {bill = b, districts = D.df2di df}
{-|
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 ::
D.DistrictFunds -- ^ Amounts of available funds per district.
-> B.Bill -- ^ A bill requiring funding.
-> D.DistrictFunds -- ^ Contribution of each district.
manyToOne df b = fundRaising (B.amount b) df
{-|
Districts funding multiple bills. No constraints.
-}
manyToMany ::
D.DistrictFunds -- ^ Amounts of available funds per district.
-> [B.Bill] -- ^ Bills requiring funding.
-> [BillBudget] -- ^ Contribution of each district to each bill.
manyToMany df bills = zipBills bills allocated
where
billAmounts = B.amount <$> bills
fundsTotal = sum $ HM.elems df
allocated = flip fundRaising df <$> normalizeDown fundsTotal billAmounts
-- | Helper function to maintain DRY and backward compatibility.
fundRaising ::
Integer -- ^ Amount to be raised.
-> D.DistrictFunds -- ^ Amounts of available funds per district.
-> D.DistrictFunds -- ^ Contribution of each district.
fundRaising needed df = HM.fromList $ zip ds (normalizeDown needed fs)
where
(ds, fs) = unzip $ HM.toList df
|
