Haskell的動態編程備忘錄

Question

這是我第一次嘗試使用（我所理解的）動態編程。我試圖解決這個有趣的問題：A* Admissible Heuristic for die rolling on grid

的q函數試圖向後遞歸，保持壓模的定向的軌道（visited在技術上是下一個單元格，但在遞歸的條款，以防止「訪問」無限的來回循環）。儘管我不確定它提供的答案是否是最好的解決方案，但它似乎確實提供了答案。

我希望有關如何實現某種記憶化的加快它的想法 - 我沒能成功實現與lookup代替!!像memoized_fib（看到here），映射到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)) 

Answer 1

我去到工具，這種問題是data-memocombinators庫。

要使用它，只需導入Data.MemoCombinators，重命名q到別的這樣的東西作爲q'（但保留遞歸調用，因爲它們是），並定義一個新q這樣的：

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

• memo3爲每個參數提供memoizer，爲三個參數函數創建一個memoizer。
• 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))