在Haskell中实现memoization函数

Question

我是Haskell的新手，我正在尝试实现一个基本的memoization函数，它使用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'值，这是我需要的，因为它包含来自中间计算的内存值。但是，我不想在mem的返回值中引入Map，因为这样传递给memoize的函数就必须处理Map。

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

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

Answer 1

如果您的输入足够小，您可以做的一件事是将memo表作为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]

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

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

这是Integer的一种可能的结构。

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

这可能不能直接帮助您实现memoization，但您可以使用其他人的...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中查看