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

Question

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

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

Я надеюсь, что идеи о том, как реализовать какое-то запоминание, чтобы ускорить его - я безуспешно пытался реализовать что-то вроде memoized_fib (видело here) с lookup вместо !!, отображения 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 для функции трех аргументов, учитывая memoizers для каждого аргумента.
• integral - простой меморандум для интегральных типов.
• pair сочетает в себе два меморандума для создания 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 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))