A * допустимая эвристика для прокатки штампа по сетке

Вот мой алгоритм, примененный к примеру пола с сеткой 300x300, начиная с (23,25) и заканчивая (282,199). Он находит минимальный путь и сумму (1515, что на 2 пункта меньше результата Павла 1517) за 0,52 секунды. Версия с таблицами поиска вместо вычисления небольших секций заняла 0,13 секунды.

Код Хаскелла:

import Data.List (minimumBy)
import Data.Ord (comparing)
import Control.Monad (guard)

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

--dieStartingOrientation = [4,3,1,6,2,5] --left,right,top,bottom,front,back

rows = 300
columns = 300

paths (startRow,startColumn) (endRow,endColumn) dieStartingOrientation = 
  solve (dieTop dieStartingOrientation,[]) [(startRow,startColumn)] dieStartingOrientation where
    leftBorder = max 0 (min startColumn endColumn)
    rightBorder = min columns (max startColumn endColumn)
    topBorder = endRow
    bottomBorder = startRow
    solve result@(cost,moves) ((i,j):pathTail) die =
      if (i,j) == (endRow,endColumn)
         then [(result,die)]
         else do
           ((i',j'),move) <- ((i+1,j),"U"):next
           guard (i' <= topBorder && i' >= bottomBorder && j' <= rightBorder && j' >= leftBorder)
           solve (cost + dieTop (rollDie die move),move:moves) ((i',j'):(i,j):pathTail) (rollDie die move) 
        where next | null pathTail            = [((i,j+1),"R"),((i,j-1),"L")]
                   | head pathTail == (i,j-1) = [((i,j+1),"R")]
                   | head pathTail == (i,j+1) = [((i,j-1),"L")]
                   | otherwise                = [((i,j+1),"R"),((i,j-1),"L")]

--300x300 grid starting at (23, 25) and ending at (282,199)

applicationNum = 
  let (r,c) = (282-22, 199-24)
      numRowReductions = floor (r/4) - 1
      numColumnReductions = floor (c/4) - 1
      minimalR = r - 4 * fromInteger numRowReductions
      minimalC = c - 4 * fromInteger numColumnReductions
  in (fst . fst . minimumBy (comparing fst) $ paths (1,1) (minimalR,minimalC) [4,3,1,6,2,5])
     + 14*numRowReductions + 14*numColumnReductions

applicationPath = [firstLeg] ++ secondLeg ++ thirdLeg
               ++ [((0,["R"]),[])] ++ [minimumBy (comparing fst) $ paths (1,1) (2,4) die2] 
    where
      (r,c) = (282-22, 199-24) --(260,175)
      numRowReductions = floor (r/4) - 1
      numColumnReductions = floor (c/4) - 1
      minimalR = r - 4 * fromInteger numRowReductions
      minimalC = c - 4 * fromInteger numColumnReductions
      firstLeg = minimumBy (comparing fst) $ paths (1,1) (minimalR,minimalC) [4,3,1,6,2,5]
      die0 = snd firstLeg
      secondLeg = tail . foldr mfs0 [((0,["R"]),die0)] $ [1..numColumnReductions - 1]
      die1 = snd . last $ secondLeg
      thirdLeg = tail . foldr mfs1  [((0,[]),die1)] $ [1..numRowReductions - 3 * div (numColumnReductions - 1) 4 - 1]
      die2 = rollDie (snd . last $ thirdLeg) "R"
      mfs0 a b = b ++ [((0,["R"]),[])] ++ [minimumBy (comparing fst) $ paths (1,1) (4,4) (rollDie (snd . last $ b) "R")]
      mfs1 a b = b ++ [((0,["U"]),[])] ++ [minimumBy (comparing fst) $ paths (1,1) (4,1) (rollDie (snd . last $ b) "U")]

Вывод:

*Main> applicationNum
1515

*Main> applicationPath
[((31,["R","R","R","R","U","U","R","U","R"]),[5,2,1,6,4,3])
,((0,["R"]),[]),((25,["R","R","R","U","U","U"]),[3,4,1,6,5,2])
,((0,["R"]),[]),((24,["R","U","R","R","U","U"]),[5,2,1,6,4,3])
................((17,["R","R","R","U"]),[5,2,1,6,4,3])]
(0.52 secs, 32093988 bytes)

Список букв " R " и "U":

*Main> let listRL = concatMap (\((a,b),c) -> b) applicationPath
*Main> listRL
["R","R","R","R","U","U","R","U","R","R","R","R","R","U","U","U","R","R","U","R"
..."U","R","R","R","R","U"]

Сумма пути с использованием начального умереть и список "R" и "U":

*Main> let sumPath path = foldr (\move (cost,die) -> (cost + dieTop (rollDie die move), rollDie die move)) (1,[4,3,1,6,2,5]) path
*Main> sumPath listRL
(1515,[5,2,1,6,4,3])

