aboutsummaryrefslogtreecommitdiff
path: root/lib/Malodivo/Budget.hs
blob: edc066847300bf4cad689c6a1ab61354205ad36f (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
{-|

Budget planning in the Kingdom of Malodivo.

-}
module Malodivo.Budget
  ( DistrictFunds
  , manyToOne
  ) 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 = HM.map takeMoney funds
  where
    needed = B.amount bill
    available = sum $ HM.elems funds
    requested = min needed available
    takeMoney m = requested * m `div` available