滝の音

滝の音

名こそ流れてなお聞こえけれ

VBAでパフォーマンスの良いライフゲームをつくろう! その1 概要とver2まで

  • はじめにの前に
    この記事は以前に「見たまま」編集であげたものを「Markdown」に変更したものです。
    コードのみやすさのために移しました。

  • はじめに  

こんにちはー。  

じつは。。。。  

 

ノートパソコン買いました!!!  

 

いえい。  

これからはパソコンでブログの記事が書けます。  

今までは基本ケータイで書いていて  

プログラミングのコードを載せたりしたいときはネカフェでやっていました。  

そのせいで投稿のスパンがぶれぶれでしたが。。  

 

これからは定期的に更新していこうと思います。  

 

あと自前のpcを入手したことでjavaやcにも触れられるようになりました。  

どちらも勉強中です!  

もうちょっとしたらjavaでのプログラミングもブログに書きたいなと思います。  

 

とりあえず今回は慣れ親しんでいるVBAで。  

 

今回はだいぶ古典的ですがライフゲームのプログラミングについて。  

今回は特にパフォーマンスを上げることをテーマにやります。  

 

とりあえずどういうプログラムをかけばよいのかを確認。  

 

各セルについて次世代に  

生存するか  

死滅するか  

誕生するか  

 

を調べてそれを可視化すればいいのですよね。  

 

やり方はいろいろあるでしょうがとりあえず直感的にコードを書きました。  

 

Sub life_game_Ver1()

 Dim field As Range

 Dim f_size As Integer

 Dim trgt As Range

 Dim p1 As Variant

 Dim p2 As Variant

 Dim cnt As Integer

 Dim stock() As String

 Dim num As Integer

 Dim kigou As String

 '------------------------------

 '生きているセルには■を入れます

 '------------------------------

 kigou = "■"

 '-----------------------------------------------------

 'fieldはセルの生死判定をする領域

 'f_size * f_size のセルを扱います

 '-----------------------------------------------------

 f_size = 30

 Set field = Range(Cells(2, 2), Cells(2, 2).Offset(f_size - 1, f_size - 1))

 '-----------------------------------------------------

 'numはstockをredimするための数字

 'stockには次世代に生存しているセルのアドレスを入れます

 'その生死判定がこの先

 '-----------------------------------------------------

 num = 0

 ReDim stock(num)

 '-----------------------------------------------------

 '生死判定の概要を書きます

 'fieldのセルをひとつずつ取り出す

 'その周囲8マスと自身をtrgtとして指定

 'trgtに■がいくつ入っているか調べる

 '■のサイズで現段階での自身の生死で次世代の生死を判定

 '生存する場合はそのセルのアドレスをstockに保存

 '以上です!

 '-----------------------------------------------------

 For Each p1 In field

    Set trgt = Range(p1.Offset(-1, -1), p1.Offset(1, 1))

    cnt = 0

    For Each p2 In trgt

        If p2 = kigou Then

            cnt = cnt + 1

        End If

    Next p2

    Select Case p1.Value

        Case kigou

            If cnt = 3 Or cnt = 4 Then

                ReDim Preserve stock(num)

                stock(num) = p1.Address

                num = num + 1

            End If

        Case Else

            If cnt = 3 Then

                ReDim Preserve stock(num)

                stock(num) = p1.Address

                num = num + 1

            End If

    End Select

 Next p1

'-------------------------------

'stockがない場合

'全滅なので終了

'-------------------------------

 If stock(0) = "" Then

    Exit Sub

 End If

'-------------------------------

'ループを終わらせたい場合

'cells(1,52)に何かを書き込めばstop

'-------------------------------

 If Cells(1, 52) <> "" Then

    Stop

 End If

 '------------------------------

 'いったんシートをまっさらに

 '------------------------------

 Cells.ClearContents

 '-------------------------

 '生存セルに■を書き込む

 '-------------------------

 For Each p1 In stock

    Range(p1) = kigou

 Next p1

 '---------------------------------

 'このプロシージャを頭から繰り返す

 '時間はこのコードが読まれた2秒後

 '---------------------------------

  Application.OnTime Now() + TimeValue("0:00:02"), "life_game_Ver1"

End Sub

 

とりあえず動作は確認できました。  

このコードの概要は。。。  

 

Fieldのセルひとつひとつについて  

周囲8マスと自身の合計9マスの■の数を数える  

それによって次世代の状態を調べる  

次世代に生きている場合はそのセルのアドレスをstockに保存  

Fieldの全セルについて調べ終わったら  

いったんシートをまっさらにしてから  

Stockに入っているアドレスに■を書き込む  

もしも書き込む先がない場合は全滅なので終了  

 

という感じです。  

このVer1をどうにかしてパフォーマンスを上げていくのが今回やることです。  

  • その前に・・・  

ライフゲームはある状態のfieldに対して処理をするものです。  

そのために「ある状態」というものをつくるコードもつくらねば。  

Sub initialization()

 Dim field As Range

 Dim f_size As Integer

 Dim p1 As Variant

 Dim kigou As String

 Cells.ClearContents

 kigou = "■"

 f_size = 30

 Set field = Range(Cells(2, 2), Cells(2, 2).Offset(f_size - 1, f_size - 1))

 '-----------------------------------------------------

 'fieldのセルひとつひとつに

 '一定の確率で■を入れます

 '-----------------------------------------------------

 For Each p1 In field

    If Rnd() < 0.5 Then

        Range(p1.Address) = kigou

    End If

 Next p1

End Sub

これでfieldの各セルに対して50%の確率で■が書き込まれます。  

life_game_ver1を一部書き換えてつくりました。  