Вычисление (r,c) из (1,1) с использованием списка "R" и " U " (так как мы начинаем с (1,1,), (r,c) настраивается на (282-22, 199-24):

*Main> let rc path = foldr (\move (r,c) -> if move == "R" then (r,c+1) else (r+1,c)) (1,1) path
*Main> rc listRL 
(260,175)

Алгоритм / Решение

Continuing the research below, it seems that the minimal face-sum path (MFS) 
can be reduced, mod 4, by either rows or columns like so:

MFS (1,1) (r,c) == MFS (1,1) (r-4,c) + 14, for r > 7
                == MFS (1,1) (r,c-4) + 14, for c > 7

This makes finding the number for the minimal path straightforward:

MFS (1,1) (r,c) = 
  let numRowReductions = floor (r/4) - 1
      numColumnReductions = floor (c/4) - 1
      minimalR = r - 4 * numRowReductions
      minimalC = c - 4 * numColumnReductions
  in MFS (1,1) (minimalR,minimalC) + 14*numRowReductions + 14*numColumnReductions

minimalR and minimalC are always less than eight, which means we can easily
pre-calculate the minimal-face-sums for these and use that table to quickly
output the overall solution.

Но как мы найдем этот путь?
из моего тестирования, похоже, это работает аналогично:

MFS (1,1) (1,anything) = trivial
MFS (1,1) (anything,1) = trivial
MFS (1,1) (r,c), for r,c < 5 = calculate solution in your favorite way
MFS (1,1) (r,c), for either or both r,c > 4 = 
  MFS (1,1) (minimalR,minimalC) -> roll -> 
  MFS (1,1) (min 4 r-1, min 4 c-1) -> roll -> 
  ...sections must be arranged so the last one includes 
     four rotations for one axis and at least one for the other.
     keeping one row or column the same till the end seems to work.
     (For Paul's example above, after the initial MFS box, I moved in 
     fours along the x-axis, rolling 4x4 boxes to the right, which 
     means the y-axis advanced in threes and then a section in fours 
     going up, until the last box of 2x4. I suspect, but haven't checked, 
     that the sections must divide at least one axis only in fours for 
     this to work)...
  MFS (1,1) (either (if r > 4 then 4 else min 2 r, 4) 
             or     (4, if c > 4 then 4 else min 2 c))
  => (r,c) is now reached

Например,

  MFS (1,1) (5,13) = MFS (1,1) (1,5) -> roll right -> 
                     MFS (1,1) (1,4) -> roll right -> MFS (1,1) (5,4)

  MFS (1,1) (2,13) = MFS (1,1) (1,5) -> roll right -> 
                     MFS (1,1) (1,4) -> roll right -> MFS (1,1) (2,4)

свойства костей, наблюдаемые при эмпирическом тестировании

For target points farther than (1,1) to (2,3), for example (1,1) to (3,4)
or (1,1) to (4,6), the minimum path top-face-sum (MFS) is equal if you 
reverse the target (r,c). In other words: 

1. MFS (1,1) (r,c) == MFS (1,1) (c,r), for r,c > 2

Не только тот.

2. MFS (1,1) (r,c) == MFS (1,1) (r',c'), for r,c,r',c' > 2 and r + c == r' + c'
   e.g., MFS (1,1) (4,5) == MFS (1,1) (5,4) == MFS (1,1) (3,6) == MFS (1,1) (6,3)

Но вот что интересно:

The MFS for any target box (meaning from startPoint to endPoint) that
can be reduced to a symmetrical combination of (r,c) (r,c) or (r,c) (c,r), for 
r,c > 2, can be expressed as the sum of the MFS of the two smaller symmetrical 
parts, if the die-roll (the change in orientation) between the two parts is 
accounted for. In other words, if this is true, we can breakdown the calculation
into smaller parts, which is much much faster.

For example: 
 Target-box (1,1) to (7,6) can be expressed as: 
 (1,1) (4,3) -> roll right -> (1,1) (4,3) with a different starting orientation

 Check it, baby: 
 MFS  (1,1) (7,6) = MFS (1,1) (4,3) + MFS (1,1) (4,3) 
 (when accounting for the change in starting orientation, rolling right in 
 between)

 Eq. 2., implies that MFS (1,1) to (7,6) == MFS (1,1) (5,8)
 and MFS (1,1) (5,8) can be expressed as (1,1) (3,4) -> roll right -> (1,1) (3,4)

 Check it again: 
 MFS (1,1) (7,6) = MFS (1,1) (5,8) = MFS (1,1) (3,4) + MFS (1,1) (3,4)
 (when accounting for the change in starting orientation, rolling right in
 between)

Не только это.

The symmetrical parts can apparently be combined in any way:

3. MFS (1,1) (r,c) -> roll-right -> MFS (1,1) (r,c) equals
   MFS (1,1) (r,c) -> roll-right -> MFS (1,1) (c,r) equals
   MFS (1,1) (r,c) -> roll-up -> MFS (1,1) (r,c) equals
   MFS (1,1) (r,c) -> roll-up -> MFS (1,1) (c,r) equals
   MFS (1,1) (2*r-1, 2*c) equals
   MFS (1,1) (2*r, 2*c-1), for r,c > 2