Memoization with Monad.Memo for mutual recursion in Haskell

Question

I'm doing some dynamic programming in Haskell with mutual recursion implementation.

I decided to speed things up using memoization.

Monad.Memo offers MemoT transformer for that exact case. But it uses Map as internal representation for stored values. And while this gave me order of magnitude speed boost it is still not enough.

While lib supports Array-based and Vector-based implementation as internal storage it only works for simple recursion and I did not found any transformers like MemoT to use it for mutual recursion.

What is the best way to do mutual recursion memoization with efficient vector based internal representation (if any)?

My next question is about memoization effect. So I expected my function to take more time during first run and much less during consecutive runs. But what I found running it in ghci the time it takes each time is the same. So no difference between first and second run. I measured time as follows:

timeit $ print $ dynamic (5,5)

With dynamic being my function.

The full implementation is as follows:

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)]

Added:

According to #liqui comment I tried memcombinators.

So first is the non memoized initial implementation:

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)]

Then my attempt to memization (only changed part):

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)

The result a bit of paradox. It is 3 time slower than non memoized recursive implementation. Memoizing only one function (namely fq) and not touching fv gives results 2 times slower. The more I memoize with memcombinators the slower the computation. And again no difference between first and second invocation.

Also the last question. What is the rationale for choosing between Monad.Memo or memcombinators or MemotTrie? There is a point on using last 2 in comments. What are the situations when Monad.Memo is a better choice?

I don't see any reason why this package wouldn't allow you to write mutually recursive functions. Something like `fun0 = memo $ \x -> .. fun1 (x-1) ..; fun1 = memo $ \x -> .. fun0 (x+1) ..` should work. For the 2nd question, there's no reason to expect the output of the function to be saved between different invocations of the function (indeed, this will never occur). This isn't how memoization of pure functions works. — user2407038, Sep 19 '17 at 16:24
I did according to tutorial on this page: https://hackage.haskell.org/package/monad-memo It is stated there using memo for both functions will not work and suggested approach I copied. As for execution time. How achieve only one calculation of the memoized table (map) and not recalculate each time function is invoked? — aliko, Sep 19 '17 at 16:29
1. A memoized function a la `MemoT` will reduce computation time for recursive calls. What you are asking about seems to be memoization in support of independent, non-recursive calls to the function - right? 2. Are you only testing in GHCi? The interpreter is not for benchmarking, you should compile (with `-O2`) and measure run times of binaries when performance is of interest. — Thomas M. DuBuisson, Sep 19 '17 at 19:02
Well i'm happy to have recursive calls memoized and already gained a good boost from it. But I want to have memoization between calls as well because there is no big point to repeat the same calculation. As for correct measurment of performance I would agree with you. But I believe ghci still gives good rough estimation and shows performance difference between implementations. — aliko, Sep 19 '17 at 19:34
The package doesn't do anything too terribly weird. There's no bizarre action at a distance. You can only benefit from memoization within a single call to `startEvalMemoT`. If you want to chain calls manually for whatever reason, you'll need to use `runMemoT` instead, and explicitly pass the cache around. Recursion doesn't really have anything to do with it. — dfeuer, Sep 19 '17 at 20:11
Since your computations are pure, perhaps you would like a pure memoization package such as [MemoTrie](https://hackage.haskell.org/package/MemoTrie) or [data-memocombinators](https://hackage.haskell.org/package/data-memocombinators). These will memoize results between calls even in the pure fragment, as they lean on laziness to do the memoization, so there are no "effects". — luqui, Sep 20 '17 at 01:44
Thanks #liqui for suggestion. I added an attempt on data-memcombinators though it gave me not boost but lost of performance. — aliko, Sep 20 '17 at 08:43

score 0 · Accepted Answer · answered Sep 20 '17 at 10:06

Finally MemoTrie did the job. At first invocation it works as fast (possibly much faster) than Monad.Memo and at consecutive invocations it take virtually no time!

And tha change in code is trivial compared to monadic approach:

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)]

Still I would like to know what is the benefits of using Monad.Memo and what are use cases for that? Or it becomes obsolete with MemoTrie?

Why Memocombinators did not worked for me?

What is the rule of thumb on choosing between Monad.Memo, Memocombinators or MemoTrie?

Memoization with Monad.Memo for mutual recursion in Haskell

1 Answers1