VBAで暗号を実装しよう その3 ポリュビオス暗号
- はじめに
さてさて。
「暗号を実装しよう」の第3段です。
記事のストックがないので大急ぎで書いています笑
今回はポリュビオス暗号。
全く聞いたことない笑
- さっくと歴史
5*5の25マス目にアルファベットを入れて
各アルファベットを記入する代わりに
そのマス目の行列番号を記述していく
タイプのものです。
| 行列 | 1 | 2 | 3 | 4 | 5 |
|---|---|---|---|---|---|
| 1 | a | b | c | d | e |
| 2 | f | g | h | I,j | k |
| 3 | l | m | n | o | p |
| 4 | q | r | s | t | u |
| 5 | v | w | x | y | z |
この表がフォーマルタイプ。
Go home を伝達したい場合は
書き手は
22 34 23 34 32 15
のように変換して
読み手は
表を見ながら
Gohome
と復元します。
これももっと詳しく知りたい方はググってきてください笑
- とりあえず暗号化
96 93 13 35 21 48 45 17 46 76 54 56 93 43 81 28 54 72 24 93 43 21 56 36 39 75 32 92 57 57 63 51 92 99 26 64 54 81 51 76 76 35 19 28 87 35 76 81 14 91 81 73 27 44 36 19 72 26 14 57 44 67 81
わー。
きーもーちーわーるーいー。
ほんとにぞわぞわする。
自分は暗号に触れる適性がないのかな笑
これがポリュビオス暗号です。
本来は全角の空行は入らないでしょうが
原文の見やすさのために取り入れました。
- 暗号について
またまた能書き。
この手のものは換字式暗号といいます。
「かんじ」じゃなくて「かえじ」って読むらしいです。
文字を何かに置き換えるってやつですね。
今回は文字を数字に置き換えています。
文字と数字が一対一対応になっているので
換字表を知っている人同士では簡単に読み書きできます。
じゃあ換字表を知らない人が解読するにはどうすればいいのか。
これって無理ゲーっぽいですよね。。
だって対応の起こりうるパターン数が多すぎるのだもの。
スキュタレー暗号のように物量作戦はむりですね。
じゃあ最強の暗号だ！！
と思いきや
これも現代ではすでにザルの暗号になっています。
頻度分析と呼ばれる手法によって。
これは
文字の出現頻度と暗号文での換字の出現頻度を対応付けて復元していくやり方です。
9世紀にすでに解読法が記録されているみたいですね。
でもポリュビオス暗号が生まれた時期が紀元前1世紀であることを考えると
記録上では800~900年くらいは解読不能（正確には難しい？）なツールだったのかもしれませんね。
- 暗号化のコード
今回はまず換字表を用意する必要があるので
それを作成するコードから
Function pattern_make() Dim trgt As Range Dim t As Integer Dim list() As Variant Dim d(0 To 1) As Integer Dim rp As Range Dim div As Integer '---------------------- '作業用シートで並び替えて 'listに書き込む '---------------------- Sheets.Add For i = 1 To 83 Cells(i, 1) = Chr(-32097 + (i - 1)) Cells(i, 2) = Rnd() Next t = Cells(1, 1).End(xlDown).Row Set trgt = Range(Cells(1, 1), Cells(t, 2)) trgt.Sort Cells(1, 2), xlAscending list = trgt Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True '---------------------------- '換字表を作成する '---------------------------- Set rp = Cells(11, 1) div = 9 For i = 1 To UBound(list, 1) d(0) = (i - 1) \ div + 1 d(1) = (i - 1) Mod div + 1 rp.Offset(d(0), d(1)) = list(i, 1) Next End Function
コードの中のdivという変数も結構だいじです。
だたこれは根性さえあれば暗号文から読み取れますが。
次にメインの関数
Sub polybius_coding() Dim str As String Dim str2 As String '------------------ 'strを読み込む '------------------ str = txt_input '------------------ 'strを暗号化 '------------------ str2 = coding(str) '------------------ 'str2を記述 '------------------ Call txt_output(str2) End Sub
形式は前回のスタキュレー暗号とほとんど一緒ですね。
というか一緒になるようにしています。
このコードの肝は関数codingなのですが
それはもちろんスタキュレーとは違う仕様です。
以下詳細。
Function coding(str) As String Dim pattern() As Integer Dim char As String Dim num As Integer Dim ans As String ReDim pattern(1 To 83) '------------------------ '換字表を読み込む '------------------------ pattern = pattern_input '------------------------ 'strを暗号化 '------------------------ For i = 1 To Len(str) char = Mid(str, i, 1) num = Asc(char) + 32098 If num < 1 Or 83 < num Then ans = ans & char Else ans = ans & pattern(num) & " " End If Next coding = ans End Function
この中にもさらに関数pattern_inputが入っています。
それで換字表を認識して
それに沿った変換をそれ以降で行っています。
その中でも特にいい感じのコードはこれ。
If num < 1 Or 83 < num Then ans = ans & char Else ans = ans & pattern(num) & " " End If
これによって換字表に入っていない文字はそのままの形で暗号文に組み込まれます。
全角のスペースとか
“―”これとか
“。”これとか
がそのまま読み込まれます。
やりたい人は
上の記号たちも換字表に入れちゃえばいいのかなと思います。
多分簡単にできると思いますよー。
- 復元のコード
換字表を持っていない状態での復元には頻度分析を使うと思いますが
頻度分析のプログラミングは難しそうなので
今回はスルーします。
今回は換字表を持っている人が復元する方法だけで。
ちなみに換字表は以下の通り。
| 行列 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| 1 | ぇ | ぬ | か | ひ | し | げ | ゅ | ゐ | の |
| 2 | は | ど | ぺ | ほ | ゃ | も | つ | で | よ |
| 3 | そ | べ | ぞ | ぱ | い | る | び | ず | ふ |
| 4 | ぅ | む | ご | く | り | ぴ | へ | ぽ | ま |
| 5 | が | わ | ゆ | す | さ | あ | と | ゑ | ね |
| 6 | ぃ | や | ち | じ | せ | ゎ | ろ | め | ぼ |
| 7 | ぜ | に | を | づ | ぁ | お | み | え | ざ |
| 8 | う | ら | ぎ | ば | ぉ | だ | た | き | け |
| 9 | ょ | っ | ん | れ | ぶ | こ | ぐ | ぷ | て |
| 10 | ぢ | な |
まずはメイン
Sub polybius_restoration() Sheets("ポリュビオス").Activate Dim str As String Dim str2 As String '------------------ 'strを読み込む '------------------ str = txt_input '------------------ 'strを復元 '------------------ str2 = restoration(str) '------------------ 'str2を記述 '------------------ Call txt_output(str2) End Sub
次は関数coding
Function restoration(str) As String Dim pattern() As Integer Dim box As Variant Dim kaeji As Variant Dim d(0 To 1) As Integer Dim ans As String ReDim pattern(1 To 83) '------------------------ '換字表を読み込む '------------------------ pattern = pattern_input '------------------------ 'strを復元 '------------------------ box = Split(str, " ") kaeji = Range(Cells(12, 2), Cells(21, 10)) For i = LBound(box) To UBound(box) If Val(box(i)) = 0 Then ans = ans & box(i) Else d(0) = Mid(box(i), 1, Len(box(i)) - 1) d(1) = Right(box(i), 1) ans = ans & kaeji(d(0), d(1)) End If Next restoration = ans End Function
復元した結果はこちらー。
こんかいは ぽりゅぴおすあんごうです にほんごはあるふぁべっととちがって もじすうがおおいので たいおうひょうをつくるのにも ひとくろう
またしてもやる価値のない暗号化でした笑
あ。
そういえば換字表はシート上に出力しているので
そのセル番号がこのコードで考慮されていないものになってしまうと
正しく変換されなくなってしまいます。
これはちょっとシステムとして脆弱かも。。
どうやって解決しようかなー。
たぶんメモ帳に出力することになるんだろうけど。
今回はパスで。。
- まとめ
換字式の暗号は
換字表をどうやって共有するのかが肝ですね。
これを奪い取ることが一番楽な解読法な気がするもの笑
次回はまたちょっと「形式の修正」を行います。
関数の「txt_input」と「txt_output」に不満な部分があるので。。
具体的には
読み込み先、書き込み先のテキストファイルを選択できるようにします。
おわり。
VBAで暗号を実装しよう その2 暗号文をメモ帳で管理
- はじめに
前回スキュタレー暗号を扱いましたが
書いたコードで不便な場所があったので
ひとつ「形式の修正」をします。
- メモ帳を扱う
前回はシート上のセルから文字列を読み込んで
また別のセルに書き出していましたが
それだとちょっと不便かもしれないので
メモ帳から文字列を読み込んで
VBAで演算をして
結果をメモ帳に返す仕様にしましょう。
- コード
まずはファイルから文字列を読み込んで
その値を返す関数です。
Function txt_input() As String Dim ans As String Dim file_name As String file_name = "ここにファイルのアドレスを載せます" Open file_name For Input As #1 Line Input #1, ans Close #1 txt_input = ans End Function
次は演算した文字列データを
ファイルに書き出す関数です。
Function txt_output(str As String) Dim file_name As String file_name = "ここにファイルのアドレスを載せます" Open file_name For Output As #1 Print #1, str Close #1 End Function
- 組み込んでみよう
スキュタレー暗号に組み込んでみましょう。
関数をプログラムの中に組み込むことって
意外と難しいですよね。。
どこに組み込めばいいんだろう？？
という風になりがち。
Sub Scytare_coding() Sheets("スキュタレー").Activate Dim str As String Dim str2 As String '------------------ 'strを認識 '------------------ str = txt_input '------------------ 'strを暗号化 '------------------ str2 = coding(str) '------------------ 'str2を記述 '------------------ Call txt_output(str2) End Sub
各関数は既出なので
気になる方は前回の投稿を見てください。
機能を分割しておくと
その中のどれかをちょっと書き換えるだけで済むから楽ですね～
- まとめ
さっきも書いたのですが
機能を分割しておけば
仕様を変えたいときに変えやすいですね。
オブジェクト指向ではないのだろうけど
このやり方もまるっきり不便というわけではないかなと思っています。
VBAでパフォーマンスの良いライフゲームをつくろう その6 マシンの性能
- はじめに
前回終わりを宣言したこのコーナーですが
ちょっと試してみたいことがあったのでもう一回だけ。
- マシンを変えてみる
今まで使っていたのはMyノートパソコン
スペックはどうやって表現するのだろう
メモリは2Gです。
それに対して今回使ってみたのが
メモリが8Gのネカフェのパソコン。
Ver7とVer8_1を扱います。 F_sizeを100で計測。
ちなみにMyノートパソコンでの結果は前回の通り。
| ノートパソコン | ネカフェのパソコン | ||
|---|---|---|---|
| Ver7 | Ver8_1 | Ver7 | Ver8_1 |
| 調査終了0.046875 | 調査終了 0.1411133 | 調査終了0.03125 | 調査終了 0.046875 |
| 更新終了0.328125 | 更新終了 0.21875 | 更新終了0.046875 | 更新終了 0.03125 |
ちょっとみにくいですかね。。
ネカフェのパソコンのほうが段違いのスピードを出しています。
Ver7もVer8_1も等しく高速になりました。
このマシンではf_sizeが100では速いってことしかわからないですね。
Ver7とVer8.1それぞれの強みがどのf_sizeまで通用するのか。
もうちょっとf_sizeを上げて測りますか。
| Ver7 | Ver8_1 | |
|---|---|---|
| 100 | 0.03125 | 0.046875 |
| 0.078125 | 0.03125 | |
| 140 | 0.03125 | 0.078125 |
| 0.109375 | 0.03125 | |
| 180 | 0.046875 | 0.078125 |
| 0.125 | 0.054688 | |
| 450 | 0.140625 | 0.390015 |
| 0.6875 | 0.218018 | |
| 700 | 0.3125 | 0.935974 |
| 1.695313 | 0.218994 |
各f_sizeの1段目が調査時間で
2段目が更新時間です。
F_sizeを700くらいまでもっていくと
ひとつひとつのセルに書き込むことには無理があるみたいですね。
ただ1マスに700の文字列を入れることにも無理があるみたい。
んー。
これが次への布石になるだろうか。
ちなみにf_size700だと小さすぎてセルの動きがよくわからないです。
なんかざわざわしてる
くらいな見え方。
- まとめ
今回一番理解できたことは
マシンの性能が上がるとパフォーマンスも上がるということ。
まぁ。
現状でMyノートパソコンの性能を使いこなせているかは謎ですが。
たぶん使いこなせていないんだろうなぁ。
というわけで。
このコーナーは終了。
次回のコーナーもこうご期待。
VBAでパフォーマンスの良いライフゲームをつくろう その5 Ver7と8.1
- はじめに
このコーナーも第5回。
飽きたか飽きてないかでいうと
飽きてきました笑
- Ver7は配列
Ver7はめちゃ速くなります。
このアイディアは思い浮かんではいたものの
実装するとすごいめんどくさくなりそうだなー
と思って放置していたのですが
いいやり方を思いついたのでようやく実装できます。
シートへのアクセスを減らして速度を上げることが一番簡単な手法。
今回はまずシートの情報を配列に書いて
配列の中身を書き換えて
最後に配列をシートに貼り付けます。
今まではシートの情報を取得して
計算の結果を配列に書いて
最後に配列を貼り付ける
というやり方でした。
ちょっと中途半端なやり方でしたが
シート情報を配列に入れてしまうと配列のサイズを決められてしまいます。
ふつうはそれは便利な特徴なのですが
そうなってしまうと配列の中に「隅」や「端」ができてしまいます。
それらの周囲は8マスではなくなってしまうので
計算するのに特別なやり方が必要になってしまいます。
これはまぁ書けばいいのですがちょっと大変そうだなぁ
と思って書いていませんでした。
ただ今回思いつきました。
読み込むシート情報を本来必要なものより一回り大きく読み込めばいいんです。
たとえばRange(cells(2,2),cells(9,9))の88マスを扱いたい場合は
Range(cells(1,1),cells(10,10))の1010マスを読み込んで
実際に処理するのは8*8マス分にすれば解決します。
配列で説明すると
10*10のシート情報をStockに書き込むと
Stock(1 to 10, 1 to 10)として書き込まれます。
そしてcell_jdgでは
For i = 2 to 9 For j = 2 to 9 ‘処理をする Next Next
みたいにすれば大丈夫です。
ただ処理の仕方も今までとは少し違うのでcell_jdgのちゃんとしたコードを載せますね。
Function cell_jdg(f_size, stock, q) As Variant() Dim p1 As Variant Dim trgt As Range Dim cnt As Integer Dim ans() As Variant ReDim ans(1 To f_size + 2, 1 To f_size + 2) '------------------------------------------------ 'field内の各セルに対して '自身と周囲の計9マスの生きているセルを数えて 'それによって生死を判定します '生きている場合はそのセルに対応するans()に1を入れる '------------------------------------------------ For i = 2 To f_size + 1 For j = 2 To f_size + 1 cnt = stock(i - 1, j - 1) + stock(i - 1, j) + stock(i - 1, j + 1) + _ stock(i, j - 1) + stock(i, j) + stock(i, j + 1) + _ stock(i + 1, j - 1) + stock(i + 1, j) + stock(i + 1, j + 1) Select Case stock(i, j) Case 1 If cnt = 3 Or cnt = 4 Then ans(i, j) = 1 End If Case Else If cnt = 3 Then ans(i, j) = 1 End If End Select Next j Next i cell_jdg = ans End Function
これで速度がどうなるかというと。
| f_size\Version | Ver6_1 | Ver7 |
|---|---|---|
| 30 | 調査終了 0.078125 | 調査終了0.0078125 |
| 更新終了 0.0625 | 更新終了0.0546875 | |
| 50 | 調査終了 0.21875 | 調査終了0.0078125 |
| 更新終了 0.109375 | 更新終了0.109375 | |
| 70 | 調査終了0.4208984 | 調査終了0.015625 |
| 更新終了0.21875 | 更新終了0.15625 |
調査時間が30倍くらい？に上がりました。
更新時間はCell_dscをいじっていないので特に変わらず。
このコーナーの初めのほうで決めた目標が100*100のセルに対して1秒間隔で画面を更新していくことでした
なんだか行けそうなので試してみますか。
調査終了0.046875
更新終了0.328125
余裕ですね笑
これにてチャレンジクリア！
。。。
というのもあっけないですね。
Ver7にケチをつけるなら
更新速度の遅さ。
7070 つまり4900マスで0.15秒
100100 10000マスで0.32秒
これは遠からず壁が来ますね。
更新速度にこだわったVer8を作ってみましょう。
- 更新速度を上げよう
これはシンプルなやり方がありますよね。
書き込むセル数が肝なら
それを減らせばよい。
1行の内容を1つのセルに入れてみましょう。
ただしこれを行うと欠点もあります。
セルの条件付き書式が使えなくなることと
数値以外のものを扱わねばならいことと
１つのセルに対するデータ量が増えてしまうこと。
ちなみに初期画面はこんな感じです。
“■”が生きているセル
”□”が死んでいるセル
という風に表します。
速度を測るぞ～
いまさら100*100に耐えられない仕様は論外なので
F_sizeは100で計測します。
じゃん。
調査終了 0.1411133
更新終了 0.21875
ってこれだけじゃよくわからないですね。
先ほどのVer７と比較してみると
| Ver7 | Ver8 |
|---|---|
| 調査終了0.046875 | 調査終了 0.1411133 |
| 更新終了0.328125 | 更新終了 0.21875 |
んー。これは。。
更新速度は速くなりましたが
調査速度が遅くなりました。
トータルではいい勝負？
ちなみにf_sizeを150にしてみると。
| Ver7 | Ver8_1 |
|---|---|
| 調査終了0.078125 | 調査終了0.3276367 |
| 更新終了0.722168 | 更新終了0.4853516 |
んー。
両者のいいところ悪いところがはっきり出ていますね。
これは正式にはバージョンアップできないなぁ。
- まとめ
Ver7はVer6の意思を引き継がない形となってしまいました。
sheetの中身を配列に移すにはVariant型でないといけないらしいんですよね。
Ver8はうまいこといかなかったー
かといって悪いこともない。
Ver8_１としておきますか。
Ver7もVer8_1もいいところと悪いところがそれぞれあり
これらのいい点を統合出来たらバージョンアップということにしましょう。
ただちょっとやり方が思いつかないので
今回のライフゲームのコーナーはここまでにしましょうか。
当初の100*100はクリアしたしねっ
VBAでパフォーマンスの良いライフゲームをつくろう その4 迷走しながらもVer6まで更新
- はじめに
さて～！！
笑
今回はライフゲームの第4回ですね。
前回は配列をシートに模してそこにセル状態を書き込み
最後にシートに貼り付ける
という手法を取りました。
今回はVer５でできるだけ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と記入されたセルを黒く塗りつぶす仕様にしました。
そしてセルに記述される文字の色を白にしました。
上の表で書いた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の数字を上げていくと
自分の成長がはっきりと感じられていいですね。
コードを書くぐらいで成長していく今だけの楽しみかもしれませんが笑
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 |
あらまぁびっくり！
Ver３と調査速度はほとんど変わらず更新速度を3倍にひきあげました！
それにf_sizeが70以上ではVer4_1と同程度の更新時間！
これはめちゃ強いですよ！
ただf_sizeが50以下の場合ではVer4_1の処理は優秀ですね。
これは捨てがたい魅力です。
- まとめ
とりあえずVer4_2を正式のバージョンアップVer4としますが。
Ver4_1も捨てずに残しておきます。
何かを改善すれば最強のアルゴリズムになるかもですので。。
あ。そういえばしれっと更新した部分があります。
「initialization」のコードもVer4_2式に変更しました。
あとは「mother」にｑという変数を増やしました。
世代を表示するセルなどを固定しないための変数です。
これをつけないと大事なセルが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まで書いてしまっていることがつらい。。。
こういう意味でも根幹の機能面ではない
いうなれば「デザイン面」は初めに整えておかないとひたすら面倒なことになります。。
ただ元の素養がないのでこうして面倒な思いをしてあげていくしかないのか。。。
よく言えば「不器用」なやりかた。
不器用に「」がつくと良いイメージがあります笑
今回はここでおわり。
VBAでパフォーマンスの良いライフゲームをつくろう その2 関数への分割とユーザーフォーム
- はじめにの前に
この記事は以前に「見たまま」編集であげたものを「Markdown」に変更したものです。
載せているコードの見易さのために移しました。
- はじめに
この記事はとっくにあげていたつもりが
あげわすれていました。
あんまり本稿とは関係のない、リアルタイムとのずれの話を。
ノートパソコンを買ってからは記事をワードに書いておいて時期を見計らって投稿しているのですが
記事をストックしておくと当然ながら「今の自分」とのずれが生じますよね。
特に今回のようなバージョンを更新していくコーナーではめちゃくちゃ違和感があります。
明らかな「過去の自分」を発表しているような変な感覚。
現在の自分はこの投稿のコードを書いた時よりは進化しているのでほんとに変な感じです。
この投稿ではバージョンを1から3にあげるのですが
リアルタイムではもっと更新されています。
フリーザじゃないけどこのコードはあと5段階強くなります。。。
違和感。
でもそれって何かを発信するときには少なからず感じることなのかもしれませんね。
起きてから発信するまでには時差があるので。
今まではブログをその場で書いたらその場で投稿していたのであまりその違和感は感じませんでしたが
今後はそういった感覚にも慣れないとなぁ。
例えば集団で何かをしようとか、人に何かをさせようと思ったらこの違和感をより感じるでしょうしね。
（実はさいきん、プログラミング初心者にjavaを教えて、自分の書いてほしいコードを書いてくれるマンを育てようとしているのですが、それはまた別のコーナーで。たぶん次のコーナーで書きます）
- 関数への分割
可読性をあげるためにlife_game_Ver2の各フェイズを関数に書き換えました。
些細なことですが、何度もコードを書き換えていく場合は細かく関数に分けておくことが吉だと思います。
Sub life_game_Ver3() Dim kigou As String Dim f_size As Integer Dim field As Range Dim gene As Integer Dim time_watch As Single Dim stock() As String '--------------------------------- 'geneは世代数を記録するためのセル '--------------------------------- gene = Cells(1, 26 * 3 + 2).Value '------------------------------ '生きているセルには■を入れます '------------------------------ 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)) '------------------------------------- '調査フェイズの計測 '------------------------------------- time_watch = Timer stock() = cell_jdg(field, kigou) Debug.Print "調査終了" & Timer - time_watch '-------------------------------------- '更新フェイズの計測 '-------------------------------------- time_watch = Timer Call continue_jdg(stock) Call cell_dsc(stock, kigou) Debug.Print "更新終了" & Timer - time_watch '------------------------- '世代数を更新する '------------------------- Cells(1, 26 * 3 + 2).Value = gene + 1 '--------------------------------- 'このプロシージャを頭から繰り返す '--------------------------------- Application.OnTime Now() + TimeValue("0:00:02"), "life_game_Ver3" End Sub
続いてそれぞれの関数です。
まずはcell_jdg。
これは各セルの次世代の状態を判定する関数です。
内容はVer2と同じです。
Function cell_jdg(field, kigou) As String() Dim trgt As Range Dim p1 As Variant Dim p2 As Variant Dim cnt As Integer Dim stock() As String Dim num As Integer num = 0 ReDim stock(num) '------------------------------------------------ '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 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 cell_jdg = stock End Function
次はcontinue_jdg。
繰り返し処理を行うかを決めます。
Function continue_jdg(stock) '------------------------------- 'stockがない場合 '全滅なのでstop '------------------------------- If stock(0) = "" Then Stop End If '------------------------------- 'ループを終わらせたい場合 'cells(1,52)に何かを書き込めばstop '------------------------------- If Cells(1, 26 * 3) <> "" Then Stop End If End Function
最後がcell_dsc。
次世代に生存するセルを記述します。
Function cell_dsc(stock, kigou) Dim p1 As Variant '------------------------------ 'いったんシートをまっさらに '------------------------------ Cells.ClearContents '------------------------- '生存セルに■を書き込む '------------------------- For Each p1 In stock Range(p1) = kigou Next p1 End Function
はい。
これで関数への分割が終わりました。
ただこれだけでVer3に更新というのも味気がないので
もう一つ追加というか整理をします。
- ユーザーフォームによる変数の指定
今使っているコードは「initialization」と「life_game_verN」のふたつです。
現状ではf_sizeを変更するためにはそれぞれのコード内のf_sizeを書き換えないといけないので面倒くさいです。
ほかにも何かの変数の中身を変えたい場合に二度手間になってしまうのは情けない。
なのでそれらをまとめて管理するコードを書きます。
見やすさを重視したいのでユーザーフォームを作りましょう。
ユーザーフォームは「中学数学」のコーナーでだいぶ慣れた気がします。
ユーザーフォームの名前は「mother」にします。
自分なりのコードネーム？をいろいろ使うのにあこがれています笑
ユーザーフォームの見た目はこんな感じ。
今回は水色系にしてみました。
せっかくなのでf_sizeだけでなく
kigouとreturn_timeもここで指定します。
return_timeはOnTimeに入れる値です。
ここで何秒おきに繰り返すかも指定します。
続いてユーザーフォームのコードを。
Private Sub CmdB1_Click() Dim f_size As Integer Dim kigou As String Dim return_time As String Dim field As Range '----------------------------- 'フォームの数値の読み込み '----------------------------- 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)) '---------------------------- '実行コードの決定 '---------------------------- Select Case True Case OB1 Call initialization(f_size, kigou, field) Case OB2 Call life_game_Ver3(f_size, return_time, kigou) End Select End Sub
当然ですがこれによって「initialization」と「life_gae_VerN」の中身も少し変わります。
Sub initialization(f_size, kigou, field) Dim p1 As Variant Cells.ClearContents '----------------------------------------------------- 'fieldのセルひとつひとつに '一定の確率で■を入れます '----------------------------------------------------- For Each p1 In field If Rnd() < 0.5 Then Range(p1.Address) = kigou End If Next p1 End Sub
life_game_VerNのほうは。。。
Sub life_game_Ver3(f_size, return_time, kigou) 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, 26 * 3 + 2).Value '------------------------------------- '調査フェイズの計測 '------------------------------------- time_watch = Timer stock() = cell_jdg(field, kigou) Debug.Print "調査終了" & Timer - time_watch '-------------------------------------- '更新フェイズの計測 '-------------------------------------- time_watch = Timer Call continue_jdg(stock) Call cell_dsc(stock, kigou) Debug.Print "更新終了" & Timer - time_watch '------------------------- '世代数を更新する '------------------------- Cells(1, 26 * 3 + 2).Value = gene + 1 '--------------------------------- 'このプロシージャを頭から繰り返す '--------------------------------- Application.OnTime Now() + TimeValue(return_time), _ "'life_game_Ver3 """ & f_size & """, """ & return_time & """ , """ & kigou & """'" End Sub
こんな感じです。
これでユーザーフォームでいくつかの変数を扱えます。
各プロシージャで定義する必要がなくなったのでコードの見た目もすっきりしました。
Ver3はここまで。
本当はVer１でこのくらいのレベルまで行ってもいいはずなのですが。
二度もバージョンアップしたのにまだ体裁の面しかいじれていない。。
まだまだ修行不足ですね。
- まとめ
実はこの記事を書く前にVer2の機能面を変更したVer3とVer4を書いたのですが
速度を測る際にあちこちのコード内の数字をいじって走らせることにストレスを感じたのでこのVer3をはさむことにしました。
なので実はVer4とVer5もすでにできているのですが
記事に書くのは次回になりそうです。。
もうVer6とVer7での変更点も決めているのに。。
これはプログラミングうんぬんよりは計画性の問題な気がします。
もう少しまともになろう。
