monad_prob.hs

import Data.Ratio
import Data.List
import Control.Monad

--
-- 非決定性計算をしたい場合にモナドを使うと良い感じ
--

newtype Prob a = Prob { getProb :: [(a, Rational)] } deriving Show -- (3, 1%2) = 50 % の確率の 3
instance Functor Prob where
  fmap f (Prob xs) = Prob $ map (\(x, p) -> (f x, p)) xs

-- Prob をモナド化する

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

instance Monad Prob where
  return x = Prob [(x, 1%1)]
  m >>= f = flatten (fmap f m) -- bind では確率リストを平らにする
  fail _ = Prob []

--
-- コイン投げを例に使ってみる
--

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

coin :: Prob Coin -- 普通のコイン
coin = Prob [(Heads, 1%2), (Tails, 1%2)]

fakeCoin :: Prob Coin -- イカサマコイン
fakeCoin = Prob [(Heads,1%10), (Tails, 9%10)]

-- 3 回投げてすべて裏になる確率を求めてみる

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

main = print $ getProb flipThree -- 3 枚とも裏になる確率は 9/40