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.