基于密钥的记忆

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版本保持集合映射输入到memoized输出.当它获得输入时,它会检查集合,返回memoized值(如果可用).否则,它使用函数的原始版本计算输出,将输出保存在集合中,并返回新记忆的输出.因此,memoized集合在函数的生命周期中不断增长.

Haskell的备忘录就像你提到的eschew状态,而是预先计算一个包含记忆输出集合的数据结构,使用懒惰来确保在需要之前不计算特定输出的值.除了一些关键点之外,这与有状态方法有很多共同之处:

• 由于集合是不可变的,因此它永远不会增长.每次重新计算未记忆的输出.
• 由于在使用函数之前创建了集合,因此它不知道将使用哪些输入.因此,记忆者必须提供一组记忆的输入.

手动实现相当简单:

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).如果可以枚举所有可能的输入,那么我们可以使用该枚举来构建我们的数据结构.

在您的情况下,因为您只想记住key树的结构,最简单的方法可能是使用wrapMemoCombinators包中的函数:

wrap ::(a - > b) - >(b - > a) - >备注a - >备忘录b

给出a和b之间的a和同构的memoizer,为b构建一个memoizer.

因此,如果您的key值具有相应的Memo值(比如说type Key = Int),并且您有从Keys到的双射Tree Key Val,那么您可以使用该双射为您的Tree Key Val函数制作一个memoizer :

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