Add the Recursive Backtracker algorithm
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 08 Jul 2016 20:17:45 +0000 |
parents |
c4156d654176
|
children |
d1a73b73b4c7
|
branches/tags |
(none) |
files |
package.lisp src/demo.lisp src/generation.lisp src/grid.lisp |
Changes
--- a/package.lisp Sat Jul 02 22:34:25 2016 +0000
+++ b/package.lisp Fri Jul 08 20:17:45 2016 +0000
@@ -118,7 +118,10 @@
#:wilson
#:wilson-generator
#:hunt-and-kill
- #:hunt-and-kill-generator)
+ #:hunt-and-kill-generator
+ #:recursive-backtracker
+ #:recursive-backtracker-generator
+ )
(:import-from #:snakes
#:defgenerator
#:do-generator
--- a/src/demo.lisp Sat Jul 02 22:34:25 2016 +0000
+++ b/src/demo.lisp Fri Jul 08 20:17:45 2016 +0000
@@ -152,8 +152,6 @@
(line x1 y2 x2 y2))))))))
-
-
(defun find-longest-path (grid)
(let ((distances (-> (grid-ref grid 0 0)
cell-distance-map
@@ -183,7 +181,7 @@
(with-setup
;; Maze
(when (and (not finished-generating)
- (dividesp frame 4))
+ (dividesp frame 3))
(when *instant*
(iterate (while (not (funcall gen)))))
(when (funcall gen)
@@ -192,7 +190,7 @@
(draw-maze sketch::instance)
;; UI
(with-font *ui-font*
- (text "algorithm: [a]ldous-broder [b]inary tree [h]unt and kill [s]idewinder [w]ilson"
+ (text "algorithm: [a]ldous-broder [b]inary tree [h]unt and kill [r]ecursive backtracker [s]idewinder [w]ilson"
(+ (- *center-x*) 5) (- *center-y* 44))
(text "display: [C]olor distances [I]nstant generation [L]ongest path [S]tats"
(+ (- *center-x*) 5) (- *center-y* 24)))
@@ -311,6 +309,7 @@
(:scancode-a (setf *generator* 'aldous-broder-generator))
(:scancode-w (setf *generator* 'wilson-generator))
(:scancode-h (setf *generator* 'hunt-and-kill-generator))
+ (:scancode-r (setf *generator* 'recursive-backtracker-generator))
(:scancode-l (if *shift*
(toggle *show-longest*)
nil))
@@ -350,7 +349,7 @@
(defun run-stats (&key (iterations 100) (size 15))
(iterate
(for algorithm :in '(binary-tree sidewinder aldous-broder wilson
- hunt-and-kill))
+ hunt-and-kill recursive-backtracker))
(iterate
(repeat iterations)
(for grid = (make-grid size size))
@@ -362,7 +361,9 @@
(averaging time-single :into time-average)
(finally
(format t "~A (~D by ~:*~D)~%" algorithm size)
- (format t "Dead Ends: ~10,2F~%" dead-ends)
+ (format t "Dead Ends: ~10,2F (~4,1F%)~%"
+ dead-ends
+ (* 100 (/ dead-ends (* size size))))
(format t "Average Run Time: ~10,2Fms~%"
(/ time-average internal-time-units-per-second 1/1000))
(format t "Total Run Time: ~10,2Fms~%"
@@ -372,4 +373,5 @@
;;;; Run
+; (run-stats)
; (defparameter *demo* (make-instance 'demo))
--- a/src/generation.lisp Sat Jul 02 22:34:25 2016 +0000
+++ b/src/generation.lisp Fri Jul 08 20:17:45 2016 +0000
@@ -162,7 +162,13 @@
;;;; Hunt and Kill
+;;; The Hunt and Kill algorithm starts by carving out a random path, always
+;;; selecting unvisited cells.
;;;
+;;; When it carves itself into a dead end it scans the grid for the unvisited
+;;; cell that has one or more visited neighbors. It picks a random visited
+;;; neighbor and links this new cell to it, then continues the carving from
+;;; there.
(defgenerator hunt-and-kill-generator (grid)
(labels ((visited-p (cell)
@@ -198,3 +204,33 @@
(defun hunt-and-kill (grid)
(do-generator (_ (hunt-and-kill-generator grid)))
grid)
+
+
+;;;; Recursive Backtracker
+;;; The Recursive Backtracker algorithm starts by carving out a random path,
+;;; always selecting unvisited nodes. When it carves itself into a dead end, it
+;;; backtracks along the path until it hits the first cell that DOES have
+;;; neighbors, and continues from there.
+
+(defgenerator recursive-backtracker-generator (grid)
+ (labels ((visited-p (cell)
+ (not (null (cell-links cell))))
+ (random-unvisited-neighbor (cell)
+ (random-elt (remove-if #'visited-p (cell-neighbors cell)))))
+ (iterate
+ (with stack = (list (grid-ref grid 0 0)))
+ (while stack)
+ (for cell = (first stack))
+ (for neighbor = (random-unvisited-neighbor cell))
+ (with-cell-active (cell :mark-group)
+ (yield)
+ (if neighbor
+ (progn (cell-link cell neighbor)
+ (push neighbor stack))
+ (progn (setf (cell-active-group cell) nil)
+ (pop stack))))))
+ (grid-clear-active grid))
+
+(defun recursive-backtracker (grid)
+ (do-generator (_ (recursive-backtracker-generator grid)))
+ grid)
--- a/src/grid.lisp Sat Jul 02 22:34:25 2016 +0000
+++ b/src/grid.lisp Fri Jul 08 20:17:45 2016 +0000
@@ -108,7 +108,7 @@
:element-doc-string "All cells in a grid")
(defclause-sequence ROW-OF-GRID nil
- :access-fn #'grid-row
+ :access-fn 'grid-row
:size-fn (lambda (grid)
(array-dimension (grid-cells grid) 0))
:sequence-type 'grid