Finding the longest path in a maze

Well, I asked for it… my last post on building mazes in Haskell led to the follow-on question: how do you pick a starting and ending point for the maze?

Defining the Question

There’s not an obvious answer, because we need a set of criteria for choosing starting and ending points.  Depending on the application, the following might all be requirements:

• Perhaps the starting and ending points need to be at the edges of the maze (e.g., for printed mazes in children’s game books).  Perhaps they need to be on opposite sides of the maze (e.g., for hedge mazes protecting a wizard’s castle).  Or perhaps they can be anywhere at all (e.g., locations of staircases for a rogue-like game).
• Are we looking to build a path with the longest total length?  With the most turns?  With the most choices?

I’ll answer the question as follows:

Suppose that an entrance and an exit can be placed anywhere.  How can you find the entrance and exit points that lead to the longest path through the maze?

Turning the Maze Into a Graph

My representation for mazes in the previous installment wasn’t ideal for this task.  I chose to consider a maze to be a list of walls: nice for drawing it, but less nice for deciding whether there’s a wall between two adjacent cells.  So the first task will be to convert the list of walls into an adjacency list representation of a graph.  For efficiency’s sake, I’ll go via a Set data structure, which I’ve imported qualified with the prefix ‘S’.

mazeExits :: Int -> Int -> [Wall] -> Array Cell [Cell]
mazeExits w h walls = array rng [ (c, exits c) | c <- range rng ]
  where
    rng         = ((0,0), (w-1,h-1))
    wallSet     = S.fromList walls
    exits (x,y) = [ (x-1,y) | x > 0, not (V (x-1,y) `S.member` wallSet) ]
               ++ [ (x+1,y) | x < w-1, not (V (x,y) `S.member` wallSet) ]
               ++ [ (x,y-1) | y > 0, not (H (x,y-1) `S.member` wallSet) ]
               ++ [ (x,y+1) | y < h-1, not (H (x,y) `S.member` wallSet) ]

I also derived an Ord instance for Wall, so it can fit in the Set.  The list comprehensions are a little unusual there, having no binding operations… but it certainly looks nicer than the alternative with if statements!

Doing the Search

Now we need a search algorithm to find the longest path in the graph.  Note that the graph is a tree, which helps a lot, since we don’t need to worry about cycles, and any node can be chosen as a root.  Depth first search works here, but the details are a bit tricky.  The longest path in a subtree rooted at c is one of the following two things:

1. The longest subpath in one of its subtrees, or
2. The concatenation of the longest two paths from c to a leaf of two distinct subtrees.

At each step of the depth first search, we want to find two things: the longest paths to leaves in each of the subtrees, and the longest paths contained entirely within each of the subtrees.  We can then consider all of the possibilities, and calculate the same two for the larger tree.  The result looks like this:

longestPath :: Array Cell [Cell] -> [Cell]
longestPath exits = fst (go (0,0) (0,0))
  where
    -- First result of go is the longest path entirely within the subtree.
    -- Second result of go is the longest path from the root to a leaf.
    go :: Cell -> Cell -> ([Cell], [Cell])
    go p c = let results    = map (go c) [ c' | c' <- exits ! c, c' /= p ]
                 rootPaths  = map snd results ++ [ [], [] ]
                 sorted     = sortBy (compare `on` (negate . length)) rootPaths
                 localSub   = let (a:b:_) = sorted in reverse a ++ [c] ++ b
                 allSubs    = localSub : map fst results
                 longestSub = maximumBy (compare `on` length) allSubs
             in  (longestSub, c : head sorted)

I’ve arbitrarily chosen (0,0) as my starting point, and then implemented the DFS algorithm described earlier.  This gives us, as desired, the longest path between any points in the map.

Drawing the Path

The drawing code is straightforward.  After the obvious plumbing to get the path to rendering code, we modify drawMaze to add this to the end.

    setSourceRGB 1 0 0
    moveTo (15 + 10 * fromIntegral x0) (15 + 10 * fromIntegral y0)
    forM_ path $ \(x,y) -> do
        lineTo (15 + 10 * fromIntegral x) (15 + 10 * fromIntegral y)
    stroke

Looking at the Result

Here are some mazes with the longest paths marked.