--- 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))
--- 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))
--- 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)
--- 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)))))))