滝の音

滝の音

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

VBAでパフォーマンスの良いライフゲームをつくろう その3 測定にてVer4を決めよう

  • はじめにの前に

見たまま編集で書いたものをMarkdownに移植させたので
もしかしたら一部変なところがあるかもです

  • はじめに

さて~!!!!
今回からようやく機能面をいじります!!

今回は特に。
次世代に生き残るセルの記録とそれを記述する箇所をいじります。
現状がVer3なのですが今回はVer4まで更新します。

  • バージョンアップについて

今までは根幹的なところをいじらなかったため一本道の更新でしたが
ここからは「考え方」が入ってくるためなかなかまっすぐは進まないです。
いくつか候補を出してそれぞれの性能を測ってそれで正式な更新版を決めていきます。
その過程は省いてもいいのかもしれませんが
せっかくなのでその試行錯誤ものせてみようと思います。

  • RangeとUnionでVer4_1

次世代に生き残るセルの記録とそれの記述。
Ver3ではどうやっているのかというと。
生き残るセルのアドレスをいったん保存して
Fieldをいったんまっさらにして
保存したアドレスのセルにひとつずつ■を書き込む。
というやり方です。

とりあえず見た目的には「ひとつずつ」というところを何とかしたいですね。
処理速度的にもおそらくですが「一気に」できたほうが速い気がしますよね。

ということでVer4_1を考えました。
生き残るセルのアドレスを保存するのではなく
生き残るセルを直接まとめて
それらに一気に書き込むというやり方。

具体的にはstockをRangeとして定義して
生き残るセルをUnionを使ってまとめていきます。
コード全体を書くのは重いのでcell_jdgとcell_dscを載せますね。
まずはcell_jdg

Function cell_jdg2(field, kigou, q) As Range
 Dim trgt As Range
 Dim p1 As Variant
 Dim p2 As Variant
 Dim cnt As Integer
 Dim stock As Range
 Dim num As Integer
 Set stock = Cells(1, q + 4)
'------------------------------------------------
'field内の各セルに対して
'自身と周囲の計9マスの生きているセルを数えて
'それによって生死を判定します
'生きている場合はそのセルをstockにunion
'------------------------------------------------
  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
                Set stock = Union(Range(p1.Address), stock)
            End If
        Case Else
            If cnt = 3 Then
                Set stock = Union(Range(p1.Address), stock)
            End If
    End Select
 Next p1
 Set cell_jdg2 = stock
End Function

つづいてcell_dsc

Function cell_dsc2(stock, kigou)
'------------------------------
'いったんシートをまっさらに
'------------------------------
 Cells.ClearContents
'-------------------------
'生存セルに■を書き込む
'-------------------------
 stock = kigou
End Function

さて。ここからがパフォーマンスの肝。
測定です。

F_size=50で計測を。

ver3 50 ver4_1 50
調査終了0.390625 調査終了0.703125
更新終了0.6259766 更新終了0.1416016
調査終了0.390625 調査終了0.6562
更新終了0.53125 更新終了0.140625

おお!
更新速度がだいぶ上がりましたね!
4倍くらい?
しかし調査速度がやけに遅い??

ver3 70 ver4_1 70
調査終了0.703125 調査終了2.391602
更新終了1.016602 更新終了0.5458984
調査終了0.75 調査終了2.25
更新終了1.052734 更新終了0.546875
Ver3 100 Ver4_1 100
調査終了1.484375 調査終了16.25
更新終了2.867188 更新終了0.34375
調査終了1.5 調査終了14.625
更新終了2.84375 更新終了0.8125

んー。F_sizeを上げてみると調査にかかる時間がネックになりますね。
ただ更新速度は比較的すばらしいのですが。。

おそらくUnionがおいしくないみたいなのでちょっとした実験を。
F_sizeを50にして
調査フェイズでUnionをする箇所をコメント化してみました。
これによってUnionの部分のみが無効になります。

その時の調査にかかった時間が0.4060059です。
これはVer3の調査時間と同程度です。

つまりUnionは時間がかかることがわかりますね。

