Memoization avec Monad.Memo pour la récurrence mutuelle dans Haskell

Question

Je suis en train de faire de la programmation dynamique dans Haskell avec une implémentation de récurrence mutuelle.

J'ai décidé d'accélérer les choses en utilisant la mémo.

Monad.Memo offre un transformateur MemoT pour ce cas précis. Mais il utilise Map comme représentation interne pour les valeurs stockées. Et même si cela m'a donné un ordre de grandeur de la vitesse de boost, ce n'est toujours pas suffisant. Alors que lib supporte l'implémentation basée sur les tableaux et les vecteurs comme stockage interne, il ne fonctionne que pour une simple récursion et je n'ai trouvé aucun transformateur comme MemoT pour l'utiliser pour la récurrence mutuelle. Quelle est la meilleure façon de faire une mémoisation de récurrence mutuelle avec une représentation interne efficace basée sur un vecteur (le cas échéant)?

Ma question suivante concerne l'effet mémo. Je m'attendais donc à ce que ma fonction prenne plus de temps pendant la première manche et beaucoup moins pendant les courses consécutives. Mais ce que j'ai trouvé en cours d'exécution dans ghci le temps qu'il faut chaque fois est le même. Donc pas de différence entre le premier et le deuxième passage. J'ai mesuré le temps comme suit:

timeit $ print $ dynamic (5,5) 

Avec dynamique étant ma fonction.

La mise en œuvre complète est la suivante:

import Control.Monad.Memo 
import Control.Monad.Identity 

type Pos = (Int, Int) 

type MemoQ = MemoT (Int, Int, Int) [Int] 
type MemoV = MemoT (Int, Int, Int) Int 
type MemoQV = MemoQ (MemoV Identity) 

-- we are moving to (0,0) as we can always shift the world by substituting variables 
-- due to symmetry of cost function it is enougth to solve for only positive x and y 
dynamic :: Pos -> [Int] 
dynamic (x, y) = lastUnique $ map (evalQ x y) [1 ..] 
    where lastUnique (x0:x1:xs) | x0 == x1 = x0 
           | otherwise = lastUnique (x1:xs) 

evalQ :: Int -> Int -> Int -> [Int] 
evalQ x y n = startEvalMemo . startEvalMemoT $ fqmon x y n 

fqmon :: Int -> Int -> Int -> MemoQV [Int] 
fqmon _ _ 0 = return [0,0,0,0] 
fqmon x y n = do 
    let pts = neighbours (x, y) 
    let v = for3 memol1 fvmon n 
    let c = cost (x, y) 
    let q = fmap (c +) . uncurry v 
    traverse q pts 

fvmon :: Int -> Int -> Int -> MemoQV Int 
fvmon _ 0 0 = return 0 
fvmon 0 x y = return $ cost (x, y) 
fvmon n x y | limit  = return 1000000 
      | otherwise = liftM minimum $ for3 memol0 fqmon x' y' (n - 1) 
      where x' = abs x 
       y' = abs y 
       limit = x' > 25 || y' > 25 

cost :: Pos -> Int 
cost (x, y) = abs x + abs y 

neighbours :: Pos -> [Pos] 
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)] 

---

Ajouté:

Selon commentaire #liqui J'ai essayé memcombinators.

Alors d'abord est la non mise en œuvre initiale memoized:

type Pos = (Int, Int) 

dynamic :: Int -> Int -> [Int] 
dynamic x y = lastUnique $ map (fq x y) [1 ..] 
    where lastUnique (x0:x1:xs) | x0 == x1 = x0 
           | otherwise = lastUnique (x1:xs) 

fq :: Int -> Int -> Int -> [Int] 
fq _ _ 0 = [0, 0, 0, 0]   -- Q at 0 step is 0 in all directions 
fq x y n = (cost (x, y) +) . (uncurry $ fv n) <$> neighbours (x, y) 

