滝の音

滝の音

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

VBAでパフォーマンスの良いライフゲームをつくろう その4 迷走しながらもVer6まで更新

  • はじめに

さて~!!

今回はライフゲームの第4回ですね。
前回は配列をシートに模してそこにセル状態を書き込み
最後にシートに貼り付ける
という手法を取りました。

今回はVer5でできるだけforを使わない。
Ver6でデータサイズを小さくする。
を実現したいと思います。

先に言っておくと
今回はだいぶ迷走の回です。

  • ちゃちゃっとVer5

Cell_jdgをいじります。
具体的にはForを一つ外します。 現状はこう。

 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

この中のFor Each p2 in target
の部分を書き換えます。

For Each p1 In field
    Set trgt = Range(p1.Offset(-1, -1), p1.Offset(1, 1))
    cnt = WorksheetFunction.CountIf(trgt, kigou)

    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

ForではなくConntIfを使って調べています。
こんなちょっとした変更でも。。

f_size\Version Ver4 Ver5
30 調査終了0.1557617 調査終了0.1088867
更新終了0.078125 更新終了0.078125
50 調査終了0.3911133 調査終了0.25
更新終了0.2661133 更新終了0.28125
70 調査終了0.828125 調査終了0.53125
更新終了0.5629883 更新終了0.5170898

調査フェイズが約1.5倍になっています。
Forの回数が1/9になった恩恵ですね。
できることならFieldのForも外したいのですが。。。
まだちょっと無理そうです。

  • 本質を理解せずにつくったVer6_1

最初はstock配列やkigouをString型からInteger型にすれば速くなるでしょ!
っていう軽いノリで書きました。

今は生きているセルに"■"を打ち込んでいますが
生きているセルに1、死んでいるセルに0を打ち込むタイプ。
それがVer6_1です。

f_size\Version Ver5 ver6_1
30 調査終了0.109375 調査終了0.078125
更新終了0.125 更新終了0.0625
50 調査終了0.2646484 調査終了0.21875
更新終了0.2822266 更新終了0.109375
70 調査終了0.546875 調査終了0.4208984
更新終了0.53125 更新終了0.21875

調査時間は約1.25倍
更新時間が2倍になりました。

ただ。
もうちょっと調べているうちに
Byte型というもっと小さいものある?
とか
メモリというものを使ってあれこれしている?
ということに興味を持ったので
これを機に調べてみました。

  • 記事にしようと思ったのですが

一応調べたことをまとめたのですが
ちょっとあまりにもお粗末すぎるので
概要だけ載せますね。

仕事をするとき。
メモリは作業机の大きさ。
一度に乗りきらない場合はHDDを使うが
めちゃ速度が落ちる。
なのでメモリを大きくするか
メモリが耐えられるコードを書くことが肝?

1Byteが8bitなのはただの決め事。

VBAにはVarPtrという関数があり
自分がプロシージャ中に定義したデータが格納されているメモリ番地を教えてくれる。
ただそれの活用法はよくわからず。

VBAではDimで変数の型を決めているが
それぞれの型で確保されるメモリのサイズは違う
ので必要な分だけ定義していくのがメモリにやさしそう?

んー。
なんか言葉だけ覚えたって感じです。
これをつかってVer6_2をつくる。
などの工夫はできませんでした。

んー。
何のための章だこれは?

  • 仕方ないのでVer6_1を正式にVer6に

あ。
言い忘れていました。
Ver6ではセルへのアクセスを0と1を打ち込むことにして
配列のサイズと記述の負荷を下げているのですが
それでは視覚的によろしくないですよね。

なので条件付き書式を使いました。
1と記入されたセルを黒く塗りつぶす仕様にしました。
そしてセルに記述される文字の色を白にしました。

f:id:nozomi-hayashi:20180715190656g:plain

上の表で書いた6_1の速度はたしか1,0で回しただけなので
実際はもうちょっと遅くなるかも。。

  • まとめ

んー。。。
今回は迷走の回でした。

やろうとおもったけどできなかったーということばかり。。。

でもメモリのことをちょっぴり学んだり
データ型について考えたりする機会にはなりました。

とりあえず覚えておけば何かの役に立つかな?
最後にVer6の正式バージョンのコードを載せます。

まずはlife_game_Ver6です。

Sub life_game_Ver6(f_size, return_time, q)

 Dim field As Range
 Dim gene As Integer
 Dim time_watch As Single
 Dim stock() As Integer
'---------------------------------
'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, 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_Ver6 " & f_size & ", """ & return_time & """," & q & "'"

End Sub

次にそれぞれの関数。
cell_jdg

Function cell_jdg(f_size, field, q) As Integer()
 Dim p1 As Variant
 Dim trgt  As Range
 Dim cnt As Integer
 Dim stock() As Integer
 
 ReDim stock(1 To f_size, 1 To f_size)
 
'------------------------------------------------
'field内の各セルに対して
'自身と周囲の計9マスの生きているセルを数えて
'それによって生死を判定します
'生きている場合はそのセルに対応するstockに1を入れる
'------------------------------------------------
 For Each p1 In field
    Set trgt = Range(p1.Offset(-1, -1), p1.Offset(1, 1))
    cnt = WorksheetFunction.Sum(trgt)

    Select Case p1.Value
        Case 1
            If cnt = 3 Or cnt = 4 Then
                stock(p1.Row - 1, p1.Column - 1) = 1
            End If
        Case Else
            If cnt = 3 Then
                stock(p1.Row - 1, p1.Column - 1) = 1
            End If
    End Select
    
 Next p1
 
 cell_jdg = stock
End Function

つぎはcontinue_jdg

Function continue_jdg(stock, q)
'-------------------------------
'stockがない場合
'全滅なのでstop
'-------------------------------
 'ここは今までとだいぶ違うアルゴリズムを考えているので
 '次のバージョンアップで書きます
'-------------------------------
'ループを終わらせたい場合
'cells(1,q)に何かを書き込めばstop
'-------------------------------
 If Cells(1, q) <> "" Then
    Stop
 End If
End Function

ここの処理の一部が放置しっぱなしになっていますね。。

最後がcell_dsc

Function cell_dsc(field, stock)
'-------------------------
'生存セルに1を書き込む
'-------------------------
 field = stock
End Function

基本的にバージョンアップは上位互換だと思っているので番号の低いバージョンのコードは全部消しています。
唯一Ver4_1だけは毛並みが違ったので残していますが。
でもこのブログのように低いバージョンのものも記事として残しておくと
また更新するたびにVerNの数字を上げていくと
自分の成長がはっきりと感じられていいですね。

コードを書くぐらいで成長していく今だけの楽しみかもしれませんが笑