haskell - 在 Haskell 中实现内存功能

Question

我对 Haskell 相当陌生，我正在尝试实现一个基本的内存功能，它使用 Data.Map 来存储计算值。我的示例是针对 Project Euler Problem 15，其中涉及计算 20x20 网格中从一个角到另一个角的可能路径数。

这就是我到目前为止所拥有的。我还没有尝试编译，因为我知道它不会编译。我将在下面解释。

import qualified Data.Map as Map

main = print getProblem15Value

getProblem15Value :: Integer
getProblem15Value = getNumberOfPaths 20 20

getNumberOfPaths :: Integer -> Integer -> Integer
getNumberOfPaths x y = memoize getNumberOfPaths' (x,y)
where getNumberOfPaths' mem (0,_) = 1
      getNumberOfPaths' mem (_,0) = 1
      getNumberOfPaths' mem (x,y) = (mem (x-1,y)) + (mem (x,y-1))

memoize :: ((a -> b) -> a -> b) -> a -> b
memoize func x = fst $ memoize' Map.Empty func x
    where memoize' map func' x' = case (Map.lookup x' map) of (Just y) -> (y, map)
                                                              Nothing -> (y', map'')
           where y' = func' mem x'
                 mem x'' = y''
                 (y'', map') = memoize' map func' x''
                 map'' = Map.insert x' y' map'

所以基本上，我的结构方式是 memoize 是一个组合器(根据我的理解)。记忆化之所以有效，是因为 memoize 提供了一个函数(在本例中为 getNumberOfPaths')，其中包含一个用于递归调用的函数 (mem)，而不是让getNumberOfPaths' 调用本身，这将在第一次迭代后删除内存。

我的 memoize 实现采用一个函数(在本例中是 getNumberOfPaths')和一个初始值(在本例中是一个元组 (x,y) 表示距网格另一个角的网格单元距离的数量)。它调用具有相同结构的 memoize'，但包含一个空的 Map 来保存值，并返回一个包含返回值和新计算的 Map< 的元组。/。 memoize' 进行映射查找并返回该值，如果存在值则返回原始映射。如果不存在值，则返回计算值和新映射。

这就是我的算法崩溃的地方。为了计算新值，我使用 mem 和 x' 调用 func' (getNumberOfPaths')。 mem 只是返回 y''，其中 y'' 包含在再次调用 memoize' 的结果中。 memoize' 还返回一个新映射，然后我们向其中添加新值并用作 memoize' 的返回值。

这里的问题是行 (y'', map') = memoize' map func' x'' 应该位于 mem 下，因为它依赖于 x''，它是mem的参数。我当然可以做到这一点，但随后我将丢失我需要的 map' 值，因为它包含来自中间计算的内存值。但是，我不想将 Map 引入到 mem 的返回值中，因为这样传递给 memoize 的函数将必须处理 map 。

很抱歉，如果这听起来令人困惑。很多超高阶函数的东西让我感到困惑。

我确信有办法做到这一点。我想要的是一个通用的 memoize 函数，它允许递归调用，就像 getNumberOfPaths 的定义一样，其中计算逻辑不必确切地关心内存是如何完成的.

Answer 1

如果您的输入足够小，您可以做的一件事是将备忘录表分配为 Array 而不是 Map，提前包含所有结果，但懒惰地计算:

import Data.Array ((!), array)

numPaths :: Integer -> Integer -> Integer
numPaths w h = get (w - 1) (h - 1)
  where

    table = array (0, w * h)
      [ (y * w + x, go x y)
      | y <- [0 .. h - 1]
      , x <- [0 .. w - 1]
      ]

    get x y = table ! fromInteger (y * w + x)

    go 0 _ = 1
    go _ 0 = 1
    go x y = get (x - 1) y + get x (y - 1)

如果您愿意，您还可以将其拆分为单独的函数:

numPaths w h = withTable w h go (w - 1) (h - 1)
  where
    go mem 0 _ = 1
    go mem _ 0 = 1
    go mem x y = mem (x - 1) y + mem x (y - 1)

withTable w h f = f'
  where
    f' = f get
    get x y = table ! fromInteger (y * w + x)
    table = makeTable w h f'

makeTable w h f = array (0, w * h)
  [ (y * w + x, f x y)
  | y <- [0 .. w - 1]
  , x <- [0 .. h - 1]
  ]

我不会剧透，但答案还有一个非递归公式。