ついでに。
配列の操作(Ver3では生存セルのアドレスを配列に記録しています)は速いこともわかります。
Ver4_1の調査フェイズでUnion部分をコメント化したものは
つまりはForの処理を回しただけのものです。
Ver3はForの処理を回してさらに配列の処理も行っています。
それにもかかわらずそれらふたつの処理速度がほとんど同じということは
配列の処理は速い。ということですよね。

あとは現在の調査フェイズのForの処理をf_size=50で回すと0.4秒はかかってしまうこともわかります。

  • 配列を貼り付けるVer4_2

Unionは遅い。
配列は速い。
その二つがわかりました。
今回できればクリアしたいことは。
生存セルの記述を「一気に」行うこと。

ということは。
配列で処理しつつ記述は一気に行う。

ができればいいのですよね。
ということでVer4_2です。
Ver3とだいたい同じなのですが。
生存セルのアドレスを保存するのではなく
Fieldとおなじサイズの配列を定義して
生存セルのアドレスと対応する箇所の配列に■を入れることにします。

。。。
説明が難しい。
Fieldの(1,1)のセルが生存する場合は
Stock(1,1)=”■”
とするということです!!

そして生存セルを記述する際にはfield = stock と書くだけでstockの状態を貼り付けることができます。

すると。。。

ver3 30 ver4_1 30 ver4_2 30
調査終了0.171875 調査終了0.15625 調査終了0.15625
更新終了0.1083984 更新終了0.046875 更新終了0.21875
調査終了0.15625 調査終了0.171875 調査終了0.1572266
更新終了0.1083984 更新終了0.0625 更新終了0.2333984
ver3 50 ver4_1 50 ver4_2 50
調査終了0.390625 調査終了0.703125 調査終了0.3916016
更新終了0.6259766 更新終了0.1416016 更新終了0.2958984
調査終了0.390625 調査終了0.6562 調査終了0.375
更新終了0.53125 更新終了0.140625 更新終了0.296875
ver3 70 ver4_1 70 ver4_2 70
調査終了0.703125 調査終了2.391602 調査終了0.7041016
更新終了1.016602 更新終了0.5458984 更新終了0.609375
調査終了0.75 調査終了2.25 調査終了0.703125
更新終了1.052734 更新終了0.546875 更新終了0.53125
Ver3 100 Ver4_1 100 Ver4_2 100
調査終了1.484375 調査終了16.25 調査終了1.469
更新終了2.867188 更新終了0.34375 更新終了0.8920002
調査終了1.5 調査終了14.625 調査終了1.452999
更新終了2.84375 更新終了0.8125 更新終了0.8610001

あらまぁびっくり!
Ver3と調査速度はほとんど変わらず更新速度を3倍にひきあげました!

それにf_sizeが70以上ではVer4_1と同程度の更新時間!
これはめちゃ強いですよ!

ただf_sizeが50以下の場合ではVer4_1の処理は優秀ですね。
これは捨てがたい魅力です。

  • まとめ

とりあえずVer4_2を正式のバージョンアップVer4としますが。
Ver4_1も捨てずに残しておきます。
何かを改善すれば最強のアルゴリズムになるかもですので。。

あ。そういえばしれっと更新した部分があります。
「initialization」のコードもVer4_2式に変更しました。
あとは「mother」にqという変数を増やしました。
世代を表示するセルなどを固定しないための変数です。
これをつけないと大事なセルがfieldに飲み込まれてしまう場合があるのです。

最後に「mother」「initialization」「life_game_ver4」のコードを載せますね。

Private Sub CmdB1_Click()
 Dim f_size As Integer
 Dim kigou As String
 Dim return_time As String
 Dim field As Range
 Dim q As Integer
'-----------------------------
'フォームの数値の読み込み
'-----------------------------
 f_size = Val(TB1)
 return_time = TB2
 kigou = TB3
'----------------------------
'fieldの設定
'----------------------------
 Set field = Range(Cells(2, 2), Cells(2, 2).Offset(f_size - 1, f_size - 1))
'---------------------------------
'qは大事なセルを指定するための数値
'---------------------------------
 q = q_jdg(f_size)
