haskell - 基于 key 的内存

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 来为 map 建立索引，它非常适合但看起来有点笨拙。

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

我可以很容易地看出如何用这种风格写出这个函数，通过所有的计算明确地将我的“表”线程:

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

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

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

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

这很容易手动实现:

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 函数:

wrap :: (a -> b) -> (b -> a) -> Memo a -> Memo b

Given a memoizer for a and an isomorphism between a and b, build a memoizer for b.

因此，如果您的 key 值具有相应的 Memo 值(例如，type Key = Int)，并且你有一个从 Key 到 Tree Key Val 的双射，然后你可以使用为您的 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