2008年7月12日土曜日

ライフゲーム

物理の業界にもビジュアル的に面白い話が結構あってその一つが「ライフゲーム」
最近ちょっと興味を持っている。
ライフゲームはいわゆるセルオートマトンの一種らしい。かなり昔からある。有名なのがコンウェイのライフゲームというヤツで、原理はオセロみたいなもんだ。オセロ盤に白黒の駒を敷き詰めて、自分が白のとき、周りの八つのうち2個もしくは3個が白なら次も白、自分が黒なら周りの八つのうち3個が白のときだけ次に白となる、という至って単純な規則のみで離散化された、しかも2状態しかない小宇宙の時間発展を決定する。こんなに規則は単純なのに、白黒の模様はとんでもなく複雑な挙動をする。複雑系とか、量子論との絡みもありそうで、なかなかアツイ話で色々適応できそうだと思ってるんだけど。(セルオートマトンの手法で流体力学の問題を解こうって話もあるしね)面白そうなんで参考図書ぼちぼち読んでたら自分とこのPCでシミュレートしたくなった。

まぁそんなこんなで、本業で同じことばっかりやってるのもだいぶ飽きたので、週末はこれで遊ぶことにした。規則は単純だから、コード自体は書くの簡単とはいえ、ライフゲームは可視化してなんぼ。可視化部分を考えるのが経験ないためメンドクサイ。そこでExcelつかうことにした。ExcelのVBAマクロで書けば、VBAの組み込み関数でセルの色や罫線とかをいじれるから楽勝。
作ってみたところざっとこんな感じ

Sub lifegamerun()
' ele は全要素の数
' shape は変換後の列数の数

Dim col As Integer, row As Integer
Dim r_on As Range, setrange As Range
Dim limitr As Integer, limitc As Integer
Dim n As Integer, m As Integer
Dim r As Integer, c As Integer
Dim shape As Integer
Dim sr As Integer, sc As Integer
Dim i As Integer, j As Integer
Dim timing As Integer, itrmax As Integer
Dim ele As Integer
Dim a() As Integer, b() As Integer

col = Application.InputBox(prompt:="列(横)の数を入力してください", _
Title:="列数", Type:=1)
row = Application.InputBox(prompt:="行(縦)の数を入力してください:", _
Title:="行数", Type:=1)
Set setrange = Application.InputBox(prompt:="ライフゲームの表示をする部分の設定をします。左上のセルを指定してください", _
Title:="on", Type:=8)
sr = setrange.row
sc = setrange.Column
limitr = setrange.row + col - 1
limitc = setrange.Column + row - 1
Range(Rows(sr), Rows(limitr)).RowHeight = 10
Range(Columns(sc), Columns(limitc)).ColumnWidth = 2

With Range(Cells(sr, sc), Cells(limitr, limitc))
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlContinuous
End With

'初期化'
ReDim a(row, col)
ReDim b(row, col)
For i = 1 To row
For j = 1 To col
a(i, j) = 0
b(i, j) = 0
Next j
Next i

MsgBox "初期状態を設定してください。On状態にしたいセルをクリックしてください。範囲外のセルを指定すると終了します"

Do
Set r_on = Application.InputBox(prompt:="onのセルを指定してください", _
Title:="on", Type:=8)
r = r_on.row
c = r_on.Column

If r > limitr Or c > limitc Or c < sc Or r < sr Then
x = MsgBox("初期設定を終了しますか?", Buttons:=vbYesNo)
If x = vbYes Then
Exit Do
End If
End If
If r <= limitr And c <= limitc And r >= sr And c >= sc Then

With Cells(r, c)
.Interior.ColorIndex = 10
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlContinuous
End With
a(r - sr + 1, c - sc + 1) = 1

End If

Loop
itrmax = Application.InputBox("回数の上限を設定してください", "動作の回数", Type:=1)

timing = 0
timestep row, col, a(), b(), sr, sc, limitr, limitc, timing, itrmax

End Sub

Sub setmatrix(row As Integer, col As Integer, a() As Integer, b() As Integer)
Dim i As Integer, j As Integer
Dim def As Integer
For i = 1 To row
For j = 1 To col
def = 0
For refi = i - 1 To i + 1
For refj = j - 1 To j + 1
If refi >= 1 And refi <= row And refj >= 1 And refj <= col Then
def = def + a(refi, refj)
End If
Next refj
Next refi
def = def - a(i, j) '自分自身のカウントを引く'
'for debug'
'Cells(i, j) = def'
If a(i, j) = 1 Then
If def = 2 Or def = 3 Then
b(i, j) = 1
Else
b(i, j) = 0
End If
Else
If def = 3 Then
b(i, j) = 1
Else
b(i, j) = 0
End If
End If

Next j
Next i

End Sub

Sub timestep(row As Integer, col As Integer, a() As Integer, b() As Integer, sr As Integer, sc As Integer, _
limitr As Integer, limitc As Integer, timing As Integer, itrmax As Integer)
Dim i As Integer, j As Integer

setmatrix row, col, a(), b()

For i = 1 To row
For j = 1 To col
a(i, j) = b(i, j)
Next j
Next i

For i = 1 To row
For j = 1 To col
If a(i, j) = 1 Then
With Cells(i + sr - 1, j + sc - 1)
.Interior.ColorIndex = 10
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlContinuous
End With
Else
With Cells(i + sr - 1, j + sc - 1)
.Interior.ColorIndex = 19
.Interior.Pattern = xlSolid
.Borders.LineStyle = xlContinuous
End With
End If
Next j
Next i
timing = timing + 1
If timing > itrmax Then
Stop
End If

timestep row, col, a(), b(), sr, sc, limitr, limitc, timing, itrmax
End Sub

あまり洗練されたインターフェースではないけど、一応動く。ペンタデカスロンの挙動をみたりなかなかおもろい。しばらく遊べそうだ。Excelは結構やれば使えるツールな予感。しかしBloggerってなんでインデントしてるの全部左寄せにしてしまうんだ。見づらい

0 コメント: