动态规划在Haskell中的记忆化

Question

动态规划在Haskell中的记忆化

15

这是我第一次尝试使用（据我理解的）动态规划。我正在尝试解决这个有趣的问题：A* Admissible Heuristic for die rolling on grid

q函数尝试向后递归，并跟踪骰子的方向（visited在技术上是下一个单元格，但“visited”是指递归中为了防止无限回和转圈）。虽然我不确定它提供的答案是否是最佳解决方案，但它似乎确实提供了一个答案。

我希望能够得到有关如何实现某种记忆化以加速计算的想法 - 我曾试图实现类似于memoized_fib（在此处看到：here），将lookup而不是!!映射到q的组合列表中的(i,j)，但得到了Nothing，没有双关语之意。

Haskell代码：

import Data.List (minimumBy)
import Data.Ord (comparing)

fst3 (a,b,c) = a

rollDie die@[left,right,top,bottom,front,back] move
  | move == "U" = [left,right,front,back,bottom,top]
  | move == "D" = [left,right,back,front,top,bottom]
  | move == "L" = [top,bottom,right,left,front,back]
  | move == "R" = [bottom,top,left,right,front,back]

dieTop die = die!!2

leftBorder = max 0 (min startColumn endColumn - 1)
rightBorder = min columns (max startColumn endColumn + 1)
topBorder = endRow
bottomBorder = startRow

infinity = 6*rows*columns

rows = 10
columns = 10

startRow = 1
startColumn = 1

endRow = 6
endColumn = 6

dieStartingOrientation = [4,3,1,6,2,5] --left,right,top,bottom,front,back

q i j visited 
  | i < bottomBorder || i > topBorder 
    || j < leftBorder || j > rightBorder = (infinity,[1..6],[])
  | i == startRow && j == startColumn    = (dieTop dieStartingOrientation,dieStartingOrientation,[])
  | otherwise                            = (pathCost + dieTop newDieState,newDieState,move:moves)
      where previous
              | visited == (i, j-1) = zip [q i (j+1) (i,j),q (i-1) j (i,j)] ["L","U"]
              | visited == (i, j+1) = zip [q i (j-1) (i,j),q (i-1) j (i,j)] ["R","U"]
              | otherwise           = zip [q i (j-1) (i,j),q i (j+1) (i,j),q (i-1) j (i,j)] ["R","L","U"]
            ((pathCost,dieState,moves),move) = minimumBy (comparing (fst3 . fst)) previous
            newDieState = rollDie dieState move

main = putStrLn (show $ q endRow endColumn (endRow,endColumn))

- גלעד ברקן

1

我认为如果您发布一下未成功的尝试，这会有所帮助。 - svick

我曾经花费很长时间在Haskell中解决记忆化问题。虽然我不记得细节，但最终我成功了（我想是的；它可能有其他问题，比如空间泄漏），通过定义一个数组实例，使得任何给定索引的值都是基于其他数组元素计算出来的。然后惰性评估似乎强制所有数组元素按正确顺序“填充”，这似乎有点神奇（尽管我更感到宽慰而不是高兴）。换句话说，数据结构“引导”，函数“跟随”。 - j_random_hacker

@j_random_hacker 请查看应用的骰子算法--在2.13秒内完成300x300的计算，无需表格，比Paul的A*算法更小，很酷吧？https://dev59.com/UGQn5IYBdhLWcg3wzZ76#16629766 - גלעד ברקן

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- hammar · Accepted Answer

我处理这类问题的首选工具是data-memocombinators库。

要使用它，只需导入Data.MemoCombinators，将您的q重命名为其他名称，例如q'（但保留递归调用不变），然后像这样定义新的q：

q = M.memo3 M.integral M.integral (M.pair M.integral M.integral) q'

memo3 可以为一个带有三个参数的函数制作记忆器，需要为每个参数提供记忆器。
integral 是一个简单的整型记忆器。
pair 将两个记忆器组合在一起，以制作这些类型的对应的记忆器。
最后，我们将这个记忆器应用于 q' 中，以获得一个记忆化版本。

就是这样。你的函数现在已经被记忆了。是时候来测试它了:

> :set +s
> q endRow endColumn (endRow,endColumn)
(35,[5,2,4,3,6,1],["R","R","R","R","R","U","U","U","U","U"])
(0.01 secs, 516984 bytes)

完整代码如下：

import Data.List (minimumBy)
import Data.Ord (comparing)
import qualified Data.MemoCombinators as M

fst3 (a,b,c) = a

rollDie die@[left,right,top,bottom,front,back] move
  | move == "U" = [left,right,front,back,bottom,top]
  | move == "D" = [left,right,back,front,top,bottom]
  | move == "L" = [top,bottom,right,left,front,back]
  | move == "R" = [bottom,top,left,right,front,back]

dieTop die = die!!2

leftBorder = max 0 (min startColumn endColumn - 1)
rightBorder = min columns (max startColumn endColumn + 1)
topBorder = endRow
bottomBorder = startRow

infinity = 6*rows*columns

rows = 10
columns = 10

startRow = 1
startColumn = 1

endRow = 6
endColumn = 6

dieStartingOrientation = [4,3,1,6,2,5] --left,right,top,bottom,front,back

q = M.memo3 M.integral M.integral (M.pair M.integral M.integral) q'
  where
    q' i j visited 
      | i < bottomBorder || i > topBorder || j < leftBorder || j > rightBorder = (infinity,[1..6],[])
      | i == startRow && j == startColumn    = (dieTop dieStartingOrientation,dieStartingOrientation,[])
      | otherwise                            = (pathCost + dieTop newDieState,newDieState,move:moves)
      where previous
              | visited == (i, j-1) = zip [q i (j+1) (i,j),q (i-1) j (i,j)] ["L","U"]
              | visited == (i, j+1) = zip [q i (j-1) (i,j),q (i-1) j (i,j)] ["R","U"]
              | otherwise           = zip [q i (j-1) (i,j),q i (j+1) (i,j),q (i-1) j (i,j)] ["R","L","U"]
            ((pathCost,dieState,moves),move) = minimumBy (comparing (fst3 . fst)) previous
            newDieState = rollDie dieState move

main = putStrLn (show $ q endRow endColumn (endRow,endColumn))