Mazes in Haskell, My Version

Earlier today, I read this article by Mihai Maruseac about generating mazes in Haskell.  It’s very interesting, but it turns out I’m a maze generation algorithm bigot.  As far as I’m concerned, there’s only one right way to generate mazes, and it’s this:

1. Construct the maze with all possible walls (so each cell is isolated).
2. Pick a random wall such that there’s no way to get from one side to the other.
3. Tear down that wall.
4. Repeat until the entire maze is navigable.

Sadly, this isn’t how Mihai decided to do it, so I was forced (forced, I tell you!) to spend some time writing my own maze generator.

Equivalence Relations

It turns out that the tricky step here is #2: how can you efficiently tell whether there’s a way to get from one side of a wall to the other.  A maze solver would do it, of course, but solving the maze once per wall isn’t the most scalable answer out there.  Instead, you want to keep track of the separate “rooms” in your maze as you go.

An efficient data structure for this task, called “union find”, has been known to the imperative world for decades: Tarjan showed back in the 70s that it runs in time that’s very nearly linear (with some additional factor that grows like the inverse of the Ackerman function… that is, ludicrously slowly).  Sadly, this seems to be one of those data structures that’s confined to the imperative world.  There’s not an obvious translation into the functional world.  I could just use an imperative implementation, in IO or ST… but that would be too easy.  Instead, I decided to find an implementation of an externally-pure, internally-stateful version of that algorithm.  I failed to find one, so I wrote one instead.  Here it is: persistent-equivalence.

I based the general technique off of one by Conchon and Filliatre.  They used a persistent array under the hood, and threw in a bit of unsafe mutation to implement path compression.  Well, the path compression bit is easy: it’s just an atomicModifyIORef.  It’s perfectly safe, since no exposed function can ever give a different result depending on whether it’s been modified or not.  In fact, I’m not even certain it needs to atomic, but I’ve played it safe for now.  The second major change made by Conchon and Filliatre is sadly less safe: they arranged to make changes to the persistent array (naively a DiffArray) to “reroot” it when old versions are accessed.  However, their code for doing this is clearly a minefield in the presence of multithreading… I was up for tackling the task, until I realized that STM is forbidden inside unsafePerformIO, and the interactions between various locks are mind-boggling…

Rather than enter the depths of thread-safety hell, or else potentially expose an API that claims it’s safe but really isn’t, I instead gave up.  DiffArray is good enough for us anyway, since we won’t be doing any backtracking.

Just as a side comment, this structure is a widely known example of an imperative structure that’s hard to translate into the functional world… but when you *do* translate at least its public interface, the result is rather beautiful.  I’ve never seen a specification of “union find” that I’d consider particularly enlightening… but when it’s converted to a functional interface, it’s immediately clear what you’re dealing with: equivalence relations.  Instead of talking about some operation names that were made up for this specific purpose, we’re looking at a very simple idea from mathematics.  The imperative viewpoint, though, obscured this by encouraging you to only speak in terms of the operations, and avoid ever talking about a specific equivalence relation you’ve got.  I’m much happier with the functional interface.

Generating the Maze

Now that I’ve got an implementation of equivalence relations, I’m well on my way to having a maze.  I declare a few data types for cells and walls:

-- Vertical walls are to the right of their cell (so the x component
-- must be less than width - 1), and horizontal walls are to the top
-- of their cell (so the y component must be less than height - 1).

type Cell = (Int, Int)
data Wall = H Cell | V Cell deriving (Eq, Show)

And I write the code to generate a maze, which works out in a nice recursive style.

process rooms []     = []
process rooms (H (x,y) : ws)
    | equiv rooms (x,y) (x,y+1) = H (x,y) : process rooms ws
    | otherwise                 = process (equate (x,y) (x,y+1) rooms) ws
process rooms (V (x,y) : ws)
    | equiv rooms (x,y) (x+1,y) = V (x,y) : process rooms ws
    | otherwise                 = process (equate (x,y) (x+1,y) rooms) ws

genMaze :: RandomGen gen => Int -> Int -> gen -> [Wall]
genMaze w h gen = finalWalls
  where allWalls = [ H (x,y) | x <- [0 .. w-1], y <- [0 .. h-2] ]
                ++ [ V (x,y) | x <- [0 .. w-2], y <- [0 .. h-1] ]
        startRooms = emptyEquivalence ((0,0), (w-1, h-1))
        startWalls = shuffle' allWalls (length allWalls) gen
        finalWalls = process startRooms startWalls

To generate a maze, you make a list of all the walls in the chosen size, shuffle them (using the random-shuffle package from Hackage), build an initial empty equivalence relation between cells (that is, each cell is its own separate room), and start considering the walls one by one in the random order chosen.  For each wall, if its two sides are already connected (the cells are in the same equivalence class), you keep the wall.  Else, you knock it down, and proceed with a new equivalence relation considering those cells connected now.  This is exactly the algorithm given at the start.

Showing the Result

I turned to Gtk2Hs for a quick GUI displaying the resulting maze.  The code is not terribly interesting, so I’ll just drop it in for the sake of completeness.

First, we have Cairo code for drawing the maze (for the sake of simplicity, I’ve hard-coded each cell to 30×30 pixels):

drawMaze :: Int -> Int -> [Wall] -> Render ()
drawMaze w h walls = do
    rectangle 10 10 (30 * fromIntegral w) (30 * fromIntegral h)
    forM_ walls $ \wall -> case wall of
        H (x,y) -> do
            moveTo (10 + 30 * fromIntegral x) (40 + 30 * fromIntegral y)
            lineTo (40 + 30 * fromIntegral x) (40 + 30 * fromIntegral y)
        V (x,y) -> do
            moveTo (40 + 30 * fromIntegral x) (10 + 30 * fromIntegral y)
            lineTo (40 + 30 * fromIntegral x) (40 + 30 * fromIntegral y)
    stroke

Next we’ll build a window to display it:

displayMaze :: Int -> Int -> [Wall] -> IO ()
displayMaze w h walls = do
    initGUI
    wnd <- windowNew
    wnd `on` deleteEvent $ liftIO mainQuit >> return False
    set wnd [
        windowDefaultWidth  := 20 + 30 * w,
        windowDefaultHeight := 20 + 30 * h ]

    da <- drawingAreaNew
    containerAdd wnd da
    da `on` exposeEvent $ do
        dw <- eventWindow
        liftIO $ renderWithDrawable dw (drawMaze w h walls)
        return False

    widgetShowAll wnd
    mainGUI

Finally, we pull that all together…

main = do
    [read -> w, read -> h] <- getArgs
    gen <- newStdGen
    displayMaze w h (genMaze w h gen)

There you are, mazes in Haskell, my way!

Examples

Just for the fun of it, I present a couple mazes: