Stateモナドを使ってメモ化する。

statememo.hs

-- 「つまずきの記憶 モナド(3)」のソースコード
-- Stateモナドを使ったメモ化 [statememo.hs]
import Control.Monad.State          -- Stateモナドを使えるようにする。
import qualified Data.Map as M

-- 状態操作関連
type Memo a b = M.Map a b 

getResult :: Ord a => a -> Memo a b -> Maybe b
getResult = M.lookup

putResult :: Ord a => (a, b) -> Memo a b -> Memo a b 
putResult = uncurry M.insert

sEmpty :: Memo a b 
sEmpty = M.empty

-- 抽象的に定義したメモ化関数
-- 今回改造したのはこの部分だけである。
type MemoFunc a b = a -> State (Memo a b) b

runMemo :: MemoFunc a b -> a -> b
runMemo f x = evalState (f x) sEmpty

memo :: Ord a => MemoFunc a b -> MemoFunc a b 
memo f x = state $ \s ->
    case getResult x s of
        Just v  -> (v, s)
        Nothing -> let (v, s1) = runState (f x) s
                   in  (v, putResult (x, v) s1) 

----- ここまでが共通の定義（部品）-----

-- 以下にメモ化を利用した関数を定義する。

-- (1) Fibonacci関数
mfib :: MemoFunc 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)

fib :: Int -> Integer
fib = runMemo mfib

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

-- 元の両替コード
-- GHCi で cc (100, [50,25,10,5,1]) などとして実行する。
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 で runMemo mcc (100, [50,25,10,5,1]) などとして実行する。
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)

-- runMemo も隠してしまうのならこうする。
change :: (Amount, [Coin]) -> Count
change = runMemo mcc