Память динамического программирования в 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))

Ответы

Ответ 1

Мой инструмент для этой проблемы - библиотека data-memocombinators.

Чтобы использовать его, просто импортируйте Data.MemoCombinators, переименуйте q в нечто другое, например q' (но оставите рекурсивные вызовы, как есть), и определите новый q следующим образом:

q = M.memo3 M.integral M.integral (M.pair M.integral M.integral) q'
  • memo3 создает memoizer для функции с тремя аргументами, учитывая memoizers для каждого аргумента.
  • integral - простой memoizer для интегральных типов.
  • pair объединяет два memoizers для создания memoizer для пар этих типов.
  • Наконец, мы применяем этот memoizer к q' для получения memoized версии.

И что это. Теперь ваша функция будет сохранена. Время проверки:

> :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 [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))