基於密鑰的記憶

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