动态规划(Haskell,Hofstader M/F 序列)
Dynamic Programming (Haskell, Hofstader M/F sequence)
这个有效:
f :: Int -> Int
f n = gof n where
gof 0 = 1
gof i = i - ms!! ( fs!! (i-1) )
gom 0 = 0
gom i = i - fs!! ( ms!! (i-1) )
fs = [gof j | j <- [0..n]]
ms = [gom j | j <- [0..n]]
m n = gom n where
gof 0 = 1
gof i = i - ms!! ( fs!! (i-1) )
gom 0 = 0
gom i = i - fs!! ( ms!! (i-1) )
fs = [gof j | j <- [0..n]]
ms = [gom j | j <- [0..n]]
然而,它确实是重复的。有没有办法避免重复这些代码块?一些参考资料,这是对 :
的改编
http://jelv.is/blog/Lazy-Dynamic-Programming/
序列参考:
https://en.wikipedia.org/wiki/Hofstadter_sequence
我对照数字核对了它:
https://oeis.org/A005378
https://oeis.org/A005379
它生成正确的数字并且比基本代码快得多,基本代码在开始出现递归深度问题之前根本不会太高。
首先,您可以在顶级绑定中进行模式匹配。通常这并不意味着发生了很多有趣的事情,但如果你想在两个顶级绑定之间共享本地助手,它会有所帮助。
m2 :: Int -> Int
f2 :: Int -> Int
(m2, f2) = (gom, gof)
where
gof 0 = 1
gof i = i - ms !! ( fs !! (i-1) )
gom 0 = 0
gom i = i - fs !! ( ms !! (i-1) )
fs = map gof [0..]
ms = map gom [0..]
您会注意到其中还有一个技巧。我没有将列表 fs
和 ms
限制到它们的最大大小,而是让懒惰来处理它们的限制。列表不会在需要记忆早期结果的地方创建。
但是列表索引是 O(n)。即使去掉其中的一部分也可以显着加快速度。如果您查看同一函数的递归模式,您会发现 gom i
总是调用 gom (i-1)
,gof
也是如此。您可以使用它通过传递先前的值来删除这些查找的列表索引。不幸的是,这同样不适用于对相反函数的调用,因为它们不那么容易遵循。但它仍然删除了大量的工作。并且可以通过进一步利用懒惰的方式来完成:
m3, f3 :: Int -> Int
(m3, f3) = ((ms !!), (fs !!))
where
(ms, fs) = unzip pairs
pairs = (0, 1) : zipWith iter [1..] pairs
iter i (mp, fp) = (i - fs !! mp, i - ms !! fp)
递归辅助函数已替换为同时延迟创建两个结果列表。此模式与标准递归的不同之处在于它不需要达到基本情况,并且需要采取某种措施防止在提供完整答案之前立即找到基本情况。这种模式被称为共同递归。 (或者 corecursion,如果我懒惰打字的话。)同样的想法,但它会产生相反方向的答案。
或者您可以只使用许多 memoization packages which supports mutual recursive function. Below is the implementation that uses monad-memo 中的一个,它确实需要以 monadic 形式定义的记忆函数,否则只是您原始实现的直接翻译。
import Control.Monad.Memo
import Control.Monad.ST
-- Same function in monadic form
gof 0 = return 1
gof i = do
-- gof is memoized on level 0
fs <- memol0 gof (i-1)
-- gom is on level 1
ms <- memol1 gom fs
return (i - ms)
-- Same here
gom 0 = return 0
gom i = do
ms <- memol1 gom (i-1)
fs <- memol0 gof ms
return (i - fs)
-- Eval monadic form into normal Int -> Int function
fm :: Int -> Int
-- Data.Map-based memoization cache
fm = startEvalMemo . startEvalMemoT . gof
mm :: Int -> Int
mm = startEvalMemo . startEvalMemoT . gom
-- Or much faster vector-based memoization cashe
fmv :: Int -> Int
-- We use two separate caches: mutable unboxed vectors of `(n+1)` length
fmv n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . gof $ n
mmv :: Int -> Int
mmv n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . gom $ n
-- This is quite fast in comparison to the original solution
-- but compile it with -O2 to be able to compute `f 1000000`
main :: IO ()
main =
print ((fm 100000, mm 100000),(fmv 1000000, mmv 1000000))
这个有效:
f :: Int -> Int
f n = gof n where
gof 0 = 1
gof i = i - ms!! ( fs!! (i-1) )
gom 0 = 0
gom i = i - fs!! ( ms!! (i-1) )
fs = [gof j | j <- [0..n]]
ms = [gom j | j <- [0..n]]
m n = gom n where
gof 0 = 1
gof i = i - ms!! ( fs!! (i-1) )
gom 0 = 0
gom i = i - fs!! ( ms!! (i-1) )
fs = [gof j | j <- [0..n]]
ms = [gom j | j <- [0..n]]
然而,它确实是重复的。有没有办法避免重复这些代码块?一些参考资料,这是对 :
的改编http://jelv.is/blog/Lazy-Dynamic-Programming/
序列参考:
https://en.wikipedia.org/wiki/Hofstadter_sequence
我对照数字核对了它:
https://oeis.org/A005378 https://oeis.org/A005379
它生成正确的数字并且比基本代码快得多,基本代码在开始出现递归深度问题之前根本不会太高。
首先,您可以在顶级绑定中进行模式匹配。通常这并不意味着发生了很多有趣的事情,但如果你想在两个顶级绑定之间共享本地助手,它会有所帮助。
m2 :: Int -> Int
f2 :: Int -> Int
(m2, f2) = (gom, gof)
where
gof 0 = 1
gof i = i - ms !! ( fs !! (i-1) )
gom 0 = 0
gom i = i - fs !! ( ms !! (i-1) )
fs = map gof [0..]
ms = map gom [0..]
您会注意到其中还有一个技巧。我没有将列表 fs
和 ms
限制到它们的最大大小,而是让懒惰来处理它们的限制。列表不会在需要记忆早期结果的地方创建。
但是列表索引是 O(n)。即使去掉其中的一部分也可以显着加快速度。如果您查看同一函数的递归模式,您会发现 gom i
总是调用 gom (i-1)
,gof
也是如此。您可以使用它通过传递先前的值来删除这些查找的列表索引。不幸的是,这同样不适用于对相反函数的调用,因为它们不那么容易遵循。但它仍然删除了大量的工作。并且可以通过进一步利用懒惰的方式来完成:
m3, f3 :: Int -> Int
(m3, f3) = ((ms !!), (fs !!))
where
(ms, fs) = unzip pairs
pairs = (0, 1) : zipWith iter [1..] pairs
iter i (mp, fp) = (i - fs !! mp, i - ms !! fp)
递归辅助函数已替换为同时延迟创建两个结果列表。此模式与标准递归的不同之处在于它不需要达到基本情况,并且需要采取某种措施防止在提供完整答案之前立即找到基本情况。这种模式被称为共同递归。 (或者 corecursion,如果我懒惰打字的话。)同样的想法,但它会产生相反方向的答案。
或者您可以只使用许多 memoization packages which supports mutual recursive function. Below is the implementation that uses monad-memo 中的一个,它确实需要以 monadic 形式定义的记忆函数,否则只是您原始实现的直接翻译。
import Control.Monad.Memo
import Control.Monad.ST
-- Same function in monadic form
gof 0 = return 1
gof i = do
-- gof is memoized on level 0
fs <- memol0 gof (i-1)
-- gom is on level 1
ms <- memol1 gom fs
return (i - ms)
-- Same here
gom 0 = return 0
gom i = do
ms <- memol1 gom (i-1)
fs <- memol0 gof ms
return (i - fs)
-- Eval monadic form into normal Int -> Int function
fm :: Int -> Int
-- Data.Map-based memoization cache
fm = startEvalMemo . startEvalMemoT . gof
mm :: Int -> Int
mm = startEvalMemo . startEvalMemoT . gom
-- Or much faster vector-based memoization cashe
fmv :: Int -> Int
-- We use two separate caches: mutable unboxed vectors of `(n+1)` length
fmv n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . gof $ n
mmv :: Int -> Int
mmv n = runST $ (`evalUVectorMemo`(n+1)) . (`evalUVectorMemo`(n+1)) . gom $ n
-- This is quite fast in comparison to the original solution
-- but compile it with -O2 to be able to compute `f 1000000`
main :: IO ()
main =
print ((fm 100000, mm 100000),(fmv 1000000, mmv 1000000))