Maze Jam example from Lambda Jam 2013, Chicago, in Clojure

mazejam.clj

;; Maze Jam from Lambda Jam 2013, Chicago
;;
;; by Stuart Sierra, http://stuartsierra.com/
;;
;; There are probably bugs in this code.
;;
;; Copyright (c) 2013 Stuart Sierra
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; * Redistributions of source code must retain the above copyright
;;   notice, this list of conditions and the following disclaimer.
;;
;; * Redistributions in binary form must reproduce the above copyright
;;   notice, this list of conditions and the following disclaimer in
;;   the documentation and/or other materials provided with the
;;   distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
;; OF THE POSSIBILITY OF SUCH DAMAGE.

(ns mazejam
  (:require [clojure.set :refer (union)]
            ;; Needs Leiningen dependency [org.clojure/data.json "0.2.2"]
            [clojure.data.json :refer (pprint-json)]))

(def directions
  "Bits representating of the cardinal directions."
  {:north 1
   :south 2
   :east  4
   :west  8})

(def new-cell
  "A new cell, closed in all directions."
  0)

(defn new-maze
  "Returns a new maze in which all cells are closed."
  [rows cols]
  (vec (repeat rows (vec (repeat cols new-cell)))))

(defn neighbors
  "Given a cell position x,y in a maze of dimensions rows*cols, returns
  a sequence of that cell's neighbors as [x y] coordinate pairs."
  [[x y] [rows cols]]
  (filter (fn [[nx ny]]
            (and (< -1 nx rows)
                 (< -1 ny cols)))
          (for [[i j] [[0 1] [0 -1] [1 0] [-1 0]]]
            [(+ x i) (+ y j)])))

(defn add-passage
  "Returns a modified cell with a new opened passage. direction is one
  of :north, :south, :east, or :west."
  [cell direction]
  (bit-or cell (directions direction)))

(defn wall-between
  "Given two cell coordinates x1,y1 and x2,y2 returns the cardinal
  direction moving from cell 1 to cell 2."
  [[x1 y1] [x2 y2]]
  (condp = [(- x2 x1) (- y2 y1)]
    [0 1]  :east
    [0 -1] :west
    [1 0]  :south
    [-1 0] :north))

(def inverse
  "Returns the inverse of the given direction. E.g. :north returns
  :south."
  {:north :south
   :south :north
   :east :west
   :west :east})

(defn cut
  "Updates maze by adding a passage between the two cells at x1,y1 and
  x2,y2."
  [maze [x1 y1] [x2 y2]]
  (let [direction (wall-between [x1 y1] [x2 y2])]
    (-> maze
        (update-in [x1 y1] add-passage direction)
        (update-in [x2 y2] add-passage (inverse direction)))))

(defn dimens
  "Returns the dimensions of a maze as a pair of [rows cols]"
  [maze]
  [(count maze)
   (count (first maze))])

(defn carve
  "Retursively builds a maze by carving passages between cells. Chooses
  randomly which cell to carve next."
  ([maze]
     (let [first-cell
           (rand-nth (let [[rows cols] (dimens maze)]
                       (for [i (range rows) j (range cols)] [i j])))]
       (carve maze
              #{first-cell}
              #{})))
  ([maze carved visited]
     {:pre [(set? carved)]}
     (if (empty? carved)
       maze
       (let [cell (rand-nth (vec carved))
             nbrs (remove (union carved visited)
                          (neighbors cell (dimens maze)))]
         (if (empty? nbrs)
           (recur maze (disj carved cell) (conj visited cell))
           (let [nbr (rand-nth nbrs)]
             (recur (cut maze cell nbr)
                    (conj carved nbr)
                    (conj visited cell))))))))

(defn build-maze
  "Builds a maze of rows*cols size and prints a JSON representation of
  it, for pasting into http://mazesjam.apphb.com/index.html"
  [rows cols]
  (pprint-json (carve (new-maze rows cols))))