ライフゲーム 2 (高速化)
ライフゲーム - armbrust の日記 の続きです。
元ネタは lispbuilder-sdlでライフゲーム書いてみた - masatoi’s blog
からいただいております。
(今更ですが、念のため。
Windows の Clozure CL と SBCL で動作確認しています。
ただ、Windows では、動作中の repl 操作は Clozure CL でしかできません)
え〜と・・・、
徘徊してたら Life Lexicon を見つけて、
そこからライフゲームのプログラムをＤＬして動かしてみたら、
超高速描画モードってのがあって、
こういうのも面白いなと思ったので、
こっちも高速化してみました。
と言っても、更新があったドットだけ描画処理するように変更しただけです。
まあ、これだけでも効果は大きかったです。
デフォのフィールドサイズと配置 (新しい銃ｘ３の宇宙船工場) なら
50 〜 60fps は出てると思います。
速すぎて、
が、
のように見えます。
これじゃあ宇宙船というより魚・・・。
ソースの最後の方のコメントにも書いてますが、
変化を目で追いたいなら 10fps 以下に落とさないとムリかも。
あと、前回の配置だと 10 秒ほどで崩壊してしまうので、
最初から宇宙船イーターを出しておくように変えました。
■2012-10-04 追記: update-next-gen に不要な処理が混じっていたので削除しました。
■2012-10-10 追記: cl-ppcre:split が不要なのに気づいたので削除しました。
life.cl:
;; original: http://d.hatena.ne.jp/masatoi/20111029/1319893156 (require :lispbuilder-sdl) (require :lispbuilder-sdl-gfx) (require :alexandria) ;; ドットサイズとフィールドサイズ (defparameter dt 3) ; 余白に 1 ドット使ってしまうので 2 以上で指定 (defparameter wx 240) (defparameter wy 160) ;; いろいろ用意しておく (defparameter world nil) (defparameter world-prev nil) (defparameter map-init nil) ; 初期表示用 (defparameter gen 0) ; 世代表示用 (defparameter skip-gen 1) ; 0 にすると更新が止る (load "map-init.cl") ; 初期配置のリストは別ファイルで書いておく ;; 部分的な初期配置を行う関数 (はみ出し置きには非対応) (defun put-shape (world list-pos-shape) (let* ((pos (nth 0 list-pos-shape)) (shape (nth 1 list-pos-shape)) (px (nth 0 pos)) (py (nth 1 pos)) (swx (length (nth 0 shape))) (swy (length shape))) (loop for i from 0 to (1- swx) do (loop for j from 0 to (1- swy) do (setf (aref world (+ px i) (+ py j)) (let ((c (char (nth j shape) i))) (if (or (eql c #\Space) (eql c #\.)) 0 1))))))) ;; フィールドの初期化 (defun init () (setf world (make-array (list wx wy) :element-type 'fixnum)) (setf world-prev (make-array (list wx wy) :element-type 'fixnum)) (map nil #'(lambda (x) (put-shape world x)) map-init) (setf gen 0)) ;; 生きている個体が隣接する8個のセルにどれだけいるかをカウントする (defun count-neighboring-individual (world i j) (let* ((max-i (1- wx)) (max-j (1- wy)) (next-i (if (= i max-i) 0 (1+ i))) (prev-i (if (= i 0) max-i (1- i))) (next-j (if (= j max-j) 0 (1+ j))) (prev-j (if (= j 0) max-j (1- j)))) (+ (aref world prev-i prev-j) (aref world prev-i j) (aref world prev-i next-j) (aref world i prev-j) (aref world i next-j) (aref world next-i prev-j) (aref world next-i j) (aref world next-i next-j)))) ;; 1世代後のフィールドを返す (defun update-next-gen (world) (let ((next-world (alexandria:copy-array world))) (loop for i from 0 to (1- wx) do (loop for j from 0 to (1- wy) do (let ((sell-value (aref world i j)) (sell-neighboring (count-neighboring-individual world i j))) (cond ((and (zerop sell-value) ; 誕生 (= sell-neighboring 3)) (setf (aref next-world i j) 1)) ((and (> sell-value 0) ; 過疎or過密 (or (<= sell-neighboring 1) (>= sell-neighboring 4))) (setf (aref next-world i j) 0)))))) next-world)) (defun life () (sdl:with-init () (sdl:window (* dt wx) (* dt wy)) ; ウインドウのサイズ (setf (sdl:frame-rate) 60) ; フレームレートを60fpsに (init) (sdl:with-events () (:quit-event () t) ; ウインドウが閉じられたときの処理 (:idle () (setf world-prev (alexandria:copy-array world)) (dotimes (n skip-gen) (setf world (update-next-gen world))) (loop for i from 0 to (1- wx) do (loop for j from 0 to (1- wy) do ;; 高速化 (更新されたドットだけ描く) (if (or (zerop gen) (/= (aref world i j) (aref world-prev i j))) (sdl-gfx:draw-box (sdl:rectangle :x (* i dt) :y (* j dt) :w (1- dt) :h (1- dt)) :color (if (zerop (aref world i j)) (sdl:color :r #x55 :g #x55 :b #x55) sdl:*white*))))) (setf gen (+ gen skip-gen)) (sdl:set-caption (format nil "generations: ~a" gen) nil) ; 世代表示 (sdl:update-display) )))) (life)
map-init.cl:
;; 反転用の関数など (defun reverse-shape-v (shape) (reverse shape)) (defun reverse-shape-h (shape) (mapcar #'reverse shape)) (defun reverse-shape-vh (shape) (mapcar #'reverse (reverse shape))) ;; 配置の書き方を http://www.bitstorm.org/gameoflife/lexicon/ 準拠にしてみた ;; 新しい銃 左上方向に発射 (defparameter gun-lu '( ".................................." "...............OOO..............OO" "...............O...O............OO" "...............O....O............." "................O...O............." ".................................." ".OO.............O...O............." ".OO............O....O............." "...............O...O............OO" "...............OOO..............OO" ".................................." ".................................." ".................................." ".................................." ".................................." "..O.....O........................." ".OOO...OOO........................" "OO.O...O.OO......................." ".................................." ".................................." "...O...O.........................." "...O...O.........................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".OO.....OO........................" ".OO.....OO........................" )) ;; 新しい銃 右下方向に発射 (発射のタイミングがちょっと違う) (defparameter gun-rd '( "........................OO.....OO." "........................OO.....OO." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".................................." ".......................OO.O...O.OO" ".......................O..O...O..O" "........................OOO...OOO." ".................................." ".................................." ".................................." ".................................." ".................O................" "OO...............OO..............." "OO................OO.............." ".............OO..OO............OO." "...............................OO." ".................................." ".................................." ".............OO..OO..............." "OO................OO.............." "OO...............OO..............." ".................O................" )) ;; 新しい銃 右上方向に発射 (gun-rd を上下反転したもの) (defparameter gun-ru (reverse-shape-v gun-rd)) ;; 宇宙船を食うやつ (defparameter eater '( "OO.." "O.O." "..O." "..OO" )) ;; ブリンカー (defparameter blinker '( "..O.." "..O.." "..O.." )) ;; 初期配置のリスト (座標と名前) (defparameter map-init (list (list '( 20 10) gun-rd) (list '( 23 101) gun-ru) (list '( 96 101) gun-lu) (list '(220 75) eater) )) #| ;;; コメントいろいろ ;; repl から ↓ を評価して直接置いてみたりとか (put-shape world (list '(220 10) blinker)) ;; repl から ↓ を評価して描画速度(フレームレート)を変えたりとか (setf (sdl:frame-rate) 60) (setf (sdl:frame-rate) 30) (setf (sdl:frame-rate) 10) ; 変化を目視したいなら、これくらい (setf (sdl:frame-rate) 1) (setf (sdl:frame-rate) 0) ; 0 にしても止るわけじゃない ;; skip-gen を 2 以上にすると、描画処理を飛ばして計算更新だけするので、更に加速できる ;; とは言っても、あまり大きな数字を入れると、計算更新に時間取られすぎてトロトロになる (setf skip-gen 7) (setf skip-gen 3) (setf skip-gen 1) ;; repl から初期化するには・・・ (setf skip-gen 0) ; 計算更新を一旦止めて・・・ (init) ; 初期化して・・・(ちょっとだけ待ってると描画更新が起きる) (setf skip-gen 1) ; 計算更新を再開 ;; あ、Windows の SBCL だと実行中に repl が入力を受け付けないので・・・orz |#
