Память динамического программирования в Haskell

Это моя первая попытка использовать (то, что я понимаю) динамическое программирование. Я пытаюсь решить эту интересную проблему: A * Допустимая эвристика для прокатки по сетке

Функция q пытается вернуться назад, отслеживая ориентацию штампа (visited технически следующая ячейка, но "посещенная" с точки зрения рекурсии для предотвращения бесконечных циклов "назад и назад" ). Хотя я не уверен, что ответ, который он предоставляет, является лучшим решением, тем не менее, он, похоже, дает ответ.

Я надеюсь на идеи о том, как реализовать какую-то мемуатацию, чтобы ускорить ее - я безуспешно пытался реализовать что-то вроде memoized_fib (см. здесь) с lookup вместо !!, отображая q в список комбинаций (i,j), но получив Nothing, каламбур не предназначен.

Код Haskell:

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

fst3 (a,b,c) = a

rollDie [email protected][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))

import Data.List (minimumBy) import Data.Ord (comparing) import qualified Data.MemoCombinators as M fst3 (a,b,c) = a rollDie [email protected][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))

Ответ 1