'----------------------------
'実行コードの決定
'----------------------------
 Select Case True
    Case OB1
        Call initialization(f_size, kigou, field)
    Case OB2
        Debug.Print "Ver4_1 " & f_size
        Call life_game_Ver4_1(f_size, return_time, kigou, q)
 End Select
 Unload Me
End Sub
Function q_jdg(f_size) As Integer
 Dim ans As Integer
 Do While ans < f_size
    ans = ans + 26
 Loop
 q_jdg = ans
End Function
Sub initialization(f_size, kigou, field)
 Dim p1 As Variant
 Dim stock() As String
 Cells.ClearContents
 ReDim stock(1 To f_size, 1 To f_size)
 '-----------------------------------------------------
 'fieldのセルひとつひとつに
 '一定の確率で■を入れます
 '-----------------------------------------------------
 For Each p1 In field
    If Rnd() < 0.5 Then
        stock(p1.Row - 1, p1.Column - 1) = kigou
    End If
 Next p1
 field = stock
End Sub
Sub life_game_Ver4(f_size, return_time, kigou, q)
 Dim field As Range
 Dim gene As Integer
 Dim time_watch As Single
 Dim stock() As String
'---------------------------------
'fieldの設定
'---------------------------------
 Set field = Range(Cells(2, 2), Cells(2, 2).Offset(f_size - 1, f_size - 1))
'---------------------------------
'geneは世代数を記録するためのセル
'---------------------------------
 gene = Cells(1, q + 2).Value
'-------------------------------------
'調査フェイズの計測
'-------------------------------------
 time_watch = Timer
    stock = cell_jdg(f_size, field, kigou, q)
 Debug.Print "調査終了" & Timer - time_watch
'--------------------------------------
'更新フェイズの計測
'--------------------------------------
 time_watch = Timer
    Call continue_jdg(stock, q)
    Call cell_dsc(field, stock)
 Debug.Print "更新終了" & Timer - time_watch
 '-------------------------
 '世代数を更新する
 '-------------------------
 Cells(1, q + 2).Value = gene + 1
 '---------------------------------
 'このプロシージャを頭から繰り返す
 '---------------------------------
 Application.OnTime Now() + TimeValue(return_time), _
  "'life_game_Ver4 " & f_size & ", """ & return_time & """ , """ & kigou & """," & q & "'"
End Sub
Function cell_jdg(f_size, field, kigou, q) As String()
 Dim p1 As Variant
 Dim p2 As Variant
 Dim trgt As Range
 Dim cnt As Integer
 Dim stock() As String
 ReDim stock(1 To f_size, 1 To f_size)
'------------------------------------------------
'field内の各セルに対して
'自身と周囲の計9マスの生きているセルを数えて
'それによって生死を判定します
'生きている場合はそのセルに対応する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
                stock(p1.Row - 1, p1.Column - 1) = kigou
            End If
        Case Else
            If cnt = 3 Then
                stock(p1.Row - 1, p1.Column - 1) = kigou
            End If
    End Select
 Next p1
 cell_jdg = stock
End Function
Function continue_jdg(stock, q)
'-------------------------------
'stockがない場合
'全滅なのでstop
'-------------------------------
 'ここは今までとだいぶ違うアルゴリズムを考えているので
 '次のバージョンアップで書きます
'-------------------------------
'ループを終わらせたい場合
'cells(1,q)に何かを書き込めばstop
'-------------------------------
 If Cells(1, q) <> "" Then
    Stop
 End If
End Function
 
Function cell_dsc(field, stock)
'-------------------------
'生存セルに■を書き込む
'-------------------------
 field = stock
End Function

今回は以上です。
ブログにあげるために整理している段階で気づくこともやはりいくつかありますね。

一番感じたのは速度の結果がめちゃわかりにくこと。
これは次回までに改善したいですが。。
この書式でVerまで書いてしまっていることがつらい。。。

こういう意味でも根幹の機能面ではない
いうなれば「デザイン面」は初めに整えておかないとひたすら面倒なことになります。。

ただ元の素養がないのでこうして面倒な思いをしてあげていくしかないのか。。。
よく言えば「不器用」なやりかた。
不器用に「」がつくと良いイメージがあります笑

今回はここでおわり。