├── img ├── 3d-maze.png ├── bore-maze.png ├── delta-maze.png ├── eller-maze.png ├── inset-maze.png ├── polar-maze.png ├── prim-maze.png ├── sigma-maze.png ├── tick-maze.png ├── weave-maze.png ├── wrap-maze.png ├── braided-maze.png ├── culled-maze.png ├── kruskal-maze.png ├── masked-maze.png ├── sample-maze.png ├── wilsons-maze.png ├── division-maze.png ├── sidewinder-maze.png ├── triforce-maze.png ├── backtracker-maze.png ├── binary-tree-maze.png ├── growing-prim-maze.png ├── aldous-broder-maze.png ├── division-room-maze.png ├── fully-braided-maze.png ├── horizontal-wrap-maze.png ├── hunt-and-kill-maze.png ├── kruskal-weave-maze.png ├── growing-backtracker-maze.png └── infinite-sidewinder-maze.png ├── .gitignore ├── test └── meiro │ ├── aldous_broder_test.clj │ ├── hunt_and_kill_test.clj │ ├── triangle.txt │ ├── template.txt │ ├── binary_tree_test.clj │ ├── wilson_test.clj │ ├── backtracker_test.clj │ ├── triangle_test.clj │ ├── growing_tree_test.clj │ ├── graph_test.clj │ ├── division_test.clj │ ├── sidewinder_test.clj │ ├── wrap_test.clj │ ├── hex_test.clj │ ├── prim_test.clj │ ├── polar_test.clj │ ├── kruskal_test.clj │ ├── grid_3d_test.clj │ ├── eller_test.clj │ ├── ascii_test.clj │ ├── weave_test.clj │ ├── core_test.clj │ └── dijkstra_test.clj ├── deps.edn ├── project.clj ├── src └── meiro │ ├── triangle.clj │ ├── aldous_broder.clj │ ├── binary_tree.clj │ ├── hunt_and_kill.clj │ ├── wilson.clj │ ├── hex.clj │ ├── wrap.clj │ ├── canvas.cljs │ ├── backtracker.clj │ ├── nethack.clj │ ├── growing_tree.clj │ ├── graph.clj │ ├── polar.clj │ ├── ascii.clj │ ├── prim.clj │ ├── sidewinder.clj │ ├── division.clj │ ├── grid_3d.clj │ ├── dijkstra.clj │ ├── weave.clj │ ├── unicode.clj │ ├── kruskal.clj │ ├── eller.clj │ ├── core.clj │ └── png.clj ├── LICENSE └── README.md /img/3d-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/3d-maze.png -------------------------------------------------------------------------------- /img/bore-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/bore-maze.png -------------------------------------------------------------------------------- /img/delta-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/delta-maze.png -------------------------------------------------------------------------------- /img/eller-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/eller-maze.png -------------------------------------------------------------------------------- /img/inset-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/inset-maze.png -------------------------------------------------------------------------------- /img/polar-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/polar-maze.png -------------------------------------------------------------------------------- /img/prim-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/prim-maze.png -------------------------------------------------------------------------------- /img/sigma-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/sigma-maze.png -------------------------------------------------------------------------------- /img/tick-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/tick-maze.png -------------------------------------------------------------------------------- /img/weave-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/weave-maze.png -------------------------------------------------------------------------------- /img/wrap-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/wrap-maze.png -------------------------------------------------------------------------------- /img/braided-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/braided-maze.png -------------------------------------------------------------------------------- /img/culled-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/culled-maze.png -------------------------------------------------------------------------------- /img/kruskal-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/kruskal-maze.png -------------------------------------------------------------------------------- /img/masked-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/masked-maze.png -------------------------------------------------------------------------------- /img/sample-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/sample-maze.png -------------------------------------------------------------------------------- /img/wilsons-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/wilsons-maze.png -------------------------------------------------------------------------------- /img/division-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/division-maze.png -------------------------------------------------------------------------------- /img/sidewinder-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/sidewinder-maze.png -------------------------------------------------------------------------------- /img/triforce-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/triforce-maze.png -------------------------------------------------------------------------------- /img/backtracker-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/backtracker-maze.png -------------------------------------------------------------------------------- /img/binary-tree-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/binary-tree-maze.png -------------------------------------------------------------------------------- /img/growing-prim-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/growing-prim-maze.png -------------------------------------------------------------------------------- /img/aldous-broder-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/aldous-broder-maze.png -------------------------------------------------------------------------------- /img/division-room-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/division-room-maze.png -------------------------------------------------------------------------------- /img/fully-braided-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/fully-braided-maze.png -------------------------------------------------------------------------------- /img/horizontal-wrap-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/horizontal-wrap-maze.png -------------------------------------------------------------------------------- /img/hunt-and-kill-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/hunt-and-kill-maze.png -------------------------------------------------------------------------------- /img/kruskal-weave-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/kruskal-weave-maze.png -------------------------------------------------------------------------------- /img/growing-backtracker-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/growing-backtracker-maze.png -------------------------------------------------------------------------------- /img/infinite-sidewinder-maze.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/defndaines/meiro/HEAD/img/infinite-sidewinder-maze.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | *.jar 4 | *.class 5 | /.lein-* 6 | /.nrepl-port 7 | *.swp 8 | scratch.clj 9 | /log 10 | .DS_Store 11 | maze.png 12 | /template.txt 13 | tags 14 | .cpcache/ 15 | -------------------------------------------------------------------------------- /test/meiro/aldous_broder_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.aldous-broder-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.aldous-broder :as ab])) 5 | 6 | (deftest create-test 7 | (testing "Ensure all cells are linked." 8 | (is (every? #(not-any? empty? %) 9 | (ab/create (meiro/init 10 12)))))) 10 | -------------------------------------------------------------------------------- /test/meiro/hunt_and_kill_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.hunt-and-kill-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.hunt-and-kill :as hunt-and-kill])) 5 | 6 | (deftest create-test 7 | (testing "Ensure all cells are linked." 8 | (is (every? #(not-any? empty? %) 9 | (hunt-and-kill/create (meiro/init 10 12)))))) 10 | -------------------------------------------------------------------------------- /test/meiro/triangle.txt: -------------------------------------------------------------------------------- 1 | xxxxxxxxxxxx.xxxxxxxxxxxx 2 | xxxxxxxxxxx...xxxxxxxxxxx 3 | xxxxxxxxxx.....xxxxxxxxxx 4 | xxxxxxxxx.......xxxxxxxxx 5 | xxxxxxxx.........xxxxxxxx 6 | xxxxxxx...........xxxxxxx 7 | xxxxxx.............xxxxxx 8 | xxxxx...xxxxxxxxx...xxxxx 9 | xxxx.....xxxxxxx.....xxxx 10 | xxx.......xxxxx.......xxx 11 | xx.........xxx.........xx 12 | x...........x...........x 13 | ......................... 14 | -------------------------------------------------------------------------------- /test/meiro/template.txt: -------------------------------------------------------------------------------- 1 | ........................... 2 | ........................... 3 | ........................... 4 | ...xx...xx...xxx...xxxx.... 5 | ...xxx.xxx..xxxxx..xxxxx... 6 | ...xxxxxxx..xx.....xx.xx... 7 | ...xx.x.xx...xxx...xx.xx... 8 | ...xx...xx.....xx..xx.xx... 9 | ...xx...xx..xxxxx..xxxxx... 10 | ...xx...xx...xxx...xxxx.... 11 | ........................... 12 | ........................... 13 | ........................... 14 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.9.0"} 2 | org.clojure/data.generators {:mvn/version "0.1.2"}} 3 | :aliases {:test {:extra-paths ["test"] 4 | :extra-deps {com.cognitect/test-runner 5 | {:git/url "https://github.com/cognitect-labs/test-runner.git" 6 | :sha "5fb4fc46ad0bf2e0ce45eba5b9117a2e89166479"}} 7 | :main-opts ["-m" "cognitect.test-runner"]}}} 8 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject meiro "0.1.0-SNAPSHOT" 2 | :description "Working through Mazes for Programmers" 3 | :url "https://github.com/defndaines/meiro" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.10.1"] 7 | [org.clojure/data.generators "1.0.0"]] 8 | :profiles {:dev 9 | {:dependencies [[org.clojure/test.check "1.0.0"]]}}) 10 | -------------------------------------------------------------------------------- /test/meiro/binary_tree_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.binary-tree-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.binary-tree :as bt] 5 | [meiro.dijkstra :as d])) 6 | 7 | 8 | (deftest create-test 9 | (testing "Ensure all cells are linked." 10 | (is (every? #(not-any? empty? %) (bt/create (m/init 10 12))))) 11 | (testing "Resuling maze is perfect." 12 | (let [maze (bt/create (m/init 15 15))] 13 | (is (d/solution maze [0 0] [14 14])) 14 | (is (d/solution maze (m/random-pos maze) (m/random-pos maze)))))) 15 | -------------------------------------------------------------------------------- /src/meiro/triangle.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.triangle 2 | "Triangle maze generation. 3 | Triangle mazes rely on a normal grid, but assume the [0 0] cell is positioned 4 | pointing up, with the possibility of connecting to a cell to the south. 5 | Each triangle then alternates orientation, such that a triangle pointing down 6 | can only link to cells to the north, east, and west." 7 | (:require [meiro.core :as m])) 8 | 9 | 10 | (defn neighbors 11 | "Get all potential neighbors of a position in a given grid." 12 | [grid [row col]] 13 | (filter 14 | #(m/in? grid %) 15 | [[row (dec col)] [row (inc col)] 16 | (if (even? (+ row col)) 17 | [(inc row) col] 18 | [(dec row) col])])) 19 | -------------------------------------------------------------------------------- /test/meiro/wilson_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.wilson-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.wilson :as wilson])) 5 | 6 | 7 | (deftest walk-test 8 | (testing "Path includes one visited cell." 9 | (let [maze (meiro/init 8 8)] 10 | (is (= [0 0] 11 | (last (#'meiro.wilson/walk 12 | maze 13 | (remove #{[0 0]} (meiro/all-positions maze)))))) 14 | (is (= [3 4] 15 | (last (#'meiro.wilson/walk 16 | maze 17 | (remove #{[3 4]} (meiro/all-positions maze))))))))) 18 | 19 | (deftest create-test 20 | (testing "Ensure all cells are linked." 21 | (is (every? #(not-any? empty? %) (wilson/create (meiro/init 10 12)))))) 22 | -------------------------------------------------------------------------------- /src/meiro/aldous_broder.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.aldous-broder 2 | "Aldous-Broder uses a random walk to generate an unbiased maze. 3 | Because it randomly navigates to the next cell without regard to 4 | cells it has already visited, it can take an excessively long time to 5 | generate, especially on large mazes." 6 | (:require [meiro.core :as m])) 7 | 8 | (defn create 9 | "Create a random maze using the Aldous-Broder algorithm." 10 | [grid] 11 | (loop [maze grid 12 | cell (m/random-pos grid) 13 | unvisited (dec (* (count grid) (count (first grid))))] 14 | (if (zero? unvisited) 15 | maze 16 | (let [neighbor (rand-nth (m/neighbors maze cell))] 17 | (if (empty? (get-in maze neighbor)) 18 | (recur (m/link maze cell neighbor) neighbor (dec unvisited)) 19 | (recur maze neighbor unvisited)))))) 20 | -------------------------------------------------------------------------------- /test/meiro/backtracker_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.backtracker-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.backtracker :as bt])) 5 | 6 | (deftest create-test 7 | (testing "Ensure all cells are linked." 8 | (is (every? #(not-any? empty? %) (bt/create (meiro/init 10 12)))))) 9 | 10 | (deftest create-with-mask-test 11 | (testing "Some cells can be masked and a valid maze generates." 12 | (let [grid (-> (meiro/init 10 10) 13 | (update-in [0 4] conj :mask) 14 | (update-in [0 6] conj :mask)) 15 | maze (bt/create grid)] 16 | (is (= [:mask] (get-in maze [0 4]))) 17 | (is (= [:south] (get-in maze [0 5]))) ; Cell not orphaned 18 | (is (= [:mask] (get-in maze [0 6]))) 19 | (is (every? #(not-any? empty? %) maze))))) 20 | -------------------------------------------------------------------------------- /src/meiro/binary_tree.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.binary-tree 2 | "Binary-tree produces mazes with a bias that flows down and to the right. 3 | All mazes will have a single corridor on both the southern and eastern edges." 4 | (:require [meiro.core :as m])) 5 | 6 | 7 | (defn- south-east 8 | "Identify valid south and east positions relative to provided position." 9 | [maze [row col]] 10 | (filter 11 | #(m/in? maze %) 12 | [[(inc row) col] [row (inc col)]])) 13 | 14 | 15 | (defn- link-neighbor 16 | "Reducing function which links a cell to a random neighbor to the south or 17 | east." 18 | [maze pos] 19 | (let [neighbors (south-east maze pos)] 20 | (if (seq neighbors) 21 | (m/link maze pos (rand-nth neighbors)) 22 | maze))) 23 | 24 | 25 | (defn create 26 | "Create a random grid using the binary tree algorithm." 27 | [grid] 28 | (reduce link-neighbor grid (m/all-positions grid))) 29 | -------------------------------------------------------------------------------- /src/meiro/hunt_and_kill.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.hunt-and-kill 2 | "Hunt and Kill performs a random walk against unvisited cells, then searches 3 | for the first unvisited cell adjacent to a visited cell to link and continue, 4 | until all cells have been visited." 5 | (:require [meiro.core :as m])) 6 | 7 | 8 | (defn- visited-neighbors 9 | "Get all positions neighboring `pos` which have been visited." 10 | [maze pos] 11 | (remove #(empty? (get-in maze %)) (m/neighbors maze pos))) 12 | 13 | 14 | (defn- hunt 15 | "Find first unvisited position with a visited neighbor." 16 | [maze positions] 17 | (first 18 | (for [pos positions 19 | neighbor (visited-neighbors maze pos) 20 | :when (seq (get-in maze neighbor))] 21 | [pos neighbor]))) 22 | 23 | 24 | (defn create 25 | "Create a random maze using the Hunt and Kill algorithm." 26 | [grid] 27 | (loop [maze grid 28 | pos (m/random-pos maze) 29 | positions (remove #{pos} (m/all-positions maze))] 30 | (if (seq positions) 31 | (let [unvisited (m/empty-neighbors maze pos)] 32 | (if (seq unvisited) 33 | (let [neighbor (rand-nth unvisited)] 34 | (recur (m/link maze pos neighbor) 35 | neighbor 36 | (remove #{neighbor} positions))) 37 | (let [[hunted visited] (hunt maze positions)] 38 | (recur (m/link maze hunted visited) 39 | hunted 40 | (remove #{hunted} positions))))) 41 | maze))) 42 | -------------------------------------------------------------------------------- /src/meiro/wilson.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.wilson 2 | "Wilson's algorithm uses a loop-erasing random walk to generate an unbiased 3 | maze. Because it randomly navigates to the next cell without regard to 4 | cells it has already visited, it can take an excessively long time to 5 | generate, especially on large mazes." 6 | (:require [meiro.core :as m])) 7 | 8 | 9 | (defn- pop-rand 10 | "Remove a random element from a collection of positions. 11 | Used to identify the starting position of the maze." 12 | [positions] 13 | (let [pos (rand-nth positions)] 14 | (remove #{pos} positions))) 15 | 16 | 17 | (defn- walk 18 | "Perform a loop-erasing random walk." 19 | [maze unvisited] 20 | (loop [pos (rand-nth unvisited) 21 | path [pos]] 22 | (if (some #{pos} unvisited) 23 | (let [index (.indexOf path pos)] 24 | (if (= -1 index) 25 | (recur (rand-nth (m/neighbors maze pos)) 26 | (conj path pos)) 27 | (recur (rand-nth (m/neighbors maze pos)) 28 | (subvec path 0 (inc index))))) 29 | (conj path pos)))) 30 | 31 | 32 | (defn- link-path 33 | "Create links in the maze between each step in a path." 34 | [maze path] 35 | (reduce 36 | (fn [acc [pos-1 pos-2]] (m/link acc pos-1 pos-2)) 37 | maze 38 | (partition 2 1 path))) 39 | 40 | 41 | (defn create 42 | "Create a random maze using Wilson's algorithm." 43 | [grid] 44 | (loop [maze grid 45 | unvisited (pop-rand (m/all-positions grid))] 46 | (if (seq unvisited) 47 | (let [path (walk grid unvisited)] 48 | (recur 49 | (link-path maze path) 50 | (remove (set path) unvisited))) 51 | maze))) 52 | -------------------------------------------------------------------------------- /src/meiro/hex.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.hex 2 | "Sigma (hexagon) maze generation. 3 | Hexagonal grids connect north to south, northwest to southeast, 4 | and northeast to southwest. Otherwise, they maintain a rectangular grid, 5 | so can build upon a core `init`. 6 | Hexagons stagger across the row, and these algorithms assume [0 0] is 7 | northwest from [0 1]." 8 | (:require [meiro.core :as m])) 9 | 10 | 11 | (defn neighbors 12 | "Get all potential neighbors of a position in a given grid." 13 | [grid pos] 14 | (let [[row col] pos] 15 | (filter 16 | #(m/in? grid %) 17 | (concat 18 | [[(dec row) col] [(inc row) col]] ; north-south 19 | (if (even? col) 20 | [[(dec row) (dec col)] [(dec row) (inc col)] 21 | [row (dec col)] [row (inc col)]] 22 | [[row (dec col)] [row (inc col)] 23 | [(inc row) (dec col)] [(inc row) (inc col)]]))))) 24 | 25 | 26 | 27 | (defn direction 28 | "Get the direction from pos-1 to pos-2." 29 | [[row-1 col-1] [row-2 col-2]] 30 | (cond 31 | (and (= col-1 col-2) (< row-1 row-2)) :south 32 | (and (= col-1 col-2) (> row-1 row-2)) :north 33 | (and (= row-1 row-2) (odd? col-1) (< col-1 col-2)) :northeast 34 | (and (= row-1 row-2) (odd? col-1) (> col-1 col-2)) :northwest 35 | (and (= row-1 row-2) (even? col-1) (< col-1 col-2)) :southeast 36 | (and (= row-1 row-2) (even? col-1) (> col-1 col-2)) :southwest 37 | (and (< row-1 row-2) (< col-1 col-2)) :southeast 38 | (and (< row-1 row-2) (> col-1 col-2)) :southwest 39 | (and (> row-1 row-2) (< col-1 col-2)) :northeast 40 | (and (> row-1 row-2) (> col-1 col-2)) :northwest)) 41 | 42 | 43 | (def link 44 | "Link cells in a hex grid." 45 | (m/link-with direction)) 46 | -------------------------------------------------------------------------------- /src/meiro/wrap.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.wrap 2 | "Functions for generating mazes which wrap around on themselves 3 | (think Pac-Man)." 4 | (:require [meiro.core :as m])) 5 | 6 | 7 | (defn neighbors 8 | "Get all potential neighbors of a position in a given grid. 9 | When a position is at the edge of the grid, wrap around to the other side." 10 | [grid [row col]] 11 | (let [height (count grid) 12 | width (count (first grid))] 13 | #{[(mod (dec row) height) col] 14 | [(mod (inc row) height) col] 15 | [row (mod (dec col) width)] 16 | [row (mod (inc col) width)]})) 17 | 18 | 19 | (defn neighbors-horizontal 20 | "Get all potential neighbors of a position in a given grid. 21 | When a position is at first or last columns of a grid, wrap around to the 22 | other side." 23 | [grid [row col]] 24 | (let [width (count (first grid))] 25 | (filter 26 | #(m/in? grid %) 27 | #{[(dec row) col] 28 | [(inc row) col] 29 | [row (mod (dec col) width)] 30 | [row (mod (inc col) width)]}))) 31 | 32 | 33 | (defn direction 34 | "Get the direction from pos-1 to pos-2. 35 | Positions which wrap around the edge of the grid still use a cardinal 36 | direction so that rendered mazes treat it like a warp open in the edgs." 37 | [[row-1 col-1] [row-2 col-2]] 38 | (let [row-diff (- row-1 row-2) 39 | col-diff (- col-1 col-2)] 40 | (cond 41 | (= 0 row-diff) (cond 42 | (= 1 col-diff) :west 43 | (= -1 col-diff) :east 44 | (= 0 col-1) :west 45 | (= 0 col-2) :east) 46 | (= 0 col-diff) (cond 47 | (= 1 row-diff) :north 48 | (= -1 row-diff) :south 49 | (= 0 row-1) :north 50 | (= 0 row-2) :south) 51 | :else nil))) 52 | 53 | 54 | (def link 55 | "Link cells in a wrapped grid." 56 | (m/link-with direction)) 57 | -------------------------------------------------------------------------------- /src/meiro/canvas.cljs: -------------------------------------------------------------------------------- 1 | (ns meiro.canvas 2 | "Functions for drawing mazes onto a canvas object." 3 | (:require [clojure.spec.alpha :as spec])) 4 | 5 | (def cell-size 6 | "Cell size constant which determines cell width and height in image." 7 | 15) 8 | 9 | (defn draw-line 10 | "Draw line on canvas from coordinates [x y] to [x' y']." 11 | [context x y x' y'] 12 | (let [[x y x' y'] (map (partial * cell-size) [x y x' y'])] 13 | (.moveTo context x y) 14 | (.lineTo context x' y')) 15 | (.stroke context)) 16 | 17 | 18 | (spec/fdef line-fn 19 | :args (spec/cat :context any? :x nat-int? :x' nat-int? :y nat-int? :y' nat-int?) 20 | :ret nil?) 21 | 22 | 23 | (defn scaled-line-fn 24 | "Create a function which will draw a line to scale. Returned function will 25 | expect that a distance of 1 is a single cell unit, and will use the factor 26 | to increase the final size when drawn." 27 | [factor] 28 | (fn [context x y x' y'] 29 | (let [[x y x' y'] (map (partial * factor) [x y x' y'])] 30 | (.moveTo context x y) 31 | (.lineTo context x' y')) 32 | (.stroke context))) 33 | 34 | 35 | (defn render 36 | "Render a `maze` into the provided `context`, using the `draw-fn` to draw 37 | line edges. Caller should have already set up the context to the appropriate 38 | dimensions and prepared to be 'drawn' into. This function only draws edges, 39 | top left to bottom right, and does not render 'cells'. This function will 40 | not 'scale' the image; it expects the `draw-fn` to handle this." 41 | [maze context draw-fn] 42 | (let [rows (count maze) 43 | cols (count (first maze))] 44 | (draw-fn context 0 0 0 rows) 45 | (draw-fn context 0 0 cols 0) 46 | (doseq [[y row] (map-indexed vector maze)] 47 | (doseq [[x cell] (map-indexed vector row)] 48 | (when (not-any? #{:east} cell) 49 | (draw-fn context (inc x) y (inc x) (inc y))) 50 | (when (not-any? #{:south} cell) 51 | (draw-fn context x (inc y) (inc x) (inc y))))))) 52 | -------------------------------------------------------------------------------- /test/meiro/triangle_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.triangle-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.triangle :as triangle] 5 | [meiro.backtracker :as backtracker])) 6 | 7 | 8 | (deftest neighbors-test 9 | (testing "Top row behavior." 10 | (is (= [[0 1] [1 0]] 11 | (triangle/neighbors (m/init 3 3) [0 0]))) 12 | (is (= [[0 0] [0 2]] 13 | (triangle/neighbors (m/init 3 3) [0 1]))) 14 | (is (= [[0 1] [1 2]] 15 | (triangle/neighbors (m/init 3 3) [0 2]))) 16 | (is (= [[0 1] [0 3] [1 2]] 17 | (triangle/neighbors (m/init 4 4) [0 2]))) 18 | (is (= [[0 2]] 19 | (triangle/neighbors (m/init 4 4) [0 3])))) 20 | (testing "Odd row behavior." 21 | (is (= [[1 1] [0 0]] 22 | (triangle/neighbors (m/init 3 3) [1 0]))) 23 | (is (= [[1 0] [1 2] [2 1]] 24 | (triangle/neighbors (m/init 3 3) [1 1]))) 25 | (is (= [[1 1] [0 2]] 26 | (triangle/neighbors (m/init 3 3) [1 2]))) 27 | (is (= [[1 1] [1 3] [0 2]] 28 | (triangle/neighbors (m/init 4 4) [1 2]))) 29 | (is (= [[1 2] [2 3]] 30 | (triangle/neighbors (m/init 4 4) [1 3])))) 31 | (testing "Even row behavior." 32 | (is (= [[2 1] [3 0]] 33 | (triangle/neighbors (m/init 4 4) [2 0]))) 34 | (is (= [[2 0] [2 2] [1 1]] 35 | (triangle/neighbors (m/init 4 4) [2 1]))) 36 | (is (= [[2 1] [3 2]] 37 | (triangle/neighbors (m/init 4 3) [2 2]))) 38 | (is (= [[2 1] [2 3] [3 2]] 39 | (triangle/neighbors (m/init 4 4) [2 2]))) 40 | (is (= [[2 2] [1 3]] 41 | (triangle/neighbors (m/init 4 4) [2 3]))))) 42 | 43 | 44 | (deftest create-test 45 | (testing "Ensure all cells are linked." 46 | (is (every? 47 | #(not-any? empty? %) 48 | (backtracker/create (m/init 10 10) 49 | [0 0] 50 | triangle/neighbors 51 | m/link))))) 52 | -------------------------------------------------------------------------------- /src/meiro/backtracker.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.backtracker 2 | "The Recursive Backtracker algorithm uses a biased random walk to generate a 3 | maze. While there are unvisited cells, it chooses one at random, but when it 4 | encounters a dead end, it backtracks on its path until it finds a cell with 5 | unvisited neighbors and walks, repeating until all cells have been linked." 6 | (:require [meiro.core :as m] 7 | [clojure.spec.alpha :as spec])) 8 | 9 | 10 | (spec/fdef create 11 | :args (spec/alt 12 | :1-arg (spec/cat :grid :meiro.core/grid) 13 | :2-args (spec/cat :grid :meiro.core/grid :pos :meiro.core/pos) 14 | :4-args (spec/cat 15 | :grid :meiro.core/grid 16 | :pos :meiro.core/pos 17 | :neighbor-fn ifn? 18 | :link-fn ifn?) 19 | :5-args (spec/cat 20 | :grid :meiro.core/grid 21 | :pos :meiro.core/pos 22 | :neighbor-fn ifn? 23 | :link-fn ifn? 24 | :select-fn ifn?)) 25 | :ret :meiro.core/maze) 26 | (defn create 27 | "Create a random maze using the Recursive Backtracker algorithm. 28 | If a `pos` is passed, then the random walk will begin at that position. 29 | `neighbor-fn` and `link-fn` allow for alternative (e.g., polar) mazes 30 | to use the algorithm. A `select-fn` allows for selecting which unvisited 31 | neighbor to visit." 32 | ([grid] (create grid (m/random-pos grid))) 33 | ([grid pos] (create grid pos m/neighbors m/link)) 34 | ([grid pos neighbor-fn link-fn] 35 | (create grid pos neighbor-fn link-fn rand-nth)) 36 | ([grid pos neighbor-fn link-fn select-fn] 37 | (loop [maze grid 38 | stack (list pos)] 39 | (if (seq stack) 40 | (let [pos (first stack) 41 | unvisited (m/empty-neighbors maze neighbor-fn pos)] 42 | (if (seq unvisited) 43 | (let [neighbor (select-fn unvisited)] 44 | (recur 45 | (link-fn maze pos neighbor) 46 | (conj stack neighbor))) 47 | (recur maze (rest stack)))) 48 | maze)))) 49 | -------------------------------------------------------------------------------- /test/meiro/growing_tree_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.growing-tree-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.growing-tree :as growing-tree] 4 | [meiro.prim] 5 | [meiro.graph :as graph])) 6 | 7 | 8 | (deftest newer-pos-test 9 | (testing "Get the newer position from an edge." 10 | (is (nil? (#'meiro.growing-tree/outside-forest #{[0 0] [0 1]} 11 | [[0 0] [0 1]]))) 12 | (is (= [0 1] 13 | (#'meiro.growing-tree/outside-forest #{[0 0]} 14 | [[0 0] [0 1]]))))) 15 | 16 | 17 | (deftest recreate-prims-algorithm-test 18 | (testing "Creating a maze using Prim's Algorithm." 19 | (is (= (dec (* 8 12)) 20 | (count (:edges 21 | (growing-tree/create 8 12 22 | (java.util.PriorityQueue.) 23 | #'meiro.prim/poll 24 | #'meiro.prim/to-active!)))))) 25 | (testing "Ensure all cells are linked." 26 | (is (every? 27 | #(not-any? empty? %) 28 | (graph/forest-to-maze 29 | (growing-tree/create 10 12 30 | (java.util.PriorityQueue.) 31 | #'meiro.prim/poll 32 | #'meiro.prim/to-active!)))))) 33 | 34 | 35 | (deftest recreate-recursive-backtracker-test 36 | (testing "Creating a maze using recursive backtracker." 37 | (is (every? 38 | #(not-any? empty? %) 39 | (graph/forest-to-maze 40 | (growing-tree/create 41 | 18 10 42 | '() 43 | (fn [q] [(first q) (rest q)]) 44 | (fn [new-edges queue remaining-edges] 45 | (reduce 46 | (fn [[q es] e] 47 | (let [remaining (disj es e)] 48 | (if (= es remaining) 49 | [q es] 50 | [(conj q e) 51 | remaining]))) 52 | [queue remaining-edges] 53 | (shuffle new-edges))))))))) 54 | -------------------------------------------------------------------------------- /test/meiro/graph_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.graph-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.graph :as graph])) 4 | 5 | 6 | (deftest edges-test 7 | (testing "Initialize all the edges in a grid." 8 | (is (= (+ (* 4 (dec 5)) (* (dec 4) 5)) 9 | (count (graph/all-edges 4 5)))) 10 | (is (= (- (* 2 15 6) 15 6) 11 | (count (graph/all-edges 15 6)))))) 12 | 13 | 14 | (deftest init-forests-test 15 | (testing "Forest initialization for a grid." 16 | (is (= (* 5 4) 17 | (count (graph/init-forests 5 4)))) 18 | (is (= (* 6 15) 19 | (count (graph/init-forests 6 15)))))) 20 | 21 | 22 | (deftest find-forest-test 23 | (testing "Able to find forests by position." 24 | (let [forests (graph/init-forests 6 15)] 25 | (is (= {:width 6 :height 15 :nodes #{[4 13]} :edges []} 26 | (graph/find-forest forests [4 13]))) 27 | (is (nil? 28 | (graph/find-forest forests [4 15])))))) 29 | 30 | 31 | (deftest merge-forests-test 32 | (testing "Merge two forests with a shared edge." 33 | (is (= {:width 3 :height 6 :nodes #{[2 4] [2 5]} :edges [[[2 4] [2 5]]]} 34 | (graph/merge-forests 35 | {:width 3 :height 6 :nodes #{[2 4]} :edges []} 36 | {:width 3 :height 6 :nodes #{[2 5]} :edges []} 37 | [[2 4] [2 5]])))) 38 | (testing "Set width and height if missing from one forest." 39 | (is (= 4 40 | (:width (graph/merge-forests 41 | {:nodes #{[1 0]} :edges []} 42 | {:width 4 :height 5 :nodes #{[0 0]} :edges []} 43 | [[0 0] [1 0]])))) 44 | (is (= 4 45 | (:width (graph/merge-forests 46 | {:width 4 :height 5 :nodes #{[0 0]} :edges []} 47 | {:nodes #{[1 0]} :edges []} 48 | [[0 0] [1 0]])))) 49 | (is (= 5 50 | (:height (graph/merge-forests 51 | {:nodes #{[1 0]} :edges []} 52 | {:width 4 :height 5 :nodes #{[0 0]} :edges []} 53 | [[0 0] [1 0]])))) 54 | (is (= 5 55 | (:height (graph/merge-forests 56 | {:width 4 :height 5 :nodes #{[0 0]} :edges []} 57 | {:nodes #{[1 0]} :edges []} 58 | [[0 0] [1 0]])))))) 59 | -------------------------------------------------------------------------------- /src/meiro/nethack.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.nethack 2 | "Generate a NetHack-style ASCII representation of a maze." 3 | (:require [clojure.string :as string])) 4 | 5 | 6 | (def ^:private horizontal-wall "-") 7 | (def ^:private verticle-wall "|") 8 | (def ^:private inside-cell ".") 9 | (def ^:private cell-link ".") 10 | ; (def ^:private start-cell "@" 11 | ; (def ^:private end-cell "$") 12 | (def ^:private corridor "#") 13 | (def ^:private corridor-wall " ") 14 | 15 | 16 | (defn- top-level 17 | "Render the top edge of the maze." 18 | [maze] 19 | (string/join 20 | (repeat 21 | (inc (* 2 (count (first maze)))) 22 | horizontal-wall))) 23 | 24 | 25 | (defn- cell-room-level 26 | "Render the cell level, i.e., where the 'inside' of the cell is displayed." 27 | ([cell] (cell-room-level cell inside-cell)) 28 | ([cell inside] 29 | (concat inside 30 | (if (some #{:east} cell) cell-link verticle-wall)))) 31 | 32 | 33 | (defn- bottom-room-level 34 | "Render the bottom edge of a cell, or precisely the south and south-east 35 | edge." 36 | [cell] 37 | (concat 38 | (if (some #{:south} cell) cell-link horizontal-wall) 39 | (if (some #{:south} cell) 40 | (if (not-any? #{:east} cell) verticle-wall horizontal-wall) 41 | horizontal-wall))) 42 | 43 | 44 | (defn render-room 45 | "Render a maze in NetHack style as if it was the interior of a room." 46 | ([maze] 47 | (apply str 48 | (top-level maze) \newline 49 | (mapcat 50 | (fn [row] 51 | (concat verticle-wall (mapcat cell-room-level row) "\n" 52 | verticle-wall (mapcat bottom-room-level row) "\n")) 53 | maze)))) 54 | 55 | 56 | (defn cell-corridor-level 57 | "Render the cell level, i.e., where the 'inside of the cell is displayed." 58 | [cell] 59 | (concat corridor 60 | (if (some #{:east} cell) corridor corridor-wall))) 61 | 62 | 63 | (defn bottom-corridor-level 64 | "Render the bottom edge of a cell, or precisely the south and south-east 65 | edge." 66 | [cell] 67 | (concat 68 | (if (some #{:south} cell) corridor corridor-wall) 69 | corridor-wall)) 70 | 71 | 72 | (defn render-corridor 73 | "Render a maze in NetHack style as if it was a series of corridors." 74 | [maze] 75 | (clojure.string/join 76 | (mapcat 77 | (fn [row] 78 | (concat (mapcat cell-corridor-level row) "\n" 79 | (mapcat bottom-corridor-level row) "\n")) 80 | maze))) 81 | -------------------------------------------------------------------------------- /test/meiro/division_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.division-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.division :as division])) 5 | 6 | 7 | (deftest link-all-test 8 | (testing "All cells linked." 9 | (is (= [[[:south :east] [:south :east :west] [:south :west]] 10 | [[:north :south :east] [:north :south :east :west] 11 | [:north :south :west]] 12 | [[:north :east] [:north :east :west] [:north :west]]] 13 | (#'meiro.division/link-all (m/init 3 3)))))) 14 | 15 | 16 | (deftest divide-horizontal-test 17 | (testing "Grid can be split horizontally." 18 | (let [divided (#'meiro.division/divide-horizontal 19 | (#'meiro.division/link-all (m/init 2 10)) 20 | 0 0 2 10 #'meiro.division/divide?)] 21 | (is (= 1 22 | (count (filter #(some #{:south} %) (get divided 0))))) 23 | (is (= 1 24 | (count (filter #(some #{:north} %) (get divided 1)))))))) 25 | 26 | 27 | (deftest divide-vertical-test 28 | (testing "Grid can be split vertically." 29 | (let [divided (#'meiro.division/divide-vertical 30 | (#'meiro.division/link-all (m/init 10 2)) 31 | 0 0 10 2 #'meiro.division/divide?)] 32 | (is (= 1 33 | (count (filter #(some #{:east} %) 34 | (map (fn [row] (get row 0)) divided))))) 35 | (is (= 1 36 | (count (filter #(some #{:west} %) 37 | (map (fn [row] (get row 1)) divided)))))))) 38 | 39 | 40 | (deftest division-fn-test 41 | (testing "Rate of 0% only returns true for height and width of 1." 42 | (let [div? (#'meiro.division/divide-fn 5 0.0)] 43 | (is (div? 1 8)) 44 | (is (div? 8 1)) 45 | (is (not (div? 2 2))))) 46 | (testing "Rate of 100% will create rooms below size threshold." 47 | (let [div? (#'meiro.division/divide-fn 4 1.0)] 48 | (is (div? 4 4)) 49 | (is (not (div? 4 5))) 50 | (is (not (div? 5 4))) 51 | (is (not (div? 5 5)))))) 52 | 53 | 54 | (deftest create-test 55 | (testing "Ensure all cells are linked." 56 | (is (every? #(not-any? empty? %) 57 | (division/create (m/init 12 10))))) 58 | ; (testing "Even with rooms, all mazes should be perfect." 59 | ; (let [maze (create (m/init 25 25) 4 0.5)] 60 | ; (is (d/solution maze [0 0] [24 24])) 61 | ; (is (d/solution maze (m/random-pos maze) (m/random-pos maze))))) 62 | ) 63 | -------------------------------------------------------------------------------- /test/meiro/sidewinder_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.sidewinder-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.sidewinder :as sidewinder])) 5 | 6 | 7 | (deftest western-path-test 8 | (let [maze [[[:south] [:south] [:east] [:west :east] 9 | [:west :south] [:south] [:east] 10 | [:west :south]] 11 | [[:north :east] [:north :west :south] [:east] [:west :east] 12 | [:north :west :east] [:north :west :south] [:south] 13 | [:north :south]] 14 | [[:east] [:north :west :east] [:west :east] [:west :east] 15 | [:west :east] [:north :west :east] [:north :west :east] 16 | [:north :west]]]] 17 | (testing "No linked cell to the west" 18 | (is (= '([0 0]) (#'meiro.sidewinder/path-west maze [0 0])))) 19 | (testing "One linked cell to the west" 20 | (is (= '([0 3] [0 2]) (#'meiro.sidewinder/path-west maze [0 3])))) 21 | (testing "Multiple linked cells to the west" 22 | (is (= '([1 5] [1 4] [1 3] [1 2]) 23 | (#'meiro.sidewinder/path-west maze [1 5])))))) 24 | 25 | 26 | (deftest create-test 27 | (testing "Ensure all cells are linked." 28 | (is (every? #(not-any? empty? %) (sidewinder/create (meiro/init 10 12)))))) 29 | 30 | 31 | (deftest corridor-test 32 | (testing "Get corridor paths." 33 | (let [row [[:east] [] [:east] [:east] []]] 34 | (is (= [0] 35 | (#'meiro.sidewinder/corridor row 0))) 36 | (is (= [1 0] 37 | (#'meiro.sidewinder/corridor row 1))) 38 | (is (= [2] 39 | (#'meiro.sidewinder/corridor row 2))) 40 | (is (= [3 2] 41 | (#'meiro.sidewinder/corridor row 3))) 42 | (is (= [4 3 2] 43 | (#'meiro.sidewinder/corridor row 4)))))) 44 | 45 | 46 | (deftest create-row-test 47 | (testing "Weights used to decide direction." 48 | (is (= [[:east] [:east] [:east] [:south]] 49 | (#'meiro.sidewinder/create-row 4 {:south 0 :east 1}))) 50 | (is (= [[:south] [:south] [:south] [:south]] 51 | (#'meiro.sidewinder/create-row 4 {:south 1 :east 0}))))) 52 | 53 | 54 | (deftest last-row-test 55 | (testing "Last row can only link to itself." 56 | (is (= [[:east] [:east] [:east] [:west]] 57 | (sidewinder/last-row 4))))) 58 | 59 | 60 | (deftest create-lazy-test 61 | (testing "Build a maze using infinite approach." 62 | (let [maze (sidewinder/create-lazy 8)] 63 | (is (= 8 64 | (count (first (drop 25 maze)))))))) 65 | -------------------------------------------------------------------------------- /test/meiro/wrap_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.wrap-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.wrap :as wrap] 4 | [meiro.core :as m])) 5 | 6 | 7 | (deftest neighbors-test 8 | (let [grid (m/init 4 5)] 9 | (testing "Get neighbors at edges of the grid." 10 | (is (= #{[1 4] [1 1] [0 0] [2 0]} (set (wrap/neighbors grid [1 0])))) 11 | (is (= #{[0 0] [0 2] [1 1] [3 1]} (set (wrap/neighbors grid [0 1])))) 12 | (is (= #{[0 1] [0 4] [1 0] [3 0]} (set (wrap/neighbors grid [0 0])))) 13 | (is (= #{[0 0] [3 4] [1 4] [0 3]} (set (wrap/neighbors grid [0 4])))) 14 | (is (= #{[0 0] [3 4] [2 0] [3 1]} (set (wrap/neighbors grid [3 0])))) 15 | (is (= #{[3 3] [3 0] [2 4] [0 4]} (set (wrap/neighbors grid [3 4]))))) 16 | (testing "Get neighbors to a cell inside a grid" 17 | (is (= #{[0 1] [1 0] [1 2] [2 1]} (set (wrap/neighbors grid [1 1])))) 18 | (is (= #{[1 3] [2 2] [2 4] [3 3]} (set (wrap/neighbors grid [2 3]))))))) 19 | 20 | 21 | (deftest neighbors-horizontal-test 22 | (let [grid (m/init 4 5)] 23 | (testing "Get neighbors at edges of the grid." 24 | (is (= #{[1 4] [1 1] [0 0] [2 0]} 25 | (set (wrap/neighbors-horizontal grid [1 0])))) 26 | (is (= #{[0 0] [0 2] [1 1]} 27 | (set (wrap/neighbors-horizontal grid [0 1])))) 28 | (is (= #{[0 1] [0 4] [1 0]} 29 | (set (wrap/neighbors-horizontal grid [0 0])))) 30 | (is (= #{[0 0] [1 4] [0 3]} 31 | (set (wrap/neighbors-horizontal grid [0 4])))) 32 | (is (= #{[3 4] [2 0] [3 1]} 33 | (set (wrap/neighbors-horizontal grid [3 0])))) 34 | (is (= #{[3 3] [3 0] [2 4]} 35 | (set (wrap/neighbors-horizontal grid [3 4]))))) 36 | (testing "Get neighbors to a cell inside a grid" 37 | (is (= #{[0 1] [1 0] [1 2] [2 1]} 38 | (set (wrap/neighbors-horizontal grid [1 1])))) 39 | (is (= #{[1 3] [2 2] [2 4] [3 3]} 40 | (set (wrap/neighbors-horizontal grid [2 3]))))))) 41 | 42 | 43 | (deftest direction-test 44 | (testing "Cells at edges can link to opposite edge." 45 | (is (= :north (wrap/direction [0 3] [4 3]))) 46 | (is (= :south (wrap/direction [3 1] [0 1]))) 47 | (is (= :east (wrap/direction [5 5] [5 0]))) 48 | (is (= :west (wrap/direction [4 0] [4 2])))) 49 | (testing "Cardinal directions when adjacent." 50 | (is (= :north (wrap/direction [2 3] [1 3]))) 51 | (is (= :south (wrap/direction [3 1] [4 1]))) 52 | (is (= :east (wrap/direction [5 1] [5 2]))) 53 | (is (= :west (wrap/direction [4 3] [4 2]))))) 54 | -------------------------------------------------------------------------------- /test/meiro/hex_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.hex-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.hex :as hex] 5 | [meiro.backtracker :as backtracker])) 6 | 7 | 8 | (deftest neighbors-test 9 | (testing "First row behavior." 10 | (is (= [[1 0] [0 1]] 11 | (hex/neighbors (m/init 3 3) [0 0]))) 12 | (is (= [[1 1] [0 0] [0 2] [1 0] [1 2]] 13 | (hex/neighbors (m/init 3 3) [0 1]))) 14 | (is (= [[1 2] [0 1]] 15 | (hex/neighbors (m/init 3 3) [0 2]))) 16 | (is (= [[1 2] [0 1] [0 3]] 17 | (hex/neighbors (m/init 4 4) [0 2]))) 18 | (is (= [[1 3] [0 2] [1 2]] 19 | (hex/neighbors (m/init 4 4) [0 3])))) 20 | (testing "Middle row behavior." 21 | (is (= [[0 0] [2 0] [0 1] [1 1]] 22 | (hex/neighbors (m/init 3 3) [1 0]))) 23 | (is (= [[0 1] [2 1] [1 0] [1 2] [2 0] [2 2]] 24 | (hex/neighbors (m/init 3 3) [1 1]))) 25 | (is (= [[0 2] [2 2] [0 1] [1 1]] 26 | (hex/neighbors (m/init 3 3) [1 2]))) 27 | (is (= [[0 2] [2 2] [0 1] [0 3] [1 1] [1 3]] 28 | (hex/neighbors (m/init 4 4) [1 2]))) 29 | (is (= [[0 3] [2 3] [1 2] [2 2]] 30 | (hex/neighbors (m/init 4 4) [1 3])))) 31 | (testing "Last row behavior." 32 | (is (= [[2 0] [2 1] [3 1]] 33 | (hex/neighbors (m/init 4 4) [3 0]))) 34 | (is (= [[2 1] [3 0] [3 2]] 35 | (hex/neighbors (m/init 4 4) [3 1]))) 36 | (is (= [[2 2] [2 1] [2 3] [3 1] [3 3]] 37 | (hex/neighbors (m/init 4 4) [3 2]))) 38 | (is (= [[2 3] [3 2]] 39 | (hex/neighbors (m/init 4 4) [3 3]))) 40 | (is (= [[3 4] [3 3] [4 3]] 41 | (hex/neighbors (m/init 5 5) [4 4]))))) 42 | 43 | 44 | (deftest direction-test 45 | (testing "North-south." 46 | (is (= :north (hex/direction [2 3] [1 3]))) 47 | (is (= :south (hex/direction [1 5] [2 5])))) 48 | (testing "Northwest-southeast." 49 | (is (= :northwest (hex/direction [1 1] [1 0]))) 50 | (is (= :southeast (hex/direction [1 0] [1 1]))) 51 | (is (= :northwest (hex/direction [1 2] [0 1]))) 52 | (is (= :southeast (hex/direction [0 1] [1 2])))) 53 | (testing "northeast-southwest." 54 | (is (= :northeast (hex/direction [1 1] [1 2]))) 55 | (is (= :southwest (hex/direction [1 2] [1 1]))) 56 | (is (= :northeast (hex/direction [2 0] [1 1]))) 57 | (is (= :southwest (hex/direction [1 1] [2 0]))))) 58 | 59 | 60 | (deftest create-test 61 | (testing "Ensure all cells are linked." 62 | (is (every? 63 | #(not-any? empty? %) 64 | (backtracker/create (m/init 10 10) [0 0] hex/neighbors hex/link))))) 65 | -------------------------------------------------------------------------------- /src/meiro/growing_tree.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.growing-tree 2 | "The Growing Tree algorithm is an abstraction on generating a minimum spanning 3 | tree to connect cells in a maze. 4 | The algorithm starts from a single cell and then chooses the next node using 5 | the poll function provided. As new nodes are added to a forest, its 6 | edges are added to the available edges until the tree is complete." 7 | (:require [meiro.graph :as graph])) 8 | 9 | 10 | ;; NOTE: The code assumes that edges are always given in ascending order. 11 | ;; For example, [[0 1] [0 2]] and not [[0 2] [0 1]]. 12 | 13 | 14 | (defn- pos-edges 15 | "Get all edges to a given position. Does not check for validity." 16 | [[x y :as pos]] 17 | [[[x (dec y)] pos] 18 | [pos [x (inc y)]] 19 | [pos [(inc x) y]] 20 | [[(dec x) y] pos]]) 21 | 22 | 23 | (defn- outside-forest 24 | "Retrieve the newer position from an edge. 25 | Returns nil if both positions in an edge are already in the nodes set. 26 | Will only return one position, so expect undefined behavior elsewhere if post 27 | positions are not in the provided nodes." 28 | [nodes edge] 29 | (first 30 | (remove 31 | (fn [pos] (contains? nodes pos)) 32 | edge))) 33 | 34 | 35 | (defn create 36 | "Create a maze with the provided dimensions. 37 | The `queue` manages the state of active edges and relies on the passed 38 | functions to manage that state. 39 | The `poll-fn` is a single-argument function taking the `queue`, and used 40 | to remove a single item from the queue. It returns the item and updated queue. 41 | The `shift-fn` takes three arguments, a sequence of edges, the queue, and a 42 | set of unqueued (remaining) edges. It transfers the edges from the unqueued 43 | collection to the queue." 44 | [width height queue poll-fn shift-fn] 45 | (let [node-total (* width height) 46 | start-pos [(rand-int width) (rand-int height)] 47 | every-edge (set (graph/all-edges width height)) 48 | [start-queue start-edges] (shift-fn (pos-edges start-pos) 49 | queue 50 | every-edge)] 51 | (loop [forest {:width width :height height :nodes #{start-pos} :edges []} 52 | queue start-queue 53 | edges start-edges] 54 | ;; Maze is complete when all nodes are accounted for or queue is empty. 55 | (if (or (= node-total (count (:nodes forest))) (empty? queue)) 56 | forest 57 | (let [[edge rest-q] (poll-fn queue) 58 | pos (outside-forest (:nodes forest) edge)] 59 | ;; Only add the edge if it links to a new position. 60 | (if (seq pos) 61 | (let [[q es] (shift-fn (pos-edges pos) rest-q edges)] 62 | (recur 63 | (-> forest 64 | (update :nodes conj pos) 65 | (update :edges conj edge)) 66 | q es)) 67 | (recur forest rest-q edges))))))) 68 | -------------------------------------------------------------------------------- /test/meiro/prim_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.prim-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.prim :as prim] 4 | [meiro.graph :as graph])) 5 | 6 | 7 | (deftest to-active-test 8 | (testing "Valid edges transfer from known edges into queue." 9 | ;; North-west corner 10 | (let [queue (java.util.PriorityQueue.) 11 | known-edges (set (graph/all-edges 3 4)) 12 | [after-queue after-edges] (#'meiro.prim/to-active! 13 | (#'meiro.prim/pos-edges [0 0]) 14 | queue 15 | known-edges)] 16 | (is (= 2 (.size after-queue))) 17 | (is (not (let [[_ edge] (.peek after-queue)] 18 | (contains? after-edges edge)))) 19 | (is (let [[_ edge] (.poll after-queue)] 20 | (or (= [[0 0] [0 1]] edge) 21 | (= [[0 0] [1 0]] edge))))) 22 | ;; South-east corner 23 | (let [queue (java.util.PriorityQueue.) 24 | known-edges (set (graph/all-edges 3 4)) 25 | [after-queue after-edges] (#'meiro.prim/to-active! 26 | (#'meiro.prim/pos-edges [2 3]) 27 | queue 28 | known-edges)] 29 | (is (= 2 (.size after-queue))) 30 | (is (not (let [[_ edge] (.peek after-queue)] 31 | (contains? after-edges edge)))) 32 | (is (let [[_ edge] (.poll after-queue)] 33 | (or (= [[1 3] [2 3]] edge) 34 | (= [[2 2] [2 3]] edge))))) 35 | ;; Middle 36 | (let [queue (java.util.PriorityQueue.) 37 | known-edges (set (graph/all-edges 3 4)) 38 | [after-queue after-edges] (#'meiro.prim/to-active! 39 | (#'meiro.prim/pos-edges [1 2]) 40 | queue 41 | known-edges)] 42 | (is (= 4 (.size after-queue))) 43 | (is (not (let [[_ edge] (.peek after-queue)] 44 | (contains? after-edges edge)))) 45 | (is (let [[_ edge] (.poll after-queue)] 46 | (or (= [[0 2] [1 2]] edge) 47 | (= [[1 1] [1 2]] edge) 48 | (= [[1 2] [2 2]] edge) 49 | (= [[1 2] [1 3]] edge))))))) 50 | 51 | 52 | (deftest newer-pos-test 53 | (testing "Get the newer position from an edge." 54 | (is (nil? (#'meiro.prim/newer-pos #{[0 0] [0 1]} 55 | [[0 0] [0 1]]))) 56 | (is (= [0 1] 57 | (#'meiro.prim/newer-pos #{[0 0]} 58 | [[0 0] [0 1]]))))) 59 | 60 | 61 | (deftest create-test 62 | (testing "Creating a maze using Prim's Algorithm." 63 | (is (= (dec (* 8 12)) 64 | (count (:edges (prim/create 8 12)))))) 65 | (testing "Ensure all cells are linked." 66 | (is (every? 67 | #(not-any? empty? %) 68 | (graph/forest-to-maze (prim/create 10 12)))))) 69 | -------------------------------------------------------------------------------- /src/meiro/graph.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.graph 2 | "Graph-based functions for creating mazes. 3 | While most of the functions in the core namespace use a position-aware grid, 4 | these functions work in direct terms of nodes and edges." 5 | (:require [meiro.core :as m] 6 | [meiro.weave :as w] 7 | [clojure.set] 8 | [clojure.spec.alpha :as spec])) 9 | 10 | 11 | ;; Nodes (cells) are [x y] coordinates, but y increases as it goes down. 12 | ;; Treat [0 0] as the northwest corner of a grid or maze. 13 | (spec/def ::node (spec/tuple :row nat-int? :col nat-int?)) 14 | 15 | ;; Edges are a pair of nodes. They need not be adjacent. 16 | (spec/def ::edge (spec/tuple ::node :kind vector? :count 2 :distinct true)) 17 | 18 | ;; Forests are a map of nodes and edges. A spanning tree is complete when there 19 | ;; is only one forest remaining. 20 | (spec/def ::width pos-int?) 21 | (spec/def ::height pos-int?) 22 | (spec/def ::nodes (spec/coll-of ::node :kind set?)) 23 | (spec/def ::edges (spec/coll-of :edge :kind vector?)) 24 | (spec/def ::forest (spec/keys :req-un [::width ::height ::nodes ::edges])) 25 | 26 | 27 | (spec/fdef all-edges 28 | :args (spec/cat :width ::width :height ::height) 29 | :ret ::edges) 30 | (defn all-edges 31 | "Get all edges in a grid given a width and height." 32 | [width height] 33 | (concat 34 | (for [x (range (dec width)) y (range height)] 35 | [[x y] [(inc x) y]]) 36 | (for [x (range width) y (range (dec height))] 37 | [[x y] [x (inc y)]]))) 38 | 39 | 40 | (spec/fdef init-forests 41 | :args (spec/cat :width ::width :height ::height) 42 | :ret ::forest) 43 | (defn init-forests 44 | "Get all the nodes in a grid and put them into forest maps." 45 | [width height] 46 | (reduce 47 | (fn [acc e] (conj acc {:width width :height height :nodes #{e} :edges []})) 48 | #{} 49 | (for [x (range width) y (range height)] [x y]))) 50 | 51 | 52 | (spec/fdef find-forest 53 | :args (spec/cat :forests ::forest :pos ::node) 54 | :ret ::forest) 55 | (defn find-forest 56 | "Get the forest containing the position." 57 | [forests pos] 58 | (first 59 | (filter 60 | (fn [f] (contains? (:nodes f) pos)) 61 | forests))) 62 | 63 | 64 | (spec/fdef merge-forests 65 | :args (spec/cat :f-1 ::forest :f-2 ::forest :edge ::edge) 66 | :ret ::forest) 67 | (defn merge-forests 68 | "Merge two forests into forest set." 69 | [f-1 f-2 edge] 70 | (let [{ns-1 :nodes es-1 :edges} f-1 71 | {ns-2 :nodes es-2 :edges} f-2] 72 | {:width (or (:width f-1) (:width f-2)) 73 | :height (or (:height f-1) (:height f-2)) 74 | :nodes (clojure.set/union ns-1 ns-2) 75 | :edges (conj (into es-1 es-2) edge)})) 76 | 77 | 78 | (spec/fdef forest-to-maze 79 | :args (spec/cat :forest ::forest) 80 | :ret :meiro.core/maze) 81 | (defn forest-to-maze 82 | "Convert a forest map to the standard maze format used in most PNG functions." 83 | [forest] 84 | (reduce 85 | (fn [maze [[x y] [x' y']]] 86 | (w/link maze [y x] [y' x'])) 87 | (m/init (:height forest) (:width forest)) 88 | (:edges forest))) 89 | -------------------------------------------------------------------------------- /src/meiro/polar.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.polar 2 | "Polar (circular) maze generation. 3 | Although a rectangular grid can be used to generate polar mazes, this leads to 4 | mazes pinched in the center and wide at the edges. The solution presented here 5 | seeks to maintain roughly square cell proportions by increasing the number of 6 | cells per row as it gets further away from the center. Polar grids cannot 7 | rely on simple coordinate math to determine neighbors. All polar cells, 8 | except the center, will have a single 'inward', 'clockwise', 9 | and 'counter-clockwise' neighbor, but can have multiple 'outward' 10 | neighbors." 11 | (:require [meiro.core :as m]) 12 | (:import (java.lang Math))) 13 | 14 | 15 | (defn init 16 | "Initialize a polar grid of cells with the given number of rows, 17 | which can be accessed by index. Conceptually, [0 0] is the center; 18 | [1, 0] is the cell directly 'east' from the center. Rendering functions expect 19 | that rows start along the positive x axis and rotate clockwise." 20 | ([rows] (init rows [])) 21 | ([rows v] 22 | (let [height (/ 1.0 rows)] 23 | (loop [acc [[v]] 24 | row 1] 25 | (if (< row rows) 26 | (let [radius (/ row rows) 27 | circumference (* 2 Math/PI radius) 28 | prev (count (last acc)) 29 | estimated-cell-width (/ circumference prev) 30 | ratio (Math/round (/ estimated-cell-width height)) 31 | cells (* prev ratio)] 32 | (recur (conj acc (vec (repeat cells v))) (inc row))) 33 | acc))))) 34 | 35 | 36 | (defn neighbors 37 | "Get all potential neighbors of a position in a given grid." 38 | [grid pos] 39 | (let [[row col] pos 40 | inward (count (get grid (dec row))) 41 | cells (count (get grid row)) 42 | outward (count (get grid (inc row)))] ; 0 when row is last. 43 | (filter 44 | #(m/in? grid %) 45 | (concat 46 | ;; Inward 47 | (if (= 1 row) ; All row 1 cells have same parent. 48 | [[0 0]] 49 | [[(dec row) (int (Math/floor (* col (/ inward cells))))]]) 50 | ;; Counter/Clockwise. Last cell is neighbor to first cell in row. 51 | (when (pos? row) 52 | [[row (mod (dec col) cells)] [row (mod (inc col) cells)]]) 53 | ;; Outward 54 | (cond 55 | (zero? row) [[1 0] [1 1] [1 2] [1 3] [1 4] [1 5]] 56 | (zero? outward) [] 57 | (= cells outward) [[(inc row) col]] 58 | :else [[(inc row) (* 2 col)] [(inc row) (inc (* 2 col))]]))))) 59 | 60 | 61 | (defn direction 62 | "Get the direction from pos-1 to pos-2. 63 | Assumes [0 0] is the center." 64 | [[row-1 col-1] [row-2 col-2]] 65 | (cond 66 | (< row-1 row-2) [row-2 col-2] ; outward (just link cell) 67 | (> row-1 row-2) :inward 68 | (= col-1 (inc col-2)) :counter-clockwise 69 | (= col-2 (inc col-1)) :clockwise 70 | (zero? col-1) :counter-clockwise ; wrap around 71 | (zero? col-2) :clockwise)) ; wrap around 72 | 73 | 74 | (def link 75 | "Link cells in a polar grid." 76 | (m/link-with direction)) 77 | -------------------------------------------------------------------------------- /src/meiro/ascii.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.ascii 2 | "Generate an ASCII representation of a maze. Useful for debugging." 3 | (:require [clojure.java.io :as io] 4 | [clojure.string :as string])) 5 | 6 | (def ^:private corner "+") 7 | (def ^:private horizontal-wall "---") 8 | (def ^:private verticle-wall "|") 9 | (def ^:private inside-cell " ") 10 | (def ^:private verticle-link " ") 11 | (def ^:private horizontal-link " ") 12 | 13 | (defn- top-level 14 | "Render the top edge of the maze." 15 | [maze] 16 | (string/join 17 | (flatten 18 | (concat 19 | corner 20 | (repeat (count (first maze)) (concat horizontal-wall corner)) 21 | "\n")))) 22 | 23 | (defn- cell-level 24 | "Render the cell level, i.e., where the 'inside' of the cell is displayed. 25 | This may contain values, or will default to just empty space." 26 | ([cell] (cell-level cell inside-cell)) 27 | ([cell inside] 28 | (concat inside 29 | (if (some #{:east} cell) verticle-link verticle-wall)))) 30 | 31 | (defn- bottom-level 32 | "Render the bottom edge of a cell, or precisely the south and south-east 33 | edge." 34 | [cell] 35 | (concat (if (some #{:south} cell) horizontal-link horizontal-wall) corner)) 36 | 37 | (defn render 38 | "Render a maze as ASCII art. Uses the cell-fn if provided." 39 | ([maze] 40 | (apply str 41 | (top-level maze) 42 | (mapcat 43 | (fn [row] 44 | (concat verticle-wall (mapcat cell-level row) "\n" 45 | corner (mapcat bottom-level row) "\n")) 46 | maze))) 47 | ;; Could just call (render maze (fn [_] inside-cell)), but feel like there's 48 | ;; a more elegant solution hiding here which I'll eventually figure out. 49 | ([maze cell-fn] 50 | (apply str 51 | (top-level maze) 52 | (flatten 53 | (for [row (range (count maze))] 54 | (concat 55 | verticle-wall 56 | (for [col (range (count (first maze)))] 57 | (cell-level (get-in maze [row col]) 58 | (cell-fn [row col]))) 59 | "\n" 60 | corner 61 | (for [col (range (count (first maze)))] 62 | (bottom-level (get-in maze [row col]))) 63 | "\n")))))) 64 | 65 | (defn show-distance 66 | "Auxiliary function for rendering distance values inside a cell. 67 | Uses base-36 to avoid spacing issues in smaller mazes." 68 | [distances] 69 | (fn [cell] 70 | (str \space (Integer/toString (get-in distances cell) 36) \space))) 71 | 72 | (defn show-solution 73 | "Auxiliary function for rendering the solution to a maze." 74 | [solution] 75 | (fn [cell] 76 | (str \space (if (some #{cell} solution) \* \space) \space))) 77 | 78 | (defn line-to-row 79 | "Convert line of 'x' and '.' to a grid row with masked cells." 80 | [line] 81 | (vec (map #(if (= \. %) [] [:mask]) line))) 82 | 83 | (defn read-grid 84 | "Read in an ASCII grid using 'x' to mark masked cells and '.' for open 85 | cells." 86 | [file-name] 87 | (with-open [reader (io/reader file-name)] 88 | (vec (map line-to-row (line-seq reader))))) 89 | -------------------------------------------------------------------------------- /test/meiro/polar_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.polar-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.polar :as polar] 4 | [meiro.backtracker :as backtracker])) 5 | 6 | 7 | (deftest init-test 8 | (testing "Number of cells per row increase." 9 | (is (= [[[]]] (polar/init 1))) 10 | (is (= [[[]] [[] [] [] [] [] []]] (polar/init 2))) 11 | (is (= [[[]] 12 | [[] [] [] [] [] []] 13 | [[] [] [] [] [] [] [] [] [] [] [] []]] 14 | (polar/init 3))) 15 | (is (= 192 16 | (count (last (polar/init 36)))))) 17 | 18 | (testing "Create with value other than []." 19 | (is (= [[nil] [nil nil nil nil nil nil]] (polar/init 2 nil))) 20 | (is (= [[0] 21 | [0 0 0 0 0 0] 22 | [0 0 0 0 0 0 0 0 0 0 0 0]] 23 | (polar/init 3 0))))) 24 | 25 | 26 | (deftest neighbors-test 27 | (testing "Row 0 behavior." 28 | (is (= [[1 0] [1 1] [1 2] [1 3] [1 4] [1 5]] 29 | (polar/neighbors (polar/init 2) [0 0])))) 30 | (testing "Row 1 behavior." 31 | (is (= [[0 0] [1 5] [1 1] [2 0] [2 1]] 32 | (polar/neighbors (polar/init 3) [1 0])))) 33 | (testing "Inward decreases." 34 | (is (= [[1 3] [2 6] [2 8] [3 14] [3 15]] 35 | (polar/neighbors (polar/init 4) [2 7]))) 36 | (is (= [[1 4] [2 7] [2 9] [3 16] [3 17]] 37 | (polar/neighbors (polar/init 4) [2 8]))) 38 | (is (= [[1 4] [2 8] [2 10] [3 18] [3 19]] 39 | (polar/neighbors (polar/init 4) [2 9])))) 40 | (testing "Outward increases." 41 | (is (= [[4 22] [5 21] [5 23] [6 44] [6 45]] 42 | (polar/neighbors (polar/init 7) [5 22]))) 43 | (is (= [[4 23] [5 22] [5 0] [6 46] [6 47]] 44 | (polar/neighbors (polar/init 7) [5 23])))) 45 | (testing "No inward or outward change." 46 | (is (= [[7 13] [8 12] [8 14] [9 13]] 47 | (polar/neighbors (polar/init 10) [8 13])))) 48 | (testing "Last row." 49 | (is (= [[8 13] [9 12] [9 14]] 50 | (polar/neighbors (polar/init 10) [9 13]))))) 51 | 52 | 53 | (deftest direction-test 54 | (testing "Cardinal directions." 55 | (is (= :inward (polar/direction [2 3] [1 3]))) 56 | (is (= :inward (polar/direction [1 5] [0 0]))) 57 | (is (= :inward (polar/direction [1 0] [0 0]))) 58 | (is (= :clockwise (polar/direction [5 1] [5 2]))) 59 | (is (= :counter-clockwise (polar/direction [4 3] [4 2])))) 60 | (testing "Wrap around the grid." 61 | (is (= :clockwise (polar/direction [1 5] [1 0]))) 62 | (is (= :counter-clockwise (polar/direction [1 0] [1 5])))) 63 | (testing "South cells just return coordinates." 64 | (is (= [4 1] (polar/direction [3 1] [4 1]))))) 65 | 66 | 67 | (deftest link-test 68 | (testing "Cells link." 69 | (let [center [0 0] 70 | south [1 3] 71 | maze (polar/link (polar/init 3) center south)] 72 | (is (= [south] (get-in maze center))) 73 | (is (= [:inward] (get-in maze south)))))) 74 | 75 | 76 | (deftest create-test 77 | (testing "Ensure all cells are linked." 78 | (is (every? 79 | #(not-any? empty? %) 80 | (backtracker/create 81 | (polar/init 10) [0 0] polar/neighbors polar/link))))) 82 | -------------------------------------------------------------------------------- /src/meiro/prim.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.prim 2 | "Prims's algorithm uses a minimum spanning tree to connect cells in a maze. 3 | The algorithm starts from a single cell and then chooses the next node based 4 | upon the cost of available edges. As new nodes are added to a forest, its 5 | edges are added to the available edges until the tree is complete." 6 | (:require [meiro.graph :as graph])) 7 | 8 | 9 | ;; NOTE: The code assumes that edges are always given in ascending order. 10 | ;; For example, [[0 1] [0 2]] and not [[0 2] [0 1]]. 11 | 12 | 13 | (defn- pos-edges 14 | "Get all edges to a given position. Does not check for validity." 15 | [[x y :as pos]] 16 | [[[x (dec y)] pos] 17 | [pos [x (inc y)]] 18 | [pos [(inc x) y]] 19 | [[(dec x) y] pos]]) 20 | 21 | 22 | (defn- newer-pos 23 | "Retrieve the newer position from an edge. 24 | Returns nil if both positions in an edge are already in the nodes set. 25 | Will only return one position, so expect undefined behavior elsewhere if post 26 | positions are not in the provided nodes." 27 | [nodes edge] 28 | (first 29 | (remove 30 | (fn [pos] (contains? nodes pos)) 31 | edge))) 32 | 33 | 34 | (defn poll 35 | "Retrieves and removes the head of the queue, or returns nil if this queue is 36 | empty. 37 | Wrapper function to abstract PriorityQueue interface." 38 | [queue] 39 | (let [[_ edge] (.poll queue)] 40 | [edge queue])) 41 | 42 | 43 | (defn to-active! 44 | "Move new edges to the queue, removing them from remaining edges. 45 | It is expected that the queue is a mutable Java PriorityQueue and will modify 46 | the state of the queue." 47 | [new-edges queue remaining-edges] 48 | (reduce 49 | (fn [[q es] e] 50 | (let [remaining (disj es e)] 51 | (if (= es remaining) ; edge was already used or is invalid 52 | [q es] 53 | [(do 54 | (.offer q [(rand-int 10) e]) 55 | q) 56 | remaining]))) 57 | [queue remaining-edges] 58 | new-edges)) 59 | 60 | 61 | (defn create 62 | "Create a maze with the provided dimensions using Prim's algorithm." 63 | [width height] 64 | (let [node-total (* width height) 65 | start-pos [(rand-int width) (rand-int height)] 66 | every-edge (set (graph/all-edges width height)) 67 | [start-queue start-edges] (to-active! (pos-edges start-pos) 68 | (java.util.PriorityQueue.) 69 | every-edge)] 70 | (loop [forest {:width width :height height :nodes #{start-pos} :edges []} 71 | queue start-queue 72 | edges start-edges] 73 | ;; Maze is complete when all nodes are accounted for or queue is empty. 74 | (if (or (= node-total (count (:nodes forest))) (empty? queue)) 75 | forest 76 | (let [[edge rest-q] (poll queue) 77 | pos (newer-pos (:nodes forest) edge)] 78 | ;; Only add the edge if it links to a new position. 79 | (if (seq pos) 80 | (let [[q es] (to-active! (pos-edges pos) rest-q edges)] 81 | (recur 82 | (-> forest 83 | (update :nodes conj pos) 84 | (update :edges conj edge)) 85 | q es)) 86 | (recur forest queue edges))))))) 87 | -------------------------------------------------------------------------------- /test/meiro/kruskal_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.kruskal-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.kruskal :as kruskal] 4 | [meiro.graph :as graph])) 5 | 6 | 7 | (deftest weave-edges-test 8 | (testing "Able to identify non-adjacent edges in forests." 9 | (let [forests #{{:nodes #{[4 3]} :edges []} {:nodes #{[4 4]} :edges []} 10 | {:nodes #{[2 3]}:edges []} {:nodes #{[2 4]} :edges []} 11 | {:nodes #{[2 0]} :edges []} {:nodes #{[0 0]} :edges []} 12 | {:nodes #{[1 0] [1 2]} :edges [[[1 0] [1 2]]]} 13 | {:nodes #{[1 4]} :edges []} {:nodes #{[4 2]} :edges []} 14 | {:nodes #{[0 2]} :edges []} 15 | {:nodes #{[1 1] [4 1] [3 1] [2 1] [0 1]} 16 | :edges [[[0 1] [1 1]] [[1 1] [2 1]] 17 | [[2 1] [3 1]] [[3 1] [4 1]]]} 18 | {:nodes #{[3 0] [3 2]} :edges [[[3 0] [3 2]]]} 19 | {:nodes #{[0 3]} :edges []} {:nodes #{[2 2]} :edges []} 20 | {:nodes #{[1 3]} :edges []} {:nodes #{[3 3]} :edges []} 21 | {:nodes #{[3 4]} :edges []} {:nodes #{[4 0]} :edges []} 22 | {:nodes #{[0 4]} :edges []}}] 23 | (is (= [[[1 0] [1 1]] [[1 1] [1 2]] [[3 0] [3 1]] [[3 1] [3 2]]] 24 | (#'meiro.kruskal/weave-edges forests)))))) 25 | 26 | 27 | (deftest rm-weave-edges-test 28 | (testing "Remove weave edges for collection of edges." 29 | (let [weave-edges [[[1 0] [1 1]] [[1 1] [1 2]] [[3 0] [3 1]] [[3 1] [3 2]]] 30 | all (graph/all-edges 5 5) 31 | without (#'meiro.kruskal/rm-weave-edges all weave-edges)] 32 | (is (every? 33 | (fn [e] (not-any? #{e} without)) 34 | weave-edges))))) 35 | 36 | 37 | (deftest create-test 38 | (testing "Creating a maze using Kruskal's Algorithm." 39 | (is (= (dec (* 8 12)) 40 | (count (:edges (kruskal/create 8 12)))))) 41 | (testing "Ensure all cells are linked." 42 | (is (every? 43 | #(not-any? empty? %) 44 | (graph/forest-to-maze (kruskal/create 10 12)))))) 45 | 46 | 47 | (deftest weave-test 48 | (let [forests (graph/init-forests 3 3)] 49 | (testing "Can add weaves to forests for a Kruskal's maze." 50 | (is (= [[[0 1] [2 1]]] 51 | (-> forests 52 | (kruskal/weave [1 1] :horizontal) 53 | (graph/find-forest [0 1]) 54 | :edges))) 55 | (is (= [[[1 0] [1 1]] [[1 1] [1 2]]] 56 | (-> forests 57 | (kruskal/weave [1 1] :horizontal) 58 | (graph/find-forest [1 1]) 59 | :edges))) 60 | (is (= [[[0 1] [1 1]] [[1 1] [2 1]]] 61 | (-> forests 62 | (kruskal/weave [1 1] :vertical) 63 | (graph/find-forest [1 1]) 64 | :edges))) 65 | (is (= [[[1 0] [1 2]]] 66 | (-> forests 67 | (kruskal/weave [1 1] :vertical) 68 | (graph/find-forest [1 0]) 69 | :edges)))) 70 | (testing "Invalid requests return original forests." 71 | (is (= forests 72 | (kruskal/weave forests [0 0]))) 73 | (is (= forests 74 | (kruskal/weave forests [0 1])))))) 75 | -------------------------------------------------------------------------------- /src/meiro/sidewinder.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.sidewinder 2 | "Sidewinder algorithm is like binary-tree, but randomly chooses a position in 3 | a horizontal corridor to move south from when moving south. This algorithm's 4 | bias creates vertical paths and will always have a single corridor along 5 | the southern edge." 6 | (:require [meiro.core :as m] 7 | [clojure.data.generators :as gen])) 8 | 9 | 10 | (def ^:private default-weights 11 | "Constants allow for different weights for each direction. 12 | Higher south weight has longer vertical corridors. 13 | Higher east weight has longer horizontal corridors." 14 | {:south 4 :east 5}) 15 | 16 | 17 | (defn- possible-directions 18 | "Determine which directions are valid from the provided pos." 19 | [maze pos] 20 | (vals 21 | (filter 22 | #(m/in? maze (first %)) 23 | {(m/south pos) :south (m/east pos) :east}))) 24 | 25 | 26 | (defn- path-west 27 | "Get a path sequence of positions west of the provided position, 28 | including that position." 29 | [maze pos] 30 | (if (seq (filter #{:west} (get-in maze pos))) 31 | (cons pos (path-west maze (m/west pos))) 32 | [pos])) 33 | 34 | 35 | (defn- link-fn 36 | "Generate a function which will link a given position to a random neighbor to 37 | the south or east. When linking to south, the link will be created from any 38 | position in the current east-west corridor, not necessarily from `pos`." 39 | [weights] 40 | (fn [maze pos] 41 | (let [directions (possible-directions maze pos)] 42 | (if (seq directions) 43 | (case (gen/weighted (select-keys weights directions)) 44 | :east (m/link maze pos (m/east pos)) 45 | :south (let [from (rand-nth (path-west maze pos))] 46 | (m/link maze from (m/south from)))) 47 | maze)))) 48 | 49 | 50 | (defn create 51 | "Create a random maze using the sidewinder algorithm." 52 | ([grid] (create grid default-weights)) 53 | ([grid weights] 54 | (reduce 55 | (link-fn weights) 56 | grid 57 | (for [row (range (count grid)) col (range (count (first grid)))] 58 | [row col])))) 59 | 60 | 61 | (defn- corridor 62 | "Get a path sequence of linked positions west of the provided position, 63 | including that position." 64 | [row pos] 65 | (cons pos 66 | (take-while 67 | (fn [pos] (= [:east] (get row pos))) 68 | (range (dec pos) -1 -1)))) 69 | 70 | 71 | (defn- create-row 72 | "Create a maze row using the Sidewinder algorithm. 73 | This approach does not create mutual links, but only links to the south 74 | or east." 75 | ([width weights] 76 | (reduce 77 | (fn [row pos] 78 | (case (gen/weighted (select-keys weights [:east :south])) 79 | :east (assoc row pos [:east]) 80 | :south (let [from (rand-nth (corridor row pos))] 81 | (update row from conj :south)))) 82 | (conj (vec (repeat (dec width) [])) [:south]) 83 | (range (dec width))))) 84 | 85 | 86 | (defn last-row 87 | "Create the last row of a Sindwinder maze." 88 | [width] 89 | (conj 90 | (vec (repeat (dec width) [:east])) 91 | [:west])) 92 | 93 | 94 | (defn create-lazy 95 | "Create a potentially infinite Sidewinder maze." 96 | ([width] (create-lazy width default-weights)) 97 | ([width weights] 98 | (cons (create-row width weights) 99 | (lazy-seq (create-lazy width weights))))) 100 | -------------------------------------------------------------------------------- /test/meiro/grid_3d_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.grid-3d-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.grid-3d :as grid-3d])) 4 | 5 | ;;; Position Functions 6 | 7 | (deftest adjacent-test 8 | (testing "true if cells are adjacent." 9 | (is (grid-3d/adjacent? [0 0 0] [0 0 1])) 10 | (is (grid-3d/adjacent? [0 0 0] [0 1 0])) 11 | (is (grid-3d/adjacent? [0 0 0] [1 0 0])) 12 | (is (not (grid-3d/adjacent? [0 0 0] [0 0 2]))) 13 | (is (not (grid-3d/adjacent? [0 0 0] [0 2 0]))) 14 | (is (not (grid-3d/adjacent? [0 0 0] [2 0 0]))) 15 | (is (not (grid-3d/adjacent? [0 0 0] [0 1 1]))) 16 | (is (not (grid-3d/adjacent? [0 0 0] [1 0 1]))) 17 | (is (not (grid-3d/adjacent? [0 0 0] [1 1 0]))))) 18 | 19 | 20 | (deftest direction-test 21 | (testing "Cardinal directions." 22 | (is (= :down (grid-3d/direction [2 2 3] [1 2 3]))) 23 | (is (= :up (grid-3d/direction [2 2 3] [3 2 3]))) 24 | (is (= :north (grid-3d/direction [2 2 3] [2 1 3]))) 25 | (is (= :south (grid-3d/direction [2 3 1] [2 4 1]))) 26 | (is (= :east (grid-3d/direction [2 5 1] [2 5 2]))) 27 | (is (= :west (grid-3d/direction [2 4 3] [2 4 2])))) 28 | (testing "Not adjacent." 29 | (is (nil? (grid-3d/direction [0 0 0] [0 0 0]))) 30 | (is (nil? (grid-3d/direction [0 0 0] [2 0 0]))) 31 | (is (nil? (grid-3d/direction [0 0 0] [0 2 0]))) 32 | (is (nil? (grid-3d/direction [0 0 0] [0 0 2]))))) 33 | 34 | 35 | (deftest init-test 36 | (testing "First levels, then rows, each row contains columns." 37 | (let [grid (grid-3d/init 4 5 3)] 38 | (is (= [[[[] [] []] [[] [] []] [[] [] []] [[] [] []] [[] [] []]] 39 | [[[] [] []] [[] [] []] [[] [] []] [[] [] []] [[] [] []]] 40 | [[[] [] []] [[] [] []] [[] [] []] [[] [] []] [[] [] []]] 41 | [[[] [] []] [[] [] []] [[] [] []] [[] [] []] [[] [] []]]] 42 | grid)) 43 | (is (= 4 (count grid))) 44 | (is (= 5 (count (first grid)))) 45 | (is (= 3 (count (first (first grid)))))))) 46 | 47 | 48 | (deftest in?-test 49 | (testing "Checking whether positions are in a grid." 50 | (let [grid (grid-3d/init 4 5 3)] 51 | (is (grid-3d/in? grid [0 0 0])) 52 | (is (grid-3d/in? grid [3 4 2])) 53 | (is (not (grid-3d/in? grid [0 0 -1]))) 54 | (is (not (grid-3d/in? grid [0 -1 0]))) 55 | (is (not (grid-3d/in? grid [-1 0 0]))) 56 | (is (not (grid-3d/in? grid [3 4 3]))) 57 | (is (not (grid-3d/in? grid [3 5 2]))) 58 | (is (not (grid-3d/in? grid [4 4 2])))))) 59 | 60 | 61 | (deftest neighbors-test 62 | (testing "Get all neighbors for a position." 63 | (let [grid (grid-3d/init 3 4 3)] 64 | (is (= [[0 1 0] [1 0 0] [0 0 1]] 65 | (grid-3d/neighbors grid [0 0 0]))) 66 | (is (= [[2 3 1] [1 3 2] [2 2 2]] 67 | (grid-3d/neighbors grid [2 3 2]))) 68 | (is (= [[1 3 1] [1 1 1] [2 2 1] [1 2 0] [1 2 2] [0 2 1]] 69 | (grid-3d/neighbors grid [1 2 1])))))) 70 | 71 | 72 | (deftest random-pos-test 73 | (testing "Random position is from within the grid." 74 | (let [grid (grid-3d/init 6 5 4)] 75 | (is (grid-3d/in? grid (grid-3d/random-pos grid))))) 76 | (testing "Ignore masked cells." 77 | (let [base (grid-3d/init 2 2 2) 78 | grid (reduce (fn [acc e] (update-in acc e conj :mask)) base 79 | (for [z [0 1] y [0 1] x [0 1] 80 | :when (not= 0 z y x)] 81 | [z y x]))] 82 | (is (= [0 0 0] (grid-3d/random-pos grid)))))) 83 | -------------------------------------------------------------------------------- /src/meiro/division.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.division 2 | "The Recursive Division algorithm is a 'wall adding' algorithm, which divides 3 | a completely open grid into subsections until it can no longer be subdivided." 4 | (:require [meiro.core :as m])) 5 | 6 | 7 | (defn- link-all 8 | "Generate a grid where all cells are already linked." 9 | [grid] 10 | (let [rows (count grid) 11 | columns (count (first grid))] 12 | (as-> grid g 13 | (reduce (fn [acc e] (update-in acc e conj :north)) g 14 | (for [row (range 1 rows) col (range columns)] [row col])) 15 | (reduce (fn [acc e] (update-in acc e conj :south)) g 16 | (for [row (range (dec rows)) col (range columns)] [row col])) 17 | (reduce (fn [acc e] (update-in acc e conj :east)) g 18 | (for [row (range rows) col (range (dec columns))] [row col])) 19 | (reduce (fn [acc e] (update-in acc e conj :west)) g 20 | (for [row (range rows) col (range 1 columns)] [row col]))))) 21 | 22 | 23 | (declare divide) 24 | 25 | 26 | (defn- divide-horizontal 27 | "Divide a grid horizontally." 28 | [grid row col height width div-fn] 29 | (let [south-of (rand-int (dec height)) 30 | passage-at (+ col (rand-int width))] 31 | (-> 32 | (reduce 33 | (fn [acc e] (m/unlink acc e (m/south e))) 34 | grid 35 | (for [c (range col (+ col width)) 36 | :when (not= c passage-at)] 37 | [(+ row south-of) c])) 38 | (divide row col (inc south-of) width div-fn) 39 | (divide (+ row south-of 1) col (- height south-of 1) width div-fn)))) 40 | 41 | 42 | (defn- divide-vertical 43 | "Divide a grid vertically." 44 | [grid row col height width div-fn] 45 | (let [east-of (rand-int (dec width)) 46 | passage-at (+ row (rand-int height))] 47 | (-> 48 | (reduce 49 | (fn [acc e] (m/unlink acc e (m/east e))) 50 | grid 51 | (for [r (range row (+ row height)) 52 | :when (not= r passage-at)] 53 | [r (+ col east-of)])) 54 | (divide row col height (inc east-of) div-fn) 55 | (divide row (+ col east-of 1) height (- width east-of 1) div-fn)))) 56 | 57 | 58 | (defn- divide? 59 | "Should a grid with the given height and width be divided further?" 60 | [height width] 61 | (or (<= height 1) (<= width 1))) 62 | 63 | 64 | (defn- divide-fn 65 | "Generate a function to determine whether a grid with the given height and 66 | width be divided further? 67 | Allow for random rooms of up to `size` to be created within the maze. 68 | Rooms will be created at `rate` frequency whenever a sub-grid is below the 69 | `size` threshold, such that 1.0 will always create rooms and 0.0 will never." 70 | [size rate] 71 | (fn [height width] 72 | (or (<= height 1) (<= width 1) 73 | (and (<= height size) (<= width size) (< (rand) rate))))) 74 | 75 | 76 | (defn- divide 77 | "Divide a grid. 78 | The function will work against a sub-grid defined by the `row` and `column` 79 | as the northwest corner and extending `height` and `width` from that point. 80 | A wall with a single passage will be created within the sub-grid, and then 81 | each recursively call this function with the resulting sub-grid from that 82 | division." 83 | ([grid row column height width] (divide grid row column height width divide?)) 84 | ([grid row column height width decision-fn] 85 | (if (decision-fn height width) 86 | grid 87 | (if (> height width) 88 | (divide-horizontal grid row column height width decision-fn) 89 | (divide-vertical grid row column height width decision-fn))))) 90 | 91 | 92 | (defn create 93 | "Create a random maze using the Recursive Division algorithm." 94 | ([grid] 95 | (divide (link-all grid) 0 0 (count grid) (count (first grid)))) 96 | ([grid room-size room-rate] 97 | (divide (link-all grid) 0 0 (count grid) (count (first grid)) 98 | (divide-fn room-size room-rate)))) 99 | -------------------------------------------------------------------------------- /src/meiro/grid_3d.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.grid-3d 2 | "Utilities for generating three dimensional mazes. 3 | In addition to the four cardinal directions, cells can link up and down. 4 | Positions are identified by [level, row, column]." 5 | (:require [clojure.spec.alpha :as spec])) 6 | 7 | 8 | (spec/def ::pos (spec/tuple :level nat-int? :row nat-int? :col nat-int?)) 9 | 10 | (spec/def ::direction #{:up :down :north :south :east :west}) 11 | 12 | (spec/def ::grid 13 | (spec/coll-of 14 | (spec/coll-of 15 | (spec/coll-of (spec/and coll? empty?) :kind vector? :into vector?) 16 | :kind vector? :into vector?) 17 | :kind vector? :into vector?)) 18 | 19 | 20 | ;;; Position Functions 21 | 22 | (spec/fdef adjacent? 23 | :args (spec/cat :pos-0 ::pos :pos-1 ::pos) 24 | :ret boolean?) 25 | (defn adjacent? 26 | "Are two positions adjacent. 27 | Function does not check that positions are within the bounds of a grid." 28 | [[level-1 row-1 col-1] [level-2 row-2 col-2]] 29 | (or 30 | (and (= level-1 level-2) 31 | (= row-1 row-2) 32 | (= 1 (Math/abs ^int (- col-1 col-2)))) 33 | (and (= level-1 level-2) 34 | (= 1 (Math/abs ^int (- row-1 row-2))) 35 | (= col-1 col-2)) 36 | (and (= 1 (Math/abs ^int (- level-1 level-2))) 37 | (= row-1 row-2) 38 | (= col-1 col-2)))) 39 | 40 | 41 | (spec/fdef direction 42 | :args (spec/cat :pos-0 ::pos :pos-1 ::pos) 43 | :ret ::direction) 44 | (defn direction 45 | "Get the direction from pos-1 to pos-2. 46 | Assumes [0 0 0] is the lower-north-west corner." 47 | [[level-1 row-1 col-1] [level-2 row-2 col-2]] 48 | (case [(- level-1 level-2) (- row-1 row-2) (- col-1 col-2)] 49 | [1 0 0] :down 50 | [-1 0 0] :up 51 | [0 1 0] :north 52 | [0 -1 0] :south 53 | [0 0 1] :west 54 | [0 0 -1] :east 55 | nil)) 56 | 57 | 58 | (spec/fdef init 59 | :args (spec/alt 60 | :3-args (spec/cat :level nat-int? :row nat-int? :col nat-int?) 61 | :4-args (spec/cat :level nat-int? :row nat-int? :col nat-int? 62 | :v (spec/and coll? empty?))) 63 | :ret ::grid) 64 | (defn init 65 | "Initialize a grid of cells with the given number of levels, rows, and 66 | columns, which can be accessed by index. Conceptually, [0 0 0] is the lower 67 | north-west corner." 68 | ([levels rows columns] (init levels rows columns [])) 69 | ([levels rows columns v] 70 | (vec (repeat levels 71 | (vec (repeat rows 72 | (vec (repeat columns v)))))))) 73 | 74 | 75 | (spec/fdef in? 76 | :args (spec/cat :grid ::grid :pos ::pos) 77 | :ret boolean?) 78 | (defn in? 79 | "Is the position within the bounds of the grid." 80 | [grid [level row col]] 81 | (let [max-level (dec (count grid)) 82 | max-row (dec (count (get grid level))) 83 | max-col (dec (count (get-in grid [level row])))] 84 | (and 85 | (<= 0 level max-level) 86 | (<= 0 row max-row) 87 | (<= 0 col max-col)))) 88 | 89 | 90 | (spec/fdef neighbors 91 | :args (spec/cat :grid ::grid :pos ::pos) 92 | :ret (spec/coll-of ::pos)) 93 | (defn neighbors 94 | "Get all potential neighbors of a position in a given grid" 95 | [grid [level row col]] 96 | (filter 97 | #(in? grid %) 98 | #{[(dec level) row col] [(inc level) row col] 99 | [level (dec row) col] [level (inc row) col] 100 | [level row (dec col)] [level row (inc col)]})) 101 | 102 | 103 | (spec/fdef random-pos 104 | :args (spec/cat :grid ::grid) 105 | :ret ::pos) 106 | (defn random-pos 107 | "Select a random position from the grid." 108 | [grid] 109 | (let [pos [(rand-int (count grid)) 110 | (rand-int (count (first grid))) 111 | (rand-int (count (ffirst grid)))]] 112 | ;; When grids contain masked cells, make sure to return an unmasked cell. 113 | (if (empty? (get-in grid pos)) 114 | pos 115 | (random-pos grid)))) 116 | -------------------------------------------------------------------------------- /src/meiro/dijkstra.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.dijkstra 2 | "Dijkstra's algorithm for measuring distances. This in turn can be used to 3 | find solutions as well as shortest and longest paths." 4 | (:require [meiro.core :as m])) 5 | 6 | 7 | (defn- empty-neighbors 8 | "Given a grid of distances, find neighbors of a pos which haven't been 9 | calculated yet." 10 | [grid pos neighbors] 11 | (filter 12 | #(nil? (get-in grid %)) 13 | (map #(m/pos-to % pos) neighbors))) 14 | 15 | 16 | (defn- init-distances 17 | "Initialize the distance calculation grid." 18 | [grid] 19 | (m/init (count grid) (count (first grid)) nil)) 20 | 21 | 22 | (defn distances 23 | "Calculate distances to each pos relative from starting pos. 24 | Assumes a perfect maze." 25 | ([maze] (distances maze [0 0])) 26 | ([maze pos] 27 | (distances maze pos (init-distances maze) 0)) 28 | ([maze pos acc dist] 29 | (if (seq pos) 30 | (reduce 31 | #(distances maze %2 %1 (inc dist)) 32 | (assoc-in acc pos dist) 33 | (empty-neighbors acc pos (get-in maze pos))) 34 | acc))) 35 | 36 | 37 | (defn distances-by-breadth 38 | "Calculate distances to each position relative from the starting position 39 | (defaults to [0 0] if not provided. Does a breadth-first search, so it can 40 | handle non-perfect mazes or mazes with rooms." 41 | ([maze] (distances-by-breadth maze [0 0])) 42 | ([maze pos] 43 | (loop [neighbors (list pos) 44 | acc (init-distances maze) 45 | dist 0] 46 | (if (seq neighbors) 47 | (let [level (reduce (fn [a e] (assoc-in a e dist)) acc neighbors)] 48 | (recur 49 | (set (mapcat 50 | (fn [pos] (empty-neighbors level pos (get-in maze pos))) 51 | neighbors)) 52 | level 53 | (inc dist))) 54 | acc)))) 55 | 56 | 57 | (defn solution 58 | "Provide the path between to two cells in the maze." 59 | [maze start end] 60 | (let [dist (distances maze start) 61 | step (fn [pos n] 62 | (last (filter #(= (dec n) (get-in dist %)) 63 | (map #(m/pos-to % pos) (get-in maze pos)))))] 64 | (loop [acc '() 65 | pos end] 66 | (let [n (get-in dist pos)] 67 | (if (zero? n) 68 | (conj acc pos) 69 | (recur (conj acc pos) (step pos n))))))) 70 | 71 | 72 | (defn shortest-path 73 | "Get the shortest path between two positions in a maze. 74 | Accommodates non-perfect mazes." 75 | ([maze start end] 76 | (let [dist (distances-by-breadth maze start) 77 | step (fn [pos n] 78 | (filter #(= (dec n) (get-in dist %)) 79 | (map #(m/pos-to % pos) (get-in maze pos))))] 80 | ((fn get-shorty [paths] 81 | (let [n (get-in dist (ffirst paths))] 82 | (if (zero? n) 83 | (first paths) 84 | (get-shorty 85 | (reduce 86 | (fn [acc [head & _ :as path]] 87 | (let [steps (step head n)] 88 | (if (seq steps) 89 | (map (fn [e] (conj path e)) steps) 90 | acc))) 91 | '() paths))))) 92 | (list (list end)))))) 93 | 94 | 95 | (defn farthest-pos 96 | "Find the farthest position from a given position, using [0 0] if none is 97 | provided." 98 | ([maze] (farthest-pos maze [0 0])) 99 | ([maze pos] 100 | (let [dist (distances maze pos)] 101 | (second 102 | (last 103 | (sort-by first 104 | (for [[x row] (map-indexed vector dist) 105 | [y v] (map-indexed vector row)] 106 | [v [x y]]))))))) 107 | 108 | 109 | (defn longest-path 110 | "Provide the path between the cells farthest apart in the maze." 111 | [maze] 112 | (let [farthest (farthest-pos maze) 113 | and-back (farthest-pos maze farthest)] 114 | (solution maze and-back farthest))) 115 | -------------------------------------------------------------------------------- /src/meiro/weave.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.weave 2 | "Functions for generating a weave maze. 3 | Unless otherwise stated, these functions are designed to work on rectangular 4 | grids. Weave mazes are allowed to pass under neighbors when certain conditions 5 | are met. 6 | * Passages cannot dead end while underneath another cell. 7 | * Passages must be perpendicular, one north-south, one east-west. 8 | * Passages cannot change direction while traveling under other passages." 9 | (:require [meiro.core :as m])) 10 | 11 | 12 | (defn north-south? 13 | "Check if a cell is a north-south corridor." 14 | [cell] 15 | (= #{:north :south} (set cell))) 16 | 17 | 18 | (defn east-west? 19 | "Check if a cell is an east-west corridor." 20 | [cell] 21 | (= #{:east :west} (set cell))) 22 | 23 | 24 | (defn- cells-to 25 | "Get a sequence of cell positions in a given direction." 26 | [maze dir-fn pos] 27 | (take-while 28 | #(m/in? maze %) 29 | (cons (dir-fn pos) 30 | (lazy-seq (cells-to maze dir-fn (dir-fn pos)))))) 31 | 32 | 33 | (defn- weave-cell-fn 34 | "Generate a function which which check for a weave candidate in a given 35 | direction." 36 | [corridor-fn dir-fn next-fn] 37 | (fn 38 | [maze pos] 39 | (when (corridor-fn (get-in maze (next-fn pos))) 40 | (first 41 | (take-while 42 | (fn [pos] 43 | (empty? (get-in maze pos))) 44 | (drop-while 45 | (fn [pos] 46 | (corridor-fn (get-in maze pos))) 47 | (cells-to maze dir-fn (next-fn pos)))))))) 48 | 49 | 50 | (def cell-west 51 | "Return a cell to the west if it matches weave conditions." 52 | (weave-cell-fn north-south? m/west 53 | (fn [[row col]] [row (dec col)]))) 54 | 55 | 56 | (def cell-east 57 | "Return a cell to the east if it matches weave conditions." 58 | (weave-cell-fn north-south? m/east 59 | (fn [[row col]] [row (inc col)]))) 60 | 61 | 62 | (def cell-north 63 | "Return a cell to the north if it matches weave conditions." 64 | (weave-cell-fn east-west? m/north 65 | (fn [[row col]] [(dec row) col]))) 66 | 67 | 68 | (def cell-south 69 | "Return a cell to the south if it matches weave conditions." 70 | (weave-cell-fn east-west? m/south 71 | (fn [[row col]] [(inc row) col]))) 72 | 73 | 74 | (defn neighbors 75 | "Get all potential neighbors of a position in a given maze." 76 | [maze pos] 77 | (filter 78 | #(m/in? maze %) 79 | (list 80 | (cell-north maze pos) (m/north pos) 81 | (m/south pos) (cell-south maze pos) 82 | (m/east pos) (cell-east maze pos) 83 | (cell-west maze pos) (m/west pos)))) 84 | 85 | 86 | (defn positions-between 87 | "Get the path between two positions, not including the provided positions." 88 | [[row-1 col-1] [row-2 col-2]] 89 | (if (= row-1 row-2) 90 | (if (< col-1 col-2) 91 | (map (fn [col] [row-1 col]) (range (inc col-1) col-2)) 92 | (map (fn [col] [row-1 col]) (range (inc col-2) col-1))) 93 | (if (< row-1 row-2) 94 | (map (fn [row] [row col-1]) (range (inc row-1) row-2)) 95 | (map (fn [row] [row col-1]) (range (inc row-2) row-1))))) 96 | 97 | 98 | (defn link 99 | "Link two cells in a maze, including creating under passages to weave." 100 | ([maze pos-1 pos-2] 101 | (if (m/adjacent? pos-1 pos-2) 102 | (-> maze 103 | (update-in pos-1 conj (m/direction pos-1 pos-2)) 104 | (update-in pos-2 conj (m/direction pos-2 pos-1))) 105 | (as-> maze $ 106 | (update-in $ pos-1 conj pos-2) 107 | (update-in $ pos-2 conj pos-1) 108 | (reduce 109 | (fn [acc e] (update-in acc e conj :under)) 110 | $ (positions-between pos-1 pos-2)))))) 111 | 112 | 113 | (defn direction 114 | "Get the direction from pos-1 to pos-2, even if not adjacent. 115 | Assumes [0 0] is the north-west corner." 116 | [[row-1 col-1] [row-2 col-2]] 117 | (if (= row-1 row-2) 118 | (if (> col-1 col-2) 119 | :west 120 | :east) 121 | (if (> row-1 row-2) 122 | :north 123 | :south))) 124 | -------------------------------------------------------------------------------- /src/meiro/unicode.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.unicode 2 | "Unicode rendering of a maze. 3 | 4 | NOTE: Not pretty. This is super clunky, since all maze edges are treated 5 | exceptionally. I don't intend to revist this code to clean it up." 6 | (:require [meiro.core :as m])) 7 | 8 | (def ^:private corner "\u254b") 9 | (def ^:private nw-corner "\u250f") 10 | (def ^:private ne-corner "\u2513") 11 | (def ^:private sw-corner "\u2517") 12 | (def ^:private se-corner "\u251b") 13 | (def ^:private nes-tee "\u2523") 14 | (def ^:private nws-tee "\u252b") 15 | (def ^:private wse-tee "\u2533") 16 | (def ^:private wne-tee "\u253b") 17 | (def ^:private ew-edge "\u2501") 18 | ;; These are the right size, but don't align correctly. 19 | ; (def ^:private n-edge "\u2579") 20 | ; (def ^:private s-edge "\u257b") 21 | ; (def ^:private e-edge "\u257a") 22 | ; (def ^:private w-edge "\u2578") 23 | (def ^:private n-edge "\u2503") 24 | (def ^:private s-edge "\u2503") 25 | (def ^:private e-edge "\u2501") 26 | (def ^:private w-edge "\u2501") 27 | (def ^:private horizontal-wall "\u2501\u2501") 28 | (def ^:private verticle-wall "\u2503") 29 | (def ^:private inside-cell " ") 30 | (def ^:private verticle-link " ") 31 | (def ^:private horizontal-link " ") 32 | 33 | (defn- top-level [maze] 34 | (apply str 35 | (flatten 36 | (concat 37 | nw-corner 38 | (map 39 | #(concat horizontal-wall (if (some #{:east} %) ew-edge wse-tee)) 40 | (butlast (first maze))) 41 | horizontal-wall ne-corner 42 | "\n")))) 43 | 44 | (defn- cell-level [cell] 45 | (concat inside-cell 46 | (if (some #{:east} cell) verticle-link verticle-wall))) 47 | 48 | (defn- bottom-row 49 | "Get south and south-east characters for a given row." 50 | [maze cell] 51 | (case [(some #{:south} (get-in maze cell)) 52 | (some #{:east} (get-in maze cell)) 53 | (some #{:east} (get-in maze (m/south cell))) 54 | (some #{:south} (get-in maze (m/east cell)))] 55 | [:south :east :east nil] [horizontal-link e-edge] 56 | [:south :east nil :south] [horizontal-link s-edge] 57 | [:south nil :east :south] [horizontal-link n-edge] 58 | [nil :east :east :south] [horizontal-wall w-edge] 59 | [nil :east :east nil] [horizontal-wall ew-edge] 60 | [:south nil nil :south] [horizontal-link verticle-wall] 61 | [:south :east nil nil] [horizontal-link nw-corner] 62 | [nil :east nil :south] [horizontal-wall ne-corner] 63 | [nil nil :east :south] [horizontal-wall se-corner] 64 | [:south nil :east nil] [horizontal-link sw-corner] 65 | [:south nil nil nil] [horizontal-link nes-tee] 66 | [nil nil nil :south] [horizontal-wall nws-tee] 67 | [nil :east nil nil] [horizontal-wall wse-tee] 68 | [nil nil :east nil] [horizontal-wall wne-tee] 69 | [nil nil nil nil] [horizontal-wall corner])) 70 | 71 | (defn- bottom-left 72 | [maze cell] 73 | (if (some #{:south} (get-in maze cell)) 74 | verticle-wall 75 | nes-tee)) 76 | 77 | (defn- bottom-last 78 | [maze cell] 79 | (if (some #{:south} (get-in maze cell)) 80 | [horizontal-link verticle-wall] 81 | [horizontal-wall nws-tee])) 82 | 83 | (defn- last-row 84 | [row] 85 | (flatten 86 | (concat 87 | verticle-wall 88 | (map cell-level row) 89 | "\n" 90 | sw-corner 91 | (map (fn [cell] 92 | [horizontal-wall 93 | (if (some #{:east} cell) verticle-link verticle-wall)]) 94 | (butlast row)) 95 | horizontal-wall se-corner "\n"))) 96 | 97 | (defn render 98 | "Render a maze as unicode art." 99 | [maze] 100 | (apply 101 | str 102 | (concat 103 | (top-level maze) 104 | (flatten 105 | (for [row (range (dec (count maze)))] 106 | (concat 107 | verticle-wall 108 | (for [col (range (count (first maze)))] 109 | (cell-level (get-in maze [row col]))) 110 | "\n" 111 | (bottom-left maze [row 0]) 112 | (for [col (range (dec (count (first maze))))] 113 | (bottom-row maze [row col])) 114 | (bottom-last maze [row (dec (count (first maze)))]) 115 | "\n"))) 116 | (last-row (last maze))))) 117 | -------------------------------------------------------------------------------- /test/meiro/eller_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.eller-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.graph :as graph] 4 | [meiro.eller :as eller])) 5 | 6 | 7 | (deftest for-forests-test 8 | (testing "Get the forests for a given row." 9 | (is (= #{{:width 3 :height 1 :nodes #{[0 0]} :edges []} 10 | {:width 3 :height 1 :nodes #{[1 0]} :edges []} 11 | {:width 3 :height 1 :nodes #{[2 0]} :edges []}} 12 | (eller/for-forests #{} 0 3 1))) 13 | (is (= #{{:width 3 :height 3 :nodes #{[0 2]} :edges []} 14 | {:width 3 :height 3 :nodes #{[1 2]} :edges []} 15 | {:width 3 :height 3 :nodes #{[2 2]} :edges []}} 16 | (eller/for-forests #{} 2 3 3))) 17 | (is (= #{{:width 3 :height 1 :nodes #{[0 0]} :edges []} 18 | {:width 3 :height 1 :nodes #{[1 0]} :edges []} 19 | {:width 3 :height 1 :nodes #{[2 0]} :edges []}} 20 | (eller/for-forests 21 | #{{:width 3 :height 1 :nodes #{[1 0]} :edges []}} 22 | 0 3 1))) 23 | (is (= #{{:width 3 :height 2 :nodes #{[0 1]} 24 | :edges []} 25 | {:width 3 :height 2 :nodes #{[1 1] [0 0] [1 0]} 26 | :edges [[[0 0] [1 0]] [[1 0] [1 1]]]} 27 | {:width 3 :height 2 :nodes #{[2 1] [2 0]} 28 | :edges [[[2 0] [2 1]]]}} 29 | (eller/for-forests 30 | #{{:width 3 :height 2 :nodes #{[1 1] [0 0] [1 0]} 31 | :edges [[[0 0] [1 0]] [[1 0] [1 1]]]} 32 | {:width 3 :height 2 :nodes #{[2 1] [2 0]} 33 | :edges [[[2 0] [2 1]]]}} 34 | 1 3 2))))) 35 | 36 | 37 | (deftest merge-all-test 38 | (testing "Merge multiple forests into a single forest." 39 | (is (= {:width 3 :height 1 :nodes #{[0 0] [1 0] [2 0]} 40 | :edges [[[0 0] [1 0]] [[1 0] [2 0]]]} 41 | (eller/merge-all 42 | #{{:width 3 :height 1 :nodes #{[0 0]} :edges []} 43 | {:width 3 :height 1 :nodes #{[1 0]} :edges []} 44 | {:width 3 :height 1 :nodes #{[2 0]} :edges []}}))) 45 | (let [forest (eller/merge-all 46 | #{{:width 3 :height 2 :nodes #{[0 1]} 47 | :edges []} 48 | {:width 3 :height 2 :nodes #{[1 1] [0 0] [1 0]} 49 | :edges [[[0 0] [1 0]] [[1 0] [1 1]]]} 50 | {:width 3 :height 2 :nodes #{[2 1] [2 0]} 51 | :edges [[[2 0] [2 1]]]}})] 52 | (is (= 3 (:width forest))) 53 | (is (= 2 (:height forest))) 54 | (is (filter #(= % [[0 0] [1 0]]) (:edges forest))) 55 | (is (filter #(= % [[1 0] [1 1]]) (:edges forest))) 56 | (is (filter #(= % [[2 0] [2 1]]) (:edges forest))) 57 | (is (= (dec (* (:width forest) (:height forest))) 58 | (count (:edges forest)))) 59 | (is (= (set (for [x (range (:width forest)) 60 | y (range (:height forest))] 61 | [x y])) 62 | (:nodes forest)))))) 63 | 64 | 65 | (deftest horizontal-link-test 66 | (testing "Link cells in a row." 67 | (is (= #{{:width 3 :height 1 68 | :nodes #{[0 0] [1 0] [2 0]} 69 | :edges [[[0 0] [1 0]] [[1 0] [2 0]]]}} 70 | (#'meiro.eller/link-horizontal 71 | (eller/for-forests #{} 0 3 1) 72 | 0 1.0)))) 73 | (testing "No links in a row." 74 | (let [forests (eller/for-forests #{} 0 3 1)] 75 | (is (= forests 76 | (#'meiro.eller/link-horizontal forests 0 0.0)))))) 77 | 78 | 79 | (deftest vertical-link-test 80 | (testing "Link cells vertically." 81 | (is (= #{{:width 2 :height 2 :nodes #{[0 0] [0 1]} :edges [[[0 0] [0 1]]]} 82 | {:width 2 :height 2 :nodes #{[1 0] [1 1]} :edges [[[1 0] [1 1]]]}} 83 | (#'meiro.eller/link-vertical 84 | (eller/for-forests #{} 0 2 2) 85 | 0 1.0)))) 86 | (testing "Only one cell per corridor links south." 87 | (is (= 2 88 | (-> (eller/for-forests #{} 0 2 2) 89 | (#'meiro.eller/link-horizontal 0 1.0) 90 | (#'meiro.eller/link-vertical 0 1.0) 91 | first 92 | :edges 93 | count))))) 94 | 95 | 96 | (deftest create-test 97 | (let [width 2 98 | height 5 99 | forest (eller/create width height)] 100 | (testing "Creating a maze using Eller's Algorithm." 101 | (is (= (* width height) 102 | (count (:nodes forest)))) 103 | (is (= (dec (* width height)) 104 | (count (:edges forest))))) 105 | (testing "Ensure all cells are linked." 106 | (is (every? 107 | #(not-any? empty? %) 108 | (graph/forest-to-maze forest)))))) 109 | -------------------------------------------------------------------------------- /src/meiro/kruskal.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.kruskal 2 | "Kruskal's algorithm uses a minimum spanning tree to connect cells in a maze. 3 | Although spanning trees typically have weights to edges to resolve paths, 4 | using a random sort to the edges can achieve the effect we need to create a 5 | maze. 6 | This algorithm is not designed to work with the other approaches. 7 | Instead of using a row-column arrangement, this algorithm uses x y 8 | coordinates aligned with the needs of a renderer." 9 | (:require [meiro.core :as m] 10 | [meiro.graph :as graph] 11 | [meiro.weave :as w])) 12 | 13 | 14 | (defn- partition-edges 15 | "Partition non-adjacent edges from a weave." 16 | [non-adj] 17 | (reduce 18 | (fn [acc [pos-1 pos-2]] 19 | (concat 20 | acc 21 | (partition 22 | 2 1 23 | (concat [pos-1] 24 | (w/positions-between pos-1 pos-2) 25 | [pos-2])))) 26 | [] non-adj)) 27 | 28 | 29 | (defn- weave-edges 30 | "Get all the edges associated with a weave from a collection of forests." 31 | [forests] 32 | (partition-edges 33 | (reduce 34 | (fn [acc e] 35 | (let [es (:edges e)] 36 | (concat 37 | acc 38 | (filter (fn [[a b]] (not (m/adjacent? a b))) es)))) 39 | [] forests))) 40 | 41 | 42 | (defn- rm-weave-edges 43 | "Remove non-adjacent edges to prevent invalid links against a weave." 44 | [edges weave-edges] 45 | (reduce 46 | (fn [acc e] 47 | (if (some #{e} weave-edges) 48 | acc 49 | (conj acc e))) 50 | [] edges)) 51 | 52 | 53 | (defn create 54 | "Create a maze with the provided dimensions." 55 | ([width height] (create width height (graph/init-forests width height))) 56 | ([width height forests] 57 | (loop [forests forests 58 | edges (shuffle 59 | (rm-weave-edges 60 | (graph/all-edges width height) 61 | (weave-edges forests)))] 62 | (if (> (count forests) 1) 63 | (let [[pos-1 pos-2 :as edge] (first edges) 64 | f-1 (graph/find-forest forests pos-1) 65 | f-2 (graph/find-forest forests pos-2)] 66 | (recur 67 | (if (= f-1 f-2) 68 | forests 69 | (let [merged (graph/merge-forests f-1 f-2 edge)] 70 | (-> forests 71 | (disj f-1 f-2) 72 | (conj merged)))) 73 | (rest edges))) 74 | (first forests))))) 75 | 76 | 77 | (defn- can-weave? 78 | "Are the given forests eligible to weave?" 79 | [north south east west middle dir] 80 | (not 81 | (or 82 | (some nil? [north south east west]) 83 | (= east north) 84 | (= east south) 85 | (= west north) 86 | (= west south) 87 | (if (= dir :vertical) 88 | (or (= middle east) (= middle west)) 89 | (or (= middle north) (= middle south)))))) 90 | 91 | 92 | (defn weave 93 | "Add a weave to the forests centered on the provided `pos`. 94 | A direction can also be passed, either `:horizontal` or `:vertical`. 95 | If :horizontal is indicated, the weave will pass under horizontally. 96 | If the forests already have edges which would violate the requested weave, 97 | the original forests will be return unchanged." 98 | ([forests pos] (weave forests pos :vertical)) 99 | ([forests [x y :as pos] dir] 100 | (let [middle (graph/find-forest forests pos) 101 | n-pos [x (dec y)] 102 | north (graph/find-forest forests n-pos) 103 | s-pos [x (inc y)] 104 | south (graph/find-forest forests s-pos) 105 | e-pos [(inc x) y] 106 | east (graph/find-forest forests e-pos) 107 | w-pos [(dec x) y] 108 | west (graph/find-forest forests w-pos)] 109 | (if (can-weave? north south east west middle dir) 110 | (if (= dir :horizontal) 111 | (let [vertical (graph/merge-forests 112 | (graph/merge-forests north middle [n-pos pos]) 113 | south [pos s-pos]) 114 | horizontal (graph/merge-forests east west [w-pos e-pos])] 115 | (-> forests 116 | (disj north south east west middle) 117 | (conj vertical) 118 | (conj horizontal))) 119 | ; (= dir :vertical) 120 | (let [horizontal (graph/merge-forests 121 | (graph/merge-forests west middle [w-pos pos]) 122 | east [pos e-pos]) 123 | vertical (graph/merge-forests north south [n-pos s-pos])] 124 | (-> forests 125 | (disj north south east west middle) 126 | (conj horizontal) 127 | (conj vertical)))) 128 | ; ineligible 129 | forests)))) 130 | -------------------------------------------------------------------------------- /src/meiro/eller.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.eller 2 | "Eller's algorithm generates a forest row-by-row, combining all the forests at 3 | the end into a single result. It behaves like Sidewinder in that it can merge 4 | cells left to right, but then only one passage will link south." 5 | (:require [meiro.core :as m] 6 | [meiro.graph :as graph] 7 | [clojure.spec.alpha :as spec])) 8 | 9 | 10 | (def ^:private horizontal-weight 11 | "Weight used to decide whether to link horizontally in a row. 12 | The higher the weight, the greater the chance that cells will be linked in a 13 | row. 1.0 will cause all cells in a row to be linked." 14 | 0.5) 15 | 16 | (def ^:private vertical-weight 17 | "Weight used to decide whether to link vertically from a row. 18 | The higher the weight, the greater the chance that cells will be linked to 19 | the row beneath. 1.0 will cause all cells in a row to be linked." 20 | 0.5) 21 | 22 | 23 | (spec/fdef for-forests 24 | :args (spec/cat :forests :meiro.graph/forest 25 | :row nat-int? 26 | :width :meiro.graph/width 27 | :height :meiro.graph/height) 28 | :ret :meiro.graph/forest) 29 | (defn for-forests 30 | "Get the forests for a row. If there is no forest yet for a node in the row, 31 | a new forest will be generated." 32 | [forests row width height] 33 | (reduce 34 | (fn [acc pos] 35 | (if-let [_forest (graph/find-forest acc pos)] ;; TODO Unused!?! 36 | acc 37 | (conj acc {:width width :height height :nodes #{pos} :edges []}))) 38 | forests 39 | (for [col (range width)] [col row]))) 40 | 41 | 42 | (spec/fdef neighboring-forests 43 | :args (spec/cat :forests :meiro.graph/forest :node :meiro.graph/node) 44 | :ret :meiro.graph/forest) 45 | (defn- neighboring-forests 46 | "Get all forests with nodes adjancent to the provided node." 47 | [forests node] 48 | (filter 49 | (fn [f] (some #(m/adjacent? node %) (:nodes f))) 50 | forests)) 51 | 52 | 53 | (spec/fdef merge-all 54 | :args (spec/cat :forests :meiro.graph/forest) 55 | :ret :meiro.graph/forest) 56 | (defn merge-all 57 | "Merge all forests by finding an adjacent node in another forest to link." 58 | [forests] 59 | (loop [[forest & tail] forests] 60 | (if (seq tail) 61 | (let [node (first (shuffle (:nodes forest))) 62 | neighbors (neighboring-forests tail node)] 63 | (if (seq neighbors) 64 | (let [neighbor (first (shuffle neighbors)) 65 | adj (filter (fn [n] (m/adjacent? node n)) (:nodes neighbor)) 66 | edge (vec (sort [node (rand-nth adj)]))] 67 | (recur 68 | (conj 69 | (remove #(= % neighbor) tail) 70 | (graph/merge-forests forest neighbor edge)))) 71 | (recur (conj tail forest)))) 72 | forest))) 73 | 74 | 75 | (spec/fdef link-horizontal 76 | :args (spec/alt 77 | :2-args (spec/cat :forests :meiro.graph/forest :row nat-int?) 78 | :3-args (spec/cat :forests :meiro.graph/forest 79 | :row nat-int? 80 | :weight :meiro.core/rate)) 81 | :ret :meiro.graph/forest) 82 | (defn link-horizontal 83 | "Randomly link some cells in a row." 84 | ([forests row] (link-horizontal forests row horizontal-weight)) 85 | ([forests row weight] 86 | (reduce 87 | (fn [acc [x y :as pos]] 88 | (let [forest (graph/find-forest acc pos)] 89 | (if (< (rand) weight) 90 | (let [pos-right [(inc x) y] 91 | neighbor (graph/find-forest acc pos-right)] 92 | (if (map? neighbor) 93 | (-> acc 94 | (disj forest neighbor) 95 | (conj (graph/merge-forests forest neighbor [pos pos-right]))) 96 | acc)) 97 | acc))) 98 | forests 99 | (for [x (range (:width (first forests)))] [x row])))) 100 | 101 | 102 | (spec/fdef link-vertical 103 | :args (spec/alt 104 | :2-args (spec/cat :forests :meiro.graph/forest :row nat-int?) 105 | :3-args (spec/cat :forests :meiro.graph/forest 106 | :row nat-int? 107 | :weight :meiro.core/rate)) 108 | :ret :meiro.graph/forest) 109 | (defn link-vertical 110 | "Randomly link some cells in a row to the next row." 111 | ;; TODO Currently only links once per corridor. Refactor to change this bias? 112 | ([forests row] (link-vertical forests row vertical-weight)) 113 | ([forests row weight] 114 | (let [next-row (inc row) 115 | height (:height (first forests))] 116 | (if (= next-row height) 117 | forests 118 | (reduce 119 | (fn [acc forest] 120 | (let [corridor (filter (fn [[_ y]] (= row y)) (:nodes forest))] 121 | (if (seq corridor) 122 | (if (< (rand) weight) 123 | (let [[x _ :as pos] (rand-nth corridor) 124 | pos-below [x next-row]] 125 | (-> acc 126 | (disj forest) 127 | (conj (graph/merge-forests 128 | forest 129 | {:nodes #{pos-below}} 130 | [pos pos-below])))) 131 | acc) 132 | acc))) 133 | forests 134 | forests))))) 135 | 136 | 137 | (spec/fdef create 138 | :args (spec/cat :width :meiro.graph/width :height :meiro.graph/height) 139 | :ret :meiro.graph/forest) 140 | (defn create 141 | "Create a maze using Eller's algorithm. Returns a forest." 142 | [width height] 143 | (loop [row 0 144 | forests #{}] 145 | (if (= row height) 146 | (merge-all forests) 147 | (recur 148 | (inc row) 149 | (-> forests 150 | (for-forests row width height) 151 | (link-horizontal row) 152 | (link-vertical row)))))) 153 | -------------------------------------------------------------------------------- /test/meiro/ascii_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.ascii-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.ascii :as ascii] 5 | [clojure.string :as string])) 6 | 7 | 8 | (deftest cell-level-test 9 | (testing "Default rendering." 10 | (is (= '(\space \space \space \space) 11 | (#'meiro.ascii/cell-level [:east :south]))) 12 | (is (= '(\space \space \space \|) 13 | (#'meiro.ascii/cell-level [:south])))) 14 | (testing "Pass value for inside." 15 | (is (= '(\space \1 \space \space) 16 | (#'meiro.ascii/cell-level [:east :south] " 1 "))) 17 | (is (= '(\space \2 \space \|) 18 | (#'meiro.ascii/cell-level [:south] " 2 "))))) 19 | 20 | (deftest ascii-art 21 | (testing "Ensure rows and columns match." 22 | (is (= (string/join \newline ["+---+---+---+" 23 | "| | | |" 24 | "+---+---+---+" 25 | "| | | |" 26 | "+---+---+---+\n"]) 27 | (ascii/render (m/init 2 3)))) 28 | (is (= (string/join \newline ["+---+---+" 29 | "| | |" 30 | "+---+---+" 31 | "| | |" 32 | "+---+---+" 33 | "| | |" 34 | "+---+---+" 35 | "| | |" 36 | "+---+---+" 37 | "| | |" 38 | "+---+---+\n"]) 39 | (ascii/render (m/init 5 2))))) 40 | (testing "Links are represented as gaps in the wall." 41 | (is (= (string/join \newline ["+---+---+" 42 | "| | |" 43 | "+---+---+" 44 | "| |" 45 | "+---+---+\n"]) 46 | (ascii/render (m/link (m/init 2 2) [1 1] [1 0])))) 47 | (is (= (string/join \newline ["+---+---+" 48 | "| | |" 49 | "+---+ +" 50 | "| | |" 51 | "+---+---+\n"]) 52 | (ascii/render (m/link (m/init 2 2) [1 1] [0 1])))))) 53 | 54 | (deftest include-distances 55 | (testing "When distances are provided." 56 | (let [maze [[[:east :south] [:west :east] [:west]] 57 | [[:north :south] [:east] [:west :south]] 58 | [[:north :east] [:west :east] [:north :west]]] 59 | distances [[0 1 2] [1 6 5] [2 3 4]]] 60 | (is (= (string/join \newline 61 | ["+---+---+---+" 62 | "| 0 1 2 |" 63 | "+ +---+---+" 64 | "| 1 | 6 5 |" 65 | "+ +---+ +" 66 | "| 2 3 4 |" 67 | "+---+---+---+\n"]) 68 | (ascii/render maze (ascii/show-distance distances))))))) 69 | 70 | (deftest include-solution 71 | (testing "When a solution is provided." 72 | (let [maze [[[:east] [:west :east :south] [:west] [:south] [:south]] 73 | [[:east :south] [:north :west] [:south] [:north :east] 74 | [:north :west :south]] 75 | [[:north :east :south] [:west] [:north :east :south] [:west] 76 | [:north :south]] 77 | [[:north :east] [:west :east] [:north :west :east] [:west :east] 78 | [:north :west]]] 79 | sol '([0 0] [0 1] [1 1] [1 0] [2 0] [3 0] [3 1] [3 2] [3 3] [3 4] 80 | [2 4] [1 4] [0 4])] 81 | (is (= (string/join \newline 82 | [ "+---+---+---+---+---+" 83 | "| * * | | * |" 84 | "+---+ +---+ + +" 85 | "| * * | | * |" 86 | "+ +---+ +---+ +" 87 | "| * | | * |" 88 | "+ +---+ +---+ +" 89 | "| * * * * * |" 90 | "+---+---+---+---+---+\n"]) 91 | (ascii/render maze (ascii/show-solution sol))))))) 92 | 93 | (deftest masked-test 94 | (let [maze 95 | [[[:south :east] [:west] [:mask] [:south] [:mask]] 96 | [[:south :north] [:south :east] [:west :east] [:west :south :north] 97 | [:south]] 98 | [[:south :north] [:east :north] [:west] [:north :east] 99 | [:west :south :north]] 100 | [[:south :north] [:east :south] [:east :west] [:south :west] 101 | [:north :south]] 102 | [[:east :north] [:north :west :east] [:west] [:east :north] 103 | [:north :west]]]] 104 | (testing "Masked cells have no links." 105 | (is (= (string/join \newline 106 | ["+---+---+---+---+---+" 107 | "| | | | |" 108 | "+ +---+---+ +---+" 109 | "| | | |" 110 | "+ + +---+ + +" 111 | "| | | |" 112 | "+ +---+---+---+ +" 113 | "| | | |" 114 | "+ + +---+ + +" 115 | "| | |" 116 | "+---+---+---+---+---+\n"]) 117 | (ascii/render maze)))))) 118 | 119 | (deftest line-to-row-test 120 | (testing "No masking" 121 | (is (= [[] [] [] []] 122 | (ascii/line-to-row "....")))) 123 | (testing "All masking" 124 | (is (= [[:mask] [:mask] [:mask] [:mask]] 125 | (ascii/line-to-row "xxxx")))) 126 | (testing "Mixed masking" 127 | (is (= [[] [:mask] [:mask] []] 128 | (ascii/line-to-row ".xx."))))) 129 | -------------------------------------------------------------------------------- /test/meiro/weave_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.weave-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as m] 4 | [meiro.weave :as weave])) 5 | 6 | 7 | (deftest east-west-test 8 | (testing "Check for east-west corridors." 9 | (is (weave/east-west? [:east :west])) 10 | (is (weave/east-west? [:west :east])) 11 | (is (not (weave/east-west? [:east :west :south]))) 12 | (is (not (weave/east-west? [:east :west :north]))) 13 | (is (not (weave/east-west? [:south :north]))) 14 | (is (not (weave/east-west? [:east]))) 15 | (is (not (weave/east-west? [:west]))))) 16 | 17 | 18 | (deftest north-south-test 19 | (testing "Check for north-south corridors." 20 | (is (weave/north-south? [:north :south])) 21 | (is (weave/north-south? [:south :north])) 22 | (is (not (weave/north-south? [:north :south :east]))) 23 | (is (not (weave/north-south? [:north :south :west]))) 24 | (is (not (weave/north-south? [:east :west]))) 25 | (is (not (weave/north-south? [:north]))) 26 | (is (not (weave/north-south? [:south]))))) 27 | 28 | 29 | (deftest cells-to-test 30 | (testing "Gets a sequence of valid positions from a starting cell." 31 | (is (= [[0 3] [0 2] [0 1] [0 0]] 32 | (#'meiro.weave/cells-to (m/init 1 5) m/west [0 4]))) 33 | (is (= [[0 1] [0 2] [0 3] [0 4]] 34 | (#'meiro.weave/cells-to (m/init 1 5) m/east [0 0]))) 35 | (is (= [[0 3] [0 4]] 36 | (#'meiro.weave/cells-to (m/init 1 5) m/east [0 2]))) 37 | (is (= [[4 1] [3 1] [2 1] [1 1] [0 1]] 38 | (#'meiro.weave/cells-to (m/init 6 2) m/north [5 1]))) 39 | (is (= [[2 1] [3 1] [4 1]] 40 | (#'meiro.weave/cells-to (m/init 5 2) m/south [1 1]))))) 41 | 42 | 43 | (deftest cell-west-test 44 | (testing "Pick up a cell to the west if available." 45 | (is (nil? 46 | (weave/cell-west 47 | [[[:north :south] [:north :south] [:start]]] 48 | [0 2]))) 49 | (is (= [0 0] 50 | (weave/cell-west 51 | [[[] [:north :south] [:start]]] 52 | [0 2]))) 53 | (is (= [0 0] 54 | (weave/cell-west 55 | [[[] [:north :south] [:north :south] [:north :south] [:start]]] 56 | [0 4]))) 57 | (is (nil? 58 | (weave/cell-west 59 | [[[] [:north] [:north :south] [:north :south] [:start]]] 60 | [0 4]))) 61 | (is (= [0 1] 62 | (weave/cell-west 63 | [[[] [] [:north :south] [:north :south] [:start]]] 64 | [0 4]))))) 65 | 66 | 67 | (deftest cell-east-test 68 | (testing "Pick up a cell to the east if available." 69 | (is (nil? 70 | (weave/cell-east 71 | [[[:start] [:north :south] [:north :south]]] 72 | [0 0]))) 73 | (is (= [0 3] 74 | (weave/cell-east 75 | [[[:north :south] [:start] [:north :south] []]] 76 | [0 1]))))) 77 | 78 | 79 | (deftest cell-north-test 80 | (testing "Pick up a cell to the north if available." 81 | (is (nil? 82 | (weave/cell-north 83 | [[[:east :west]] [[:east :west]] [[:start]]] 84 | [2 0]))) 85 | (is (= [0 0] 86 | (weave/cell-north 87 | [[[]] [[:east :west]] [[:start]]] 88 | [2 0]))))) 89 | 90 | 91 | (deftest cell-south-test 92 | (testing "Pick up a cell to the south if available." 93 | (is (nil? 94 | (weave/cell-south 95 | [[[:start]] [[:east :west]] [[:east :west]]] 96 | [0 0]))) 97 | (is (= [2 0] 98 | (weave/cell-south 99 | [[[:start]] [[:east :west]] [[]]] 100 | [0 0]))))) 101 | 102 | 103 | (deftest neighbors-test 104 | (testing "Weave cells are available as neighbors when appropriate." 105 | (let [maze [[[] [] [] [] []] 106 | [[] [] [:east :west] [] []] 107 | [[] [:north :south] [] [:north :south] []] 108 | [[] [] [:east :west] [] []] 109 | [[] [] [] [] []]]] 110 | (is (= [[0 2] [1 2] [3 2] [4 2] [2 3] [2 4] [2 0] [2 1]] 111 | (weave/neighbors maze [2 2])))) 112 | (let [maze [[[] [] [:north] [] []] 113 | [[] [] [:east :west] [] []] 114 | [[:west] [:north :south] [] [:north :south] [:east]] 115 | [[] [] [:east :west] [] []] 116 | [[] [] [:south] [] []]]] 117 | (is (= [[1 2] [3 2] [2 3] [2 1]] 118 | (weave/neighbors maze [2 2])))) )) 119 | 120 | 121 | (deftest positions-between-test 122 | (testing "Enumerate all positions between two positions." 123 | (is (= [[0 1] [0 2]] 124 | (weave/positions-between [0 0] [0 3]))) 125 | (is (= [[0 1] [0 2]] 126 | (weave/positions-between [0 3] [0 0]))) 127 | (is (= [[2 1] [3 1]] 128 | (weave/positions-between [1 1] [4 1]))) 129 | (is (= [[2 1] [3 1]] 130 | (weave/positions-between [4 1] [1 1]))) 131 | (is (= [] 132 | (weave/positions-between [4 1] [3 1]))) 133 | (is (= [] 134 | (weave/positions-between [4 1] [4 2]))))) 135 | 136 | 137 | (deftest link-test 138 | (testing "Adjacent cells link with opposite directions." 139 | (let [above [2 2] 140 | below [3 2] 141 | m (weave/link (m/init 6 4) below above)] 142 | (is (some (comp = :north) (get-in m below))) 143 | (is (some (comp = :south) (get-in m above)))) 144 | (let [left [1 2] 145 | right [1 3] 146 | m (weave/link (m/init 6 4) left right)] 147 | (is (some (comp = :east) (get-in m left))) 148 | (is (some (comp = :west) (get-in m right))))) 149 | (testing "Non-adjacent link by position and path between marked as under." 150 | (let [base [[[] [:north :south] [:north :south] []]] 151 | maze (weave/link base [0 0] [0 3])] 152 | (is (= [[0 0]] 153 | (get-in maze [0 3]))) 154 | (is (some #{:under} (get-in maze [0 1]))) 155 | (is (some #{:under} (get-in maze [0 2]))) 156 | (is (= [[0 3]] 157 | (get-in maze [0 0])))))) 158 | 159 | 160 | (deftest direction-test 161 | (testing "Identify adjacent directions." 162 | (is (= :north (weave/direction [2 3] [1 3]))) 163 | (is (= :south (weave/direction [2 3] [3 3]))) 164 | (is (= :east (weave/direction [2 3] [2 4]))) 165 | (is (= :west (weave/direction [2 3] [2 2])))) 166 | (testing "Identify non-adjacent directions." 167 | (is (= :north (weave/direction [2 3] [0 3]))) 168 | (is (= :south (weave/direction [2 3] [5 3]))) 169 | (is (= :east (weave/direction [2 3] [2 9]))) 170 | (is (= :west (weave/direction [2 3] [2 0]))))) 171 | -------------------------------------------------------------------------------- /test/meiro/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.core-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.backtracker] 5 | [meiro.hunt-and-kill :as hunt])) 6 | 7 | ;;; Position Functions 8 | 9 | (deftest adjacent-test 10 | (testing "true if cells are adjacent." 11 | (is (meiro/adjacent? [0 0] [0 1])) 12 | (is (meiro/adjacent? [0 0] [1 0])) 13 | (is (not (meiro/adjacent? [0 0] [0 2]))) 14 | (is (not (meiro/adjacent? [0 0] [2 0]))))) 15 | 16 | (deftest direction-test 17 | (testing "Cardinal directions." 18 | (is (= :north (meiro/direction [2 3] [1 3]))) 19 | (is (= :south (meiro/direction [3 1] [4 1]))) 20 | (is (= :east (meiro/direction [5 1] [5 2]))) 21 | (is (= :west (meiro/direction [4 3] [4 2])))) 22 | (testing "Not adjacent." 23 | (is (nil? (meiro/direction [0 0] [0 0]))) 24 | (is (nil? (meiro/direction [0 0] [2 0]))) 25 | (is (nil? (meiro/direction [0 0] [0 2]))))) 26 | 27 | (deftest cell-direction-test 28 | (testing "Methods for getting the cell in a given direction" 29 | (is (= [0 1] (meiro/north [1 1]))) 30 | (is (= [2 1] (meiro/south [1 1]))) 31 | (is (= [1 2] (meiro/east [1 1]))) 32 | (is (= [1 0] (meiro/west [1 1]))))) 33 | 34 | (deftest pos-to-test 35 | (testing "Methods for getting the cell in a given direction" 36 | (is (= [0 1] (meiro/pos-to :north [1 1]))) 37 | (is (= [2 1] (meiro/pos-to :south [1 1]))) 38 | (is (= [1 2] (meiro/pos-to :east [1 1]))) 39 | (is (= [1 0] (meiro/pos-to :west [1 1]))))) 40 | 41 | ;;; Grid Functions 42 | 43 | (deftest init-test 44 | (testing "First level is row, each row contains columns." 45 | (is (= 5 (count (meiro/init 5 3)))) 46 | (is (every? #(= 4 (count %)) (meiro/init 5 4)))) 47 | (testing "Create with value other than []." 48 | (is (= [[nil nil] [nil nil]] (meiro/init 2 2 nil))) 49 | (is (= [[0] [0] [0]] (meiro/init 3 1 0))))) 50 | 51 | (deftest neighbors-test 52 | (testing "Get neighbors to a cell in a maze." 53 | (is (= #{[0 1] [1 0] [1 2] [2 1]} 54 | (set (meiro/neighbors (meiro/init 3 3) [1 1])))) 55 | (is (= #{[1 1] [0 0] [2 0]} 56 | (set (meiro/neighbors (meiro/init 3 3) [1 0])))) 57 | (is (= #{[0 0] [0 2] [1 1]} 58 | (set (meiro/neighbors (meiro/init 3 3) [0 1])))) 59 | (is (= #{[0 1] [1 0]} 60 | (set (meiro/neighbors (meiro/init 3 3) [0 0])))) 61 | (is (= #{[0 1] [1 2]} 62 | (set (meiro/neighbors (meiro/init 3 3) [0 2])))) 63 | (is (= #{[1 0] [2 1]} 64 | (set (meiro/neighbors (meiro/init 3 3) [2 0])))) 65 | (is (= #{[2 1] [1 2]} 66 | (set (meiro/neighbors (meiro/init 3 3) [2 2])))))) 67 | 68 | 69 | ;;; Maze Functions 70 | 71 | (deftest empty-neighbor-test 72 | (testing "All neighbors are empty." 73 | (let [maze [[[] [] []] [[] [] []] [[] [] []]]] 74 | (is (= '([1 0] [2 1] [1 2] [0 1]) 75 | (meiro/empty-neighbors maze [1 1]))) 76 | (is (= '([0 0] [1 1] [2 0]) 77 | (meiro/empty-neighbors maze [1 0]))) 78 | (is (= '([2 1] [1 2]) 79 | (meiro/empty-neighbors maze [2 2]))))) 80 | (testing "No neighbors are empty." 81 | (let [maze [[[:south] [:south :east] [:west :south]] 82 | [[:north :south] [:south :north] [:north :south]] 83 | [[:north :east] [:west :north] [:north]]]] 84 | (is (empty? (meiro/empty-neighbors maze [1 1]))) 85 | (is (empty? (meiro/empty-neighbors maze [1 0]))) 86 | (is (empty? (meiro/empty-neighbors maze [0 2])))))) 87 | 88 | 89 | (deftest link-with-test 90 | (testing "Adjacent cells linked by opposite directions." 91 | (let [above [2 2] 92 | below [3 2] 93 | link-fn (meiro/link-with meiro/direction) 94 | m (link-fn (meiro/init 6 4) below above)] 95 | (is (some (comp = :north) (get-in m below))) 96 | (is (some (comp = :south) (get-in m above)))) 97 | (let [left [1 2] 98 | right [1 3] 99 | m (meiro/link (meiro/init 6 4) left right)] 100 | (is (some (comp = :east) (get-in m left))) 101 | (is (some (comp = :west) (get-in m right)))))) 102 | 103 | 104 | (deftest link-test 105 | (testing "Adjacent cells linked by opposite directions." 106 | (let [above [2 2] 107 | below [3 2] 108 | m (meiro/link (meiro/init 6 4) below above)] 109 | (is (some (comp = :north) (get-in m below))) 110 | (is (some (comp = :south) (get-in m above)))) 111 | (let [left [1 2] 112 | right [1 3] 113 | m (meiro/link (meiro/init 6 4) left right)] 114 | (is (some (comp = :east) (get-in m left))) 115 | (is (some (comp = :west) (get-in m right)))))) 116 | 117 | 118 | (deftest dead-end-test 119 | (testing "No linked cell to the west" 120 | (let [maze [[[:south] [:south] [:east] 121 | [:west :east] [:west :south] [:south] [:east] 122 | [:west :south]] 123 | [[:north :east] [:north :west :south] [:east] [:west :east] 124 | [:north :west :east] [:north :west :south] [:south] 125 | [:north :south]] 126 | [[:east] [:north :west :east] [:west :east] [:west :east] 127 | [:west :east] [:north :west :east] [:north :west :east] 128 | [:north :west]]]] 129 | (is (= 8 (count (meiro/dead-ends maze))))))) 130 | 131 | 132 | (deftest braid-test 133 | (let [maze (meiro.backtracker/create (meiro/init 15 20))] 134 | (testing "Braid a maze." 135 | (is (> (count (meiro/dead-ends maze)) 136 | (count (meiro/dead-ends (meiro/braid maze))))) 137 | (is (zero? (count (meiro/dead-ends (meiro/braid maze 1.0)))))) 138 | (testing "0.0 rate doesn't braid." 139 | (is (= (count (meiro/dead-ends maze)) 140 | (count (meiro/dead-ends (meiro/braid maze 0.0)))))))) 141 | 142 | 143 | (deftest unlink-test 144 | (testing "Can unlink two cells from each other." 145 | (let [maze [[[:east :south] [:west :south]]] 146 | unlinked (meiro/unlink maze [0 0] [0 1])] 147 | (is (= [:south] (get-in unlinked [0 0]))) 148 | (is (= [:south] (get-in unlinked [0 1]))))) 149 | (testing "Dead ends are replace with :mask." 150 | (let [maze [[[:east] [:west]]] 151 | unlinked (meiro/unlink maze [0 0] [0 1])] 152 | (is (= [:mask] (get-in unlinked [0 0]))) 153 | (is (= [:mask] (get-in unlinked [0 1])))))) 154 | 155 | 156 | (deftest cull-test 157 | (let [maze (hunt/create (meiro/init 15 20))] 158 | (testing "Cull dead ends." 159 | (is (> (count (meiro/dead-ends maze)) 160 | (count (meiro/dead-ends (meiro/cull maze)))))) 161 | (testing "0.0 rate doesn't cull." 162 | (is (= (count (meiro/dead-ends maze)) 163 | (count (meiro/dead-ends (meiro/cull maze 0.0)))))))) 164 | -------------------------------------------------------------------------------- /test/meiro/dijkstra_test.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.dijkstra-test 2 | (:require [clojure.test :refer [deftest testing is]] 3 | [meiro.core :as meiro] 4 | [meiro.dijkstra :as dijkstra] 5 | [meiro.sidewinder :as sw])) 6 | 7 | 8 | (deftest empty-neighbor-test 9 | (testing "When the grid is empty." 10 | (is (= [[0 1] [2 1] [1 2] [1 0]] 11 | (#'meiro.dijkstra/empty-neighbors 12 | (meiro/init 3 3 nil) [1 1] [:north :south :east :west]))) 13 | (is (= [[2 1] [1 2]] 14 | (#'meiro.dijkstra/empty-neighbors 15 | (meiro/init 3 3 nil) [1 1] [:south :east])))) 16 | (testing "When cells have been populated already" 17 | (let [grid (assoc-in (meiro/init 3 3 nil) [2 1] 1)] 18 | (is (= [[1 2]] 19 | (#'meiro.dijkstra/empty-neighbors grid [1 1] [:south :east]))) 20 | (is (= [[1 0]] 21 | (#'meiro.dijkstra/empty-neighbors grid [2 0] [:north :east])))))) 22 | 23 | 24 | (deftest calculate-distances-test 25 | (testing "Distance calculations." 26 | (let [maze [[[:east :south] [:west :east] [:west]] 27 | [[:north :south] [:east] [:west :south]] 28 | [[:north :east] [:west :east] [:north :west]]]] 29 | (is (= [[0 1 2] [1 6 5] [2 3 4]] 30 | (dijkstra/distances maze))) 31 | (is (= [[6 7 8] [5 0 1] [4 3 2]] 32 | (dijkstra/distances maze [1 1])))))) 33 | 34 | 35 | (deftest distances-by-breadth-test 36 | (testing "Calculating distances by breadth-first search." 37 | (let [maze [[[:east :south] [:west :east] [:west]] 38 | [[:north :south] [:east] [:west :south]] 39 | [[:north :east] [:west :east] [:north :west]]]] 40 | (is (= [[0 1 2] [1 6 5] [2 3 4]] 41 | (dijkstra/distances-by-breadth maze))) 42 | (is (= [[6 7 8] [5 0 1] [4 3 2]] 43 | (dijkstra/distances-by-breadth maze [1 1]))))) 44 | (testing "Calculate distances on a braided maze." 45 | (is (= [[0 3 4] [1 2 5] [2 3 4]] 46 | (dijkstra/distances-by-breadth 47 | [[[:south :south] [:east :south] [:south :west]] 48 | [[:east :north :south :north] [:north :west] [:south :north]] 49 | [[:north :east] [:east :west] [:west :north]]])))) 50 | (testing "Calculate distances on a maze with a room." 51 | (is (= [[2 1 2] [1 0 3] [2 1 4]] 52 | (dijkstra/distances-by-breadth 53 | [[[:east] [:south :east :west] [:south :west]] 54 | [[:south :east] [:north :south :west] [:north :south]] 55 | [[:north :east] [:north :west] [:north]]] 56 | [1 1]))))) 57 | 58 | 59 | (deftest solution-test 60 | (let [sol (dijkstra/solution (sw/create (meiro/init 15 20)) [0 0] [14 19])] 61 | (testing "Must be long enough to cross at least all columns and rows." 62 | (is (< 33 (count sol)))) 63 | (testing "Starts with the provided 'start' cell." 64 | (is (= [0 0] (first sol)))) 65 | (testing "Ends with the provided 'end' cell." 66 | (is (= [14 19] (last sol))))) 67 | (testing "Solution does not jump walls." 68 | ;; Without bounds checking solution can pass through [2 1] instead of [3 0]. 69 | (let [maze [[[:east] [:west :east :south] [:west] [:south] 70 | [:south]] 71 | [[:east :south] [:north :west] [:south] [:north :east] 72 | [:north :west :south]] 73 | [[:north :east :south] [:west] [:north :east :south] [:west] 74 | [:north :south]] 75 | [[:north :east] [:west :east] [:north :west :east] [:west :east] 76 | [:north :west]]]] 77 | (is (= '([0 0] [0 1] [1 1] [1 0] [2 0] [3 0] [3 1] [3 2] [3 3] [3 4] [2 4] 78 | [1 4] [0 4]) 79 | (dijkstra/solution maze [0 0] [0 4])))))) 80 | 81 | 82 | (deftest shortest-path-test 83 | (testing "On a perfect maze, should be same as solution." 84 | (let [maze [[[:east] [:west :east :south] [:west] [:south] 85 | [:south]] 86 | [[:east :south] [:north :west] [:south] [:north :east] 87 | [:north :west :south]] 88 | [[:north :east :south] [:west] [:north :east :south] [:west] 89 | [:north :south]] 90 | [[:north :east] [:west :east] [:north :west :east] [:west :east] 91 | [:north :west]]]] 92 | (is (= '([0 0] [0 1] [1 1] [1 0] [2 0] [3 0] [3 1] [3 2] [3 3] [3 4] [2 4] 93 | [1 4] [0 4]) 94 | (dijkstra/shortest-path maze [0 0] [0 4]))))) 95 | (testing "Find shortest path (solution) when the maze has rooms." 96 | (let [maze 97 | [[[:south :east] [:south :east :west] [:south :west] [:south :east] 98 | [:south :west]] 99 | [[:north :south :east] [:north :south :east :west] 100 | [:north :south :east :west] [:north :south :east :west] 101 | [:north :south :west]] 102 | [[:north :south :east] [:north :south :east :west] 103 | [:north :south :west] [:north :south :east] [:north :west]] 104 | [[:north :east] [:north :south :east :west] [:north :west] 105 | [:north :south :east] [:south :west]] 106 | [[:east] [:north :east :west] [:west] [:north :east] 107 | [:north :west]]]] 108 | (is (= '([0 0] [1 0] [1 1] [1 2] [1 3] [2 3] [3 3] [4 3] [4 4]) 109 | (dijkstra/shortest-path maze [0 0] [4 4]))) 110 | (is (= '([4 0] [4 1] [3 1] [2 1] [1 1] [1 2] [1 3] [2 3] [3 3] [4 3] 111 | [4 4]) 112 | (dijkstra/shortest-path maze [4 0] [4 4]))))) 113 | (testing "Find shortest path when the maze is braided." 114 | (let [maze 115 | [[[:east :south] [:east :west] [:east :west] [:south :east :west] 116 | [:west :south]] 117 | [[:north :south] [:south :east] [:south :east :west] 118 | [:west :north :south] [:north :south]] 119 | [[:north :east] [:west :north] [:south :north] [:north :south] 120 | [:south :north]] 121 | [[:south :east] [:west :east] [:west :north] [:north :south] 122 | [:north :south]] 123 | [[:east :north] [:east :west] [:east :west] [:east :west :north] 124 | [:north :west]]]] 125 | (is (= '([0 0] [0 1] [0 2] [0 3] [1 3] [2 3] [3 3] [4 3] [4 4]) 126 | (dijkstra/shortest-path maze [0 0] [4 4]))) 127 | (is (= '([0 0] [1 0] [2 0] [2 1] [1 1] [1 2] [2 2] [3 2] [3 1] [3 0] 128 | [4 0]) 129 | (dijkstra/shortest-path maze [0 0] [4 0]))) 130 | (is (= '([0 4] [0 3] [1 3] [1 2] [2 2] [3 2] [3 1] [3 0] [4 0]) 131 | (dijkstra/shortest-path maze [0 4] [4 0])))))) 132 | 133 | 134 | (deftest farthest-test 135 | (let [maze [[[:east :south] [:west] [:south]] 136 | [[:north :east] [:west :east :south] [:north :west]] 137 | [[:east] [:north :west :east] [:west]]]] 138 | (testing "Finding the farthest point." 139 | (is (= [2 2] (dijkstra/farthest-pos maze))) 140 | (is (= [0 1] (dijkstra/farthest-pos maze [0 2]))) 141 | (is (= [0 1] (dijkstra/farthest-pos maze [2 0])))))) 142 | 143 | 144 | (deftest longest-path-test 145 | (let [maze [[[:east :south] [:west] [:south]] 146 | [[:north :east] [:west :east :south] [:north :west]] 147 | [[:east] [:north :west :east] [:west]]]] 148 | (testing "Finding the longest path." 149 | (is (= '([0 1] [0 0] [1 0] [1 1] [2 1] [2 2]) (dijkstra/longest-path maze)))))) 150 | -------------------------------------------------------------------------------- /src/meiro/core.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.core 2 | "Core maze-generation utilities. 3 | Mazes are represented as a vector of vectors, which can be accessed by 4 | [row column]. In a fully generated maze, each cell will contain the directions 5 | to open neighbor cells, e.g., [:east :south]." 6 | (:require [clojure.spec.alpha :as spec])) 7 | 8 | 9 | (def cardinals 10 | "Cardinal directions." 11 | #{:north :south :east :west}) 12 | 13 | (spec/def ::direction cardinals) 14 | (spec/def ::link (conj cardinals :mask)) 15 | 16 | ;; Difference between a "cell" and "pos" (or position). 17 | ;; A position is the [row col] index of a cell. 18 | (spec/def ::pos (spec/tuple :row nat-int? :col nat-int?)) 19 | (spec/def ::path (spec/+ ::pos)) 20 | 21 | ;; A cell has links to neighbors, such as [:east :north]. 22 | (spec/def ::cell (spec/coll-of ::link :kind vector? :distinct true)) 23 | 24 | ;; Difference between "grid" and "maze"? 25 | ;; A grid has no links, a maze has links between the cells. 26 | (spec/def ::grid (spec/coll-of vector? :kind vector? :min-count 1)) 27 | (spec/def ::row (spec/coll-of ::cell :kind vector? :min-count 1)) 28 | (spec/def ::maze (spec/coll-of ::row :kind vector? :min-count 1)) 29 | 30 | (spec/def ::rate (spec/double-in :min 0.0 :max 1.0 :NaN? false :infinite? false)) 31 | 32 | 33 | ;;; Position Functions 34 | 35 | (spec/fdef adjacent? 36 | :args (spec/cat :pos-1 ::pos :pos-2 ::pos) 37 | :ret boolean?) 38 | (defn adjacent? 39 | "Are two positions adjacent. 40 | Function does not check that positions are within the bounds of a grid." 41 | [pos-1 pos-2] 42 | (let [[row-1 col-1] pos-1 43 | [row-2 col-2] pos-2] 44 | (or 45 | (and (= row-1 row-2) (= 1 (Math/abs ^int (- col-1 col-2)))) 46 | (and (= col-1 col-2) (= 1 (Math/abs ^int (- row-1 row-2))))))) 47 | 48 | 49 | (spec/fdef direction 50 | :args (spec/cat :pos-1 ::pos :pos-2 ::pos) 51 | :ret (spec/nilable ::direction)) 52 | (defn direction 53 | "Get the direction from pos-1 to pos-2. 54 | Assumes [0 0] is the north-west corner." 55 | [[row-1 col-1] [row-2 col-2]] 56 | (case [(- row-1 row-2) (- col-1 col-2)] 57 | [0 1] :west 58 | [0 -1] :east 59 | [1 0] :north 60 | [-1 0] :south 61 | nil)) 62 | 63 | 64 | (spec/fdef north 65 | :args (spec/cat :pos ::pos) 66 | :ret ::pos) 67 | (defn north 68 | "Get position to the north of a given position. 69 | No bounds checking, so may return an invalid position." 70 | [[row col]] 71 | [(dec row) col]) 72 | 73 | 74 | (spec/fdef south 75 | :args (spec/cat :pos ::pos) 76 | :ret ::pos) 77 | (defn south 78 | "Get position to the south of a given position. 79 | No bounds checking, so may return an invalid position." 80 | [[row col]] 81 | [(inc row) col]) 82 | 83 | 84 | (spec/fdef east 85 | :args (spec/cat :pos ::pos) 86 | :ret ::pos) 87 | (defn east 88 | "Get position to the east of a given position. 89 | No bounds checking, so may return an invalid position." 90 | [[row col]] 91 | [row (inc col)]) 92 | 93 | 94 | (spec/fdef west 95 | :args (spec/cat :pos ::pos) 96 | :ret ::pos) 97 | (defn west 98 | "Get position to the west of a given position. 99 | No bounds checking, so may return an invalid position." 100 | [[row col]] 101 | [row (dec col)]) 102 | 103 | 104 | (spec/fdef pos-to 105 | :args (spec/cat :cardinal ::direction :pos ::pos) 106 | :ret ::pos 107 | :fn #(adjacent? (:ret %) (-> % :args :pos))) 108 | (defn pos-to 109 | "Get neighboring position given a direction. 110 | No bounds checking, so may return invalid position." 111 | [cardinal [row col]] 112 | (case cardinal 113 | :north [(dec row) col] 114 | :south [(inc row) col] 115 | :east [row (inc col)] 116 | :west [row (dec col)])) 117 | 118 | 119 | ;;; Grid Functions 120 | 121 | (spec/fdef init 122 | :args (spec/cat :rows pos-int? :columns pos-int? :v (spec/? any?)) 123 | :ret ::grid) 124 | (defn init 125 | "Initialize a grid of cells with the given number of rows and columns, 126 | which can be accessed by index. Conceptually, [0 0] is the upper left corner." 127 | ([rows columns] (init rows columns [])) 128 | ([rows columns v] 129 | (vec (repeat rows 130 | (vec (repeat columns v)))))) 131 | 132 | 133 | (spec/fdef in? 134 | :args (spec/cat :grid ::grid :pos ::pos) 135 | :ret boolean?) 136 | (defn in? 137 | "Is the position within the bounds of the grid." 138 | [grid pos] 139 | (if (seq pos) 140 | (let [[row col] pos 141 | max-row (dec (count grid)) 142 | max-col (dec (count (get grid row)))] 143 | (and 144 | (<= 0 row max-row) 145 | (<= 0 col max-col))) 146 | false)) 147 | 148 | 149 | (spec/fdef neighbors 150 | :args (spec/cat :grid ::grid :pos ::pos) 151 | :ret (spec/coll-of ::pos) 152 | :fn #(every? adjacent? %)) 153 | (defn neighbors 154 | "Get all potential neighbors of a position in a given grid" 155 | [grid [row col]] 156 | (filter 157 | #(in? grid %) 158 | #{[(dec row) col] [(inc row) col] [row (dec col)] [row (inc col)]})) 159 | 160 | 161 | (spec/fdef all-positions 162 | :args (spec/cat :grid ::grid) 163 | :ret (spec/coll-of ::pos :min-count 2) 164 | :fn #(every? (fn [pos] (in? (-> % :args :grid) pos)) (:ret %))) 165 | (defn all-positions 166 | "Get a sequence of all the positions in a grid." 167 | [grid] 168 | ;; Maybe put into set, but then would have to figure out how to 169 | ;; randomly select from set. 170 | (for [row (range (count grid)) 171 | col (range (count (first grid)))] 172 | [row col])) 173 | 174 | 175 | (spec/fdef random-pos 176 | :args (spec/cat :grid ::grid) 177 | :ret ::pos 178 | :fn #(in? (-> % :args :grid) (:ret %))) 179 | (defn random-pos 180 | "Select a random position from the grid. 181 | Will not return a masked cell if there are any in the grid." 182 | [grid] 183 | (let [pos [(rand-int (count grid)) (rand-int (count (first grid)))]] 184 | ;; When grids contain masked cells, make sure to return an unmasked cell. 185 | (if (not-any? #{:mask} (get-in grid pos)) 186 | pos 187 | (random-pos grid)))) 188 | 189 | 190 | ;;; Maze Functions 191 | 192 | (spec/fdef empty-neighbors 193 | :args (spec/alt 194 | :2-args (spec/cat :maze ::maze :pos ::pos) 195 | ;; The 3-arg ::maze can contain 196 | ;; #{::pos :north :south :east :west 197 | ;; :northeast :northwest :southeast :southwest 198 | ;; :inward :clockwise :counter-clockwise :mask}} 199 | :3-args (spec/cat :maze ::maze :neighbor-fn ifn? :pos ::pos)) 200 | :ret (spec/coll-of ::pos) 201 | :fn #(every? adjacent? %)) 202 | (defn empty-neighbors 203 | "Get all positions neighboring `pos` which have not been visited." 204 | ([maze pos] (empty-neighbors maze neighbors pos)) 205 | ([maze neighbor-fn pos] 206 | (filter #(empty? (get-in maze %)) (neighbor-fn maze pos)))) 207 | 208 | 209 | (spec/fdef link-with 210 | :args (spec/cat :direction-fn ifn?) 211 | :ret ifn?) 212 | (defn link-with 213 | "Create a link function which uses the provided direction-fn." 214 | [direction-fn] 215 | (fn [maze pos-1 pos-2] 216 | (-> maze 217 | (update-in pos-1 conj (direction-fn pos-1 pos-2)) 218 | (update-in pos-2 conj (direction-fn pos-2 pos-1))))) 219 | 220 | 221 | (spec/fdef link 222 | :args (spec/cat :maze ::maze :pos-1 ::pos :pos-2 ::pos) 223 | :ret ::maze 224 | :fn #(and 225 | (seq (get-in (:ret %) (-> % :args :pos-1))) 226 | (seq (get-in (:ret %) (-> % :args :pos-2))))) 227 | (defn link 228 | "Link two adjacent cells in a maze." 229 | ([maze pos-1 pos-2] 230 | ((link-with direction) maze pos-1 pos-2))) 231 | 232 | 233 | (spec/fdef dead-ends 234 | :args (spec/cat :maze ::maze) 235 | :ret (spec/coll-of ::pos)) 236 | (defn dead-ends 237 | "Filter for the dead ends in a maze. 238 | Fewer dead ends contribute to 'river', more flowing and meandering in a maze." 239 | [maze] 240 | (for [[y row] (map-indexed vector maze) 241 | [x cell] (map-indexed vector row) 242 | :when (and (= 1 (count cell)) (not= [:mask] cell))] 243 | [y x])) 244 | 245 | 246 | (spec/fdef braid 247 | :args (spec/cat :maze ::maze :rate (spec/? ::rate)) 248 | :ret ::maze) 249 | (defn braid 250 | "Braid a maze. 251 | Braiding introduces loops into a maze by removing dead ends. A rate can be 252 | passed in to indicate a percentage of dead ends to link, otherwise all dead 253 | end will be linked to an adjacent cell." 254 | ([maze] (braid maze 1.0)) 255 | ([maze rate] 256 | (loop [acc maze 257 | positions (dead-ends maze)] 258 | (if (seq positions) 259 | (if (> rate (rand)) 260 | (let [pos (first positions) 261 | adj (filter #(adjacent? pos %) (rest positions)) 262 | neighbor (if (seq adj) 263 | (rand-nth adj) 264 | (rand-nth (neighbors maze pos))) 265 | remaining (if (seq adj) 266 | (remove #{neighbor} (rest positions)) 267 | (rest positions))] 268 | (recur (link acc pos neighbor) remaining)) 269 | (recur acc (rest positions))) 270 | acc)))) 271 | 272 | 273 | (spec/fdef unlink 274 | :args (spec/cat :maze ::maze :pos-1 ::pos :pos-2 ::pos) 275 | :ret ::maze) 276 | (defn unlink 277 | "Unlink two cells in a maze. Will replace dead ends with a mask to facilitate 278 | rendering." 279 | [maze pos-1 pos-2] 280 | (let [cell-1 (get-in maze pos-1) 281 | cell-2 (get-in maze pos-2)] 282 | (-> maze 283 | (assoc-in 284 | pos-1 285 | (if (= 1 (count cell-1)) 286 | [:mask] 287 | (vec (remove #{(direction pos-1 pos-2)} (get-in maze pos-1))))) 288 | (assoc-in 289 | pos-2 290 | (if (= 1 (count cell-2)) 291 | [:mask] 292 | (vec (remove #{(direction pos-2 pos-1)} (get-in maze pos-2)))))))) 293 | 294 | 295 | (spec/fdef cull 296 | :args (spec/cat :maze ::maze :rate (spec/? ::rate)) 297 | :ret ::maze) 298 | (defn cull 299 | "Cull dead ends from a maze by unlinking them. 300 | This results in a sparse maze. A rate can be passed in to indicate a 301 | percentage of dead ends to unlink, otherwise all dead end will be unlinked." 302 | ([maze] (cull maze 1.0)) 303 | ([maze rate] 304 | (loop [acc maze 305 | positions (dead-ends maze)] 306 | (if (seq positions) 307 | (if (> rate (rand)) 308 | (let [pos (first positions) 309 | neighbor (pos-to (first (get-in maze pos)) pos)] 310 | (recur 311 | (unlink acc pos neighbor) 312 | (rest positions))) 313 | (recur acc (rest positions))) 314 | acc)))) 315 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor to control, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /src/meiro/png.clj: -------------------------------------------------------------------------------- 1 | (ns meiro.png 2 | "Generate a PNG image of a maze." 3 | (:require [meiro.weave :as weave]) 4 | (:import (java.awt Color Graphics2D) 5 | (java.awt.geom Line2D$Double Rectangle2D$Double 6 | Arc2D Arc2D$Double Ellipse2D$Double) 7 | (java.awt.image BufferedImage) 8 | (java.lang Math) 9 | (javax.imageio ImageIO) 10 | (java.io File))) 11 | 12 | 13 | ;; NOTE: All the grid logic at this point is built up using [row column]. 14 | ;; This means that positions, when mapped to coordinates, are flipped from 15 | ;; what one might normally expect, i.e., [y x] instead of [x y]. 16 | ;; "Fixing" this would break a lot, so I may not refactor this. 17 | 18 | 19 | (def ^:private cell-size 20 | "Cell size constant which determines cell width and height in image." 21 | 20) 22 | 23 | 24 | (def ^:private default-file 25 | "Default file name to use if none is provided." 26 | "maze.png") 27 | 28 | 29 | (defn- draw 30 | "Draw line in graphic from coordinates." 31 | [^Graphics2D graphic x y x' y'] 32 | (.draw graphic 33 | (Line2D$Double. 34 | (* cell-size x) 35 | (* cell-size y) 36 | (* cell-size x') 37 | (* cell-size y')))) 38 | 39 | 40 | (defn- draw-line 41 | "Draw a line using float-based coordinates." 42 | [^Graphics2D graphic x y x' y'] 43 | (.draw graphic (Line2D$Double. x y x' y'))) 44 | 45 | 46 | (defn- render-cells 47 | "Use a function to render each cell into a PNG image. 48 | 49 | This function extracts out the common rendering pattern for PNGs. 50 | Most rendering cares only about rendering one cell at a time, and can do 51 | that with the four arguments passed: graphic, x, y, cell. 52 | Since masking prevent cell rendering, it is integrated in here." 53 | ([maze file-name img-width img-height cell-fn] 54 | (let [img (BufferedImage. img-width img-height 55 | BufferedImage/TYPE_INT_ARGB) 56 | graphic (.createGraphics img)] 57 | (.setColor graphic Color/BLACK) 58 | (doseq [[y row] (map-indexed vector maze)] 59 | (doseq [[x cell] (map-indexed vector row)] 60 | (when (not-any? #{:mask} cell) 61 | (cell-fn graphic x y cell)))) 62 | (ImageIO/write img "png" (File. file-name))))) 63 | 64 | 65 | ;; This method is optimized not to draw a line more than once. 66 | ;; Because of this, it has to assume a rectangular grid with no masking. 67 | 68 | (defn render 69 | "Render a maze as a PNG image." 70 | ([maze] (render maze default-file)) 71 | ([maze ^String file-name] 72 | (let [rows (count maze) 73 | cols (count (first maze)) 74 | img (BufferedImage. 75 | (inc (* cell-size cols)) 76 | (inc (* cell-size rows)) 77 | BufferedImage/TYPE_INT_ARGB) 78 | graphic (.createGraphics img)] 79 | (.setColor graphic Color/BLACK) 80 | (.drawLine graphic 0 0 0 (* cell-size rows)) 81 | (.drawLine graphic 0 0 (* cell-size cols) 0) 82 | (doseq [[y row] (map-indexed vector maze)] 83 | (doseq [[x cell] (map-indexed vector row)] 84 | (when (not-any? #{:east} cell) 85 | (draw graphic (inc x) y (inc x) (inc y))) 86 | (when (not-any? #{:south} cell) 87 | (draw graphic x (inc y) (inc x) (inc y))))) 88 | (ImageIO/write img "png" (File. file-name))))) 89 | 90 | 91 | (defn render-masked 92 | "Render a maze as a PNG image, but not printing masked cells." 93 | ([maze] (render-masked maze default-file)) 94 | ([maze ^String file-name] 95 | (render-cells 96 | maze file-name 97 | (inc (* cell-size (count (first maze)))) 98 | (inc (* cell-size (count maze))) 99 | (fn [graphic x y cell] 100 | (let [x+ (inc x) 101 | y+ (inc y)] 102 | (when (not-any? #{:north} cell) 103 | (draw graphic x y x+ y)) 104 | (when (not-any? #{:west} cell) 105 | (draw graphic x y x y+)) 106 | (when (not-any? #{:east} cell) 107 | (draw graphic x+ y x+ y+)) 108 | (when (not-any? #{:south} cell) 109 | (draw graphic x y+ x+ y+))))))) 110 | 111 | 112 | (defn- square 113 | "Create a square at `coord` distance from top and left and with sides 114 | of `length`. This does not draw the square, only creates the object, as it 115 | forms the bounds of arcs drawn within it." 116 | [coord length] 117 | (Rectangle2D$Double. coord coord length length)) 118 | 119 | 120 | (defn render-polar 121 | "Render a polar grid maze as a PNG image." 122 | ;; Doesn't use render-cells because outside circle is drawn once. 123 | ([maze] (render-polar maze default-file)) 124 | ([maze ^String file-name] 125 | (let [image-size (* 2 cell-size (count maze)) 126 | img (BufferedImage. (inc image-size) (inc image-size) 127 | BufferedImage/TYPE_INT_ARGB) 128 | graphic (.createGraphics img) 129 | center (/ image-size 2)] 130 | (.setColor graphic Color/BLACK) 131 | (doseq [[y row] (map-indexed vector maze)] 132 | (when (pos? y) ; Never render the center cell. 133 | (doseq [[x cell] (map-indexed vector row)] 134 | (let [theta (/ (* 2 Math/PI) (count row)) 135 | inner-radius (* cell-size y) 136 | arc-length (/ 360 (count row)) 137 | outer-radius (* cell-size (inc y))] 138 | (when (not-any? #{:inward} cell) 139 | (let [bounds (square (- center inner-radius) (* 2 inner-radius)) 140 | start (- 360 arc-length (* x arc-length))] 141 | (.draw graphic 142 | (Arc2D$Double. bounds start arc-length Arc2D/OPEN)))) 143 | (when (not-any? #{:clockwise} cell) 144 | (let [theta-cw (* theta (inc x)) 145 | cx (+ center (* inner-radius (Math/cos theta-cw))) 146 | cy (+ center (* inner-radius (Math/sin theta-cw))) 147 | dx (+ center (* outer-radius (Math/cos theta-cw))) 148 | dy (+ center (* outer-radius (Math/sin theta-cw)))] 149 | (.draw graphic (Line2D$Double. cx cy dx dy)))))))) 150 | (.draw graphic (Ellipse2D$Double. 0 0 image-size image-size)) 151 | (ImageIO/write img "png" (File. file-name))))) 152 | 153 | 154 | (defn render-hex 155 | "Render a sigma (hex) maze as a PNG image." 156 | ([maze] (render-hex maze default-file)) 157 | ([maze ^String file-name] 158 | (let [size cell-size 159 | a-size (/ size 2.0) 160 | b-size (/ (* size (Math/sqrt 3)) 2.0) 161 | height (* b-size 2) 162 | rows (count maze) 163 | columns (count (first maze)) 164 | img-width (inc (+ (* 3 a-size columns) a-size 0.5)) 165 | img-height (inc (+ (* height rows) b-size 0.5))] 166 | (render-cells 167 | maze file-name 168 | img-width img-height 169 | (fn [graphic x y cell] 170 | (let [cx (+ size (* 3 x a-size)) 171 | cy (+ b-size (* y height) (if (odd? x) b-size 0)) 172 | x-far-west (- cx size) 173 | x-near-west (- cx a-size) 174 | x-near-east (+ cx a-size) 175 | x-far-east (+ cx size) 176 | y-near (- cy b-size) 177 | y-s (+ cy b-size)] 178 | (when (not-any? #{:north} cell) 179 | (draw-line graphic x-near-west y-near x-near-east y-near)) 180 | (when (not-any? #{:south} cell) 181 | (draw-line graphic x-near-east y-s x-near-west y-s)) 182 | (when (not-any? #{:northwest} cell) 183 | (draw-line graphic x-far-west cy x-near-west y-near)) 184 | (when (not-any? #{:southwest} cell) 185 | (draw-line graphic x-far-west cy x-near-west y-s)) 186 | (when (not-any? #{:northeast} cell) 187 | (draw-line graphic x-near-east y-near x-far-east cy)) 188 | (when (not-any? #{:southeast} cell) 189 | (draw-line graphic x-far-east cy x-near-east y-s)))))))) 190 | 191 | 192 | (defn render-delta 193 | "Render a delta (triangle) maze as a PNG image." 194 | ([maze] (render-delta maze default-file)) 195 | ([maze file-name] 196 | (let [size cell-size 197 | half-width (/ size 2.0) 198 | height (/ (* size (Math/sqrt 3)) 2.0) 199 | half-height (/ height 2) 200 | rows (count maze) 201 | columns (count (first maze)) 202 | img-width (inc (/ (* size (inc columns)) 2)) 203 | img-height (inc (* height rows))] 204 | (render-cells 205 | maze file-name 206 | img-width img-height 207 | (fn [graphic x y cell] 208 | (let [cx (+ half-width (* x half-width)) 209 | cy (+ half-height (* y height)) 210 | west-x (- cx half-width) 211 | east-x (+ cx half-width) 212 | upright? (even? (+ x y)) 213 | apex-y ((if upright? - +) cy half-height) 214 | base-y ((if upright? + -) cy half-height)] 215 | (when (not-any? #{:west} cell) 216 | (draw-line graphic west-x base-y cx apex-y)) 217 | (when (not-any? #{:east} cell) 218 | (draw-line graphic east-x base-y cx apex-y)) 219 | (when (not-any? #{:north :south} cell) 220 | (draw-line graphic east-x base-y west-x base-y)))))))) 221 | 222 | 223 | (defn- coordinates-with-inset 224 | "Derive the eight coordinates needed for rendering insets. 225 | [x1 x2 x3 x4 y1 y2 y3 y4]" 226 | [x y size inset] 227 | (let [x1 (* x size) 228 | y1 (* y size) 229 | x4 (+ x1 size) 230 | y4 (+ y1 size)] 231 | [x1 (+ x1 inset) (- x4 inset) x4 232 | y1 (+ y1 inset) (- y4 inset) y4])) 233 | 234 | 235 | (defn- open? 236 | "Does the given cell link to a cell in the provided direction, either directly 237 | or by passing underneath." 238 | [dir x y cell] 239 | (or (some #{dir} cell) 240 | (some #{dir} (map #(weave/direction [y x] %) 241 | (filter vector? cell))))) 242 | 243 | (defn- link-north 244 | "Draw inset link to the cell to the north." 245 | [graphic [_ x2 x3 _ y1 y2 _ _]] 246 | (draw-line graphic x2 y1 x2 y2) 247 | (draw-line graphic x3 y1 x3 y2)) 248 | 249 | 250 | (defn- link-south 251 | "Draw inset link to the cell to the south." 252 | [graphic [_ x2 x3 _ _ _ y3 y4]] 253 | (draw-line graphic x2 y3 x2 y4) 254 | (draw-line graphic x3 y3 x3 y4)) 255 | 256 | 257 | (defn- link-east 258 | "Draw inset link to the cell to the east." 259 | [graphic [_ _ x3 x4 _ y2 y3 _]] 260 | (draw-line graphic x3 y2 x4 y2) 261 | (draw-line graphic x3 y3 x4 y3)) 262 | 263 | 264 | (defn- link-west 265 | "Draw inset link to the cell to the west" 266 | [graphic [x1 x2 _ _ _ y2 y3 _]] 267 | (draw-line graphic x1 y2 x2 y2) 268 | (draw-line graphic x1 y3 x2 y3)) 269 | 270 | 271 | (defn render-inset 272 | "Render a maze to PNG with insets. 273 | Inset mazes will handle weave mazes by default." 274 | ([maze inset] (render-inset maze default-file inset)) 275 | ([maze ^String file-name inset] 276 | (render-cells 277 | maze file-name 278 | (inc (* cell-size (count (first maze)))) 279 | (inc (* cell-size (count maze))) 280 | (fn [graphic x y cell] 281 | (let [[_ x2 x3 _ _ y2 y3 _ :as coords] 282 | (coordinates-with-inset x y cell-size inset)] 283 | (if (open? :north x y cell) 284 | (link-north graphic coords) 285 | (draw-line graphic x2 y2 x3 y2)) 286 | (if (open? :west x y cell) 287 | (link-west graphic coords) 288 | (draw-line graphic x2 y2 x2 y3)) 289 | (if (open? :east x y cell) 290 | (link-east graphic coords) 291 | (draw-line graphic x3 y2 x3 y3)) 292 | (if (open? :south x y cell) 293 | (link-south graphic coords) 294 | (draw-line graphic x2 y3 x3 y3)) 295 | (when (some #{:under} cell) 296 | (if (some #{:north} cell) 297 | (do 298 | (link-east graphic coords) 299 | (link-west graphic coords)) 300 | (do 301 | (link-north graphic coords) 302 | (link-south graphic coords))))))))) 303 | 304 | 305 | (defn- fill-square 306 | [^Graphics2D graphic x y] 307 | (let [x' (inc (* x cell-size)) 308 | y' (inc (* y cell-size)) 309 | length (- cell-size 2)] 310 | (.fill graphic 311 | (Rectangle2D$Double. x' y' length length)))) 312 | 313 | 314 | (defn- fill-passage 315 | [^Graphics2D graphic x y x' y'] 316 | (let [start-x (inc (* x cell-size)) 317 | start-y (inc (* y cell-size)) 318 | length-x (+ cell-size (- (* x' cell-size) start-x 1)) 319 | length-y (+ cell-size (- (* y' cell-size) start-y 1))] 320 | (.fill graphic 321 | (Rectangle2D$Double. start-x start-y length-x length-y)))) 322 | 323 | 324 | (defn render-forest 325 | "Render a forest to PNG. 326 | Because forests are a collection of edges, other render functions (which are 327 | position-aware) cannot render them without conversion. To work around that, 328 | this function bores out the maze by iterating through the edges whereever they 329 | are." 330 | [forest] 331 | (let [{:keys [width height edges]} forest 332 | img-width (* cell-size width) 333 | img-height (* cell-size height) 334 | img (BufferedImage. img-width img-height 335 | BufferedImage/TYPE_INT_ARGB) 336 | graphic (.createGraphics img)] 337 | ;; Color entire image black. 338 | (.setColor graphic Color/BLACK) 339 | (.fill graphic (Rectangle2D$Double. 0 0 img-width img-height)) 340 | ;; Then bore out cells and passages with white. 341 | (.setColor graphic Color/WHITE) 342 | (doseq [[[x y] [x' y']] edges] 343 | (fill-square graphic x y) 344 | (fill-square graphic x' y') 345 | (fill-passage graphic x y x' y')) 346 | (ImageIO/write img "png" (File. default-file)))) 347 | 348 | 349 | (defn- draw-up-arrow 350 | "Draw an up arrow (pointing right)." 351 | [^Graphics2D graphic x y] 352 | (let [offset 4 353 | half-x (+ (* cell-size x) (/ cell-size 2) 1) 354 | x' (- (* cell-size (inc x)) offset) 355 | half-y (+ (* cell-size y) (/ cell-size 2))] 356 | (.draw graphic 357 | (Line2D$Double. 358 | half-x (+ (* cell-size y) offset) 359 | x' half-y)) 360 | (.draw graphic 361 | (Line2D$Double. 362 | x' half-y 363 | half-x (- (* cell-size (inc y)) offset))))) 364 | 365 | 366 | (defn- draw-down-arrow 367 | "Draw a down arrow (pointing left)." 368 | [^Graphics2D graphic x y] 369 | (let [offset 4 370 | half-x (dec (+ (* cell-size x) (/ cell-size 2))) 371 | x' (+ (* cell-size x) offset) 372 | half-y (+ (* cell-size y) (/ cell-size 2))] 373 | (.draw graphic 374 | (Line2D$Double. 375 | half-x (+ (* cell-size y) offset) 376 | x' half-y)) 377 | (.draw graphic 378 | (Line2D$Double. 379 | x' half-y 380 | half-x (- (* cell-size (inc y)) offset))))) 381 | 382 | 383 | (defn render-3d 384 | "Lay out a three-dimensional maze with each level side by side. Uses arrows to 385 | indicate when to move between levels." 386 | [maze] 387 | (let [levels (count maze) 388 | height (count (first maze)) 389 | width (count (ffirst maze)) 390 | gap-size (/ cell-size 2) 391 | img-width (+ (* gap-size levels) 392 | (* levels (* cell-size width))) 393 | img-height (inc (* cell-size height)) 394 | img (BufferedImage. img-width img-height 395 | BufferedImage/TYPE_INT_ARGB) 396 | graphic (.createGraphics img)] 397 | (.setColor graphic Color/BLACK) 398 | (doseq [[z level] (map-indexed vector maze)] 399 | (let [offset (+ (* z 0.5) (* z width))] 400 | (doseq [[y row] (map-indexed vector level)] 401 | (doseq [[x' cell] (map-indexed vector row)] 402 | (when (not-any? #{:mask} cell) 403 | (let [x (+ offset x') 404 | x+ (inc x) 405 | y+ (inc y)] 406 | (when (not-any? #{:north} cell) 407 | (draw graphic x y x+ y)) 408 | (when (not-any? #{:west} cell) 409 | (draw graphic x y x y+)) 410 | (when (not-any? #{:east} cell) 411 | (draw graphic x+ y x+ y+)) 412 | (when (not-any? #{:south} cell) 413 | (draw graphic x y+ x+ y+)) 414 | (when (some #{:up} cell) 415 | (draw-up-arrow graphic x y)) 416 | (when (some #{:down} cell) 417 | (draw-down-arrow graphic x y)))))))) 418 | (ImageIO/write img "png" (File. default-file)))) 419 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Meiro 迷路 2 | 3 | Maze generation code, inspired by working through [Mazes for 4 | Programmers](https://pragprog.com/book/jbmaze/mazes-for-programmers). 5 | Because the book leans on Object Oriented design (coded in Ruby), much of this 6 | is a re-thinking of the approaches in a Clojure style. 7 | 8 | Each maze generation algorithm is in its own namespace. 9 | 10 | Except where otherwise noted, all algorithms produce "perfect" mazes. Perfect 11 | mazes have exactly one path between any two cells in the maze. This also means 12 | that you designate any two cells as the start and end and guarantee that there 13 | is a solution. 14 | 15 | [![Dependencies Status](https://versions.deps.co/defndaines/meiro/status.svg)](https://versions.deps.co/defndaines/meiro) 16 | 17 | | [Usage](#usage) 18 | | [Algorithms](#algorithms) 19 | | [Solutions](#solutions) 20 | | [Utilities](#utilities) 21 | | [Presentation](#presentation) 22 | 23 | 24 | ## Usage 25 | 26 | Project is pretty much complete and does not have functions exposed for 27 | external use (such as through a command-line executable JAR file). All the 28 | examples below assume that you are importing into a REPL for execution. 29 | 30 | 31 | ### Displaying Mazes 32 | 33 | There are several ways to display a maze. The primary data structure used here 34 | to store a maze is a vector of vectors, where each cell indicates which 35 | directions you can navigate out of the cell to. Each of these cells is 36 | position-aware, with cells accessed by `[row column]`. 37 | 38 | Here is a 5x5 maze: 39 | ```clojure 40 | (def maze 41 | [[[:east] [:south :west :east] [:west :east] [:west :south] [:south]] 42 | [[:east :south] [:east :north :west] [:south :west] [:north :east] [:west :north]] 43 | [[:north :east] [:west] [:south :north :east] [:west] [:south]] 44 | [[:south] [:south] [:south :north :east] [:west :east] [:west :north :south]] 45 | [[:east :north] [:north :west :east] [:west :north] [:east] [:north :west]]]) 46 | ``` 47 | 48 | The easiest way to visualize a maze at the REPL is to generate an ASCII 49 | version: 50 | ```clojure 51 | user=> (require '[meiro.ascii :as ascii]) 52 | nil 53 | user=> (print (ascii/render maze)) 54 | +---+---+---+---+---+ 55 | | | | 56 | +---+ +---+ + + 57 | | | | 58 | + +---+ +---+---+ 59 | | | | | 60 | +---+---+ +---+ + 61 | | | | | 62 | + + + +---+ + 63 | | | | 64 | +---+---+---+---+---+ 65 | nil 66 | ``` 67 | 68 | And if you want to print or share a maze, it can be output as a PNG: 69 | ```clojure 70 | (require '[meiro.png :as png]) 71 | (require '[meiro.core :as m]) 72 | (require '[meiro.sidewinder :as sw]) 73 | (png/render (sw/create (m/init 15 20)) "sample-maze.png") 74 | ``` 75 | Which creates a PNG file like: 76 | 77 | ![Sample Maze](img/sample-maze.png) 78 | 79 | To print a maze with masked cells: 80 | ```clojure 81 | (def grid (ascii/read-grid "test/meiro/template.txt")) 82 | (require '[meiro.backtracker :as b]) 83 | (png/render-masked (b/create grid)) 84 | ``` 85 | 86 | ![Masked Maze](img/masked-maze.png) 87 | 88 | To print a circular (polar) maze: 89 | ```clojure 90 | (require '[meiro.polar :as polar]) 91 | (png/render-polar 92 | (b/create (polar/init 10) [0 0] polar/neighbors polar/link)) 93 | ``` 94 | 95 | ![Polar Maze](img/polar-maze.png) 96 | 97 | To print a sigma (hex) maze: 98 | ```clojure 99 | (require '[meiro.hex :as hex]) 100 | (png/render-hex 101 | (b/create (m/init 15 20) [7 9] hex/neighbors hex/link)) 102 | ``` 103 | 104 | ![Sigma Maze](img/sigma-maze.png) 105 | 106 | To print a delta (triangle) maze: 107 | ```clojure 108 | (require '[meiro.triangle :as triangle]) 109 | (def grid (ascii/read-grid "test/meiro/triangle.txt")) 110 | (png/render-delta 111 | (b/create grid [0 12] triangle/neighbors m/link)) 112 | ``` 113 | 114 | ![Delta Maze](img/delta-maze.png) 115 | 116 | To print a maze with an inset: 117 | ```clojure 118 | (png/render-inset (b/create (m/init 8 25)) 3) 119 | ``` 120 | 121 | ![Inset Maze](img/inset-maze.png) 122 | 123 | To print a maze composed of edges, the image must be bored out of a background 124 | image. Use the following: 125 | ```clojure 126 | (require '[meiro.prim :as prim]) 127 | (def forest (prim/create 25 8)) 128 | (png/render-forest forest) 129 | ``` 130 | 131 | ![Bore Maze](img/bore-maze.png) 132 | 133 | If you want to print an ASCII maze as if it were a series of corridors in 134 | NetHack: 135 | ```clojure 136 | (require '[meiro.nethack :as nethack]) 137 | (print (nethack/render-corridor maze)) 138 | 139 | ####### # ####### ####### ####### # 140 | # # # # # # # # # # # 141 | ### # # ### ### # ### ##### # ### # 142 | # # # # # # # # # 143 | ### # ### ### # ### ####### ### ### 144 | # # # # # # # # # # 145 | # # ### # # ### # ### ##### ##### # 146 | # # # # # # # # # # 147 | # # # ### ### ##### # ### ##### # # 148 | # # # # # # # # # # # # # 149 | ### ######### ### ####### # ####### 150 | 151 | ``` 152 | 153 | If you want to print an ASCII maze as if it were a situated in a 154 | NetHack room (corners could use some work): 155 | ```clojure 156 | (print (nethack/render-room maze)) 157 | ------------------------------------- 158 | |.......|.|.......|.......|.......|.| 159 | |.-----.|.|.-.---.|.-----.|.-----.|.| 160 | |...|.|.|...|...|.|...|.....|.|...|.| 161 | |--.|.|.|------.|.|--.|------.|.---.| 162 | |...|.|...|...|.|...|.......|...|...| 163 | |.---.|--.|.-.|.|--.|------.|.-----.| 164 | |.|.|...|.|.|...|.|...|.....|.....|.| 165 | |.|.|.---.|.|----.|--.|.---------.|.| 166 | |.|.|.|...|...|.....|.|...|.....|.|.| 167 | |.|.|.|.-----.|.---.|.|--.|.-.---.|.| 168 | |...|.........|...|.......|.|.......| 169 | |------------------------------------ 170 | ``` 171 | 172 | 173 | ## Algorithms 174 | 175 | There are a number of different algorithms for generating mazes. 176 | 177 | 178 | ### Binary Tree 179 | 180 | Binary Tree produces mazes by visiting each cell in a grid and opening a 181 | passage either south or east. This causes a bias toward paths which flow down 182 | and to the right. They will always have a single corridor along both the 183 | southern and eastern edges. 184 | 185 | If you wish to generate and print a random binary-tree maze, you can start up a 186 | REPL and try to following: 187 | ```clojure 188 | (require '[meiro.core :as m]) 189 | (require '[meiro.ascii :as ascii]) 190 | (require '[meiro.binary-tree :as bt]) 191 | (png/render (bt/create (m/init 8 25))) 192 | ``` 193 | 194 | Which will produce a maze like: 195 | 196 | ![Binary Tree Maze](img/binary-tree-maze.png) 197 | 198 | 199 | ### Sidewinder 200 | 201 | Sidewinder is based upon Binary Tree, but when it navigates south, it chooses a 202 | random cell from the current horizontal corridor and generates the link from 203 | there. The mazes will still flow vertically, but not to the right as with Binary 204 | Tree. All mazes will have a single horizontal corridor along the southern edge. 205 | 206 | To generate a maze using the sidewinder algorithm: 207 | ```clojure 208 | (require '[meiro.sidewinder :as sw]) 209 | (png/render (sw/create (m/init 8 25))) 210 | ``` 211 | 212 | Which will produce a maze like: 213 | 214 | ![Sidewinder Maze](img/sidewinder-maze.png) 215 | 216 | Because Sidewinder creates a maze one row at a time, it is possible to create 217 | infinite mazes. The mazes won't be perfect mazes unless completed, though. 218 | These mazes only link south or east, so you'll only be able to use certain 219 | render functions, like `ascii/render` and `png/render`, which are already 220 | optimized to only render the east and south walls per cell. Optional weights can 221 | be passed to the function. 222 | 223 | ```clojure 224 | (def infini-maze (sw/create-lazy 25 {:south 2 :east 5})) 225 | (def maze (conj (vec (take 7 infini-maze)) (sw/last-row 25))) 226 | (png/render maze) 227 | ``` 228 | 229 | Which will produce a maze like: 230 | 231 | ![Infinite Sidewinder Maze](img/infinite-sidewinder-maze.png) 232 | 233 | 234 | ### Aldous-Broder 235 | 236 | Aldous-Broder picks a random cell in the grid and the moves randomly. If it 237 | visits a cell which has not been visited before, it links it to the previous 238 | cell. The algorithm ends when all cells have been visited. 239 | 240 | Because movement is random, it can take a long time for this algorithm to 241 | finish. Because movement is completely random, the generated maze has no bias. 242 | 243 | To generate a random-walk maze using Aldous-Broder: 244 | ```clojure 245 | (require '[meiro.aldous-broder :as ab]) 246 | (png/render (ab/create (m/init 8 25))) 247 | ``` 248 | 249 | Which will produce a maze like: 250 | 251 | ![Aldous-Broder Maze](img/aldous-broder-maze.png) 252 | 253 | 254 | ### Wilson's 255 | 256 | Wilson's starts at a random cell and then does a random walk. When it introduces 257 | a loop by coming back to a visited cell, it erases the loop then continues the 258 | random walk from that point. The algorithm starts slowly, but produces a 259 | completely unbiased maze. 260 | 261 | To generate a loop-erasing, random-walk maze: 262 | ```clojure 263 | (require '[meiro.wilson :as w]) 264 | (png/render (w/create (m/init 8 25))) 265 | ``` 266 | 267 | Which will produce a maze like: 268 | 269 | ![Wilson's Maze](img/wilsons-maze.png) 270 | 271 | 272 | ### Hunt-and-Kill 273 | 274 | Hunt-and-Kill performs a random walk, but avoids visiting cells which are 275 | already linked. When it reaches a dead end but there are still cells to visit, 276 | it will look for an unvisited cell neighboring a visited cell and begin walking 277 | again from there. 278 | 279 | Hunt-and-kill mazes tend to have long, twisty passages with fewer dead ends than 280 | most of the algorithms here. It can be slower because it can visit cells many 281 | times. 282 | 283 | To generate a random-walk maze biased to the first visited cell using 284 | Hunt-and-Kill: 285 | ```clojure 286 | (require '[meiro.hunt-and-kill :as hk]) 287 | (png/render (hk/create (m/init 8 25))) 288 | ``` 289 | 290 | Which will produce a maze like: 291 | 292 | ![Hunt and Kill Maze](img/hunt-and-kill-maze.png) 293 | 294 | 295 | ### Recursive Backtracker 296 | 297 | Recursive Backtracker uses a random-walk algorithm. When it encounters a dead 298 | end, it backtracks to the last unvisited cell and resumes the random walk from 299 | that position. It completes when it backtracks to the starting cell. Resulting 300 | mazes have long, twisty passages and fewer dead ends. It should be faster than 301 | hunt-and-kill, but has to maintain the stack of all visited cells. 302 | 303 | To generate a random-walk maze biased to the last unvisited cell on the path 304 | using Recursive Backtracker: 305 | ```clojure 306 | (require '[meiro.backtracker :as b]) 307 | (png/render (b/create (m/init 8 25))) 308 | ``` 309 | 310 | Which will produce a maze like: 311 | 312 | ![Recursive Backtracker Maze](img/backtracker-maze.png) 313 | 314 | 315 | ### Kruskal's 316 | 317 | Kruskal's algorithm is focused on generating a minimum spanning tree. I decided 318 | to use a more graph-centric approach, so the `create` function returns a 319 | "forest", a map which includes the nodes and edges. It uses `x, y` coordinates, 320 | so is "backward" from the other algorithms to this point. 321 | 322 | The algorithm assigns every cell to a distinct forest, and then merges forests 323 | one at a time until there is only one forest remaining. 324 | 325 | The `png/render-forest` function will render a forest directly, or the results 326 | can be converted to the standard, grid-style maze using `graph/forest-to-maze` 327 | before passing to other `png` functions. 328 | 329 | ```clojure 330 | (require '[meiro.kruskal :as k]) 331 | (require '[meiro.graph :as graph]) 332 | (def forest (k/create 25 8)) 333 | (def maze (graph/forest-to-maze forest)) 334 | (png/render maze) 335 | ``` 336 | 337 | Which will produce a maze like: 338 | 339 | ![Kruskal's Maze](img/kruskal-maze.png) 340 | 341 | 342 | ### Prim's 343 | 344 | Prim's algorithm generates a minimum spanning tree by starting with a position 345 | and adding the "cheapest" edge available. Weights are assigned randomly to 346 | ensure a less biased maze. Like Kruskal's, the approach is graph-centric and 347 | `create` returns a collection of edges. The implementation here is a "True 348 | Prim's" approach, using weighted edges. (There are other versions possible, like 349 | Simplified Prim's, which produce more biased mazes.) 350 | 351 | ```clojure 352 | (require '[meiro.prim :as prim]) 353 | (require '[meiro.graph :as graph]) 354 | (def forest (prim/create 25 8)) 355 | (def maze (graph/forest-to-maze forest)) 356 | (png/render maze) 357 | ``` 358 | 359 | Which will produce a maze like: 360 | 361 | ![Prim's Maze](img/prim-maze.png) 362 | 363 | 364 | ### Growing Tree 365 | 366 | The Growing Tree algorithm is an abstraction over the approach in Prim's 367 | algorithm. 368 | It needs to be passed a `queue` which holds the active edges of the growing tree 369 | (forest), a `poll-fn` which removes an edge from the `queue`, and a `shift-fn` 370 | which transfers the edges of a newly added node from the set of remaining, 371 | unexplored edges to the `queue`. 372 | 373 | The bias of this algorithm will depend on how edges are added to and removed 374 | from the queue 375 | 376 | To implement Prim's algorithm using Growing Tree: 377 | ```clojure 378 | (require '[meiro.growing-tree :as grow]) 379 | (require '[meiro.prim :as prim]) 380 | (def forest (grow/create 25 8 381 | (java.util.PriorityQueue.) 382 | prim/poll 383 | prim/to-active!)) 384 | (def maze (graph/forest-to-maze forest)) 385 | (png/render maze) 386 | ``` 387 | 388 | Which will produce a maze like: 389 | 390 | ![Growing Prim's Maze](img/growing-prim-maze.png) 391 | 392 | But, Growing Tree can also be used to implement Recursive Backtracker. 393 | _Note: If you do not shuffle the new edges, the resulting "maze" will mostly be a 394 | series of connected corridors._ 395 | ```clojure 396 | (require '[meiro.growing-tree :as grow]) 397 | 398 | (defn back-poll 399 | [q] 400 | [(first q) (rest q)]) 401 | 402 | (defn back-shift 403 | [new-edges queue remaining-edges] 404 | (reduce 405 | (fn [[q es] e] 406 | (let [remaining (disj es e)] 407 | (if (= es remaining) 408 | [q es] 409 | [(conj q e) 410 | remaining]))) 411 | [queue remaining-edges] 412 | (shuffle new-edges))) 413 | 414 | (def forest (grow/create 25 8 '() back-poll back-shift)) 415 | (def maze (graph/forest-to-maze forest)) 416 | (png/render maze) 417 | ``` 418 | 419 | Which will produce a maze like: 420 | 421 | ![Growing Recursive Backtracker Maze](img/growing-backtracker-maze.png) 422 | 423 | 424 | ### Eller's 425 | 426 | Eller's algorithm processes a row at a time, creating forests as it goes. It 427 | also behaves like Sidewinder, in that it will connect to the next row from one 428 | random position in a horizontal corridor. When a forest is orphaned, because it 429 | does not have a link to the next row, then it is merged with an adjacent forest. 430 | When the last row is reached, all forests are merged. Note that when forests are 431 | merged, they can be linked at any two adjacent nodes (i.e., not necessarily the 432 | southernmost cell). 433 | 434 | To create a maze using Eller's: 435 | ```clojure 436 | (require '[meiro.eller :as eller]) 437 | (def forest (eller/create 25 8)) 438 | (png/render (graph/forest-to-maze forest)) 439 | ``` 440 | 441 | Which will produce a maze like: 442 | 443 | ![Eller's Maze](img/eller-maze.png) 444 | 445 | 446 | ### Recursive Division 447 | 448 | The Recursive Division algorithm generates fractal mazes and is distinct among 449 | all the algorithms here in that is adds walls instead of carving passages. 450 | 451 | To create a maze using Recursive Division: 452 | ```clojure 453 | (require '[meiro.division :as division]) 454 | (def maze (division/create (m/init 8 25))) 455 | (png/render maze) 456 | ``` 457 | 458 | Which will produce a maze like: 459 | 460 | ![Recursive Division Maze](img/division-maze.png) 461 | 462 | Recursive Division also enables the creation of rooms inside the maze. Do this 463 | by passing a maximum room size and a creation rate (a percentage of the time 464 | when the subdivision will stop when height and width are below the size). 465 | ```clojure 466 | (def maze (division/create (m/init 8 25) 4 0.4)) 467 | (png/render maze) 468 | ``` 469 | 470 | Which will produce a maze like: 471 | 472 | ![Recursive Division with Rooms Maze](img/division-room-maze.png) 473 | 474 | 475 | ## Solutions 476 | 477 | To calculate the distance from the north-east cell to each cell using Dijkstra's 478 | algorithm: 479 | ```clojure 480 | (require '[meiro.dijkstra :as d]) 481 | (def maze (sw/create (m/init 8 8))) 482 | (def dist (d/distances maze)) 483 | (print (ascii/render maze (ascii/show-distance dist))) 484 | ``` 485 | 486 | Which will produce a maze like: 487 | ``` 488 | +---+---+---+---+---+---+---+---+ 489 | | 0 1 | 4 | n | q p | o n | 490 | + +---+ + +---+ +---+ + 491 | | 1 2 3 | m l | o n | m | 492 | + +---+---+---+ +---+ + + 493 | | 2 3 | m l | k l | m | l | 494 | +---+ +---+ + +---+ + + 495 | | 5 4 | l k j k | l | k | 496 | + +---+---+---+ +---+ + + 497 | | 6 | 9 | k j i | h | k j | 498 | + + +---+---+ + +---+ + 499 | | 7 8 9 a | h g | j | i | 500 | +---+---+ +---+---+ + + + 501 | | g f | a b | g f | i h | 502 | +---+ +---+ +---+ +---+ + 503 | | f e d c d e f g | 504 | +---+---+---+---+---+---+---+---+ 505 | ``` 506 | 507 | To calculate and show a solution: 508 | ```clojure 509 | (def maze (b/create (m/init 8 25))) 510 | (def sol (d/solution maze [0 0] [0 24])) 511 | (print (ascii/render maze (ascii/show-solution sol))) 512 | ``` 513 | 514 | Which will produce a maze like: 515 | ``` 516 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ 517 | | * | | * * | * * | * * * * * * | * * | * * | 518 | + + + + +---+ + + + +---+---+---+ + +---+ +---+---+ +---+---+ + + + + 519 | | * | | | * * | * * | * * | | * | | | | * | * * | * | * * | | 520 | + +---+---+---+ +---+---+---+---+ +---+---+---+ + + + + + + + + +---+---+ + 521 | | * * | * * | * | * * | | * | * * * * | | | | | * * | * * | | | 522 | +---+ + + + + + + + + + +---+---+---+ + + + +---+---+---+---+ + +---+ 523 | | * * | * | * | * * | * * | | * | * | | | | | | | 524 | + +---+ + +---+---+---+ +---+ + +---+---+ + +---+---+ + +---+---+ + +---+ + 525 | | * * * | * | * * * | * * | * | * * | | | | | | | | 526 | +---+---+---+ + + +---+---+ + + + + +---+---+ + +---+---+ + +---+---+ + + 527 | | * * * * | | * * | * | | * | * | * * * | | | | | 528 | + +---+---+ +---+---+ +---+ + + + +---+---+ +---+---+---+---+ +---+---+ + +---+ 529 | | * * * | | * * | * | * * | | * * | * * | * * * * * * * | | | | | 530 | + +---+ +---+ + + + +---+---+---+---+ + +---+---+---+---+---+---+ + + + + + 531 | | | * * * | * * | * * * * * * | * * * * * * * * | | | 532 | +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ 533 | ``` 534 | 535 | 536 | ## Utilities 537 | 538 | There are a few additional utilities besides deriving solutions. 539 | 540 | 541 | ### Longest Path 542 | 543 | Dijkstra's distances calculation can be used to find the position furthest from 544 | a given start point. If none is provided, it will assume the upper left-hand 545 | corner position. 546 | ```clojure 547 | (d/farthest-pos maze) 548 | 549 | [2 20] 550 | ``` 551 | 552 | By running this algorithm twice, the second time with the output of the first 553 | run, you can determine the longest path in a maze. This can be useful if you are 554 | looking to determine start and end points. This function returns a path with 555 | all the positions. 556 | ```clojure 557 | (d/longest-path maze) 558 | 559 | ([6 20] [6 19] [7 19] [7 20] [7 21] [6 21] [5 21] [5 20] [5 19] [5 18] [6 18] 560 | [7 18] [7 17] [6 17] [6 16] [7 16] [7 15] [6 15] [6 14] [7 14] [7 13] [6 13] 561 | [5 13] [5 14] [5 15] [4 15] [4 16] [3 16] [2 16] [1 16] [1 15] [2 15] [2 14] 562 | [2 13] [3 13] [3 14] [4 14] [4 13] [4 12] [4 11] [5 11] [5 12] [6 12] [7 12] 563 | [7 11] [6 11] [6 10] [7 10] [7 9] [6 9] [6 8] [7 8] [7 7] [7 6] [7 5] [7 4] 564 | [7 3] [7 2] [7 1] [7 0] [6 0] [5 0] [4 0] [3 0] [2 0] [2 1] [1 1] [1 0] [0 0] 565 | [0 1] [0 2] [1 2] [1 3] [1 4] [1 5] [1 6] [1 7] [0 7] [0 8] [1 8] [1 9] [2 9] 566 | [2 8] [2 7] [2 6] [3 6] [4 6] [4 5] [4 4] [5 4] [5 3] [4 3] [3 3] [3 2] [3 1] 567 | [4 1] [5 1] [6 1] [6 2] [6 3] [6 4] [6 5] [5 5] [5 6] [5 7] [4 7] [4 8] [4 9] 568 | [5 9] [5 10] [4 10] [3 10] [3 11] [3 12] [2 12] [1 12] [1 13] [0 13] [0 14] 569 | [0 15][0 16] [0 17] [0 18] [1 18] [2 18] [2 19] [3 19] [3 20] [4 20] [4 21] 570 | [3 21] [2 21] [1 21] [0 21] [0 20] [0 19] [1 19] [1 20] [2 20]) 571 | ``` 572 | 573 | 574 | ### Braid 575 | 576 | By default, the algorithms produce "perfect" mazes, i.e., every position in the 577 | grid has one path to any other position in the grid. This inevitably produces 578 | dead ends. "Braiding" is the act of removing dead ends from a maze by linking 579 | them with neighbors. 580 | 581 | To enumerate the dead ends in a maze: 582 | ```clojure 583 | (def maze (b/create (m/init 8 22))) 584 | (m/dead-ends maze) 585 | 586 | ([0 10] [0 16] [1 1] [1 21] [2 5] [2 13] [3 0] [3 7] [4 2] [4 13] [4 15] [5 3] 587 | [5 10] [6 1] [6 15] [6 19] [7 11] [7 21]) 588 | ``` 589 | 590 | You can remove all dead ends with the `braid` function. 591 | ```clojure 592 | (m/braid maze) 593 | ``` 594 | 595 | ![Fully Braided Maze](img/fully-braided-maze.png) 596 | 597 | If you don't want to remove all dead ends, you can pass in a rate which will 598 | determine what percentage of the dead ends should be removed (randomly). 599 | ```clojure 600 | (def braided (m/braid maze 0.4)) 601 | (png/render braided) 602 | ``` 603 | 604 | ![Braided Maze](img/braided-maze.png) 605 | 606 | 607 | ### Cull Dead Ends 608 | 609 | Whereas braiding eliminates dead ends by connecting them to neighbors, it is 610 | also possible to `cull` dead ends, creating a sparse maze. A maze can be culled 611 | multiple times to remove more ends. Culled cells will be marked as masked, so 612 | you will need to use a rendering function which handles this sensibly. 613 | Culled mazes will remain perfect mazes. 614 | ```clojure 615 | (require '[meiro.hunt-and-kill :as hk]) 616 | (def maze (hk/create (m/init 8 22))) 617 | (png/render-inset (m/cull (m/cull maze 0.6) 0.6) 3) 618 | ``` 619 | 620 | ![Culled Maze](img/culled-maze.png) 621 | 622 | 623 | ### Weave 624 | 625 | A weave maze can connect to non-adjacent cells provided certain conditions are 626 | met. 627 | - Passages cannot dead end while underneath another cell. 628 | - Passages must be perpendicular, one north-south, one east-west. 629 | - Passages cannot change direction while traveling under other passages. 630 | 631 | A weave maze will need to be rendered using "inset", otherwise it won't be 632 | possible to visually identify the under passages. 633 | 634 | ```clojure 635 | (require '[meiro.weave :as weave]) 636 | (def maze (b/create (m/init 8 25) [0 0] weave/neighbors weave/link)) 637 | (png/render-inset maze 2) 638 | ``` 639 | 640 | ![Weave Maze](img/weave-maze.png) 641 | 642 | Kruskal's is set up to allow weave to be injected into a maze. This is done by 643 | pre-seeding the algorithm with cells already combined, and then letting the maze 644 | build around it. In order to render a weave maze, it has to be converted to the 645 | standard grid format. 646 | 647 | ```clojure 648 | (require '[meiro.kruskal :as k]) 649 | (require '[meiro.graph :as graph]) 650 | (def forests (graph/init-forests 25 8)) 651 | (def seeded (reduce k/weave forests 652 | (for [x (range 1 25 2) y (range 1 8 2)] [x y]))) 653 | (def forest (k/create 25 8 seeded)) 654 | (def maze (graph/forest-to-maze forest)) 655 | (png/render-inset maze 2) 656 | ``` 657 | 658 | ![Kruskal's Weave Maze](img/kruskal-weave-maze.png) 659 | 660 | 661 | ### Three-dimensional Mazes 662 | 663 | The `grid-3d` namespace can be used to generate three-dimensional mazes. 664 | The example below takes advantage of the controls which can be passed to the 665 | `create` function to favor spreading out on a level before ascending or 666 | descending. 667 | 668 | ```clojure 669 | (require '[meiro.grid-3d :as grid-3d]) 670 | (def grid (grid-3d/init 3 4 5)) 671 | 672 | (def link-3d (m/link-with grid-3d/direction)) 673 | 674 | (defn select-fn 675 | "Favor selecting neighbors on the same level." 676 | [neighbors] 677 | (let [n (count neighbors)] 678 | (if (and (< 2 n) (< 0.1 (rand))) 679 | (rand-nth (take (- n 2) (rest (sort neighbors)))) 680 | (rand-nth neighbors)))) 681 | 682 | (def maze (b/create grid 683 | (grid-3d/random-pos grid) 684 | grid-3d/neighbors link-3d select-fn)) 685 | 686 | (png/render-3d maze) 687 | ``` 688 | 689 | ![3D Maze](img/3d-maze.png) 690 | 691 | 692 | ### Wrapping Mazes 693 | 694 | Sometimes you may want to have maze wrap around, meaning if you step off the 695 | left edge of the maze, it re-enters on the right edge. You could use this to 696 | create a maze on a cylinder. You could use this approach to create a Pac-Man 697 | style maze as well. 698 | 699 | This will only wrap along the vertical walls: 700 | ```clojure 701 | (require '[meiro.wrap :as wrap]) 702 | (def maze (b/create (m/init 8 25) [3 13] 703 | wrap/neighbors-horizontal 704 | wrap/link)) 705 | (png/render-inset maze 2) 706 | ``` 707 | 708 | ![Horizontal Wrap Maze](img/horizontal-wrap-maze.png) 709 | 710 | To wrap off any direction: 711 | ```clojure 712 | (def maze (b/create (m/init 8 25) [3 13] wrap/neighbors wrap/link)) 713 | (png/render-inset maze 2) 714 | ``` 715 | 716 | ![Wrap Maze](img/wrap-maze.png) 717 | 718 | 719 | ## Presentation 720 | 721 | I did a presentation on this code at Pivotal in January 2018. It is available 722 | on YouTube here: 723 | [Maze Generation Algorithms in Clojure – Michael Daines](https://www.youtube.com/watch?v=eUHUX7E2OLk) 724 | 725 | 726 | ## License 727 | 728 | Copyright © 2017–2020 Michael S. Daines 729 | 730 | Distributed under the Eclipse Public License either version 1.0 or (at 731 | your option) any later version. 732 | --------------------------------------------------------------------------------