Solve a maze in the form of a 2D array using BFS - Haskell

Question

Suggestions for improving coding style are greatly appreciated.

import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Vector as V
type Queue a = ([a], [a])
emptyQueue = ([], [])
pushListToAnother fromLst toLst = L.foldl' (\ys x -> (x:ys)) toLst fromLst
enqueue :: Queue a -> a -> Queue a
enqueue (inList, outList) x = ((x:inList), outList)
dequeue :: Queue a -> Maybe (a, Queue a)
dequeue (inList, outList) = case outList of
 (y:ys) -> Just (y, (inList, ys))
 [] -> if (null inList) then Nothing else dequeue ([], reverse inList)
massEnqueue :: Queue a -> [a] -> Queue a
massEnqueue (inList, outList) items = ((pushListToAnother items inList), outList)
-- consider moving the above Queue code into a separate module.
type Grid a = V.Vector (V.Vector a)
type Indices = (Int, Int)
access grid (x, y) = (grid V.! x) V.! y
massInsert :: Ord k => [(k, v)] -> M.Map k v -> M.Map k v
massInsert elems theMap = L.foldl' (\m (k, v) -> M.insert k v m) theMap elems
validAndTraversable :: (a -> Bool) -> Grid a -> Indices -> Bool
validAndTraversable traversability grid xy@(x, y) = let xbound = V.length grid in
 let ybound = V.length (V.head grid) in
 let withinBounds = (x >= 0) && (x < xbound) && (y >= 0) && (y < ybound) in
 withinBounds && (traversability (access grid xy))
getPath :: Ord a => M.Map a a -> a -> a -> [a]
getPath visitedFromMap start current = pathHelper visitedFromMap start current []
 where pathHelper prevIndicesMap start current path = let newPath = (current:path) in
 if current == start 
 then newPath
 else case (M.lookup current prevIndicesMap) of
 Nothing -> []
 Just e -> (pathHelper prevIndicesMap start e) $! newPath
mazeSolverLoop :: Indices -> (Indices -> a -> Bool) -> (a -> Bool) -> Grid a -> Queue Indices -> M.Map Indices Indices -> [Indices]
mazeSolverLoop start isFinish traversability mazeGrid queue visitedFromMap = let item = dequeue queue in
 case item of
 Nothing -> []
 Just (currentXY, rest) -> if isFinish currentXY (access mazeGrid currentXY) 
 then getPath visitedFromMap start currentXY
 else let (x, y) = currentXY in
 let potentialNeighbors = [(x+1, y), (x, y+1), (x-1, y), (x, y-1)] in
 let isVisitable = \xy -> (validAndTraversable traversability mazeGrid xy) && (M.notMember xy visitedFromMap) in
 let unvisitedNeighbors = filter isVisitable potentialNeighbors in
 let newVisitedFromMap = massInsert (map (\xy -> (xy, currentXY)) unvisitedNeighbors) visitedFromMap in
 let newQueue = massEnqueue rest unvisitedNeighbors in
 (mazeSolverLoop start isFinish traversability mazeGrid newQueue) $! newVisitedFromMap
-- the solving functions
findUnknownFinish :: Indices -> (Indices -> a -> Bool) -> (a -> Bool) -> Grid a -> [Indices]
findUnknownFinish start isFinish traversability grid = let validityPredicate = validAndTraversable traversability grid in
 if validityPredicate start
 then let m = M.singleton start start in
 let q = enqueue emptyQueue start in
 mazeSolverLoop start isFinish traversability grid q m
 else []
findKnownFinish :: Indices -> Indices -> (a -> Bool) -> Grid a -> [Indices]
findKnownFinish start finish traversability grid = let isFinish = (\xy _ -> xy == finish) in
 findUnknownFinish start isFinish traversability grid
escapeMaze :: Indices -> (a -> Bool) -> Grid a -> [Indices]
escapeMaze start traversability grid = let isOnBounds = \b x -> (x == 0) || (x == (b-1)) in 
 let xbound = V.length grid in
 let ybound = V.length (V.head grid) in
 let isFinish = \(x, y) _ -> (isOnBounds xbound x) || (isOnBounds ybound y) in
 findUnknownFinish start isFinish traversability grid
escapeMazeV2 :: Indices -> (a -> Bool) -> Grid a -> [Indices]
escapeMazeV2 start traversability grid = let isOnBounds = \b x -> (x == 0) || (x == (b-1)) in 
 let xbound = V.length grid in
 let ybound = V.length (V.head grid) in
 let isFinish = \(x, y) _ -> (isOnBounds xbound x) || (isOnBounds ybound y) in
 let acceptableFinish = \xy a -> (isFinish xy a) && (xy /= start) in
 findUnknownFinish start acceptableFinish traversability grid
maze1 = V.fromList [(V.fromList [1,1,1,1,1,1,0]), 
 (V.fromList [0,0,0,0,0,0,0]),
 (V.fromList [1,1,1,1,1,1,0]),
 (V.fromList [0,0,0,0,0,0,0]),
 (V.fromList [0,1,1,1,1,1,1]),
 (V.fromList [0,0,0,0,0,0,0]),
 (V.fromList [1,1,1,0,1,1,1]),
 (V.fromList [0,0,0,0,0,0,0]),
 (V.fromList [0,1,1,1,1,1,0])]
