73 lines
2.3 KiB
Common Lisp
73 lines
2.3 KiB
Common Lisp
(defvar *dims* '(10 10))
|
|
(defvar *prob-t* 0.5)
|
|
(defvar *prob-f* 0.1)
|
|
(defvar *prob-p* 0.01)
|
|
|
|
(defmacro with-gensyms (names &body body)
|
|
`(let ,(mapcar (lambda (n) (list n '(gensym))) names)
|
|
,@body))
|
|
|
|
(defmacro traverse-grid (grid rowvar colvar (&rest after-cols) &body body)
|
|
(with-gensyms (dims rows cols)
|
|
`(let* ((,dims (array-dimensions ,grid))
|
|
(,rows (car ,dims))
|
|
(,cols (cadr ,dims)))
|
|
(dotimes (,rowvar ,rows ,grid)
|
|
(dotimes (,colvar ,cols ,after-cols)
|
|
,@body)))))
|
|
|
|
(defun make-new-forest (&optional (dims *dims*))
|
|
(let ((forest (make-array dims :element-type 'symbol :initial-element 'void)))
|
|
(traverse-grid forest row col nil
|
|
(if (<= (random 1.0) *prob-t*)
|
|
(setf (aref forest row col) 'tree)))))
|
|
|
|
(defun print-forest (forest)
|
|
(traverse-grid forest row col (terpri)
|
|
(ecase (aref forest row col)
|
|
((void) (write-char #\space))
|
|
((tree) (write-char #\T))
|
|
((fire) (write-char #\#))))
|
|
(values))
|
|
|
|
(defvar *neighboring* '((-1 . -1) (-1 . 0) (-1 . 1)
|
|
(0 . -1) (0 . 1)
|
|
(1 . -1) (1 . 0) (1 . 1)))
|
|
|
|
(defun neighbors (forest row col)
|
|
(loop for n in *neighboring*
|
|
for nrow = (+ row (car n))
|
|
for ncol = (+ col (cdr n))
|
|
when (array-in-bounds-p forest nrow ncol)
|
|
collect (aref forest nrow ncol)))
|
|
|
|
(defun evolve-tree (forest row col)
|
|
(let ((tree (aref forest row col)))
|
|
(cond ((eq tree 'fire) ;; if the tree was on fire, it's dead Jim
|
|
'void)
|
|
((and (eq tree 'tree) ;; if a neighbor is on fire, it's on fire too
|
|
(find 'fire (neighbors forest row col) :test #'eq))
|
|
'fire)
|
|
((and (eq tree 'tree) ;; random chance of fire happening
|
|
(<= (random 1.0) *prob-f*))
|
|
'fire)
|
|
((and (eq tree 'void) ;; random chance of empty space becoming a tree
|
|
(<= (random 1.0) *prob-p*))
|
|
'tree)
|
|
(t tree))))
|
|
|
|
(defun evolve-forest (forest)
|
|
(let* ((dims (array-dimensions forest))
|
|
(new (make-array dims :element-type 'symbol :initial-element 'void)))
|
|
(traverse-grid forest row col nil
|
|
(setf (aref new row col) (evolve-tree forest row col)))
|
|
new))
|
|
|
|
(defun simulate (forest n &optional (print-all t))
|
|
(format t "------ Initial forest ------~%")
|
|
(print-forest forest)
|
|
(dotimes (i n)
|
|
(setf forest (evolve-forest forest))
|
|
(when print-all
|
|
(progn (format t "~%------ Generation ~d ------~%" (1+ i))
|
|
(print-forest forest)))))
|