Instantly share code, notes, and snippets.

Embed
What would you like to do?
メモ付きのFibonacci関数(2)
-- 「つまずきの記憶 メモ化(3)」のソースコード
-- メモ付きのFibonacci関数 [mfib-2.hs]
-- 型の定義
-- ここでは型変数を用いてどの型にも対応できるようにしておき、
-- 実体を定義するときに具体型を与える。
type Memo a b = [(a,b)]
newtype Mc s b = McD { runMc :: s -> (b, s) }
-- メモ付きFibonacci関数
mfib :: Int -> Mc (Memo Int Integer) Integer
mfib 0 = McD (\s -> (0, s))
mfib 1 = McD (\s -> (1, s))
mfib n = McD $ \s ->
let
(n1, s1) = runMc (memo mfib (n-1)) s
(n2, s2) = runMc (memo mfib (n-2)) s1
in
(n1 + n2, s2)
-- メモ化関数
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)
-- メモ操作関数
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 = []
-- メモ付きの関数を走らせ、結果からメモを除去する。
fib :: Int -> Integer
fib n = fst $ runMc (mfib n) sEmpty
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment