在 Haskell 中实现记忆功能

Question

我是 Haskell 的新手，我正在尝试实现一个基本的记忆功能，它使用 Data.Map 来存储计算值。我的示例是针对 Project Euler 问题 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 是一个组合器（据我所知）。 memoization 之所以有效，是因为memoize 提供了一个函数（在本例中为getNumberOfPaths'），该函数具有一个调用（mem）进行递归的函数，而不是让getNumberOfPaths' 调用自身，这将在第一次迭代后删除memoization。

我的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]
  ]

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

Answer 2

您将无法实现memoize :: ((a -> b) -> a -> b) -> a -> b。为了存储某些a 的结果，您需要在内存中为a 留一个位置，这意味着您需要了解这些a 是什么。

一个笨拙的方法是为你知道所有值的类型添加一个类型类，比如Universe。

class Universe a where
    universe :: [a]

然后，您可以通过构建一个包含b 值的b 值来实现memoize :: (Ord a, Universe a) => ((a -> b) -> a -> b) -> a -> b，方法是为universe :: [a] 中的每个a 值，通过将映射查找传递给func 来创建memoed 函数，并且通过声明 bs 使用 memoed 函数来填充它们。

这不适用于Integer，因为它们的数量不是有限的。它甚至不适用于Int，因为它们太多了。要记忆像Integer 这样的类型，您可以使用MemoTrie 中使用的方法。构建一个惰性无限数据结构来保存叶子中的值。

这是Integers 的一种可能结构。

data IntegerTrie b = IntegerTrie {
    negative :: [b],
    zero :: b,
    positive :: [b]
}

更有效的结构将允许深入到 trie 中以避免指数时间查找。对于Integers，MemoTrie 采用了将键转换为位列表的方法，其中包含一对函数a -> [Bool] 和[Bool] -> a，并使用大约以下trie。

data BitsTrie b = BitsTrie {
    nil :: b,
    false :: BitsTrie b,
    true :: BitsTrie b
}

MemoTrie 继续对具有一些关联 trie 的类型进行抽象，这些关联可用于记忆它们并提供将它们组合在一起的方法。

Answer 3

这可能不会直接帮助您实现记忆，但您可以使用其他人的...monad-memo。改编他们的一个例子...

