Rosetta Code

Maze generation: Difference between revisions

Page Discussion

Maze generation (view source)

Revision as of 18:18, 21 November 2015

229 bytes removed ,  8 years ago
→‎Quality Breadth-First: Drop @(do ...). Remove while macro; while has been built in for a long time.
m (→‎{{header|REXX}}: added/changed whitespace and comments, simplified some statements.)
(→‎Quality Breadth-First: Drop @(do ...). Remove while macro; while has been built in for a long time.)
Line 5,610:
===Quality Breadth-First===
 
The following is a complete, self-contained command line utility. We also drop use of the TXR pattern extraction language and work purely in TXR Lisp.
 
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.
Line 5,622:
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>@(dodefvar vi) ;; visited hash
(defvar vipa) ;; visitedpath connectivity hash
(defvar pasc) ;; pathcount, derived from connectivitystraightness hashfator
(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))]))
 
(defun usageneigh (loc)▼
(defmacro while (expr . body)
^(forlet () (,expr)x ()from ,*bodyloc))
(each ((y (range* 0to hloc)))▼
(list (- x 1)..y (+ x 1)..y
x..(set- [viy 1) x..h](+ y t1))))▼
 
(defun neighmake-maze-impl (loccu)
(let ((xfr (fromhash loc:equal-based))
(yq (tolist loc)cu))
(list (-c x 1sc)..y (+ x 1)..y
x..(-set y 1) x..(+[fr ycu] 1)))t)
(while q
(let* ((cu (first q))
(ne (rnd-pick (remove-if (orf vi fr) (neigh cu)))))
(cond (tne (set [vifr cune] t)▼
(push cune [pa necu])▼
(push (delcu [frpa cune])▼
(push ne q)▼
(cond ((<= (dec c) 0)▼
(set q (scramble q))▼
(set c sc))))▼
(t (set [vi x..-1cu] t)▼
(del [fr (pop q))))))cu])▼
(set h (max 1pop hq)))))))▼
 
(defun make-maze-impl (cuw h sf)
(let ((frvi (hash :equal-based))
(qpa (listhash cu:equal-based))
(sc (max 1 (ctrunc sc(* sf w h) 100))))
(each (set(x [fr(range cu]-1 tw)))
(whileset [vi x..-1] qt)
(let*set ((cu[vi (firstx..h] qt))
(neeach (rnd-pick (remove-ify (orfrange* vi fr) (neigh0 cu))h)))
(cond (ne (set [frvi ne-1..y] t)
(push neset [pavi cuw..y] t))
(make-maze-impl 0..0)▼
▲ (push cu [pa ne])
pa))▼
▲ (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 makeprint-mazetops (pa w h sfj)
(leteach ((vii (hashrange* 0 :equal-basedw)))
(if (memqual i..(- j 1) ([pa (hash :equal-based)i..j])
(scput-string (max 1 (trunc (*"+ sf w h) 100)))")
(each ((x (rangeput-string "+-1 w---")))
(put-line `@str|\n@str|`)"+"))▼
▲ (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-topssides (pa w j)
(eachlet ((i (range* 0str w)""))
(ifeach (memqual(i i..(-range* j0 1w)) [pa i..j])
(if (memqual (put-string "+ i 1)..j [pa "i..j])
(put-stringset str `@str "+----"))`)
(put-lineset str `@str| "+"`)))
(set strput-line `@str| \n@str|`)))▼
 
(defun print-sidesmaze (pa w jh)
(leteach ((strj (range* 0 ""h)))
(eachprint-tops ((ipa (range*w 0 w))j)
(if (memqual (print-sides ipa 1)..jw [pa i..j]))
(print-tops pa w h))▼
(set str `@str `)
▲ (set str `@str| `)))
▲ (put-line `@str|\n@str|`)))
 
(defun print-mazeusage (pa w h)
(eachlet ((jinvocation (rangeldiff *full-args* 0 h*args*)))
(printput-tops paline w"usage: j")
(put-line `@invocation <width> <height> [<straightness>]`)▼
(print-sides pa w j))
(put-line "straightness-factor is a percentage, defaulting to 15")▼
▲ (print-tops pa w h))
(exit 1)))
 
(let ((args [mapcar int-str *args*])▼
▲ (defun usage ()
(*random-state* (make-random-state nil)))
(let ((invocation (ldiff *full-args* *args*)))
(if (put-linememq "usage:nil "args)
(usage))▼
▲ (put-line `@invocation <width> <height> [<straightness>]`)
(tree-case args▼
▲ (put-line "straightness-factor is a percentage, defaulting to 15")
((w h s (exitju 1. nk) (usage))
▲ ((w h : (s 15)) (set [viw (max -1..y] tw))
 
▲ (set [vih (max w..y]1 th))
▲ (let ((args [mapcar int-str *args*])
(*randomprint-state*maze (make-random-statemaze nilw h s) w h))
(ifelse (memq nil argsusage))))</lang>
▲ (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}}
Kazinator
543

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/167574"