基于密钥的记忆

Question

最近我一直在使用MemoCombinators和MemoTrie软件包，并试图记录一个正在采用树的函数（这是一个真正的DAG，因为几个节点被共享） 。在形式：

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

所以我想memoise类型的函数（基于它的键）：

Tree k a -> b 

现在我有一个模糊的认识，这些memoisation组合子是用来把你的函数f :: a -> a转化为a的惰性（未评估）值的结构，以便在您将其拉出时已经对其进行了评估。所以这对我的树不会有什么问题 - 不知何故，我需要把它变成一个由k索引的值的结​​构。

我想不出如何用combinator库做到这一点。一个简单的方法是制作一个函数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

因此，大多数memoization技术使用状态。记忆版本的功能 保持集合映射输入到记忆输出。当它得到一个输入时，它检查集合 返回memoized值（如果可用）。否则，它使用函数的原始版本 来计算输出，将输出保存在集合中，并返回新记忆的输出。 因此，memoized收集会在函数的使用期限内增长。

的Haskell memoizers等你提到避开状态，而是预先计算保持memoized输出的收集的数据结构 ，使用懒惰，以确保特定 输出的值，不计算直到需要的那些。这与有状态方法有很多共同之处，除了几个关键点：

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

这是相当简单的手工来实现：

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包尝试做的是使输入隐含的集合（使用功能 和类型类，repsectively）。如果所有可能的输入都可以枚举，那么我们可以使用该枚举来构建我们的数据结构。

在你的情况，因为你想memoize的上你的树刚key，最简单的方法可能 是使用wrap函数从MemoCombinators包：

包装::（一 - > b） - >（b - > a） - >备忘录a - >备忘录b

给定a和b之间的同构记忆器，为b构建记忆器。

因此，如果您key值有相应Memo值（比如说，type Key = Int）， ，你必须从Key s到Tree Key Val双射，那么你可以使用 是双射做出memoizer您Tree Key Val功能：

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

---

更新：如果你不能创造这样的映射提前，或许解决方案是使用状态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