0

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

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

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

虽然 lib 支持基于数组和基于向量的实现作为内部存储，但它仅适用于简单的递归，我没有找到任何像 MemoT 这样的转换器来使用它进行相互递归。

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

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

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 之间进行选择的理由是什么？在评论中使用 last 2 是有道理的。什么情况下 Monad.Memo 是更好的选择？

4

1 回答 1

0

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

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

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 之间进行选择的经验法则是什么？

于 2017-09-20T10:06:54.957 回答