aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2017-06-24 13:36:19 +0300
committerIgor Pashev <pashev.igor@gmail.com>2017-06-24 13:44:42 +0300
commitebe8cba9837872de3dd611d6cd615425c51fefec (patch)
tree776af0f6361d5727f65143b9d8066b85a180c2b2 /lib
parent2ed435c73d0bc80a6b0d9d16a9fd0e9a0b464ed2 (diff)
downloadmolodivo-ebe8cba9837872de3dd611d6cd615425c51fefec.tar.gz
Support many bills
Diffstat (limited to 'lib')
-rw-r--r--lib/Malodivo/Budget.hs56
-rw-r--r--lib/Malodivo/Types/District.hs4
2 files changed, 51 insertions, 9 deletions
diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs
index edc0668..e5a7282 100644
--- a/lib/Malodivo/Budget.hs
+++ b/lib/Malodivo/Budget.hs
@@ -6,6 +6,7 @@ Budget planning in the Kingdom of Malodivo.
module Malodivo.Budget
( DistrictFunds
, manyToOne
+ , manyToMany
) where
import qualified Data.HashMap.Strict as HM
@@ -70,8 +71,8 @@ True
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.
+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
@@ -93,9 +94,52 @@ 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
+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
- needed = B.amount bill
available = sum $ HM.elems funds
- requested = min needed available
- takeMoney m = requested * m `div` available
+ request = min needed available
+ takeMoney m = request * m `div` available
diff --git a/lib/Malodivo/Types/District.hs b/lib/Malodivo/Types/District.hs
index a46628d..058377b 100644
--- a/lib/Malodivo/Types/District.hs
+++ b/lib/Malodivo/Types/District.hs
@@ -22,7 +22,7 @@ module Malodivo.Types.District
import GHC.Generics (Generic)
-import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
+import Data.Aeson (FromJSON, ToJSON)
import Data.Hashable (Hashable)
-- | District of the Kindom of Malodivo.
@@ -35,7 +35,5 @@ data District
, Show
, Generic
, FromJSON
- , FromJSONKey
, ToJSON
- , ToJSONKey
)