aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Malodivo/Budget.hs55
1 files changed, 43 insertions, 12 deletions
diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs
index 438d868..a707cec 100644
--- a/lib/Malodivo/Budget.hs
+++ b/lib/Malodivo/Budget.hs
@@ -5,6 +5,7 @@ Budget planning in the Kingdom of Malodivo.
-}
module Malodivo.Budget
( DistrictFunds
+ , normalizeDown
, manyToOne
, manyToMany
) where
@@ -18,6 +19,39 @@ import qualified Malodivo.Types.District as D
type DistrictFunds = HM.HashMap D.District Integer
{-|
+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
@@ -94,7 +128,7 @@ 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)
+manyToOne funds bill = fundRaising (B.amount bill) funds
{-|
Districts funding multiple bills. No constraints.
@@ -125,21 +159,18 @@ 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
+manyToMany funds bills =
+ flip fundRaising funds <$> normalizeDown fundsTotal billAmounts
where
+ billAmounts = B.amount <$> bills
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.
+ Integer -- ^ Amount to be raised.
+ -> DistrictFunds -- ^ Amounts of available funds per district.
-> DistrictFunds -- ^ Contribution of each district.
-fundRaising funds needed = HM.map takeMoney funds
+fundRaising needed df = HM.fromList $ zip districts funds'
where
- available = sum $ HM.elems funds
- request = min needed available
- takeMoney m = request * m `div` available
+ (districts, funds) = unzip $ HM.toList df
+ funds' = normalizeDown needed funds