在Haskell动态规划的memoization [英] Dynamic Programming Memoization in Haskell
问题描述
这是我在用(我的理解是)动态规划的第一次尝试。我试图解决这个有趣的问题: A *容许启发式的模滚动网格
在①
函数试图递归倒退,跟踪(参观了模具的方向
是技术上的下一个单元,但在递归prevent无限来回循环)的术语访问的。虽然我不知道,如果它提供的答案是最好的解决方案,它似乎提供了一个答案,不过。
我希望有关如何实现某种记忆化来加快它的想法 - 我没能成功地实施类似 memoized_fib
(见过的here )与查找
而不是 !!
,映射①
的列表(I,J)
但得到没有
,没有双关语意。
哈斯克尔code:
导入Data.List模块(minimumBy)
进口Data.Ord(比较)
fst3(A,B,C)=一
rollDie死@ [左,右,上,下,前,后]招
|移动==U= [左,右,前,后,底部,顶部]
|移动==D= [左,右,后面,前面,顶部,底部]
|移动==L= [上,下,左,右,前,后]
|移动==R= [底,顶,左,右,前,后]
dieTop死亡=死亡!! 2
leftBorder =最大值0(分STARTCOLUMN ENDCOLUMN - 1)
rightBorder =最小列(最大STARTCOLUMN ENDCOLUMN + 1)的
topBorder = endRow
bottomBorder = STARTROW
无穷大= 6 *行*列
行= 10
列= 10
STARTROW = 1
STARTCOLUMN = 1
endRow = 6
ENDCOLUMN = 6
dieStartingOrientation = [4,3,1,6,2,5] --left,右,上,下,前,后
问:我Ĵ参观
| I< bottomBorder || I> topBorder
|| J< leftBorder || J> rightBorder =(无穷大,[1..6],[])
|我== STARTROW&功放;&安培; Ĵ== STARTCOLUMN =(dieTop dieStartingOrientation,dieStartingOrientation,[])
|否则=(路径开销+ dieTop newDieState,newDieState,移动:移动)
其中,previous
|访问了==(I,J-1)=拉链[齐第(j + 1)(I,J),Q(I-1)Ĵ(I,J)] [L,U]
|参观==(I,J + 1)=拉链[齐(J-1)(I,J),Q(I-1)J(下I,J)] [R,U]
|否则=拉链[齐(J-1)(I,J),气(J + 1)(I,J),Q(I-1)J(下I,J)] [R,L, U]
((路径开销,dieState,移动),移动)= minimumBy(比较(fst3。FST))previous
newDieState = rollDie dieState招
主要= putStrLn(秀$ Q endRow ENDCOLUMN(endRow,ENDCOLUMN))
我去到的工具,这种问题是的数据memocombinators 库。
要使用它,只需导入 Data.MemoCombinators
,重命名①
别的东西,如 Q'
(但保留递归调用,因为它们是),并定义一个新的①
是这样的:
Q = M.memo3 M.integral M.integral(M.pair M.integral M.integral)Q'
-
memo3
使memoizer了三个参数的功能,给memoizers每个参数。 -
积分
是一个简单的memoizer为整型。 -
对
结合了两种memoizers做出memoizer用于对这些类型的。 - 最后,我们将此memoizer为
Q'
来获得memoized版本。
就是这样。您的功能现在memoized。时间来测试它:
> :集+ 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秒,516984字节)
低于满code:
导入Data.List模块(minimumBy)
进口Data.Ord(比较)
进口资质Data.MemoCombinators为M
fst3(A,B,C)=一
rollDie死@ [左,右,上,下,前,后]招
|移动==U= [左,右,前,后,底部,顶部]
|移动==D= [左,右,后面,前面,顶部,底部]
|移动==L= [上,下,左,右,前,后]
|移动==R= [底,顶,左,右,前,后]
dieTop死亡=死亡!! 2
leftBorder =最大值0(分STARTCOLUMN ENDCOLUMN - 1)
rightBorder =最小列(最大STARTCOLUMN ENDCOLUMN + 1)的
topBorder = endRow
bottomBorder = STARTROW
无穷大= 6 *行*列
行= 10
列= 10
STARTROW = 1
STARTCOLUMN = 1
endRow = 6
ENDCOLUMN = 6
dieStartingOrientation = [4,3,1,6,2,5] --left,右,上,下,前,后
Q = M.memo3 M.integral M.integral(M.pair M.integral M.integral)Q'
哪里
Q'I J参观
| I< bottomBorder || I> topBorder || J< leftBorder || J> rightBorder =(无穷大,[1..6],[])
|我== STARTROW&功放;&安培; Ĵ== STARTCOLUMN =(dieTop dieStartingOrientation,dieStartingOrientation,[])
|否则=(路径开销+ dieTop newDieState,newDieState,移动:移动)
其中,previous
|访问了==(I,J-1)=拉链[齐第(j + 1)(I,J),Q(I-1)Ĵ(I,J)] [L,U]
|参观==(I,J + 1)=拉链[齐(J-1)(I,J),Q(I-1)J(下I,J)] [R,U]
|否则=拉链[齐(J-1)(I,J),气(J + 1)(I,J),Q(I-1)J(下I,J)] [R,L, U]
((路径开销,dieState,移动),移动)= minimumBy(比较(fst3。FST))previous
newDieState = rollDie dieState招
主要= putStrLn(秀$ Q endRow ENDCOLUMN(endRow,ENDCOLUMN))
This is my first attempt at using (what I understand to be) dynamic programming. I'm trying to tackle this interesting problem: A* Admissible Heuristic for die rolling on grid
The q
function attempts to recurse backwards, keeping track of the orientation of the die (visited
is technically the next cell, but "visited" in terms of the recursion to prevent infinite back and forth loops). Although I'm not sure if the answer it provides is the best solution, it does seem to provide an answer, nonetheless.
I'm hoping for ideas about how to implement some kind of memoization to speed it up -- I tried unsuccessfully to implement something like memoized_fib
(seen here) with lookup
instead of !!
, mapping q
to a list of combinations of (i,j)
but got Nothing
, no pun intended.
Haskell code:
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))
My go-to tool for this kind of problem is the data-memocombinators library.
To use it, simply import Data.MemoCombinators
, rename your q
to something else such as q'
(but leave the recursive calls as they are), and define a new q
like this:
q = M.memo3 M.integral M.integral (M.pair M.integral M.integral) q'
memo3
makes a memoizer for a three argument function, given memoizers for each argument.integral
is a simple memoizer for integral types.pair
combines two memoizers to make a memoizer for pairs of those types.- Finally, we apply this memoizer to
q'
to obtain a memoized version.
And that's it. Your function is now memoized. Time to test it:
> :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)
Full code below:
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))
这篇关于在Haskell动态规划的memoization的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!