スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

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

Excel VBA

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

テーマ : 算数・数学の学習
ジャンル : 学校・教育

プロフィール

みっちょ (田上 暢顕)

Author:みっちょ (田上 暢顕)
 
30年以上ひたすら毎日プログラミングを続けているエンジニアの『みっちょ』です。

ここでは開発を行う際の覚書の他、私が日頃から色々な開発を行う中で便利だと感じているツールやサービスなどを紹介しています。



連絡先
 110651321
 michyox
 4348126
 Ravijour

友達申請などWelcomeです☆
基本的に断りませんので、お気軽に申請してください♪

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。