diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Malodivo/Budget.hs | 56 | ||||
| -rw-r--r-- | lib/Malodivo/Types/District.hs | 4 |
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 ) |