【Haskell】すごいHaskellたのしく学ぼう 第14章演習問題

import Data.List
import Data.Ratio

newtype Prob a = Prob {getProb :: [(a, Rational)]} deriving Show

flatten :: Prob (Prob a) -> Prob a
flatten (Prob xs) = Prob $ concat $ map multAll xs
    where multAll (Prob innerxs, p) = map (\(x, r) -> (x, r*p)) innerxs

instance Monad Prob where
    return x = Prob [(x, 1%1)]
    m >>= f = flatten (fmap f m)
    fail _ = Prob []

data Coin = Heads | Tails deriving (Show, Eq)

coin :: Prob Coin
coin = Prob [(Heads, 1%2), (Tails, 1%2)]

loadedCoin :: Prob Coin
loadedCoin = Prob [(Heads, 1%10), (Tails, 9%10)]

flipThree :: Prob Bool
flipThree = do
    a <- coin
    b <- coin
    c <- loadedCoin
    return (all (==Tails) [a, b, c])

sumProb :: Prob Bool -> Prob Bool
sumProb (Prob xs) = Prob (foldl proc [(False, 0%1), (True, 0%1)] xs)

proc :: [(Bool, Rational)] -> (Bool, Rational) -> [(Bool, Rational)]
proc [(False, accf), (True, acct)] (b, r)
    | b == False = [(False, accf + r), (True, acct)]
    | otherwise = [(False, accf), (True, acct + r)]

結果

*Main> sumProb flipThree 
Prob {getProb = [(False,31 % 40),(True,9 % 40)]}