12345678910111213141516171819202122232425262728293031323334353637383940414243 |
- module Rolling.Prob where
- import GHC.Exts (groupWith)
- -- a probability expressed as a ratio (i.e. @P 1 2@ is a 50/50 chance)
- data P = P Int Int deriving (Eq, Ord)
- instance Show P where
- show (P n t) = show n ++ " in " ++ show t
- times :: P -> P -> P
- P a at `times` P b bt = P (a * b) (at * bt)
- combine :: [P] -> P
- combine ps =
- let tots = [ t | P _ t <- ps ]
- newTot = foldr lcm 1 tots
- newNums = [ if t == newTot then n else error "FIXME" | P n t <- ps ]
- in P (sum newNums) newTot
- -- a Prob monad that tracks possible things with their probabilities
- newtype Prob a = Prob { unprob :: [(a, P)] } deriving (Eq, Show)
- instance Functor Prob where
- fmap f (Prob xs) = Prob [(f x, p) | (x, p) <- xs]
- instance Applicative Prob where
- pure x = Prob [(x, P 1 1)]
- Prob fs <*> Prob xs = Prob [(f x, pf `times` px) | (f, pf) <- fs, (x, px) <- xs]
- instance Monad Prob where
- Prob xs >>= f =
- Prob [ (y, p `times` p')
- | (x, p) <- xs
- , (y, p') <- unprob (f x)
- ]
- -- probably the wrong name? this is collapsing identical possibilities
- -- into one
- normalize :: (Ord a) => Prob a -> Prob a
- normalize (Prob xs) =
- Prob [(fst (head rs), combine (map snd rs)) | rs <- groupWith fst xs ]
|