ダウンロード

ライフゲーム(Conway's Game of Life)

ライフゲームとは、格子状のセルと単純な規則による離散的計算モデルである
「セル・オートマトン（cellar atutomaton）」の一種です。

　cellar：「細胞状の」、atutomaton：「自動機械」を意味

１９７０年にイギリスの数学者ジョン・ホートン・コンウェイ (John Horton Conway) が
生命の誕生、進化、淘汰などのプロセスを簡易的なモデル化のために考案しました。

生物界においては、過疎でも過密でも個体の生存に適さないという
個体群生態学的な背景を規則として使用します。

単純なルールにもかかわらず、複雑なパターンを描き出すことがあります。

メニュー
規則
プログラム概要
画面の説明
処理方式
パターンサンプル
VBAコード
ダウンロード
リンクリスト
VBAコードを 全て展開　折り畳む

規則


無限に広がる2次元の格子のマス目内で規則に従ってパターンが展開されます。
マス目には2状態があり、片方は生物がいない状態（0）、もう片方は生物がいる状態（1）と します。

あるマス目において、周囲8個（上下左右、右上、右下、左上、左下）のマスの状態により次の世代が決定されます。その規則は、

1.そのマスが１の場合：周囲8マスのうち２マスまたは３マスが黒ならそのマスは１のまま（「生 存」）
　　　→適度な生物密度で生存可能
2.そのマスが０の場合：周囲8マスのうち３マスが１ならそのマスも１にする（「誕生」）
　　　→周囲に適度な生物密度があり、新しく子孫が誕生
3.それ以外の場合、そのマスは０にする（死亡）
　　　→過密、または過疎で生存不可。誕生も不可

下図は中央のセル（赤枠）での次のステップを示しています。
左端では次のステップで中央に新しく誕生、右端は過密で死滅します。
生存・死滅パターン

プログラムの概要

ほとんどはエクセルの標準関数を使用して実現しています。
実行の手順は下記。

１．次世代値を決定
　　　「現世代」シートのマス目値と近傍値から「規則」シートの規則を当てはめて次世代値を決定
　　　→標準関数のみで実現

２．「次世代」値を「現世代」値にする
　　　「次世代」シートの該当粋の値のみを「現世代」にコピー
　　　これはVBAを使用します。

２により１の値が変化すると、「次世代」の値がまた変化します。
これをVBAのループにより繰り返すと、パターンが連続して変化していきます。

プログラムはVBAコードを参照してください。



画面の説明

下は「グライダー銃」と呼ばれるパターンを実行中の図です。

①クリア：現在のデータをクリアします

②サンプル配置：いくつかのパターンサンプルを選択可
　　サンプルパターンには、「固定型」「振動型」「移動型」「繁殖型」「長寿型」を用意しています。

③ランダム配置：パターンをランダムに配置します。
　　ボタンの上の「０．１」は全体の１０％に配置することを意味しています。変更可。

④STEP：１世代ずつ実行

⑤連続実行：次世代パターンを連続して描画します。

⑥中止：実行を中止

⑦周期境界：左右端は連接、上下端も連接して周期的な境界とします。
　　すなわち、右端に移動して行ったら左から出現することになります。

⑧速い⇔遅い：実行速度を調整します。

セルＡ２の「７３」は世代数を表しています。
画面の説明
　　　


処理方式

ここでは下記のワークシートを使用しています。

現世代：現在の状態を表しています。
　　「０」が生物がいない状態、「１」が生存している状態。
　　表示形式により数値は非表示にしていて、条件付書式で「１」の場合は「緑」で表しています。
　　上図では、「緑」の部分が「１」で生物がいる状態。
　　表示形式を「標準」にすると下図のように、０と１が入力されていて、直接パターンを入力することも可能です。
現世代状態

近傍値：「現世代」のセル近傍の「１」の個数を算出
近傍値

次世代：近傍値と「規則」により算出した値から次世代を決定

次世代

規則：次世代を決定するための規則を表示したもの
　　　変更可。
　　　現在の値が「０」の場合はC列、「１」の場合はD列を参照して、近傍値から次世代の値を決定

規則

セルの色

は条件付き書式で設定

条件付き書式




パターンサンプル

　　「サンプル配置」のリストボックスから選択するだけで転記され、初期値として使用できます。


VBAコード

ＡＰＩ関数の定義（３２/６４ビット対応）と共通変数定義

#If Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Dim 中止 As Boolean '「中止」フラグ
Dim Cnt As Integer  '世代数

クリア処理－現世代データ、世代数

Private Sub cmdClear_Click()
'
' クリア
'
    Range("CURRENT").ClearContents
    Range("世代") = ""
    Range("世代").Select
    Cnt = 0
    
End Sub

ステップ実行

Private Sub cmdStep_Click()
'
' ステップ実行
'
    Range("CURRENT").Value = Sheets("次世代").Range("NEXT").Value    '次世代を現世代にコピー
    Cnt = Cnt + 1       '世代数カウントアップ
    Range("世代") = Cnt '表示
End Sub

連続実行

・ボタンの有効・無効設定
・ループ
　　世代数表示、次世代を現世代にコピー、指定時間待ち
　　「中止」ボタンが押されるまで継続
・ボタンの有効・無効設定
Private Sub cmdGo_Click()
'
' ライフゲーム開始
'
    cmdGo.Enabled = False   '連続実行ボタン無効
    cmdStop.Enabled = True  '中止ボタン有効

    Cnt = 0
    中止 = False
    
    Do
        Range("CURRENT").Value = Sheets("次世代").Range("NEXT").Value    '次世代を現世代にコピー
        Cnt = Cnt + 1       '世代数カウントアップ
        Range("世代") = Cnt '表示
        MyWait Range("速度") '周期
    Loop While (Not 中止)

    cmdGo.Enabled = True    'ボタン有効
    cmdStop.Enabled = False

End Sub

Private Sub MyWait(ByVal t As Long)
'
' 指定ミリ秒待機
'
    Const TT = 10
    
    Do While (Not 中止)
        DoEvents
        t = t - TT
        If t <= 0 Then Exit Do
        Sleep TT
    Loop

End Sub



Private Sub cmdStop_Click()
    中止 = True
End Sub

初期状態設定

・サンプル配置－リストボックスから項目クリック時に起動される
　　サンプルパターンの「名前」は"Sample_"で始まるように付けてある

・ランダム配置－「ランダム配置」ボタン起動時に配置される

・内部関数
　　IsRangeName－「名前」が有効かを判定（True-有効な名前）
　　　　リストボックスで空白や"■長寿型"などの説明項目を無視するために使用
Private Sub lstSample_Click()
'
' サンプル配置
'
    If ActiveSheet.Name <> "現世代" Then Exit Sub
    
    Dim RangeName As String
    
    RangeName = "Sample_" & lstSample.Text
    If Not IsRangeName(RangeName) Then Exit Sub
    
    cmdClear_Click
    
    Application.ScreenUpdating = False
    
    Sheets("サンプル").Range(RangeName).Copy
    Range("RESULT").Range("O20").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("世代").Select
    
    Application.ScreenUpdating = True

End Sub


Private Sub cmdRand_Click()
'
' ランダム配置
'
    Dim tmp As Range
    Dim r As Single
    
    Application.Calculation = xlCalculationManual
    
    r = Val(Range("RATIO"))
    For Each tmp In Range("RESULT")
        If Rnd < r Then
            tmp.Value = 1
        Else
            tmp.Value = 0
        End If
    Next

    Application.Calculation = xlCalculationAutomatic

    cmdGo.Enabled = True
    cmdStop.Enabled = False
    
End Sub


'---------------------------------------------------------
' 内部関数
'---------------------------------------------------------

Private Function IsRangeName(strName As String) As Boolean
'
' 有効な範囲名かをチェック
'
    Dim nm As Name
    
    IsRangeName = False
    For Each nm In Application.Names
        If strName = nm.Name Then
            IsRangeName = True
            Exit For
        End If
    Next

End Function

×
→PageTop