fv :: Int -> Int -> Int -> Int 
fv _ 0 0 = 0    -- V at (0, 0) is 0 at any atep 
fv 0 x y = cost (x, y)  -- V at 0 step is a cost 
fv n x y = minimum $ fq x y (n - 1) 

cost :: Pos -> Int 
cost (x, y) = abs x + abs y 

neighbours :: Pos -> [Pos] 
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)] 

Alors ma tentative de memization (seulement une partie modifiée):

dynamic :: Int -> Int -> [Int] 
dynamic x y = lastUnique $ map (fqmem x y) [1 ..] 
    where lastUnique (x0:x1:xs) | x0 == x1 = x0 
           | otherwise = lastUnique (x1:xs) 
-- memoizing version of fq 
fqmem :: Int -> Int -> Int -> [Int] 
fqmem x y n = fqmem' x y n 
    where fqmem' = memo3 integral integral integral fq 

-- memoizing version of fv 
fvmem :: Int -> Int -> Int -> Int 
fvmem n x y = fvmem' n x y 
    where fvmem' = memo3 integral integral integral fv 

fq :: Int -> Int -> Int -> [Int] 
fq _ _ 0 = [0, 0, 0, 0]   -- Q at 0 step is 0 in all directions 
fq x y n = (cost (x, y) +) . (uncurry $ fvmem n) <$> neighbours (x, y) 

fv :: Int -> Int -> Int -> Int 
fv _ 0 0 = 0    -- V at (0, 0) is 0 at any atep 
fv 0 x y = cost (x, y)  -- V at 0 step is a cost 
fv n x y = minimum $ fqmem x y (n - 1) 

Le résultat un peu paradoxal. Il est 3 fois plus lent que l'implémentation récursive non mémoisée. Memoizing une seule fonction (à savoir fq) et ne pas toucher fv donne des résultats 2 fois plus lent. Plus je note avec memcombinators, plus le calcul est lent. Et encore aucune différence entre la première et la deuxième invocation.

Aussi la dernière question. Quelle est la raison du choix entre Monad.Memo ou memcombinators ou MemotTrie? Il y a un point sur l'utilisation du dernier 2 dans les commentaires. Quelles sont les situations où Monad.Memo est un meilleur choix?

Answer 1

Enfin MemoTrie a fait le travail. Lors de la première invocation, cela fonctionne aussi vite (peut-être beaucoup plus vite) que Monad.Memo et lors d'invocations consécutives, il ne prend pratiquement pas de temps!

Et tha changement de code est trivial par rapport à l'approche monadique:

import Data.MemoTrie 

type Pos = (Int, Int) 

-- we are moving to (0,0) as we can always shift the world by substituting variables 
-- due to symmetry it is enougth to solve for only positive x and y 

dynamic :: Int -> Int -> [Int] 
dynamic x y = lastUnique $ map (fqmem x y) [1 ..] 
    where lastUnique (x0:x1:xs) | x0 == x1 = x0 
           | otherwise = lastUnique (x1:xs) 

fqmem = memo3 fq 
fvmem = memo3 fv 

fq :: Int -> Int -> Int -> [Int] 
fq _ _ 0 = [0, 0, 0, 0]   -- Q at 0 step is 0 in all directions 
fq x y n = (cost (x, y) +) . (uncurry $ fvmem n) <$> neighbours (x, y) 

fv :: Int -> Int -> Int -> Int 
fv _ 0 0 = 0    -- V at (0, 0) is 0 at any atep 
fv 0 x y = cost (x, y)  -- V at 0 step is a cost 
fv n x y = minimum $ fqmem x y (n - 1) 

cost :: Pos -> Int 
cost (x, y) = abs x + abs y 

neighbours :: Pos -> [Pos] 
neighbours (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)] 

Cependant, je voudrais savoir ce qui est des avantages de l'utilisation Monad.Memo et quels sont les cas d'utilisation pour cela? Ou devient-il obsolète avec MemoTrie?

Pourquoi les Memocombinators n'ont pas fonctionné pour moi?

Quelle est la règle de base pour choisir entre Monad.Memo, Memocombinators ou MemoTrie?