ハスケルでの動的プログラミングメモ帳

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ライブラリです。

単純なq'として何か他のものにあなたのqの名前を変更する（ただし、彼らがそうであるように再帰呼び出しを残す）、Data.MemoCombinatorsをインポートして、このような新しいqを定義し、それを使用するには：

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

• memo3 3つの引数関数のmemoizerを引数ごとに与えます。
• integralは、整数型の簡単なメモ帳です。
• pairは、2つのメモ帳を組み合わせて、これらの種類のペアのメモ帳を作成します。
• 最後に、memoizedバージョンを取得するために、このmemoizerを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))