Discussion on: Daily Challenge #107 - Escape the Mines

[Craig McIlwrath]

Here's my solution, in Haskell. It uses the A* path-finding algorithm using Manhattan/taxi-cab distance as the heuristic.

I don't think using a list is the best data-structure for holding the open and closed sets. It isn't great for searching for a minimum and removing elements from the middle. I might revisit this and look for a better solution, but for this challenge, it's fast enough.

There are also some things in my solution that I'm not entirely happy about. For one, getRequiredMove isn't a complete function but I didn't like my other ideas on how to put get the Move in the Tile, so I stuck with this.

import Data.List (delete, findIndex)
import Data.Maybe (isJust, fromJust, listToMaybe)

data Move = U | D | L | R deriving (Eq)

instance Show Move where
  show U = "up"
  show D = "down"
  show L = "left"
  show R = "right"

data Tile = Tile { getPos :: Pos, getF :: Int, getG :: Int, getH :: Int, getFrom :: Tile, getMove :: Move } deriving (Show)

instance Eq Tile where
  a == b = getPos a == getPos b

type Map = [[Bool]]
type Pos = (Int, Int)

getRequiredMove :: Pos -> Pos -> Move
getRequiredMove (x1, y1) (x2, y2)
  | x1 == x2     && y1 - 1 == y2 = U
  | x1 == x2     && y1 + 1 == y2 = D
  | x1 - 1 == x2 && y1 == y2     = L
  | x1 + 1 == x2 && y1 == y2     = R
  | otherwise                    = error "invalid move"

tile :: (Pos -> Int) -> Tile -> Pos -> Tile
tile h from pos = Tile { getPos = pos
                       , getG = g'
                       , getH = h'
                       , getF = g' + h'
                       , getFrom = from
                       , getMove = move
                       }
  where g' = getG from + 1
        h' = h pos
        move = getRequiredMove (getPos from) pos

executeMove :: Move -> Tile -> Pos
executeMove U (Tile (x, y) _ _ _ _ _) = (x    , y - 1)
executeMove D (Tile (x, y) _ _ _ _ _) = (x    , y + 1)
executeMove L (Tile (x, y) _ _ _ _ _) = (x - 1, y    )
executeMove R (Tile (x, y) _ _ _ _ _) = (x + 1, y    )

isInMap :: Map -> Pos -> Bool
isInMap m (x, y) = let r = length m
                       c = length $ head m
                   in  all id [ x >= 0, y >= 0, x < c, y < r ]

isNotBlocked :: Map -> Pos -> Bool
isNotBlocked m (x, y) = m !! y !! x

isValidPos :: Map -> Pos -> Bool
isValidPos m p = isInMap m p && isNotBlocked m p

getNeighbors :: Map -> (Pos -> Int) -> Tile -> [Tile]
getNeighbors m h t = map (tile h t) $
                     filter (isValidPos m) $
                     map (flip executeMove t) $
                     [U, D, L, R]

manhattanHueristic :: Pos -> Pos -> Int
manhattanHueristic (a, b) (c, d) = abs $ (a - c) + (b - d)

minimumBy :: (Ord b) => (a -> b) -> [a] -> a
minimumBy f = foldl1 (\m x -> if f x < f m then x else m)

inAny :: (Eq a) => [[a]] -> a -> Bool
inAny ass b = any id $ map (b`elem`) ass

findSmallest :: [Tile] -> Tile
findSmallest = minimumBy getF

backtrace :: Tile -> [Move]
backtrace t@(Tile _ _ _ _ f move) = if f == t then []
                                    else backtrace f ++ [move]

astar :: Map -> Pos -> (Pos -> Pos -> Int) -> [Tile] -> [Tile] -> Maybe [Move]
astar _ _ _ [] _ = Nothing
astar map end h open closed = let pivot = findSmallest open
                                  neighbors = filter (not . inAny [open, closed]) $ getNeighbors map (h end) pivot
                                  open' = neighbors ++ delete pivot open
                                  closed' = pivot : closed
                              in  if (getPos pivot) == end
                                    then Just $ backtrace pivot
                                    else astar map end h open' closed'

solve :: Map -> Pos -> Pos -> Maybe [Move]
solve map start end = astar map end manhattanHueristic [startTile] []
  where startTile = Tile { getPos = start
                         , getF = manhattanHueristic end start
                         , getG = 0
                         , getH = manhattanHueristic end start
                         , getFrom = startTile
                         , getMove = U
                         }