Mercurial > repos > other > SevenLanguagesInSevenWeeks
changeset 100:830140560f70
First successful attempt at maze parsing and solving
It struggles with large mazes (and ones with wide "paths")
but it can solve the smaller cases.
We skip in-route loops, but more optimisation is required to prune
more routes and to use more efficient/Haskell-y methods.
| author | IBBoard <dev@ibboard.co.uk> |
|---|---|
| date | Sat, 13 Jul 2019 21:09:59 +0100 |
| parents | 67631cb2ea48 |
| children | 1fae0cca1ef8 |
| files | 7-Haskell/day3-maze.hs 7-Haskell/day3-simple.maze 7-Haskell/day3.maze |
| diffstat | 3 files changed, 142 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/7-Haskell/day3-maze.hs Sat Jul 13 21:09:59 2019 +0100 @@ -0,0 +1,94 @@ +module Day3Maze where + import System.IO + + -- This is a "type" alias, because they're just naming pre-existing types with specific patterns + -- Note: Nested lists with indexes will be inefficient compared to Vectors, but I'm working with what I know! + type Maze = [[Node]] + type Coords = (Int, Int) + type Node = (Coords, [Direction]) + data Direction = North | South | East | West deriving (Show, Eq) + + -- Input map based on https://github.com/icefox/asciimaze/blob/master/sample-mazes/input1.txt + + -- Usage: + -- + -- my_maze <- parseMap "day3-simple.maze" + -- let exits = findExits my_maze + -- solveMaze my_maze exits + + -- Currently takes too long on bay3.maze because a) the paths are double-width and b) we don't discard routes that get to the same position by a different route + + parseMap :: String -> IO Maze + parseMap map_path = do + file_contents <- (readFile map_path) + let file_lines = lines file_contents + return (parseMap' file_lines) + + findExits :: Maze -> Maybe (Node, Node) + findExits maze = let exits = findExits' maze + in if (length exits) == 2 then Just (exits !! 0, exits !! 1) else Nothing + + solveMaze :: Maze -> Maybe (Node, Node) -> [Coords] + solveMaze maze (Just (start, end)) = findRoute maze (fst end) [[fst start]] + solveMaze maze _ = [] + + findRoute :: Maze -> Coords -> [[Coords]] -> [Coords] + findRoute maze exit routes + | routes == [] = [] -- No solution + | successful_routes /= [] = head successful_routes + | otherwise = findRoute maze exit (step maze routes) + where successful_routes = filter ((exit ==) . head) routes + + getNode' :: [[a]] -> Int -> Int -> a + getNode' two_d_array x y = (two_d_array !! y) !! x + + getNode :: [[a]] -> Coords -> a + getNode two_d_array (x, y) = getNode' two_d_array x y + + getRelativeNode :: Maze -> Coords -> Direction -> Node + getRelativeNode maze (x, y) direction = + case direction of + North -> getNode' maze x (y - 1) + South -> getNode' maze x (y + 1) + East -> getNode' maze (x + 1) y + West -> getNode' maze (x - 1) y + + parseMap' :: [String] -> Maze + parseMap' map_string = zipWith (makeRow map_string) [0..] map_string + + makeRow :: [String] -> Int -> String -> [Node] + makeRow map_string row_num cols = zipWith (makeNode map_string row_num) [0..] cols + + makeNode :: [String] -> Int -> Int -> Char -> Node + makeNode map_string row_num col_num node = if node /= ' ' then ((col_num, row_num), []) + else ((col_num, row_num), makeExitsList map_string row_num col_num) + + makeExitsList :: [String] -> Int -> Int -> [Direction] + -- FIXME: This can probably be done with a "map (isExit…) directions", with a modified isExit + makeExitsList map_string row_num col_num = map fst (filter snd (zip directions isExitDirections)) + where { + directions = [North, South, East, West] ; + isExitDirections = [isExit map_string col_num (row_num - 1), isExit map_string col_num (row_num + 1), isExit map_string (col_num + 1) row_num, isExit map_string (col_num - 1) row_num] + } + + isExit :: [String] -> Int -> Int -> Bool + isExit map_string x y + | y < 0 || x < 0 = False + | y >= length map_string || x >= length (map_string !! y) = False + | otherwise = (getNode' map_string x y) == ' ' + + findExits' :: Maze -> [Node] + -- Examine the outside by taking the first and last item from each row, and the first and last row) + -- This doubles up the corners, but we'll make an assumption that the corner is always filled in! + findExits' maze = let candidates = (map last maze) ++ (map head maze) ++ (head maze) ++ (last maze) + in filter (\node -> (snd node) /= []) candidates + + step :: Maze -> [[Coords]] -> [[Coords]] + step maze routes = filter (\(hd:lst) -> hd `notElem` lst) (concatMap (\route -> map (: route) (nextSteps maze route)) routes) + + nextSteps :: Maze -> [Coords] -> [Coords] + nextSteps maze route = map (fst . getRelativeNode maze pos) exits + where { + pos:prior_steps = route ; + exits = snd (getNode maze pos) + } \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/7-Haskell/day3-simple.maze Sat Jul 13 21:09:59 2019 +0100 @@ -0,0 +1,7 @@ +######## # +# # # +# #### # # +# # # +# #### ### +# # ### +# ######## \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/7-Haskell/day3.maze Sat Jul 13 21:09:59 2019 +0100 @@ -0,0 +1,41 @@ +############################# # +# # # # # +# #### # ######### ### # +# # # # # # +# #### ######### ### # # +# # # # # # # +# #### # # ############# # +# # +# ############### ### # +# # # # # # # +#### ###### #### # #### +# # # # # # # # +### ### # # # #### # +# # # # # +# ###### ### # ### # +# # # # # # # +#### ### # ### # ####### +# # # # # # # +# # # ###### ###### # +# # # # # # # +# ####### # ###### # # +# # # # # # +#### # ###### ### ####### +# # # # # # # # +# # # ####### # ###### # +# # # # +### #### ### ########## +# # # # # +# #### ### #### #### +# # # # # # # +# #### ################## # +# # # # # +####### # #### ####### +# # # # # # +# ######### # # #### +# # # # # # +######### # #### ### #### +# # # # # +# ### # ### # # + # # # # # # # +############################### \ No newline at end of file