我对 Haskell 相当陌生，我正在尝试实现一个基本的记忆函数，它使用Data.Map来存储计算值。我的例子是欧拉项目问题 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的定义中一样，其中计算逻辑不必确切地关心记忆是如何完成的。
如果您的输入足够小，您可以做的一件事是将备忘录表分配为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]
]
我不会为你剧透它，但还有一个非递归公式的答案。
您将无法实现memoize :: ((a -> b) -> a -> b) -> a -> b。为了存储某些a的结果，您将需要在内存中为该a提供一个位置，这意味着您需要了解这些a是什么。
一种笨拙的方法是为您知道所有值的类型添加一个类型类，例如Universe.
class Universe a where
universe :: [a]
然后，你可以通过构建一个Map来实现memoize :: (Ord a, Universe a) => ((a -> b) -> a -> b) -> a -> b，该包含universe :: [a]中每个a值的b值，通过将地图查找传递给func来制作备忘录函数，并通过声明它们使用备忘录函数来填充b。
这对Integer不起作用，因为它们的数量有限。它甚至对Int不起作用，因为它们太多了。要记住像Integer这样的类型，你可以使用MemoTrie中使用的方法。构建一个惰性的无限数据结构，将值保存在叶子上。
这是Integer的一种可能结构。
data IntegerTrie b = IntegerTrie {
negative :: [b],
zero :: b,
positive :: [b]
}
更有效的结构将允许深入到trie中以避免指数时间查找。对于IntegersMemoTrie采用的方法将键转换为具有某种函数a -> [Bool]和[Bool] -> a的位列表，并使用大约以下trie。
data BitsTrie b = BitsTrie {
nil :: b,
false :: BitsTrie b,
true :: BitsTrie b
}
MemoTrie继续抽象出具有一些可用于记忆它们的关联尝试的类型，并提供将它们组合在一起的方法。
这可能不会直接帮助您实现记忆，但您可以使用其他人的...莫纳德备忘录。改编他们的一个例子...
{-# 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
但是，我不想将 Map 引入 mem 的返回值中，因为这样传递给记忆的函数将不得不处理 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一起找到的记忆值的知识。
有许多方法可以做到这一点。尽管由于记忆细节的传播可能不可取，但您可以明确地传递地图。
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)。但是，这可能留给另一个答案。
我想要的是一个通用的记忆函数，它允许递归调用，就像在getNumberOfPaths的定义中一样，其中计算逻辑不必确切地关心记忆是如何完成的。
State monad 非常适合处理对状态的更新，例如对记忆值映射的更新，而不必像 https://stackoverflow.com/a/44492608/1319998 的另一个答案那样在代码的"业务逻辑"部分显式传递它。
在将记忆的细节与递归函数分开方面，您可以隐藏地图甚至状态正在使用在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 的滚动版本(好吧，在状态之上滚动)。
感谢 https://stackoverflow.com/a/44515364/1319998 对myMemo代码的建议