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