使用 Monad.Memo 进行记忆以实现 Haskell 中的相互递归

Question

我正在 Haskell 中使用相互递归实现进行一些动态编程。

我决定使用记忆来加快速度。

Monad.Memo 为这种情况提供了 MemoT 转换器。但它使用 Map 作为存储值的内部表示。虽然这给了我数量级的速度提升，但仍然不够。

虽然 lib 支持基于数组和基于矢量的实现作为内部存储，但它仅适用于简单的递归，我没有发现像 MemoT 这样的转换器可以将其用于相互递归。

使用基于向量的高效内部表示（如果有）进行相互递归记忆的最佳方法是什么？

我的下一个问题是关于记忆效果。所以我希望我的函数在第一个运行期间花费更多时间，而在连续运行期间花费更少的时间。但是我在ghci中发现运行ning它每次花费的时间都是一样的。所以第一和第二之间没有区别运行。我测的时间如下：

timeit $ print $ dynamic (5,5)

动态是我的职责。

完整实现如下：

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

已添加：

根据#liqui 评论，我尝试了 memcombinators。

所以首先是非记忆初始实现：

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

然后我的记忆尝试（只改了部分）：

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)

结果有点悖论。它比非记忆递归实现慢 3 倍。仅记忆一个函数（即 fq）而不触及 fv 会使结果慢 2 倍。我用 memcombinators 记忆得越多，计算就越慢。同样，第一次和第二次调用之间没有区别。

也是最后一个问题。在 Monad.Memo 或 memcombinators 或 MemotTrie 之间进行选择的理由是什么？在评论中使用最后 2 个是有道理的。什么情况下Monad.Memo是更好的选择？

Answer 1

最后，MemoTrie 完成了这项工作。第一次调用时它的运行速度与 Monad.Memo 一样快（可能快得多），并且在连续调用时它几乎不需要时间！

与 monadic 方法相比，代码的变化微不足道：

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

我仍然想知道使用 Monad.Memo 的好处是什么以及它的用例是什么？或者它在 MemoTrie 中变得过时了？

为什么 Memocombinators 对我不起作用？

在 Monad.Memo、Memocombinators 或 MemoTrie 之间进行选择的经验法则是什么？

使用 Monad.Memo 进行记忆以实现 Haskell 中的相互递归

Memoization with Monad.Memo for mutual recursion in Haskell

haskell

recursion

dynamic-programming

memoization

mutual-recursion