今後はこれで形成された初期状態に対してlife_game_verNのパフォーマンスを調べていきます。  

 

  • パフォーマンスとは? 数値で評価するための更新Ver2  

本題に戻ります。  

Ver1をちょっと評価してみますか。。  

 

とりあえず感覚としては。。  

毎回セルがまっさらになるせいで、そのセルが生存したのか誕生したのか死滅したのかがわからない。  

世代が更新されるまでの時間が一定にならない(おそらく処理が重いせい)。

という感じです。  

 

んー。  

感覚的です。  

 

感覚も大事なのですが  

もう少し数値を使ってパフォーマンスを評価したいですね。  

 

そのためのいくつかの機能を加えましょう。  

 

Sub life_game_Ver2()

 Dim field As Range

 Dim f_size As Integer

 Dim trgt As Range

 Dim p1 As Variant

 Dim p2 As Variant

 Dim cnt As Integer

 Dim stock() As String

 Dim num As Integer

 Dim kigou As String

 Dim gene As Integer

 gene = Cells(1, 26 * 3 + 2).Value

 Dim time_watch As Single

 time_watch = Timer

 '------------------------------

 '生きているセルには■を入れます

 '------------------------------

 kigou = "■"

 '-----------------------------------------------------

 'fieldはセルの生死判定をする領域

 'f_size * f_size のセルを扱います

 '-----------------------------------------------------

 f_size = 70

 Set field = Range(Cells(2, 2), Cells(2, 2).Offset(f_size - 1, f_size - 1))

 'Debug.Print "ver2 " & f_size

 '-----------------------------------------------------

 'numはstockをredimするための数字

 'stockには次世代に生存しているセルのアドレスを入れます

 '-----------------------------------------------------

 num = 0

 ReDim stock(num)

 '-----------------------------------------------------

 '生死判定の概要を書きます

 'fieldのセルをひとつずつ取り出す

 'その周囲8マスと自身をtrgtとして指定

 'trgtに■がいくつ入っているか調べる

 '■のサイズで現段階での自身の生死で次世代の生死を判定

 '生存する場合はそのセルのアドレスをstockに保存

 '以上です!

 '-----------------------------------------------------

 For Each p1 In field

    Set trgt = Range(p1.Offset(-1, -1), p1.Offset(1, 1))

    cnt = 0

    For Each p2 In trgt

        If p2 = kigou Then

            cnt = cnt + 1

        End If

    Next p2

    Select Case p1.Value

        Case kigou

            If cnt = 3 Or cnt = 4 Then

                ReDim Preserve stock(num)

                stock(num) = p1.Address

                num = num + 1

            End If

        Case Else

            If cnt = 3 Then

                ReDim Preserve stock(num)

                stock(num) = p1.Address

                num = num + 1

            End If

    End Select

 Next p1

 Debug.Print "調査終了" & Timer - time_watch

 time_watch = Timer

'-------------------------------

'stockがない場合

'全滅なので終了

'-------------------------------

 If stock(0) = "" Then

    Exit Sub

 End If

'-------------------------------

'ループを終わらせたい場合

'cells(1,52)に何かを書き込めばstop

'-------------------------------

 If Cells(1, 26 * 3) <> "" Then

    Stop

 End If

 '------------------------------

 'いったんシートをまっさらに

 '------------------------------

 Cells.ClearContents

 '-------------------------

 '生存セルに■を書き込む

 '-------------------------

 For Each p1 In stock

    Range(p1) = kigou

 Next p1

 Debug.Print "更新終了" & Timer - time_watch

 '-------------------------

 '世代数を更新する

 '-------------------------

 Cells(1, 26 * 3 + 2).Value = gene + 1

 '---------------------------------

 'このプロシージャを頭から繰り返す

 '時間はこのコードが読まれた1秒後

 '---------------------------------

  Application.OnTime Now() + TimeValue("0:00:3"), "life_game_Ver2"

End Sub

さきほど言ったようにVer2はVer1にいくつかの機能を足したものです。  

以下詳細。  

 

世代数のカウンターと処理時間の計測機能を足しました。  

すべてのセルについて生死確認する段階を調査フェイズ。  

そこから指定のセルの生存を表現する段階を更新フェイズ。  

としました。

 

調査終了0.15625  

更新終了0.046875  

調査終了0.15625  

更新終了0.046875  

調査終了0.15625  

更新終了0.0625  

 

蓄積したデータの一部です。  

ちなみに今回は320世代で停滞しました。  

停滞とは世代を経てもセルの生死が変わらない状態です。  

もう一回試してみたら今度は90世代で停滞したので  

あるフィールドサイズに対する停滞するまでの世代数はかなりばらつきがあるみたい。  

 

とりあえずこれで。  

フィールドサイズ  

プログラムを繰り返す秒数  

世代数  

各フェイズにかかる時間  

が分かるようになったのでパフォーマンスをはかれるようになりました。  

 

現状は30*30のフィールドで1秒おきに繰り返す仕様にすら耐えられていません。  

これを何とかしていくのがこれからやるべきことです。  

 

更新フェイズと調査フェイズを合わせても0.2秒かからないのに  

OnTimeの値を1秒にするとカクカクしてしまうのはなぜなのだろう。。。  

 

  • まとめ  

今回はここまでです。  

次回はVer3とVer4について書くつもりです。  

じつはそれらはもう作っています。  

ただ記事にできていないので少々お待ちを。。  

更新は際限がなさそうなので  

100*100のフィールドで1秒おきにカクカクせずに各セルの状態がどう変わったのが見てわかる仕様をつくること。   

を目標にしますか。  

 

ではではー。