2013年6月9日日曜日

Land of Lispの進化シミュレーションの様子をRでグラフ化する

Land of Lisp の10章で進化シミュレーションを実装します。

こんな感じ。

* が草で M が動物です。
ちなみに翻訳者のShiro氏が、遺伝子の傾向の違いを色で表示する版のGaucheのコードを公開しています。 (Island Life - GaucheでもLand of Lisp)

ところでシミュレーションを続けると、行動パターンが異なる2つの種に進化します。

  • ゾウ : ジャングル(画面中央部)の豊富な食物に集中する。ジャングルから離れないように周りをうろうろする。
  • ロバ : 乾燥帯(ジャングル以外の部分)で食物を探し回る。広い範囲を移動する。

面白いですね。

この種の分化がどのように進むのか気になったので、Rを使ってグラフ化してみます。

動物の遺伝子

進化シミュレーションのコードは公式ページで公開されています。(evolution.lisp)

動物の構造体の中身はこんな感じ。

#S(ANIMAL :X 50 :Y 15 :ENERGY 114 :DIR 0 :GENES (5 4 10 9 5 5 9 10))

genes フィードが遺伝子情報で、動物の行動パターンを決定します。 8つの整数は動物が8方向どちらに向きを変えやすいかを表します。 先頭 (スロット 0) の値が大きければその動物は向きを変えずに直進しやすく、 次 (スロット 1) の値が大きければ時計回りに45度向きを変えやすい、といった感じです。

ゾウ? それともロバ?

動物の性質を表すために、 直進率 という指標を考えました。これは動物がまっすぐ進む確率です。 直進率が高い = 長距離を移動する = ロバ、直進率が低い = うろうろする = ゾウ、と考えて良いですかね。

動物の直進率を計算する straight-rate 関数:

(defun straight-rate (animal)
  (let ((genes (animal-genes animal)))
    (/ (car genes)
       (apply #'+ genes))))

動物の状態をdump

進化の過程を知りたいので、一定間隔で動物たちの直進率をdumpします。

(defun dump-animal-state (days by)
  (loop for i
     from 1
     to days
     do (update-world)
     if (zerop (mod i by))
     collect (list i
                   (mapcar #'straight-rate *animals*))))

days で指定した日数分シミュレーションを走らせ、by で指定した間隔で全動物の直進率を計算します。
この関数は (経過日数 全動物の直進率のリスト) のリストを返します。

3日間シミュレーションを走らせて1日間隔でdumpする例:

> (defparameter *dump* (dump-animal-state 3 1))
*DUMP*
> *dump*
((1 (5/23 5/23)) (2 (1/5 1/5 5/23 5/23))
 (3 (5/23 5/23 1/5 1/5 1/5 1/5 5/23 5/23)))

Rにデータを渡す

指定期間の動物の状態を計算できるようになりましたが、 Common LispとRの間でどうやってデータをやり取りしましょう。

今回はCommon Lisp側でS式をRのデータ表現に変換することにしました。 R側はそれをevalするだけなので楽です。evalは危険だけどこういう時は手軽で便利ですね。

animal-state->r 関数は動物の状態のリストをRのデータ表現に変換します。

(defun animal-state->r (animal-state)
  (format nil "list(~{~a~^,~%     ~})~%"
          (mapcar (lambda (x)
                    (format nil
                            "list(day=~a, straightRate=c(~{~f~^, ~}))"
                            (car x)
                            (cadr x)))
                  animal-state)))

先ほどの *dump* を変換してみます。

> (animal-state->r *dump*)
"list(list(day=1, straightRate=c(0.2173913, 0.2173913)),
     list(day=2, straightRate=c(0.2, 0.2, 0.2173913, 0.2173913)),
     list(day=3, straightRate=c(0.2173913, 0.2173913, 0.2, 0.2, 0.2, 0.2, 0.2173913, 0.2173913)))
"

ファイルに書き出す関数:

(defun write-animal-state (fname animal-state)
  (with-open-file (my-stream
                   fname
                   :direction :output
                   :if-exists :supersede)
    (princ (animal-state->r animal-state)
           my-stream)))

では実際にシミュレーションを走らせて、結果をファイルに書き出します。

> (load "evolution")
T
> (write-animal-state "animal-state.R" (dump-animal-state 200000 10000))

20万日分シミュレーションを走らせ、1万日間隔で animal-state.R というファイルに書き出しました。

ちなみにdump前に (load "evolution") を実行しているのは世界をリセットするためです。 オリジナルのコードに手を入れずに手っ取り早く世界をリセットする方法が他に思いつきませんでした...

グラフの描画

Rでグラフを描画します。

plot-evolution.R

stateFile <- "animal-state.R"
stateList <- eval(parse(stateFile))

outDir <- "Rplot"
png(filename=file.path(outDir, "%03d.png"), width=400, height=300)

numTable <- data.frame(t(sapply(stateList,
                                function(x) {
                                    c(day=x[["day"]],
                                      num=length(x[["straightRate"]]))
                                })))
plot(numTable, type="o", pch=20, ylim=c(0, max(numTable[, 2])),
     main="動物の個体数", xlab="経過日数", ylab="動物の個体数")

maxX <- 1.0
maxY <- 160

for (state in stateList) {
    hist(state[["straightRate"]], breaks=seq(0, maxX, 0.02), ylim=c(0, maxY),
         main=sprintf("%7d 日後", state[["day"]]), col="gray",
         xlab="直進率", ylab="動物の個体数")
}

dev.off()

このRスクリプトを実行します。

$ mkdir Rplot
$ Rscript --vanilla plot-evolution.R

Rplot/ 以下に連番のpngファイルが生成されます。

結果

まずは動物の個体数の遷移です。

個体数は160前後で安定しています。これは植物が生える速度が常に一定のため、世界が平衡状態を保っているということでしょうか。

次に動物の直進率と個体数のヒストグラムを見てみます。

1万日後。まだ同じ傾向の動物しかいません。

3万日後。目立った変化無し。

4万日後。種の分化が始まった!

5万日後。完全に分かれました。


14万日後。ロバの直進率がさらに上がっています。


おわりに

  • 種の分化の様子を見ることができて楽しかったです。
  • Common LispとRの連携はやっつけだったので他の手法も試してみたいです。
  • 本の写経以外でCommon Lispのコードを書いたのは初めてなので、おかしなところがあったらどんどん指摘してください。

(追記)

他の手法を試してみました: Common LispでR (RCLを使ってみる)

0 件のコメント:

コメントを投稿