ライフゲームの次世代を求める

[vb]
Function NextGen(ByVal PresentGen As Variant, ByVal EdgeLoop As Boolean) As Variant
Dim tmpX As Long, tmpY As Long, LLX As Long, LLY As Long
Dim tmpG() As Boolean, tmpL As Long
Dim tmpA As Long, tmpB As Long
LLX = UBound(PresentGen, 1)
LLY = UBound(PresentGen, 2)
If EdgeLoop Then
For tmpL = 1 To LLX – 1
PresentGen(tmpL, 0) = PresentGen(tmpL, LLY – 1)
PresentGen(tmpL, LLY) = PresentGen(tmpL, 1)
Next
For tmpL = 1 To LLY – 1
PresentGen(0, tmpL) = PresentGen(LLX – 1, tmpL)
PresentGen(LLX, tmpL) = PresentGen(1, tmpL)
Next
PresentGen(0, 0) = PresentGen(LLX – 1, LLY – 1)
PresentGen(LLX, 0) = PresentGen(1, LLY – 1)
PresentGen(0, LLY) = PresentGen(LLX – 1, 1)
PresentGen(LLX, LLY) = PresentGen(1, 1)
Else
For tmpL = 0 To LLX
PresentGen(tmpL, 0) = 0
PresentGen(tmpL, LLY) = 0
Next
For tmpL = 0 To LLY
PresentGen(0, tmpL) = 0
PresentGen(LLX, tmpL) = 0
Next
End If
ReDim tmpG(LLX, LLY) As Boolean
For tmpX = 1 To LLX – 1
For tmpY = 1 To LLY – 1
tmpL = 0
For tmpA = tmpX – 1 To tmpX + 1
For tmpB = tmpY – 1 To tmpY + 1
If (PresentGen(tmpA, tmpB) And ((tmpA <> tmpX) Or (tmpB <> tmpY))) Then
tmpL = tmpL + 1
End If
Next
Next
If PresentGen(tmpX, tmpY) Then
If (tmpL <= 1) Then tmpG(tmpX, tmpY) = False
If ((tmpL = 2) Or (tmpL = 3)) Then tmpG(tmpX, tmpY) = True
If (4 <= tmpL) Then tmpG(tmpX, tmpY) = False
Else
If (tmpL = 3) Then tmpG(tmpX, tmpY) = True
End If
Next
Next
NextGen = tmpG
End Function
[/vb]

 
John Horton Conwayによって考案されたライフゲームは以下のような法則に従う。
 
①誕生:ある生物の居ない升目に隣接する升目で、生物が居る升目が3つあれば、その升目に次の世代で生物が誕生する。
②生存:ある生物の居る升目に隣接する升目で、生物が居る升目が2つか3つならば、その升目の生物は引き続き生存する。
③過疎:ある生物の居る升目に隣接する升目で、生物が居る升目が1つ以下ならば、その升目の生物は過疎により死滅する。
④過密:ある生物の居る升目に隣接する升目で、生物が居る升目が4つ以上ならば、その升目の生物は過密により死滅する。
 
これを盤面全体に対して同時に判定し次の世代に置き換えるという事を繰り返し行うことで、生命の誕生から死滅のプロセスを簡易的なモデルで再現するシミュレーションだ。
 
この次世代の様子を求めるには上記のような関数を用意すれば良い。
第1引数に現在の盤面のBoolean2次元配列を、第2引数に盤面の端を逆側に繋げるかどうかのフラグを与えて呼び出せば、次の世代の2次元配列が返ってくる。
実際には端の処理を行うためにX・Yそれぞれ0の升と最大値の升を利用するため、0から盤面に使いたいX・Yの最大値にプラス1した配列を準備して実行する。
 
これを使って、例えばエクセルのA1~AD30までの縦横30升の盤面を使ってシミュレーションを行う場合、次のようなコードでこれを次世代に更新することができる。

 
[vb]
Sub LifeTest()
Dim tmpG As Variant
Dim tmpR As Long, tmpC As Long
Dim tmpS As String
ReDim tmpG(31, 31) As Boolean
For tmpR = 1 To 30
For tmpC = 1 To 30
tmpS = CStr(ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value)
If (tmpS <> "") Then tmpG(tmpC, tmpR) = True
Next
Next
tmpG = NextGen(tmpG, True)
For tmpR = 1 To 30
For tmpC = 1 To 30
If tmpG(tmpC, tmpR) Then
ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value = "*"
Else
ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value = ""
End If
Next
Next
End Sub
[/vb]

みっちょ

SALON Doluce 代表。ハッカーでカウンセラー、占い師でカメラマン、その他あらゆる顔を持つ変な人。キッズプログラミング講師、パソコン修理、カウンセリングなど喜んで承ります。お気軽にお声掛けください!