色々詳しく書いていると長くなってしまい、全然読む気のしないモノになってしまった。そこで、今回はモナド化の話なのだがモナドの詳細は省略することにした。したがって、memo mfib (n-1) から値を取り出す箇所など、なぜそうなるのかが分からない箇所があると思うが、後日、モナドの記事の中で説明を試みてみようと思う。とりあえず今回はメモをモナド化することでコードがとてもスッキリと書けるようになる、ということをお伝えしたいと思う。

メモのモナド化

newtype を使って定義した Mc をモナドのインスタンスにしてみる。最低限必要な定義は return と (>>=) の2つである。

newtype Mc s b = McD { runMc :: s -> (b, s) }

instance Monad (Mc s) where
    return x = McD (\s -> (x, s))
    x >>= g  = McD $ \s -> let (a, s1) = runMc x s
                           in runMc (g a) s1

return は単に引数で渡された値と現在のメモの内容を対にしたものを返すだけである。

>>= の定義は慣れないうちは分かりにくいと思うので説明する。まず、(>>=) の型を思い出すと、(>>=) :: m a -> (a -> m b) -> m b であった。m を Mc s で置き換えると、

(>>=) :: Mc s a -> (a -> Mc s b) -> Mc s b

となる。戻り値の型が Mc s b なので、x >>= g は、Mc (\s -> (結果,新しいメモ)) の形になることが分かる。g の引数の型は a なので、x から a 型の値を取り出さなければならない。それが、(a, s1) = runMc x s の部分であり、この a が g に与えるべき値である。g a から(結果,新しいメモ)を取り出すため、runMc で関数にしてから s1 を与えれば良い。これが (>>=) の定義の中身である。

モナド則の確認

新しく作った型をモナドにするためには、return と (>>=) を定義するだけではダメで、これらがモナド則を満たしていることを確認しなければならない。確認するには少し長くなるので、別記事で書くことにし、ここではモナド則を満たしているものと信じて先へ進むことにする。

モナド版Fibonacci

では mfib をモナド版に改造してみる。

メモ対応に改造しようとしている関数の型を a -> b とすると、メモ対応版の関数の型は常に a -> Mc (Memo a b) b となるので、型変数を使って定義しておくとコードが見やすくなる。

type MemoFunc a b = a -> Mc (Memo a b) b

もうひとつ、メモ対応版の関数を実行して元の関数の処理結果を得るには、メモの初期値を与え、得られた結果からメモを取り除く必要があるので、それを行う関数も定義しておく。

runMemo :: MemoFunc a b -> a -> b
runMemo f x = fst $ runMc (f x) sEmpty  -- メモの初期値を与えて走らせ、メモを除く。

mfib の処理を見ると、mfib 0, mfib 1 はメモを変えずに値 1 を返すだけなので、これは return の動作そのものである。再帰呼び出しの部分は、<- で値だけを取り出して、メモの管理はモナドが背後でやってくれる。したがって、モナド版fibは以下のようになる:

mfib :: MemoFunc Int Integer  -- Intを受け取りIntegerを返すメモ版関数
mfib 0 = return 1
mfib 1 = return 1
mfib n = do
    f1 <- memo mfib (n-1)
    f2 <- memo mfib (n-2)
    return (f1 + f2)

メモに関する記述が（ほぼ）きれいに消えて無くなり、非常に見通しの良いコードとなった。runMemo で実行すると正しい結果が得られた。

*Main> runMemo mfib 100
573147844013817084101

(注) このコードをGHCiでロードすると、以下の警告が出る:

‘Mc’ is an instance of Monad but not Applicative - this will become an error in GHC 7.10, under the Applicative-Monad Proposal.

これは、「モナドのインスタンスにするためには、Applicative のインスタンスにもなってないとダメよ。GHC 7.10 からはエラーとなるからね」ということである。GHC 7.8 では警告扱いなのでプログラムを実行することはできる。
7.10は今月下旬にリリースされるらしいので、この件については近々別の記事において触れようと思う。

他の問題への再利用

これまでに定義したメモ化のコードが完全に汎用的・部品であることを確認するため、memo などの定義には全く手を加えずそのままで別の問題に使ってみる。せっかくなので、「メモ化(1)」で紹介した「記憶(memo)する関数」に載っている「両替問題」をやってみることにする。

[問題] 50セント、25セント、10セント、5セント、1セント があるとして1ドルの両替には何通りあるか。

memoを使ってメモ化することが目的なので、問題を解くプログラムコードも同記事から頂くことにし、プログラムの内容については言及しない。cc の引数をuncurry化した点が元のコードと異なっている。

type Amount  = Integer      -- 両替する金額
type Coin    = Integer      -- コインの額面
type Count   = Integer      -- 両替の仕方の数

cc :: (Amount, [Coin]) -> Count
cc (0, _)  = 1
cc (_, []) = 0
cc (a, ccs@(c:cs))
  | a < 0     = 0
  | otherwise = cc (a-c, ccs)
              + cc (a  , cs )

このコードをGHCiにロードして cc (100, [50,25,10,5,1]) とすると、直ちに 292 という解答が得られる。これを、日本の硬貨 [500,100,50,10,5,1] に変更して1000円の両替の仕方を計算させると、1分以上かかって 248908 という答えが出た。

次にmemoを使ってメモ化するため、ccを改造したmccを実装してみる。Fibonacciの場合を真似て機械的に書き換えをすると次のようになる:

mcc :: MemoFunc (Amount, [Coin]) Count
mcc (0, _)  = return 1
mcc (_, []) = return 0
mcc (a, ccs@(c:cs))
  | a < 0     = return 0
  | otherwise = do
        n1 <- memo mcc (a-c, ccs)
        n2 <- memo mcc (a  , cs )
        return (n1 + n2)

モナド版で千円の両替をさせると即座に結果が出た:

*Main> runMemo mcc (1000, [500,100,50,10,5,1])
248908

メモが正しく機能していることが分かる。プログラムの中身を理解することなく、完全に機械的にコードを書き換えただけでメモ化の恩恵に預かれるということは非常に素晴らしいことだと思うし、「これぞ部品！」という感じがする。

Fibonacciと両替のコードをひとつのファイルにまとめてGistに置いた(mfib-3.hs)。

メモ化についてはとりあえずこれで終えるが、次の記事で処理速度について少し触れ、メモの検索速度を向上させようと思う。