module Penny.Cabin.Posts.Allocate (
Allocation,
allocation,
unAllocation,
allocate) where
import qualified Control.Monad.Trans.State as St
import qualified Data.Foldable as F
import qualified Data.Traversable as T
newtype Allocation = Allocation { unAllocation :: Int }
deriving (Show, Eq, Ord)
allocation :: Int -> Allocation
allocation = Allocation
allocate ::
(Functor f, F.Foldable f, T.Traversable f)
=> f Allocation
-> Int
-> f Int
allocate m t = let
tot = F.sum . fmap (toDouble . abs . unAllocation) $ m
ratios = fmap ((/tot) . toDouble . abs . unAllocation) m
rounded = fmap (round . (* (toDouble t))) ratios
toDouble = fromIntegral :: Int -> Double
in if tot == 0
then fmap (const 0) m
else adjust rounded t
adjust :: (Functor f, F.Foldable f, T.Traversable f)
=> f Int
-> Int
-> f Int
adjust ws w = let
wsInts = fmap fromIntegral ws
diff = (fromIntegral w) F.sum wsInts in
if diff == 0
then ws
else let
ws' = St.evalState (T.mapM adjustMap ws) diff
in adjust ws' w
adjustMap :: Int -> St.State Int Int
adjustMap w = if w == 0 then return 0 else do
diff <- St.get
case compare diff 0 of
EQ -> return w
GT -> do
St.put (pred diff)
return (succ w)
LT -> do
St.put (succ diff)
return (pred w)