サイコロ振ろう

自分 advent calendar の3日目かもしれない記事です．初日の日中に所用があり深夜の投稿となったため以降自転車操業が続いています．

Haskell の System.Random は RandomGen g => g -> (a,g) というかたちで（いわば使った seed を次に渡せるようにして）pure な疑似乱数を実現しています．この g を持ち回るのがいちいちめんどくさい…ので，そういうのは暗黙にやってくれると嬉しいですね．イメージはこんな感じ

g <- getStdGn
let x = runRandom g $ do
    d <- randIntBetween 0 2
    y <- randIntBetween 1 3
    b :: Bool <- random
    return (d+y,b)
 -- x は ((d+y,b), g)

洗練されたライブラリは結構 monadic なインターフェイスを持っているようですが，このあたりの"作り方"の演習として，自分でやってみましょう．

定義

まずはこう．runRandom は単に flip で，do で長ったらしい中身を run しやすくするために作っておきます．

newtype RandomM g a = RandomM { runR :: g -> (a,g) }
runRandom :: g -> RandomM g a -> (a,g)
runRandom g r = runR r g

ここから不格好でいいから順に装備を整えていきます．

Functor

まずはファンクタ． fmap (*2) rollDice は 2,4,6,8,10,12 からランダムで返してほしいですね．

instance Functor (RandomM g) where
    fmap :: (a -> b) -> RandomM g a -> RandomM g b
    fmap f r = RandomM $ \ g -> let (a, g') = runR r g
                                    in (f a, g')

Functor law:

• fmap id = id : fmap id r = RandomM (\ g -> runR r g) なのでこれは id.
• fmap (f . g) == fmap f . fmap g : ok っぽい．

Applicative

instance Applicative (RandomM g) where
    pure :: a -> RandomM g a
    pure a = RandomM (\g -> (a,g))
    rf <*> ra = RandomM (\g -> let (f, g') = runR rf g
                                   (a, g'') = runR ra g'
                                   in (f a, g''))

Applicative functor law

• Identity. pure id <*> v = v
  • pure id <*> v = RandomM (\g -> first id $ runR v g) でok.
• Homomorphism. pure f <*> pure x = pure (f x)
  • pure f <*> pure x = RandomM (\g -> (f a, g) で ok.
• Interchange. u <*> pure y = pure ($ y) <*> u
  • pure ($ y) <*> u = RandomR (\g -> ( ($ y) uf, g')) で ok.
• Composition. pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
  • pure (.) <*> u <*> v <*> w = RandomM (\g -> ((uf .), g')) <*> v <*> w, みたいな感じで（めんどうになった）ok のはず．肝は，v<*>w が RandomM (\g -> (f a, g'')) の形になるけど，これは \g' -> (f a, g''') の形だということ．

こういう証明は手じゃなくてコンパイラが寄り添って手伝ってくれるとうれしいなあ→ Idris, Coq

Monad

instance Monad (RandomM g) where
    ra >>= fr = RandomM (\g -> let (a, g') = runR ra g in
                                    runR (fr a) g')

Monad law

• return a >>= f = f a : return = pure なので RandomM (\g -> runR (f a) g) なのでok. (f a = RandomM ff とすると \g -> runR (f a) g == runR (f a) == ff ですね．)
• m >>= return = m : m >>= return = RandomM (\g -> let (a,g') = runR m g in runR (pure a) g' ≡ (a,g') で ok.
• (m >>= f) >>= g = m >>= (\x -> f x >>= g)

使う

こんな感じかな…

import Lib
import Control.Monad
import System.Random

main :: IO ()
main = do
    g <- getStdGen
    let (results,_) = runRandom g $ foldM (\acc _ -> fmap (:acc) (rollDiceN 100)) [] [1..10000]
    mapM_ print results


rollDiceN :: RandomGen g => Int -> RandomM g Int
rollDiceN n = foldM (\acc _ -> fmap (+ acc) dice) 0 [1..n]

dice :: RandomGen g => RandomM g Int
dice = RandomM $ randomR (1,6)

mapM dice では g が試行間で引き継がれないのでうまく行かず， foldM をえらく不格好に使う形になってしまった．

  do
    x0 <- some
    x1 <- some
    x2 <- some
    return [x0,x1,x2] 

みたいなのをどう綺麗に書くか，は今後思い出すべき宿題ということで．

100個サイコロを振る，を10000回

Monad は箱だなんだと解説が乱立しますが，こうして自分で作っていくと何が何でどういうふうに要請されてるのかみたいな勘がつかめて良いです．7shi さんのHaskell 超入門 シリーズが超オススメ．

オチ

実質単なる state monad である．