【解答例】Haskell 状態系モナド 超入門

Haskell 状態系モナド 超入門の解答例です。

STモナド

Brainf*ckの前処理

【問1】次のJavaScriptによるBrainf*ckの前処理をSTモナドで書き直してください。

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.STRef

bf = "+++++++++[>++++++++<-]>."

main = do
    let jmp = runST $ do
        jmp <- newArray (0, length bf - 1) 0 :: ST s (STUArray s Int Int)
        loops <- newSTRef []
        forM_ [0 .. length bf - 1] $ \i -> do
            case bf !! i of
                '[' -> modifySTRef loops (i:)
                ']' -> do
                    start <- do
                        (h:t) <- readSTRef loops
                        writeSTRef loops t
                        return h
                    writeArray jmp start i
                    writeArray jmp i start
                _ -> return ()
        getElems jmp
    print jmp

実行結果

[0,0,0,0,0,0,0,0,0,21,0,0,0,0,0,0,0,0,0,0,0,9,0,0]

再実装

【問2】STモナドを扱うbindとreturn'を実装してください。

{-# LANGUAGE UnboxedTuples #-}

import GHC.ST
import Data.STRef

unST (ST f) = f

a `bind` b = ST $ \s ->
    let (# s1, r1 #) = unST a s
        (# s2, r2 #) = unST (b r1) s1
    in  (# s2, r2 #)

return' x = ST $ \s -> (# s, x #)

main = do
    print $ runST $
        return' 1 `bind` newSTRef `bind` \a ->
        modifySTRef a (+1) `bind` \_ ->
        readSTRef a `bind` return'

実行結果

2

Stateモナド

再実装

【問3】Stateモナドを扱うbind, return', get', put'を実装してください。

import Control.Monad
import Control.Monad.State

a `bind` b = state $ \s ->
    let (r1, s1) = runState a s
        (r2, s2) = runState (b r1) s1
    in  (r2, s2)
return' x  = state $ \s -> (x , s)
get'       = state $ \s -> (s , s)
put'    x  = state $ \_ -> ((), x)

fib x = (`evalState` (0, 1)) $
    (replicateM_ (x - 1) $
        get' `bind` \(a, b) -> put' (b, a + b)) `bind` \_ ->
    get' `bind` \v -> return' $ snd v

main = do
    print $ fib 10

実行結果

55

書き直し

【問4】問3のfibをdoと<-で書き直してください。問3で再実装した関数は使わないでください。

import Control.Monad
import Control.Monad.State

fib x = (`evalState` (0, 1)) $ do
    replicateM_ (x - 1) $ do
        (a, b) <- get
        put (b, a + b)
    v <- get
    return $ snd v

main = do
    print $ fib 10

実行結果

55

動的計画法によるフィボナッチ数の計算です。

Readerモナド

再実装

【問5】Readerモナドを扱うbind, return', ask', local'を実装してください。

import Control.Monad.Reader

a `bind` b = reader $ \r ->
    runReader (b (runReader a r)) r

return' x = reader $ \_ -> x
ask' = reader $ \r -> r
local' f m = reader $ \r -> runReader m $ f r

test x = (`runReader` x) $
    ask' `bind` \a ->
    (local' (+ 1) $
        ask' `bind` \b' ->
        return' b') `bind` \b ->
    ask' `bind` \c ->
    return' (a, b, c)

main = print $ test 1

実行結果

(1,2,1)

書き直し

【問6】問5のtestをdoと<-で書き直してください。問5で再実装した関数は使わないでください。

import Control.Monad.Reader

test x = (`runReader` x) $ do
    a <- ask
    b <- local (+ 1) $ do
        b' <- ask
        return b'
    c <- ask
    return (a, b, c)

main = print $ test 1

実行結果

(1,2,1)

Writerモナド

再実装

【問7】Writerモナドを扱うbind, return', tell'を実装してください。

import Control.Monad.Writer

a `bind` b = writer $
    let (r1, w1) = runWriter  a
        (r2, w2) = runWriter (b r1)
    in  (r2, w1 ++ w2)

return' x = writer (x, [])
tell' x = writer ((), x)

test = execWriter $
    tell' "Hello" `bind` \_ ->
    tell' ", "    `bind` \_ ->
    tell' "World" `bind` \_ ->
    tell' "!!"    `bind` \_ ->
    return' ()

main = print test

実行結果

"Hello, World!!"

bindのポイントは、状態を追記するだけなら引数としてバケツリレーする必要がないという点です。

書き直し

【問8】問7のtestをdoと<-で書き直してください。問7で再実装した関数は使わないでください。

import Control.Monad.Writer

test = execWriter $ do
    tell "Hello"
    tell ", "
    tell "World"
    tell "!!"
    return ()

main = print test

実行結果

"Hello, World!!"

関数モナド

【問9】先ほどの例のtestを通常の関数として書き直してください。

test x =
    let a = (+ 1) x  -- x + 1
        b = (* 2) x  -- x * 2
    in (a, b)

main = do
    print $ test 5

実行結果

(6,10)