diff options
| -rw-r--r-- | lib/Malodivo/Budget.hs | 55 |
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 |