Common Lispの練習でライフゲーム
Lispの練習でライフゲームを作ってみた。まだCUIで眺めることしかできない。
適当なパターンをランダムに置くことだけはできるようにしてみた。
> (generate-random-lives) > (lifegame)
ってやるとランダムな初期配置から一番メジャーなルールでライフゲームが動く。境界は周期的にした。
> (funcall glyder) > (lifegame)
とかやるとglyderだったり適当なパターンをランダムに配置してライフゲームが動く。
(defparameter *width* 80) (defparameter *height* 30) (defparameter *lives* (make-hash-table :test #'equal)) (defun count-surrounding-lives (pos lives) (let ((ctr 0)) (mapc (lambda (neighbor) (if (gethash neighbor lives) (incf ctr))) (neighbors pos)) ctr)) (defun neighbors (pos) (let* ((x (car pos)) (y (cdr pos)) (x-1 (mod (1- x) *width*)) (x+1 (mod (1+ x) *width*)) (y-1 (mod (1- y) *height*)) (y+1 (mod (1+ y) *height*))) (list (cons x-1 y+1) (cons x y+1) (cons x+1 y+1) (cons x+1 y) (cons x+1 y-1) (cons x y-1) (cons x-1 y-1) (cons x-1 y)))) (defun alivep (pos lives) (let ((surr (count-surrounding-lives pos lives))) (cond ((= surr 3) t) ((or (<= surr 1) (>= surr 4)) nil) (t (gethash pos lives))))) (defun generate-random-lives (life-density) (let ((lives (make-hash-table :test #'equal))) (loop for x below *width* do (loop for y below *height* do (if (< (random 100) life-density) (setf (gethash (cons x y) lives) t)))) (setf *lives* lives))) (defun reset-lives () (setf *lives* (make-hash-table :test #'equal))) (defun evolution () (let ((new-lives (make-hash-table :test #'equal))) (mapc (lambda (pos) (if (alivep pos *lives*) (setf (gethash pos new-lives) t))) (gen-pairs *width* *height*)) (setf *lives* new-lives))) (defun gen-pairs (xrange yrange) (let ((lst ())) (loop for x below xrange do (loop for y below yrange do (push (cons x y) lst))) lst)) (defun lifegame () (labels ((lifegame-sub (ctr) (fresh-line) (princ "Generation:") (princ ctr) (draw-lives) (evolution) (sleep 0.2) (lifegame-sub (incf ctr)))) (lifegame-sub 0))) (defun draw-lives () (fresh-line) (loop for i below (+ 2 *width*) do (princ #\-)) (loop for y below *height* do (progn (fresh-line) (princ #\|) (loop for x below *width* do (if (gethash (cons x y) *lives*) (princ #\*) (princ #\ ))) (princ #\|))) (fresh-line) (loop for i below (+ 2 *width*) do (princ #\-))) (defun maker (lst) (lambda () (let* ((xoffset (random *width*)) (yoffset (random *height*)) (lstt (rotate (invert lst (random 2)) (random 4))) (width (length (car lstt))) (height (length lstt))) (loop for y below height do (loop for x below width do (if (= 1 (nth x (nth y lstt))) (setpoint (+ xoffset x) (+ yoffset y)))))))) (defparameter *glyder-template* '((1 1 1) (1 0 0) (0 1 0))) (defparameter *light-spacecraft-template* '((0 1 0 0 1) (1 0 0 0 0) (1 0 0 0 1) (1 1 1 1 0))) (defun setpoint (x y) (setf (gethash (cons x y) *lives*) t)) (defun invert (lst inversion) (case inversion (0 lst) (1 (invertx lst)))) (defun invertx (lst) (mapcar #'reverse lst)) (defun inverty (lst) (reverse lst)) (defun transpose (lst) (labels ((col (lst) (if (some #'null lst) nil (cons (mapcar #'car lst) (col (mapcar #'cdr lst)))))) (col lst))) (defun rotate (lst rotation) (case rotation (0 lst) (1 (invertx (transpose lst))) (2 (inverty (invertx lst))) (3 (inverty (transpose lst))))) (setf glyder (maker *glyder-template*)) (setf light-spacecraft (maker *light-spacecraft-template*))
Land of Lispを読んだせいで多少影響でてる気がする。
transpose関数なんかはなかなかLispっぽくかけた気がする。
GUIに拡張するのもやりたいけどルール変えるのもやってみたいなあ。