show_solve_maze1 = let solve_maze1 = findKnownFinish (1,0) (8,6) (\a -> a == 0) maze1 in
 mapM_ (putStrLn.show) solve_maze1
maze2 = V.fromList (map V.fromList ["xxxxxxxxxxxxxxxxxxxxx",
 "x x x",
 "xx xxxx xxxxxx xxx x",
 "x x x x xx x",
 "x xxxxx xxxxxxxx x x",
 "x x xx x",
 "xxxxxx xxxxx xxxx x",
 "x xxxx x x x",
 "x xx x x x x x x xxx",
 "x xx x x x x x x",
 "xx x x x xxx xxx xxx",
 "x xx x x",
 "xxxx x xxxxxx xxxx x",
 "x xx x x x x",
 "xxxxxx x x xxxxx xxx",
 "x xx x x x x",
 "xxx x xx xxx xxx x x",
 "x x x x x x",
 "x x xxxxxx xxxx xxx x",
 "x x ox",
 "x xxxxxxxxxxxxxxxxxxx"])
show_solve_maze2 = let solve_maze2 = findUnknownFinish (1,1) (\_ a -> a == 'o') (\a -> a /= 'x') maze2 in
 mapM_ (putStrLn.show) solve_maze2
show_solve_maze2v2 = let solve_maze2 = escapeMaze (1,1) (\a -> a /= 'x') maze2 in
 mapM_ (putStrLn.show) solve_maze2
maze3 = V.fromList (map V.fromList ["###########",
 "# #",
 "# ##### # #",
 " # # #",
 "### # ### #",
 "# # #",
 "# # ### ###",
 "# # # ",
 "# ### # # #",
 "# # #",
 "###########"])
show_solve_maze3_v1 = let solve_maze3_v1 = escapeMazeV2 (3,0) (\a -> a /= '#') maze3 in
 mapM_ (putStrLn.show) solve_maze3_v1
show_solve_maze3_v2 = let solve_maze3_v2 = escapeMazeV2 (7,10) (\a -> a /= '#') maze3 in
 mapM_ (putStrLn.show) solve_maze3_v2

Answer 1

Some general ideas:

• Always give types to top level functions. It improves readability of your code very much.
• Unless you really need to, it's better to use existing data structures than inventing your own. Instead of using Queue, you could as well use Data.Sequence.

• Some of the Queue functions can be simplified, often using first from Control.Arrow:

  pushListToAnother :: [a] -> [a] -> [a]
  pushListToAnother fromLst = (reverse fromLst ++)
  enqueue :: Queue a -> a -> Queue a
  enqueue q x = first (x :) q
  massEnqueue :: Queue a -> [a] -> Queue a
  massEnqueue q items = first (pushListToAnother items) q
  

• Strictly adhere to having some maximum number of columns (often people use 72, 78 or 80). Code that goes too far to the right is very much unreadable.

• Instead of let f = foo in let g = bar in boo use just let f = foo ; g = bar in boo. For example:

  validAndTraversable :: (a -> Bool) -> Grid a -> Indices -> Bool
  validAndTraversable traversability grid xy@(x, y) =
   let xbound = V.length grid
   ybound = V.length (V.head grid)
   withinBounds = (x >= 0) && (x < xbound) && (y >= 0) && (y < ybound)
   in withinBounds && (traversability (access grid xy))
  

• Prefer guards over if/then/else. Usually it leads to more concise code and it's more idiomatic. Pattern guards can be even more helpful.

  getPath :: Ord a => M.Map a a -> a -> a -> [a]
  getPath visitedFromMap start current =
   pathHelper visitedFromMap start current []
   where
   pathHelper prevIndicesMap start current path
   | current == start
   = newPath
   | Just e <- M.lookup current prevIndicesMap
   = (pathHelper prevIndicesMap start e) $! newPath
   | otherwise
   = []
   where newPath = (current:path)
  

• Avoid code repetition, for example multiple calls to the same function, if you can factor the call out:

  maze1 = V.fromList . map V.fromList $
   [ [1,1,1,1,1,1,0]
   , [0,0,0,0,0,0,0]
   , [1,1,1,1,1,1,0]
   , [0,0,0,0,0,0,0]
   , [0,1,1,1,1,1,1]
   , [0,0,0,0,0,0,0]
   , [1,1,1,0,1,1,1]
   , [0,0,0,0,0,0,0]
   , [0,1,1,1,1,1,0]
   ]
  

• Use hlint, it'll give you a lot of useful hints.

• dxuhuang: I will definitely check out Control.Arrow and Pattern Guards. (I only have a basic understanding of monads and have yet to learn about arrows.) Thanks!
• Petr: @dxh For using first you don't need to know anything about arrows. The point is that -> is also an instance of Arrow, and so if first is specialized to -> we get (b -> c) -> ((b, d) -> (c, d)). That is, it uses a function to act on the first part of a tuple.
• syb0rg: We've been looking for a Haskell guru to join our chat room for some time now, and it looks like you would be a good fit. :)