Created
December 5, 2011 11:53
-
-
Save qoobaa/1433360 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun next-generation (board) | |
(loop for row being the elements of board using (index x) collect | |
(loop for col being the elements of row using (index y) collect | |
(next-cell-p x y board)))) | |
(defun next-cell-p (x y board) | |
(let ((count (neighbours-count x y board)) | |
(cell (cell-p x y board))) | |
(or | |
(and cell (or (= count 2) (= count 3))) | |
(and (not cell) (= count 3))))) | |
(defun cell-p (x y board) | |
(nth-or-nil y (nth-or-nil x board))) | |
(defun neighbours (x y board) | |
(mapcar (lambda (offset) (cell-p (+ x (first offset)) (+ y (second offset)) board)) | |
'((-1 -1) (-1 0) (-1 1) | |
( 0 -1) ( 0 1) | |
( 1 -1) ( 1 0) ( 1 1)))) | |
(defun neighbours-count (x y board) | |
(reduce (lambda (acc cell) (+ acc (cond (cell 1) (t 0)))) | |
(neighbours x y board) | |
:initial-value 0)) | |
(defun nth-or-nil (pos list) | |
(cond ((< pos 0) nil) | |
(t (nth pos list)))) | |
(defvar tests nil | |
"Game of life test suite") | |
;; rules | |
(defun test-rule-1 () | |
(let ((initial '((t nil) | |
(nil t))) | |
(expected '((nil nil) | |
(nil nil)))) | |
(assert (equal expected (next-generation initial))))) | |
(add-hook 'tests 'test-rule-1) | |
(defun test-rule-2 () | |
(let ((initial '((t t) | |
(nil t))) | |
(expected '((t t) | |
(t t)))) | |
(assert (equal expected (next-generation initial))))) | |
(add-hook 'tests 'test-rule-2) | |
(defun test-rule-3 () | |
(let ((initial '((t t t) | |
(t t t) | |
(t t t))) | |
(expected '((t nil t) | |
(nil nil nil) | |
(t nil t)))) | |
(assert (equal expected (next-generation initial))))) | |
(add-hook 'tests 'test-rule-3) | |
;; nth-or-nil | |
(defun test-nth-or-nil-returns-nil-for-negative-index () | |
(assert (equal nil (nth-or-nil -1 nil)))) | |
(add-hook 'tests 'test-nth-or-nil-returns-nil-for-negative-index) | |
(defun test-nth-or-nil-returns-nil-for-index-out-of-bound () | |
(assert (equal nil (nth-or-nil 1 nil)))) | |
(add-hook 'tests 'test-nth-or-nil-returns-nil-for-index-out-of-bound) | |
;; cell-p | |
(defun test-cell-p-returns-value-of-cell () | |
(assert (equal t (cell-p 0 0 '((t)))))) | |
(add-hook 'tests 'test-cell-p-returns-value-of-cell) | |
(defun test-cell-p-returns-nil-for-non-existing-cell () | |
(assert (equal nil (cell-p -1 -1 nil)))) | |
(add-hook 'tests 'test-cell-p-returns-nil-for-non-existing-cell) | |
;; neighbours | |
(defun test-neighbours-returns-neighbours-cells () | |
(assert (equal '(t nil t t t t nil t) (neighbours 1 1 '((t nil t) | |
(t nil t) | |
(t nil t)))))) | |
(add-hook 'tests 'test-neighbours-returns-neighbours-cells) | |
(defun test-neighbours-returns-8-nils-for-empty-board () | |
(assert (equal '(nil nil nil nil nil nil nil nil) (neighbours 0 0 nil)))) | |
(add-hook 'tests 'test-neighbours-returns-8-nils-for-empty-board) | |
;; neighbours-count | |
(defun test-neighbours-count-returns-count-for-neighbours-cells () | |
(assert (equal 6 (neighbours-count 1 1 '((t nil t) | |
(t nil t) | |
(t nil t)))))) | |
(add-hook 'tests 'test-neighbours-count-returns-count-for-neighbours-cells) | |
(run-hooks 'tests) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment