Instantly share code, notes, and snippets.

Embed
What would you like to do?
Stateモナドを使ってメモ化する。
-- 「つまずきの記憶 モナド(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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment