メモ機能をモナド化する
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- 「つまずきの記憶 メモ化(4)」のソースコード | |
-- メモ機能をモナド化する [mfib-3.hs] | |
-- 状態操作関連 | |
type Memo a b = [(a,b)] | |
getResult :: Ord a => a -> Memo a b -> Maybe b | |
getResult = lookup | |
putResult :: Ord a => (a, b) -> Memo a b -> Memo a b | |
putResult = (:) | |
sEmpty :: Memo a b | |
sEmpty = [] | |
-- 抽象的に定義したメモ化関数。 | |
newtype Mc s b = McD { runMc :: s -> (b, s) } | |
runMemo :: MemoFunc a b -> a -> b | |
runMemo f x = fst $ runMc (f x) sEmpty | |
instance Monad (Mc s) where | |
return x = McD (\s -> (x, s)) | |
x >>= g = McD (\s -> let (b, s1) = runMc x s in runMc (g b) s1) | |
memo :: Ord a => (a -> Mc (Memo a b) b) -> a -> Mc (Memo a b) b | |
memo f x = McD $ \s -> | |
case getResult x s of | |
Just v -> (v, s) | |
Nothing -> let (v, s1) = runMc (f x) s | |
in (v, putResult (x, v) s1) | |
type MemoFunc a b = a -> Mc (Memo a b) b | |
----- ここまでが共通の定義(部品)----- | |
-- 以下にメモ化を利用した関数を定義する。 | |
-- (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