基于键的记忆

Question

我最近一直在玩 MemoCombinators 和 MemoTrie 包，我试图记住一个正在使用树的函数（这实际上是一个伪装的 DAG，因为有几个节点是共享的）。形式为：

data Tree k a = Branch (Tree k a) (k, a) (Tree k a) | Leaf (k, a)

所以我想记住一个类型的函数（基于它的键）：

Tree k a -> b

现在我有一个模糊的理解，这些记忆组合器用于将您的函数 f :: a -> a 转换为 a 的惰性（未评估）值的结构，因此当您拉出一个时，它已经被评估了。所以这对我的树来说不是问题——不知何故，我需要把它变成一个由k 索引的值结构。

我不知道如何使用组合库来做到这一点。一种简单的解决方法是创建一个函数 k -> a 来索引地图，它非常适合，但看起来有点笨拙。

我是否在这个目标上被误导了，还是我错过了一些明显的东西？

我可以很容易地看到如何用这种风格写出这个函数，明确地将我的“表”贯穿所有计算：

f :: Tree Int Int -> Map Int Int -> (Int, Map Int Int)
f (Branch l (k, x) r) m | (Just r) <- lookup k m = r
                        | otherwise = (max rl rr, m'')
     where 
       (rl, m') = (f l m) 
       (rr, m'') = (f r m') 

但这不是很好。

Answer 1

因此，大多数记忆技术都使用状态。函数的记忆版本 保持一个集合映射输入到记忆输出。当它获得输入时，它会检查集合， 如果可用，返回记忆值。否则，它使用原始计算输出 函数的版本，将输出保存在集合中，并返回新记忆的输出。 因此，memoized 集合会随着函数的生命周期而增长。

像你提到的那样的 Haskell 记忆器避开状态，而是预先计算数据结构 保存记忆输出的集合，使用惰性来确保特定的值 直到需要才计算输出。这与有状态方法有很多共同点，除了几个关键点：

• 由于集合是不可变的，它永远不会增长。每次都会重新计算未记忆的输出。
• 由于集合是在使用函数之前创建的，所以不知道 将使用哪些输入。所以记忆器必须提供一组输入 记住。

这很容易手动实现：

module Temp where
import Prelude hiding (lookup)
import Control.Arrow ((&&&))
import Data.Map (fromList, lookup)

data Tree k a = Branch (Tree k a) (k, a) (Tree k a) | Leaf (k, a)

key :: Tree k a -> k
key (Leaf (k, _)) = k
key (Branch _ (k,_) _) = k

-- memoize a given function over the given trees
memoFor :: Ord k => [Tree k a] -> (Tree k a -> b) -> Tree k a -> b
memoFor ts f = f'
  where f' t = maybe (f t) id $ lookup (key t) m
        m = fromList $ map (key &&& f) ts

MemoCombinators 和 MemoTrie 包试图做的是将输入集合隐式化（使用函数 和类型类，分别）。如果可以枚举所有可能的输入，那么我们可以 使用该枚举来构建我们的数据结构。

在您的情况下，由于您只想记住树的 key，因此最简单的方法可能是 可以使用 MemoCombinators 包中的 wrap 函数：

换行 :: (a -> b) -> (b -> a) -> 备忘录 a -> 备忘录 b

给定 a 的 memoizer 以及 a 和 b 之间的同构，为 b 构建一个 memoizer。

因此，如果您的 key 值具有对应的 Memo 值（例如，type Key = Int）， 你有一个从Keys 到Tree Key Val 的双射，那么你可以使用 该双射为您的Tree Key Val 函数制作一个备忘录：

memoize :: (Tree Key Val -> b) -> (Tree Key Val -> b)
memoize = wrap keyToTree treeToKey memoForKey

---

更新：如果您无法提前创建这样的映射，或许解决方案是使用 state monad，这样您就可以随时随地进行记忆：

{-# LANGUAGE FlexibleContexts #-}
-- ... 

import Control.Monad.State (MonadState, gets, modify)
import Data.Map (Map, insert)
-- ... 

memoM :: (Ord k, MonadState (Map k b) m) => (Tree k a -> m b) -> (Tree k a -> m b)
memoM f = f'
  where f' t = do
        let k = key t
        v <- gets $ lookup k
        case v of
          Just b -> return b
          Nothing -> do
            b <- f t
            modify $ insert k b
            return b

-- example of use
sumM :: (Ord k, MonadState (Map k Int) m) => Tree k Int -> m Int
sumM = memoM $ \t -> case t of
        Leaf (_,b) -> return b
        Branch l (_,b) r -> do
          lsum <- sumM l
          rsum <- sumM r
          return $ lsum + b + rsum