Maze generation: Difference between revisions
→{{header|TXR}}: New implementation that is self-contained and parametrized with a "straightness factor".
(→{{header|TXR}}: Do not pass unused variables through recursion. Use special variables to avoid passing down hashes.) |
(→{{header|TXR}}: New implementation that is self-contained and parametrized with a "straightness factor".) |
||
Line 4,671:
=={{header|TXR}}==
===Simple, Depth-First===
Legend: cu = current location; vi = boolean hash of visited locations; pa = hash giving a list neighboring cells to which there is a path from a given cell.
Line 4,784 ⟶ 4,786:
| | | |
+----+----+----+----+----+----+----+----+----+----+----+----+----+----+----+</pre>
===Quality Breadth-First===
The following is a complete, self-contained command line utility.
The algorithm is quite different from the previous. This version is not recursive. This algorithm divides the maze cells into visited cells, frontier cells and unvisited cells. As in the DFS version, border cells outside of the maze area are pre-initialized as visited, for convenience. The frontier set initially contains the upper left hand corner.
The algorithm's main loop iterates while there are frontier cells. As the generation progresses, unvisited cells adjacent to frontier cells added to the frontier set. Frontier cells that are only surrounded by other frontier cells or visited cells are removed from the frontier set and become visited cells. Eventually, all unvisited cells become frontier cells and then visited cells, at which point the frontier set becomes empty and the algorithm terminates.
At every step, the algorithm picks the first cell in the frontier list. In the code, the frontier cells are kept in a hash called <code>fr</code> and also in a queue <code>q</code>. The algorithm tries to extend the frontier around the frontier cell which is at the head of the queue <code>q</code> by randomly choosing an adjacent unvisited cell. (If there is no such cell, the node is not a frontier node any more and is popped from the queue and <code>fr</code> set). If an unvisited node is picked, then a two-way path is broken from the given frontier cell to that cell, and that cell is added to the frontier set. '''Important:''' the new frontier cell is added to the head of the queue, rather than the tail.
The algorithm is modified by a "straightness" parameter, which is used to initialize a counter. Every time a new frontier node is added to the front of the queue, the counter decrements. When it reaches zero, the frontier queue is scrambled, and the counter is reset. As long as the count is nonzero, the maze growth proceeds from the previously traversed node, because the new node is placed at the head of the queue. This behavior mimics the DFS algorithm, resulting in long corridors without a lot of branching.
At the user interface level, the straightness parameter is represented as a percentage. This percentage is converted to a number of cells based on the width and height of the maze. For instance if the straightness parameter is 15, and the maze size is 20x20, it means that 15% out of 400 cells, or 60 cells will be traversed before the queue is scrambled. Then another 60 will be traversed and the queue will be scrambled, and so forth.
<lang txr>@(do
(defvar vi) ;; visited hash
(defvar pa) ;; path connectivity hash
(defvar sc) ;; count, derived from straightness fator
(defun scramble (list)
(let ((out ()))
(each ((item list))
(let ((r (rand (+ 1 (length out)))))
(set [out r..r] (list item))))
out))
(defun rnd-pick (list)
(if list [list (rand (length list))]))
(defmacro while (expr . body)
^(for () (,expr) () ,*body))
(defun neigh (loc)
(tree-bind (x . y) loc
(list (- x 1)..y (+ x 1)..y
x..(- y 1) x..(+ y 1))))
(defun make-maze-impl (cu)
(let ((fr (hash :equal-based))
(q (list cu))
(c sc))
(set [fr cu] t)
(while q
(let* ((cu (first q))
(ne (rnd-pick (remove-if (orf vi fr) (neigh cu)))))
(cond (ne (set [fr ne] t)
(push ne [pa cu])
(push cu [pa ne])
(push ne q)
(cond ((<= (dec c) 0)
(set q (scramble q))
(set c sc))))
(t (set [vi cu] t)
(del [fr cu])
(pop q)))))))
(defun make-maze (w h sf)
(let ((vi (hash :equal-based))
(pa (hash :equal-based))
(sc (max 1 (trunc (* sf w h) 100))))
(each ((x (range -1 w)))
(set [vi x..-1] t)
(set [vi x..h] t))
(each ((y (range* 0 h)))
(set [vi -1..y] t)
(set [vi w..y] t))
(make-maze-impl 0..0)
pa))
(defun print-tops (pa w j)
(each ((i (range* 0 w)))
(if (memqual i..(- j 1) [pa i..j])
(put-string "+ ")
(put-string "+----")))
(put-line "+"))
(defun print-sides (pa w j)
(let ((str ""))
(each ((i (range* 0 w)))
(if (memqual (- i 1)..j [pa i..j])
(set str `@str `)
(set str `@str| `)))
(put-line `@str|\n@str|`)))
(defun print-maze (pa w h)
(each ((j (range* 0 h)))
(print-tops pa w j)
(print-sides pa w j))
(print-tops pa w h))
(defun usage ()
(let ((invocation (ldiff *full-args* *args*)))
(put-line "usage: ")
(put-line `@invocation <width> <height> [<straightness>]`)
(put-line "straightness-factor is a percentage, defaulting to 15")
(exit 1)))
(let ((args [mapcar int-str *args*])
(*random-state* (make-random-state nil)))
(if (memq nil args)
(usage))
(tree-case args
((w h s ju . nk) (usage))
((w h : (s 15)) (set w (max 1 w))
(set h (max 1 h))
(print-maze (make-maze w h s) w h))
(else (usage)))))</lang>
{{out}}
Three mazes are generated, at the lowest,
intermediate and highest "straightness factors".
It is immediately obvious that the style of each maze
is quite different.
<pre>
# 10x10 maze with zero percent "straightness factor"
$ txr maze-generation3.txr 10 10 0
+----+----+----+----+----+----+----+----+----+----+
| | | |
| | | |
+ + +----+----+ + + +----+----+----+
| | | | | |
| | | | | |
+ + +----+ +----+----+----+----+ + +
| | | | | |
| | | | | |
+ +----+ +----+ +----+ +----+----+----+
| | |
| | |
+----+ + + + + + +----+----+----+
| | | | | | |
| | | | | | |
+----+ + +----+----+ +----+----+----+ +
| | | | |
| | | | |
+ +----+ +----+----+ + + +----+ +
| | | | | | |
| | | | | | |
+ +----+ + + + + + + + +
| | | | | | | | | |
| | | | | | | | | |
+----+ + +----+ + + +----+----+ +
| | | | | | |
| | | | | | |
+ + + + +----+----+----+----+----+ +
| | | | | |
| | | | | |
+----+----+----+----+----+----+----+----+----+----+
# with 10% straightnes factor
$ txr maze-generation3.txr 10 10 10
+----+----+----+----+----+----+----+----+----+----+
| | | | | |
| | | | | |
+ + +----+ + + + + +----+ +
| | | | |
| | | | |
+ +----+----+ +----+----+----+----+----+----+
| | | | |
| | | | |
+----+ + +----+ + +----+----+ + +
| | | | | | |
| | | | | | |
+ +----+----+ +----+ + + + +----+
| | | | | | |
| | | | | | |
+ + +----+----+----+----+----+----+ + +
| | | |
| | | |
+ + +----+ + + + +----+----+----+
| | | | | | | | |
| | | | | | | | |
+ +----+ +----+ +----+ + + + +
| | | | | |
| | | | | |
+ + +----+----+ +----+ + +----+----+
| | | | | | |
| | | | | | |
+----+----+ +----+ + +----+----+ + +
| | | |
| | | |
+----+----+----+----+----+----+----+----+----+----+
# with 100 percent straight factor
$ txr maze-generation3.txr 10 10 100
+----+----+----+----+----+----+----+----+----+----+
| | | |
| | | |
+----+ +----+ +----+----+ + + + +
| | | | | | | |
| | | | | | | |
+ +----+ +----+----+----+ + + + +
| | | | | | | |
| | | | | | | |
+ +----+ + + + +----+ +----+ +
| | | | | | |
| | | | | | |
+ + +----+ + + + +----+----+ +
| | | | | | | |
| | | | | | | |
+ + +----+ + +----+ + +----+----+
| | | | | |
| | | | | |
+ +----+----+----+----+ +----+----+----+ +
| | | | |
| | | | |
+ +----+----+ + +----+----+ + + +
| | | | | | |
| | | | | | |
+ + + +----+ + + +----+----+ +
| | | | | |
| | | | | |
+ +----+----+ +----+----+----+----+----+ +
| | |
| | |
+----+----+----+----+----+----+----+----+----+----+
=={{header|XPL0}}==
| |||