# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468009065 0
# Node ID bc2e3a4dc208f8450d18b13c36aed75f51ef0c8f
# Parent  c4156d654176a85ebf6a0840f2b5fb6c74b73fe9
Add the Recursive Backtracker algorithm

diff -r c4156d654176 -r bc2e3a4dc208 package.lisp
--- 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
diff -r c4156d654176 -r bc2e3a4dc208 src/demo.lisp
--- 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))
diff -r c4156d654176 -r bc2e3a4dc208 src/generation.lisp
--- 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)
diff -r c4156d654176 -r bc2e3a4dc208 src/grid.lisp
--- 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