Запоминание на основе ключа

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 

Теперь у меня есть смутное понимание того, что эти мемоизация комбинаторы используются, чтобы превратить ваш function 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

Итак, большинство методов memoization использует состояние. Меморанжированная версия функции хранит входы отображения коллекции для memoized выходов. Когда он получает вход, он проверяет коллекцию, , возвращая memoized значение, если доступно. В противном случае он вычисляет результат с использованием исходной версии функции , сохраняет вывод в коллекции и возвращает новый memoized вывод. Таким образом, мемуатная коллекция растет на протяжении всей функции.

Haskell memoizers, как те, которые вы упоминаете отказаться от состояния, и вместо предвычисления структуры данных, который содержит коллекцию memoized выходов, используя лень, чтобы гарантировать, что значение конкретного выхода не вычисляются до тех пор, пока это необходимо. Это имеет много общего с государственным подходом, за исключением нескольких ключевых моментов:

• Поскольку сбор неизменен, он никогда не растет. Неожиданные выходы пересчитываются каждый раз.
• Поскольку коллекция создана до использования функции, она не знает , какие входы будут использоваться. Таким образом, memoizer должен предоставить коллекцию входов, для которых memoize.

Это довольно просто реализовать вручную:

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) -> Memo a -> Memo b

С учетом меморандума для a и изоморфизма между a и b постройте memoizer для b.

Так что, если ваши key значения имеют соответствующее Memo значение (как, скажем, type Key = Int), и у вас есть биекция от Key с до Tree Key Val, то вы можете использовать , что биекция сделать memoizer для вашего Tree Key Val функции:

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

---

Update: Если вы не можете создать такое отображение заблаговременно, возможно, решение состоит в том, чтобы использовать государственную монаду, чтобы вы могли меморировать на ходу:

{-# 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