From b36973b3e08e6d1f8a7d42a6984249486d0cebfe Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Thu, 22 Jun 2017 12:24:49 +0300 Subject: Initial commit --- lib/Malodivo/Budget.hs | 101 +++++++++++++++++++++++++++++++++++++++++ lib/Malodivo/Types/Bill.hs | 44 ++++++++++++++++++ lib/Malodivo/Types/District.hs | 41 +++++++++++++++++ lib/Malodivo/Types/Ministry.hs | 32 +++++++++++++ 4 files changed, 218 insertions(+) create mode 100644 lib/Malodivo/Budget.hs create mode 100644 lib/Malodivo/Types/Bill.hs create mode 100644 lib/Malodivo/Types/District.hs create mode 100644 lib/Malodivo/Types/Ministry.hs (limited to 'lib') diff --git a/lib/Malodivo/Budget.hs b/lib/Malodivo/Budget.hs new file mode 100644 index 0000000..edc0668 --- /dev/null +++ b/lib/Malodivo/Budget.hs @@ -0,0 +1,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 +. + +>>> 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 diff --git a/lib/Malodivo/Types/Bill.hs b/lib/Malodivo/Types/Bill.hs new file mode 100644 index 0000000..336c0fb --- /dev/null +++ b/lib/Malodivo/Types/Bill.hs @@ -0,0 +1,44 @@ +{-| + +A bill is a proposed law put before the Parliament to consider and +possibly implement. Bills can be encoded to and decoded from JSON. + +>>> :set -XOverloadedStrings +>>> import Data.Aeson (decode, encode) +>>> import Data.Maybe (fromJust) +>>> import Malodivo.Types.Ministry (Ministry(..)) + +>>> let billGreateWall = Bill { name = "The Great Wall of Malodivo", ministry = Defense, amount = 4000 } +>>> encode billGreateWall +"{\"amount\":4000,\"name\":\"The Great Wall of Malodivo\",\"ministry\":\"Defense\"}" + +>>> let billShelters = fromJust $ decode "{\"amount\":1234,\"name\":\"Shelters for the Homeless\",\"ministry\":\"Welfare\"}" +>>> billShelters :: Bill +Bill {name = "Shelters for the Homeless", ministry = Welfare, amount = 1234} + +>>> ministry <$> [billShelters, billGreateWall] +[Welfare,Defense] + +>>> sum $ amount <$> [billShelters, billGreateWall] +5234 + +-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Malodivo.Types.Bill + ( Bill(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) + +import Malodivo.Types.Ministry (Ministry) + +data Bill = Bill + { name :: Text -- ^ the name of a bill, e. g. \"An Act to Construct the Great Wall of Malodivo\". + , ministry :: Ministry -- ^ the ministry getting funds to implement a bill. + , amount :: Integer -- ^ the amount of funds required to implement a bill. + } deriving (Show, Generic, FromJSON, ToJSON) diff --git a/lib/Malodivo/Types/District.hs b/lib/Malodivo/Types/District.hs new file mode 100644 index 0000000..a46628d --- /dev/null +++ b/lib/Malodivo/Types/District.hs @@ -0,0 +1,41 @@ +{-| +Districts can be encoded to and decoded from JSON: + +>>> import Data.Aeson (decode, encode) +>>> import Data.ByteString.Lazy.Char8 (pack) + +>>> encode Palolene +"\"Palolene\"" + +>>> encode [ Lakos, SouthernPalolene ] +"[\"Lakos\",\"SouthernPalolene\"]" + +>>> decode . pack $ "[ \"Lakos\" ]" :: Maybe [District] +Just [Lakos] +-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Malodivo.Types.District + ( District(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey) +import Data.Hashable (Hashable) + +-- | District of the Kindom of Malodivo. +data District + = Palolene + | SouthernPalolene + | Lakos + deriving ( Eq + , Hashable + , Show + , Generic + , FromJSON + , FromJSONKey + , ToJSON + , ToJSONKey + ) diff --git a/lib/Malodivo/Types/Ministry.hs b/lib/Malodivo/Types/Ministry.hs new file mode 100644 index 0000000..c3e315b --- /dev/null +++ b/lib/Malodivo/Types/Ministry.hs @@ -0,0 +1,32 @@ +{-| +Ministries can be encoded to and decoded from JSON: + +>>> import Data.Aeson (decode, encode) +>>> import Data.ByteString.Lazy.Char8 (pack) + +>>> encode Defense +"\"Defense\"" + +>>> encode [ Defense, Welfare ] +"[\"Defense\",\"Welfare\"]" + +>>> decode . pack $ "[ \"Science\" ]" :: Maybe [Ministry] +Just [Science] +-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Malodivo.Types.Ministry + ( Ministry(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON, ToJSON) + +-- | Ministry of the Kingdom of Malodivo. +data Ministry + = Defense + | Science + | Welfare + deriving (Show, Generic, FromJSON, ToJSON) -- cgit v1.2.3