Simple maze generation in F#

Here’s an F# implementation of the depth-first search maze generation algorithm:

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Media
open System.Windows.Shapes
open System.Windows.Threading

let width, height = 40, 20
let random = Random()

let tiles = Array.init height (fun _ -> Array.zeroCreate<bool> width)

type Tree =
    | Leaf of int * int
    | Node of int * int * Tree list

let rec buildMaze (x, y) =
    let shuffleArray array =
        let n = Array.length array
        for x = 1 to n do
            let i = n - x
            let j = random.Next(i)
            let tmp = array.[i]
            array.[i] <- array.[j]
            array.[j] <- tmp

    let neighbors = 
        [| x - 1, y; 
           x + 1, y; 
           x, y - 1; 
           x, y + 1 |]
        |> shuffleArray
        |> Array.filter(fun (x, y) -> x >= 0 && x < width && 
                                      y >= 0 && y < height)
    let visited = [ for x, y in neighbors do
                        if not tiles.[y].[x] then
                            tiles.[y].[x] <- true
                            yield buildMaze (x, y) ]
    if List.length visited > 0 then 
        Node(x, y, visited) 
        Leaf(x, y)

let maze = buildMaze (0, 0)

let window = Window()
window.Title <- "Maze generation"
let grid = Grid()
grid.Background <- SolidColorBrush(Colors.Black)
window.Content <- grid

for i = 0 to width * 2  do
    let column = ColumnDefinition()
    column.Width <- GridLength(9.6, GridUnitType.Pixel)
for i = 0 to height * 2 do
    let row = RowDefinition()
    row.Height <- GridLength(9.6, GridUnitType.Pixel)

let rec drawMaze prevx prevy node =
    let addTile (x, y) =
        let tile = Rectangle()
        tile.Width <- 9.6
        tile.Height <- 9.6
        tile.Fill <- SolidColorBrush(Colors.White)
        grid.Children.Add(tile) |> ignore
        Grid.SetColumn(tile, x)
        Grid.SetRow(tile, y)

    let colorGrid x y =
        let finalX, finalY = x * 2, y * 2
        let interX = finalX + prevx - x
        let interY = finalY + prevy - y
        addTile (finalX, finalY)
        if (interX <> finalX || interY <> finalY) then
            addTile (interX, interY)

    match node with
    | Node(x, y, children) ->
        colorGrid x y
        List.iter (drawMaze x y) children
    | Leaf(x, y) -> 
        colorGrid x y

drawMaze 0 0 maze

    let app = Application()
    app.Run(window) |> ignore

Less than 100 lines of code for a working WPF application with no XAML and some non-trivial logic is pretty sweet! F# has become my default language for coding on .NET, it’s a way more simple, concise and cohesive language than C#, that leads to better code with less potential for error.

This implementation is subject to StackOverflowExceptions with larger mazes. While implementing continuation-passing style manually to make the buildMaze function tail-recursive should be feasible, it’s not the kind of thing I actually like to do; I find it very hard to think in those terms. At this point I’m not sure how to avoid potential stack overflows without falling back to an iterative rather than recursive implementation; perhaps one of the functions in the List or Seq modules might do the trick?

Drawing the maze is a bit tricky: I use a grid with twice the size of the actual graph so that there are black gaps between paths, otherwise the drawing would be entirely white. I just need to keep track of which square is connected to which to add the proper intermediary squares (see colorGrid function).

Like any WPF application, this code requires WindowsBase.dll, PresentationCore.dll, PresentationFramework.dll and System.Xaml.dll to build.


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s