{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Memo

main = print $ startEvalMemo (getNumberOfPaths 20 20)

getNumberOfPaths :: (MonadMemo (Integer, Integer) Integer m) => Integer -> Integer -> m Integer
getNumberOfPaths 0 _ = return 1
getNumberOfPaths _ 0 = return 1
getNumberOfPaths x y = do
  n1 <- for2 memo getNumberOfPaths (x-1) y
  n2 <- for2 memo getNumberOfPaths x (y-1)
  return (n1 + n2)

...我怀疑要实现类似的东西，你可以在他们的源代码https://github.com/EduardSergeev/monad-memo 中偷看

Answer 4

但是，我不想将 Map 引入 mem 的返回值，因为这样传递给 memoize 的函数将不得不处理 Map。

如果我理解的话，您将不得不这样做一些，至少如果您的目标是将记忆值存储在地图中，该地图会根据找到的每个新值进行复制。将注意力吸引到我认为在记忆方面没有意义的事情上......

getNumberOfPaths' mem (x,y) = (mem (x-1,y)) + (mem (x,y-1))

... 表示来自一个分支mem (x-1,y) 的任何记忆，不能在另一个mem (x,y-1) 中使用，因为相同的mem 将在两个分支中使用，包含相同的信息，无论值/功能如何mem 最终成为。您必须以某种方式将记忆值从一个传递到另一个。这意味着调用递归的函数不能只返回一个Integer：它必须返回一个Integer以及一些与Integer一起找到的记忆值的知识。

有很多方法可以做到这一点。尽管由于 memoization 细节的传播可能不受欢迎，但您可以明确地传递地图。

getNumberOfPaths :: (Integer, Integer) -> Integer
getNumberOfPaths (x, y) = snd $ memoize Map.empty getNumberOfPaths' (x, y) 

getNumberOfPaths' :: Map.Map (Integer, Integer) Integer -> (Integer, Integer) -> (Map.Map (Integer, Integer) Integer, Integer)
getNumberOfPaths' map (0,_) = (map, 1)
getNumberOfPaths' map (_,0) = (map, 1)
getNumberOfPaths' map (x,y) = (map'', first + second) where
  (map',   first) = memoize map  getNumberOfPaths' (x-1, y)
  (map'', second) = memoize map' getNumberOfPaths' (x, y-1)

memoize :: Ord a => Map.Map a b -> (Map.Map a b -> a -> (Map.Map a b, b)) -> a -> (Map.Map a b, b)
memoize map f x = case Map.lookup x map of
  (Just y) -> (map, y)
  Nothing  -> (map'', y) where
    (map', y) = f map x
    map''     = Map.insert x y map'

getNumberOfPaths' 确实需要传递地图，并且需要知道它的签名，但至少它不需要与地图交互：这是在 memoize 中完成的，所以我不认为那很糟糕。

我认为如果你只是想传递一个函数，你可以。您可以将函数链用作穷人的地图，但它们必须返回 Maybe...

getNumberOfPaths :: (Integer, Integer) -> Integer
getNumberOfPaths (x, y) = snd $ memoize (const Nothing) getNumberOfPaths' (x, y) 

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

memoize :: Eq a => (a -> Maybe b) -> ((a-> Maybe b) -> a -> ((a -> Maybe b), b)) -> a -> ((a -> Maybe b), b)
memoize mem f x = case mem x of
  (Just y) -> (mem, y)
  Nothing  -> (mem'', y) where
    (mem', y) = f mem x
    mem''     = \x' -> if x' == x then Just y else mem' x'

我想知道你是否想要 a) 使用映射来存储值，以及 b) 传递一个大约为 mem 的函数。但是，我怀疑这会很棘手，因为虽然您可以传递一个从映射中提取并返回提取值的函数，但您不能从该函数中提取映射以将某些内容插入地图。

也有可能为此创建一个 monad（或使用State）。但是，这可能留给另一个答案。

Answer 5

我想要的是一个通用的 memoize 函数，它允许递归调用，就像在 getNumberOfPaths 的定义中一样，其中计算逻辑不必关心 memoization 是如何完成的。

State monad 非常适合处理对状态的更新，例如对记忆值映射的更新，而无需在代码的“业务逻辑”部分显式传递它，就像 @ 的另一个答案一样987654321@ 可以。

在将记忆的细节与递归函数分离方面，您可以隐藏在type 后面使用地图甚至状态的事实。递归函数的所有定义需要知道的是它必须返回一个MyMemo a b，而不是直接调用自己，它必须将自己和下一个参数传递给myMemo

import qualified Data.Map as Map
import Control.Monad.State.Strict

main = print $ runMyMemo getNumberOfPaths (20, 20)

getNumberOfPaths :: (Integer, Integer) -> MyMemo (Integer, Integer) Integer
getNumberOfPaths (0, _) = return 1
getNumberOfPaths (_, 0) = return 1
getNumberOfPaths (x, y) = do
  n1 <- myMemo getNumberOfPaths (x-1,y)
  n2 <- myMemo getNumberOfPaths (x,y-1)
  return (n1 + n2)

-------

type MyMemo a b = State (Map.Map a b) b

myMemo :: Ord a => (a -> MyMemo a b) -> a -> MyMemo a b
myMemo f x = gets (Map.lookup x) >>= maybe y' return
  where
    y' = do
      y <- f x
      modify $ Map.insert x y
      return y

runMyMemo :: Ord a => (a -> MyMemo a b) -> a -> b
runMyMemo f x = evalState (f x) Map.empty

以上内容本质上是 https://stackoverflow.com/a/44478219/1319998 的自己滚动版本（嗯，在 State 之上滚动）。

---

感谢https://stackoverflow.com/a/44515364/1319998对myMemo中代码的建议