

 This page uses content from Wikipedia. The original article was at Maze generation algorithm. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)




Task

Generate and show a maze, using the simple Depth-first search algorithm.

Start at a random cell.
Mark the current cell as visited, and get a list of its neighbors. For each neighbor, starting with a randomly selected neighbor:
If that neighbor hasn't been visited, remove the wall between this cell and that neighbor, and then recurse with that neighbor as the current cell.


 Related tasks
 Maze solving.


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
 
import Data.Array.ST
       (STArray, freeze, newArray, readArray, writeArray)
import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)
import System.Random (Random(..), getStdGen, StdGen)
import Control.Monad (forM_, unless)
import Control.Monad.ST (ST, stToIO)
import Data.Array (Array, (!), bounds)
import Data.Bool (bool)
 
rand
  :: Random a
  => (a, a) -> STRef s StdGen -> ST s a
rand range gen = do
  (a, g) <- randomR range <$> readSTRef gen
  gen `writeSTRef` g
  return a
 
data Maze = Maze
  { rightWalls, belowWalls :: Array (Int, Int) Bool
  }
 
maze :: Int -> Int -> StdGen -> ST s Maze
maze width height gen = do
  visited <- mazeArray False
  rWalls <- mazeArray True
  bWalls <- mazeArray True
  gen <- newSTRef gen
  (,) <$> rand (0, maxX) gen <*> rand (0, maxY) gen >>=
    visit gen visited rWalls bWalls
  Maze <$> freeze rWalls <*> freeze bWalls
  where
    visit gen visited rWalls bWalls here = do
      writeArray visited here True
      let ns = neighbors here
      i <- rand (0, length ns - 1) gen
      forM_ (ns !! i : take i ns ++ drop (i + 1) ns) $
        \there -> do
          seen <- readArray visited there
          unless seen $
            do removeWall here there
               visit gen visited rWalls bWalls there
      where
        removeWall (x1, y1) (x2, y2) =
          writeArray (bool rWalls bWalls (x1 == x2)) (min x1 x2, min y1 y2) False
    neighbors (x, y) =
      bool [(x - 1, y)] [] (0 == x) ++
      bool [(x + 1, y)] [] (maxX == x) ++
      bool [(x, y - 1)] [] (0 == y) ++ bool [(x, y + 1)] [] (maxY == y)
    maxX = width - 1
    maxY = height - 1
    mazeArray =
      newArray ((0, 0), (maxX, maxY)) :: Bool -> ST s (STArray s (Int, Int) Bool)
 
printMaze :: Maze -> IO ()
printMaze (Maze rWalls bWalls) = do
  putStrLn $ '+' : concat (replicate (maxX + 1) "---+")
  forM_ [0 .. maxY] $
    \y -> do
      putStr "|"
      forM_ [0 .. maxX] $
        \x -> do
          putStr "   "
          putStr $ bool " " "|" (rWalls ! (x, y))
      putStrLn ""
      forM_ [0 .. maxX] $
        \x -> do
          putStr "+"
          putStr $ bool "   " "---" (bWalls ! (x, y))
      putStrLn "+"
  where
    maxX = fst (snd $ bounds rWalls)
    maxY = snd (snd $ bounds rWalls)
 
main :: IO ()
main = getStdGen >>= stToIO . maze 11 8 >>= printMaze