# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1467498865 0
# Node ID c4156d654176a85ebf6a0840f2b5fb6c74b73fe9
# Parent  7a7ea0a56cbe3065aa89aaa07bc66bc31f22ed38
Add statistics and fix a bug in Wilson's algo

diff -r 7a7ea0a56cbe -r c4156d654176 package.lisp
--- a/package.lisp	Sat Jul 02 21:02:25 2016 +0000
+++ b/package.lisp	Sat Jul 02 22:34:25 2016 +0000
@@ -28,6 +28,12 @@
     #:set-empty-p
     #:hash-set
     #:set-clear
+    #:averaging
+    #:timing
+    #:real-time
+    #:run-time
+    #:since-start-into
+    #:per-iteration-into
     #:%)
   (:shadowing-import-from #:iterate
     #:in))
diff -r 7a7ea0a56cbe -r c4156d654176 src/demo.lisp
--- a/src/demo.lisp	Sat Jul 02 21:02:25 2016 +0000
+++ b/src/demo.lisp	Sat Jul 02 22:34:25 2016 +0000
@@ -346,5 +346,30 @@
     (t nil)))
 
 
+;;;; Statistics
+(defun run-stats (&key (iterations 100) (size 15))
+  (iterate
+    (for algorithm :in '(binary-tree sidewinder aldous-broder wilson
+                         hunt-and-kill))
+    (iterate
+      (repeat iterations)
+      (for grid = (make-grid size size))
+      (funcall algorithm grid)
+      (timing run-time
+              :since-start-into time-total
+              :per-iteration-into time-single)
+      (averaging (grid-dead-end-count grid) :into dead-ends)
+      (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 "Average Run Time: ~10,2Fms~%"
+                (/ time-average internal-time-units-per-second 1/1000))
+        (format t "Total Run Time:   ~10,2Fms~%"
+                (/ time-total internal-time-units-per-second 1/1000))
+        (format t "~%")
+        (finish-output)))))
+
+
 ;;;; Run
 ; (defparameter *demo* (make-instance 'demo))
diff -r 7a7ea0a56cbe -r c4156d654176 src/generation.lisp
--- a/src/generation.lisp	Sat Jul 02 21:02:25 2016 +0000
+++ b/src/generation.lisp	Sat Jul 02 22:34:25 2016 +0000
@@ -125,35 +125,35 @@
 ;;; cell, the loop is "erased" and the walk restarts from the looping point.
 
 (defgenerator wilson-generator (grid)
-  (iterate
-    (with unvisited = (make-set :initial-data (iterate (for cell :in-grid grid)
-                                                       (collect cell))))
-    (initially (setf (cell-active-group (set-pop unvisited)) t))
-    (with path = nil)
-    (with cell = (set-random unvisited))
-    (while cell)
-    (with-cell-active (cell :mark-group)
-      (let ((path-loop (member cell path)))
-        (setf path (cons cell path))
-        (cond
-          ;; If we've made a loop, trim it off.
-          (path-loop
-           (reset-active-group path path-loop)
-           (setf path path-loop
-                 cell (cell-random-neighbor cell)))
+  (let ((unvisited (make-set :initial-data (iterate (for cell :in-grid grid)
+                                                    (collect cell)))))
+    (setf (cell-active-group (set-pop unvisited)) t)
+    (iterate
+      (with path = nil)
+      (with cell = (set-random unvisited))
+      (while cell)
+      (with-cell-active (cell :mark-group)
+        (let ((path-loop (member cell path)))
+          (setf path (cons cell path))
+          (cond
+            ;; If we've made a loop, trim it off.
+            (path-loop
+             (reset-active-group path path-loop)
+             (setf path path-loop
+                   cell (cell-random-neighbor cell)))
 
-          ;; If we've hit a visited cell, carve out the path.
-          ((not (set-contains-p unvisited cell))
-           (mapc (curry #'apply #'cell-link)
-                 (n-grams 2 path))
-           (set-remove-all unvisited path)
-           (setf path nil
-                 cell (set-random unvisited)))
+            ;; If we've hit a visited cell, carve out the path.
+            ((not (set-contains-p unvisited cell))
+             (mapc (curry #'apply #'cell-link)
+                   (n-grams 2 path))
+             (set-remove-all unvisited path)
+             (setf path nil
+                   cell (set-random unvisited)))
 
-          ;; Otherwise keep going
-          (t
-           (setf cell (cell-random-neighbor cell)))))
-      (yield)))
+            ;; Otherwise keep going
+            (t
+             (setf cell (cell-random-neighbor cell)))))
+        (yield))))
   (grid-clear-active grid))
 
 (defun wilson (grid)
diff -r 7a7ea0a56cbe -r c4156d654176 src/utils.lisp
--- a/src/utils.lisp	Sat Jul 02 21:02:25 2016 +0000
+++ b/src/utils.lisp	Sat Jul 02 22:34:25 2016 +0000
@@ -176,3 +176,37 @@
   (print-unreadable-object (set stream :type t)
     (format stream "~{~S~^ ~}"
             (hash-keys (slot-value set 'data)))))
+
+
+;;;; Iterate
+(defmacro-clause (AVERAGING expr &optional INTO var)
+  (with-gensyms (count)
+    (let ((average (or var (gensym "average"))))
+      `(progn
+        (for ,average
+             :first ,expr
+             ;; continuously recompute the running average instead of keeping
+             ;; a running total to avoid bignums when possible
+             :then (/ (+ (* ,average ,count)
+                         ,expr)
+                      (1+ ,count)))
+        (for ,count :from 1)
+        ,(when (null var)
+           ;; todo handle this better
+           `(finally (return ,average)))))))
+
+(defmacro-clause (TIMING time-type &optional SINCE-START-INTO var PER-ITERATION-INTO per)
+  (let ((timing-function (ecase time-type
+                           ((real-time) #'get-internal-real-time)
+                           ((run-time) #'get-internal-run-time)))
+        (since (or var (gensym))))
+    (with-gensyms (start-time current-time previous-time)
+      `(progn
+        (with ,start-time = (funcall ,timing-function))
+        (for ,current-time = (funcall ,timing-function))
+        (for ,previous-time :previous ,current-time :initially ,start-time)
+        (for ,since = (- ,current-time ,start-time))
+        ,(when per
+           `(for ,per = (- ,current-time ,previous-time)))
+        ,(when (and (null var) (null per))
+           `(finally (return ,since)))))))