动态规划（Haskell、Hofstader M/F 序列）答案

【问题标题】：Dynamic Programming (Haskell, Hofstader M/F sequence)动态规划（Haskell、Hofstader M/F 序列）
【发布时间】：2019-02-04 20:16:32
【问题描述】：

这行得通：

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

它生成正确的数字，并且比基本代码快得多，基本代码在开始出现递归深度问题之前根本不会太高。

【问题讨论】：

好吧，您当然可以共享m 和f 之间的所有子定义。这对序列看起来你可以做得更好，并以核心递归方式生成它们。
请注意，列表上的!! 效率低下，因为它的成本为 O(n)。如果无法避免索引，请考虑使用一些 O(1) 数据结构，例如数组。递归深度也不应该是一个问题，除非它真的很大——你为什么要提到这个？（你用的不是古代的拥抱，对吧？）

标签： haskell recursion memoization

【解决方案1】：

或者您可以只使用许多支持相互递归功能的memoization 包之一。下面是使用 monad-memo 的实现，它确实需要以一元形式定义的记忆函数，否则只是原始实现的直接翻译。

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))

【讨论】：

【解决方案2】：

首先，您可以在顶级绑定中进行模式匹配。通常这并不意味着正在发生什么有趣的事情，但如果您想在两个顶级绑定之间共享本地助手，它会有所帮助。

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。）同样的想法，但它会产生相反方向的答案。

【讨论】：