【VBA編】ニューラルネットワーク（classInputUnit, classUnit）
入力層のユニットクラス
入力層のみ実装が異なります。
'[classInputUnit - 入力層のユニットクラス] Option Explicit Dim mX As Double '入力データをセットする '[引数] <- inputData : Double / 入力データ Public Property Let X(ByRef aInputData As Double) mX = aInputData End Property '入力データを返す '[戻り値] -> X : Double / 入力データ Public Property Get X() As Double X = mX End Property
ユニットクラス
ユニットクラスの実装です。
'[classUnit - ユニットクラス] Option Explicit Option Base 1 Dim mWeightList() As Double '重みのリスト Dim mBias As Double 'バイアス Dim mU As Double '活性化関数適用前の合計値 Dim mZ As Double '出力値 'パラメータ（重みとバイアス）を初期化する '[引数] <- aWeightCount : Long / 重みの数 Public Sub Initialize(ByRef aWeightCount As Long) Dim i As Long ReDim mWeightList(aWeightCount) '各重みをランダム値で初期化 For i = 1 To aWeightCount mWeightList(i) = ML.getRandom() Next 'バイアスを0で初期化 mBias = 0 End Sub '活性化関数適用前の合計値を計算する '入力値にそれぞれの重みを掛けてバイアス値を加える '[引数] <- aInputDataList() : Double / 入力値のリスト Public Sub CalcU(ByRef aInputDataList() As Double) Dim i As Long mU = mBias For i = 1 To UBound(aInputDataList) mU = mU + (mWeightList(i) * aInputDataList(i)) Next End Sub '活性化関数適用前の合計値を返す '[戻り値] -> U : Double / 活性化関数適用前の合計値 Public Property Get U() As Double U = mU End Property '出力値を格納する '[引数] <- aActivatedU : Double / 活性化関数適用後の合計値 Public Property Let Z(ByRef aActivatedU As Double) mZ = aActivatedU End Property '出力値を返す '[戻り値] -> Z : Double / 出力値 Public Property Get Z() As Double Z = mZ End Property 'バイアス値をセットする '[引数] <- aBias : Double / バイアス値 Public Sub SetBias(ByRef aBias As Double) mBias = aBias End Sub 'バイアス値を返す '[戻り値] -> GetBias : Double / バイアス値 Public Function GetBias() As Double GetBias = mBias End Function '重みをセットする '[引数] <- aIndex : Long / インデックス, aW : Double / 重み Public Sub SetW(ByRef aIndex As Long, ByRef aW As Double) mWeightList(aIndex) = aW End Sub '重みを返す '[引数] <- aIndex : Long / インデックス '[戻り値] -> GetW : Double / 重み Public Function GetW(ByRef aIndex As Long) As Double GetW = mWeightList(aIndex) End Function 'バックプロパゲーション（重みを更新する） '（学習率 × 勾配 × 入力値）の計算結果を重みから引いて、重みを更新する 'バイアスも同様に計算する（ただし、バイアスの入力値は 1） '[引数] <- aDelta : Double / 勾配の計算結果, aInputDataList() : Double / 入力値のリスト 'Public Sub UpdateWeight(ByRef aDelta As Double, ByRef aInputDataList() As Double) Public Sub Backprop(ByRef aDelta As Double, ByRef aInputDataList() As Double) Dim i As Long For i = 1 To UBound(mWeightList) mWeightList(i) = mWeightList(i) - (G.LearningRate * aDelta * aInputDataList(i)) Next mBias = mBias - (G.LearningRate * aDelta * 1) End Sub
【VBA編】ニューラルネットワーク（ML）
演算用モジュール
活性化関数や損失関数を実装します。
'[ML - マシンラーニング演算用モジュール] Option Explicit Option Base 1 '活性化関数 ReLU '[引数] <- aU : Double / ユニットの u '[戻り値] -> actReLU : Double / ReLU適用後の値 Public Function actReLU(ByVal aU As Double) As Double actReLU = WorksheetFunction.max(aU, 0) End Function '活性化関数 Softmax '[引数] <- aUList() : Double / 出力層のすべての出力値のリスト, aIndex : Long / 対象のユニットのインデックス '[戻り値] -> actSoftmax : Double / Softmax適用後の値 Public Function actSoftmax(ByRef aUList() As Double, ByRef aIndex As Long) As Double Dim i As Long Dim max As Double Dim sum As Double 'オーバーフロー対策ですべての出力値から最大値を引く必要があるため最大値を求めておく max = WorksheetFunction.max(aUList) '分母部分の計算 sum = 0 For i = 1 To UBound(aUList) sum = sum + Exp(aUList(i) - max) Next '該当ユニットの出力値を全出力値で割る actSoftmax = Exp(aUList(aIndex) - max) / sum End Function '-1 < num < 1 で0以外のランダム値を返す '[戻り値] -> getRandom() : Double / -1 より大きく 1 より小さいランダム値（0以外） Public Function getRandom() As Double Dim i As Long Dim res As Double Randomize Do res = (Rnd * 2) - 1 Loop Until res <> 0 getRandom = res End Function '損失関数 クロスエントロピーエラー '[引数] <- aT() : Long / 正解ラベル（one-hot表現された教師データ）, ' aZ : Double / ニューラルネットワークの出した予想確率（出力層ユニットの出力値） '[戻り値] -> crossEntropyError : Double / crossEntropyErrorの値 Public Function crossEntropyError(ByRef aT() As Long, ByRef aZ() As Double) As Double Dim i As Long Dim res As Double res = 0 For i = 1 To UBound(aT) res = res + (aT(i) * Log(aZ(i) + 0.0000001)) 'エラー回避のために微小な値を足している Next res = res * -1 crossEntropyError = res End Function
【VBA編】ニューラルネットワーク（ws_Main, G, mdlReadData）
ファイル指定処理
読み込むデータのCSVファイルを指定するコードです。
「ws_Main」シートに記述します。
'[ws_Main - シートオブジェクト] Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim filePath As String If Target = Range(G.RNG_TRAIN_DATA_PATH) _ Or Target = Range(G.RNG_TEST_DATA_PATH) Then Cancel = True filePath = Application.GetOpenFilename("CSV ファイル,*.csv") If filePath <> "False" Then Target.Value = filePath End If End If End Sub
標準モジュール
標準モジュールで作成する処理です。
定数やグローバル変数の宣言
標準モジュール「G」に以下のコードを書きます。
'[G - 標準モジュール] Option Explicit Public Const RNG_TRAIN_DATA_PATH As String = "C2" '訓練データのパスを格納するセル Public Const RNG_TEST_DATA_PATH As String = "C3" 'テストデータのパスを格納するセル Public Const RNG_LEARNING_RATE As String = "C7" '学習率を指定するセル Public Const RNG_MIN_LOSS As String = "C8" '学習終了と判断する損失値を指定するセル Public Const RNG_MAX_EPOCH As String = "C9" '最大何回学習するか（エポック数）を指定するセル Public Const RNG_ACT_HIDDEN As String = "C10" '隠れ層の活性化関数を指定するセル Public Const RNG_ACT_OUTPUT As String = "C11" '出力層の活性化関数を指定するセル Public Const RNG_W_LOAD As String = "C13" '重みの値をロードするかどうかを指定するセル Public Const RNG_TRAIN_CORRECT_COUNT As String = "F7" '訓練時の正解数を格納するセル Public Enum RW DATA_TITLE = 1 'データのタイトル行 DATA_START = 2 'データの開始行 End Enum Public Enum CL DATA_LABEL = 1 'データのラベル列 DATA_START = 2 'データの開始列 RESULT_LABEL = 1 '結果のラベル列 RESULT_ANSWER = 2 '結果の答え列（ニューラルネットの答え） RESULT_RATE = 3 '答えの自信度列 RESULT_TF = 4 '答えが正解かどうかを表す列 LOSS_ = 11 '損失関数の値 LOSS_CORRECT = 12 '正解数 End Enum '活性化関数の種類 Public Const VAL_ACT_ReLU As String = "ReLU" Public Const VAL_ACT_Softmax As String = "Softmax" '活性化関数の種類インデックス Public Enum ACT ReLU = 1 Softmax = 2 End Enum 'Irisの種類名 Public Const VAL_SETOSA As String = "Iris-setosa" Public Const VAL_VERSICOLOR As String = "Iris-versicolor" Public Const VAL_VIRGINICA As String = "Iris-virginica" 'Irisの種類インデックス Public Enum IRIS SETOSA = 1 VERSICOLOR = 2 VIRGINICA = 3 End Enum Public UnitCount_IN As Long '入力層のユニット数 Public UnitCount_OUT As Long '出力層のユニット数 Public UnitCount_H1 As Long '隠れ層１のユニット数 Public UnitCount_H2 As Long '隠れ層２のユニット数 Public LearningRate As Double '学習率
データの読み込み
'[mdlReadData - 標準モジュール] Option Explicit 'データの読み込み Public Sub Click_データ読み込み() Dim filePath As String Application.ScreenUpdating = False '訓練データの読み込み filePath = Range(G.RNG_TRAIN_DATA_PATH).Value Call readData(ws_Train_Data, filePath) '訓練データを標準化する Call standardizeData(ws_Train_Data, ws_Train_Data_Input) 'テストデータの読み込み filePath = Range(G.RNG_TEST_DATA_PATH).Value Call readData(ws_Test_Data, filePath) 'テストデータを標準化する Call standardizeData(ws_Test_Data, ws_Test_Data_Input) Application.ScreenUpdating = True MsgBox "データを読み込みました。", vbOKOnly + vbInformation End Sub 'データを読み込んで書き込み先のワークシートに書き込む '[引数] <- aWsData : Worksheet / 読み込んだデータを書き込む先のシート, aFilePath : String / CSVデータのファイル名 '[戻り値] -> なし Private Sub readData(ByRef aWsData As Worksheet, ByRef aFilePath As String) Dim fileNo As Long Dim r As Long Dim i As Long Dim data As String Dim datas() As String Dim dataLength As Long Const DELIMITER As String = "," With aWsData .Cells.Clear r = 1 fileNo = FreeFile Open aFilePath For Input As #fileNo Do Until EOF(1) Line Input #fileNo, data datas = Split(data, DELIMITER) dataLength = UBound(datas) 'splitはoption base 1の影響を受けないのでインデックスは0からスタート For i = 0 To dataLength .Cells(r, i + 1).Value = datas(i) Next r = r + 1 Loop Close #fileNo End With End Sub 'ワークシートのデータを標準化して書き込み先のワークシートに書き込む '[引数] <- aWsData : Worksheet / 元データがあるシート, aWsStandardized : Worksheet / 標準化したデータを書き込む先のシート '[戻り値] -> なし Private Sub standardizeData(ByRef aWsData As Worksheet, ByRef aWsStandardized As Worksheet) Dim r As Long Dim c As Long Dim i As Long Dim eRow As Long Dim eCol As Long Dim mean As Double '平均値 Dim std As Double '標準偏差 aWsStandardized.Cells.Clear With aWsData '最終行と最終列を取得する eRow = .Cells(Rows.count, 1).End(xlUp).Row eCol = .Cells(1, Columns.count).End(xlToLeft).Column '列ごとに処理 For c = CL.DATA_START To eCol '平均値と標準偏差を求める mean = WorksheetFunction.Average(.Range(.Cells(RW.DATA_START, c), .Cells(eRow, c)).Value) std = WorksheetFunction.StDev_P(.Range(.Cells(RW.DATA_START, c), .Cells(eRow, c)).Value) '標準化を行う For r = RW.DATA_START To eRow aWsStandardized.Cells(r, c).Value = WorksheetFunction.Standardize(CDbl(.Cells(r, c).Value), mean, std) Next Next 'タイトル行とラベル列をコピー貼り付け .Rows(RW.DATA_TITLE).Copy Destination:=aWsStandardized.Rows(RW.DATA_TITLE) .Columns(CL.DATA_LABEL).Copy Destination:=aWsStandardized.Columns(CL.DATA_LABEL) End With End Sub
【VBA編】ニューラルネットワーク（メイン画面）
メイン画面の数式
数式はこのように入っています。
C列の値はとりあえずこんな感じで。
モジュールとシート
必要な標準モジュール、クラスモジュールは以下の通りです。
【標準モジュール】
| オブジェクト名 | 用途 |
|---|---|
| G | 定数やグローバル変数の宣言用 |
| mdlReadData | データの読み込みに使用 |
| mdlSupervisor | 全体の制御に使用 |
| ML | マシンラーニングの演算に使用 |
【クラスモジュール】
| オブジェクト名 | 用途など |
|---|---|
| classInputLayer | 入力層の管理に使用 |
| classHiddenLayer | 隠れ層の管理に使用 |
| classOutputLayer | 出力層の管理に使用 |
| classInputUnit | 入力用ユニット |
| classUnit | 隠れ層、出力層用ユニット |
必要なシートは以下の通りです。
【シート】
| オブジェクト名 | シート名 | 用途 |
|---|---|---|
| ws_Main | main | メインのシート |
| ws_Test_Data | テストデータ | 読み込んだテストデータの格納に使用 |
| ws_Test_Data_Input | テストデータ（入力） | 入力用テストデータの格納に使用 |
| ws_Test_Result | テスト結果 | テスト結果の出力に使用 |
| ws_Train_Data | 訓練データ | 読み込んだ訓練データの格納に使用 |
| ws_Train_Data_Input | 訓練データ（入力） | 入力用訓練データの格納に使用 |
| ws_Train_Result | 訓練結果 | 訓練結果の出力に使用 |
| ws_W_H1 | w_h1 | 隠れ層１層めの重みの出力に使用 |
| ws_W_H2 | w_h2 | 隠れ層２層めの重みの出力に使用 |
| ws_W_Out | w_out | 出力層の重みの出力に使用 |
| ws_WI_H1 | wi_h1 | 隠れ層１層めの重みの初期値の出力に使用 |
| ws_WI_H2 | wi_h2 | 隠れ層２層めの重みの初期値の出力に使用 |
| ws_WI_Out | wi_out | 出力層の重みの初期値の出力に使用 |
すべて追加するとこのようになります。
【VBA編】ニューラルネットワーク（全コード）
全コード掲載
なかなか更新の時間がとれず、ずいぶんと放置してきてしまい、未完に終わってしまうのも何なのでいくつかに記事を分けて全コードを載せていきます。
概要とデータ
メイン画面
ws_Main, G, mdlReadData
classInputUnit, classUnit
classInputLayer
classHiddenLayer
classOutputLayer
mdlSupervisor
【VBA】あみだくじを作ってみる【再帰】
Excel VBA であみだくじを作ろう！
コロ子さんのブログに触発されて以前 Excel VBA で作ったあみだくじを記事にしてみました。コロ子さんとはアプローチの仕方が違いますが、実現にはいろいろな方法がありますね。
koroko.hatenablog.com
シートの作成
まずはシートの作成です。セルを方眼紙状（エクセル方眼紙）にしてあみだを作ります。
今回は幅を24px、高さを25px にしていますが、このあたりはお好みで。
あみだのルート（線）はグレーにしていますが、これもお好みで大丈夫です。
横線はこの通りでなくても構いません。
なお、A2セルの色を線の色と同じ（今回はグレー）にしておいてください。
シート名は「あみだくじ」としました。
VBAProject
コードを書く準備をします。
先ほど作成した「あみだくじ」シートのオブジェクト名を「wsMain」にします。
また、標準モジュールを追加しましょう。コードは標準モジュールに書いていきます。
標準モジュールのオブジェクト名はなんでもかまいませんが、ここでは「mdlMain」としています。
コードの作成
モジュールレベル変数の宣言
モジュールレベル変数を宣言します。
myColor は 「あみだくじ」シートの 1行目の各番号の色を格納する変数です。
baseColor は 「あみだくじ」シートの背景セルの色です。今回はエクセル的には「塗りつぶしなし」になっていますが、好みで他の色にしてもかまいません。
'[標準モジュール] Option Explicit Dim myColor As Long '自分の色 Dim baseColor As Long '地（背景）セルの色
くじを選ぶ
くじを選ぶ処理を書いていきます。インプットボックスで何番を選ぶかを聞いて、選んだ番号によって、スタートの列を決定しています。
1, 2, 3, 4, 9 以外が入力された場合は、再度入力を促すようにしました。9が入力されたら処理を終了します。
入力された番号で、列をセットします。
1 のときは 3列目、2 のときは 7列目、3 のときは 11列目、4 のときは 15列目 なので、Select Case で振り分けても構いませんが、今回は計算で求めてみました。
3列目、7列目、11列目、15列目なので、3, 7, 11, 15 の数列になっています。これは、初項 3、交差 4 の等差数列です。この等差数列の一般項を求める式は
よって
n が 1 のときは 、n が 2 のときは
となって、求める結果が得られていることがわかります。
列をセットしたら、行の初期値として 変数 r に 1 を代入しておきます。
Public Sub Click_スタート() Dim r As Long '行番号 Dim c As Long '列番号 Dim idx As Long 'どれを選ぶか 'どれを選ぶか？ Do idx = Val(InputBox("何番を選択しますか？（9で終了）")) '入力された数字から該当の列番号を計算する If 0 < idx And idx <= 4 Then c = (4 * idx) - 1 ElseIf idx = 9 Then Exit Sub Else c = 0 End If ' よくわからなければこちらでも… ' Select Case idx ' Case 1 ' c = 3 ' Case 2 ' c = 7 ' Case 3 ' c = 11 ' Case 4 ' c = 15 ' Case 9 ' Exit Sub ' Case Else ' c = 0 ' End Select Loop Until c > 0 r = 1 'ここにあみだくじ実行処理を記述 End Sub
色を取得する
くじの番号が決まったら、該当する色を取得して変数 myColor に格納します。
あわせて、背景色を変数 baseColor に格納します。今回は A1 セルの色を背景色として設定しています。
Public Sub Click_スタート() Dim r As Long '行番号 Dim c As Long '列番号 Dim idx As Long 'どれを選ぶか 'どれを選ぶか？ Do idx = Val(InputBox("何番を選択しますか？（9で終了）")) '入力された数字から該当の列番号を計算する If 0 < idx And idx <= 4 Then c = (4 * idx) - 1 ElseIf idx = 9 Then Exit Sub Else c = 0 End If Loop Until c > 0 r = 1 '**** ここから追加 **** With wsMain '自分の色を取得 myColor = .Cells(r, c).Interior.Color 'A1セルから地（背景）の色を取得 baseColor = .Range("A1").Interior.Color 'あみだくじ実行 'ゴールに "eureka!" を表示 End With '**** ここまで **** End Sub
あみだ実行部分（amidaDrive()）の実装
次のようなロジックであみだを進めています。詳しくはコード中のコメントを参考にしてください。
もし、右に行けるならば
右に行く
違えば、もし、左に行けるならば
左に行く
違えば、もし、下に行けるならば
下に行く
違えば
ゴール
プロシージャの最後に再帰呼び出しをしています。再帰呼び出しはゴールに到達するまで続きます。
'あみだくじの実行プロシージャ '引数 <- goNext:次に行けるかどうか、r:行番号、c:列番号 '戻り値 -> 次に行けたかどうか Private Function amidaDrive(ByRef goNext As Boolean, ByRef r As Long, ByRef c As Long) As Boolean If Not goNext Then '次に行けてなければそのまま goNext を返す（goNext は False になっています） amidaDrive = goNext '（amidaDrive = False のほうが直感的にわかりやすいかも） Else With wsMain '動きをわかりやすくするためのウェイト Application.Wait [Now()+"00:00:00.2"] '自分のいるセルを自分の色で着色する .Cells(r, c).Interior.Color = myColor '次に行けるかどうかを判定（この時点では goNext は True で渡されてきています） If .Cells(r, c + 1).Interior.Color <> baseColor And .Cells(r, c + 1).Interior.Color <> myColor Then '右のセルの色が、地の色でない かつ 自分の色でない 場合（＝グレーか もしくは 自分以外のプレイヤーの色 の場合）は右に行く c = c + 1 ElseIf .Cells(r, c - 1).Interior.Color <> baseColor And .Cells(r, c - 1).Interior.Color <> myColor Then '右に行けなかった場合で、左のセルの色が、地の色でない かつ 自分の色でない 場合は左に行く c = c - 1 ElseIf .Cells(r + 1, c).Interior.Color <> baseColor And .Cells(r + 1, c).Interior.Color <> myColor Then '右にも左にも行けなかった場合で、下のセルの色が、地の色でない かつ 自分の色でない 場合は下に行く r = r + 1 Else '右にも左にも下にも行けない場合は次には行けないので goNext に False をセット goNext = False End If '上記の判定処理を元に自プロシージャを再帰呼び出し amidaDrive = amidaDrive(goNext, r, c) End With End If End Function
あみだ実行部分の呼び出し
上で作成した「amidaDrive()」を呼び出します。「amidaDrive()」はゴールに到達するまで再帰処理を続けます。
変数 r と c は参照渡しで渡されているので、再帰処理中に更新されていきます。
処理が終了したときにはゴールのセルの行番号、列番号が格納されています。
到達したセルの 1 つ下のセルに「eureka!」と表示します。なぜ「eureka!」なのかというと、それはまぁ、アミダ（アミタ）ドライブですから（ｗ
Public Sub Click_スタート() Dim r As Long '行番号 Dim c As Long '列番号 Dim idx As Long 'どれを選ぶか 'どれを選ぶか？ Do idx = Val(InputBox("何番を選択しますか？（9で終了）")) '入力された数字から該当の列番号を計算する If 0 < idx And idx <= 4 Then c = (4 * idx) - 1 ElseIf idx = 9 Then Exit Sub Else c = 0 End If Loop Until c > 0 r = 1 With wsMain '自分の色を取得 myColor = .Cells(r, c).Interior.Color 'A1セルから地（背景）の色を取得 baseColor = .Range("A1").Interior.Color '**** ここから追加 **** 'あみだくじ実行 Call amidaDrive(True, r, c) 'ゴールに "eureka!" を表示 ' r と c は参照渡しされているため最後にいるセルの行と列に更新されています If .Cells(r + 1, c).Interior.Color = baseColor Then .Cells(r + 1, c).Value = "eureka!" End If '**** ここまで **** End With End Sub
復帰処理
着色された線の色を元に戻す処理です。
線の色は A2 セルから取得しています。
Public Sub Click_復帰() Dim r As Long Dim c As Long Dim lastRow As Long Dim lastColumn As Long Dim lineColor As Long With wsMain 'A1セルから地（背景）の色を取得 baseColor = .Range("A1").Interior.Color 'A2セルから線の色を取得 lineColor = .Range("A2").Interior.Color 'あみだの範囲を取得する With .UsedRange lastRow = .Item(.Count).Row lastColumn = .Item(.Count).Column End With For r = 2 To lastRow For c = 3 To lastColumn If .Cells(r, c).Interior.Color <> baseColor Then .Cells(r, c).Interior.Color = lineColor End If Next Next .Rows(lastRow).ClearContents End With End Sub
完成
ボタンを２つ作ってそれぞれに「Click_スタート」と「Click_復帰」を登録します。
これであみだくじの完成です。ぜひ動かしてみてください！
全コード（再掲）
'[標準モジュール] Option Explicit Dim myColor As Long '自分の色 Dim baseColor As Long '地（背景）セルの色 'メインのエントリポイントです。このプロシージャから実行してください。 Public Sub Click_スタート() Dim r As Long '行番号 Dim c As Long '列番号 Dim idx As Long 'どれを選ぶか 'どれを選ぶか？ Do idx = Val(InputBox("何番を選択しますか？（9で終了）")) '入力された数字から該当の列番号を計算する If 0 < idx And idx <= 4 Then c = (4 * idx) - 1 ElseIf idx = 9 Then Exit Sub Else c = 0 End If ' よくわからなければこちらでも… ' Select Case idx ' Case 1 ' c = 3 ' Case 2 ' c = 7 ' Case 3 ' c = 11 ' Case 4 ' c = 15 ' Case 9 ' Exit Sub ' Case Else ' c = 0 ' End Select Loop Until c > 0 r = 1 With wsMain '自分の色を取得 myColor = .Cells(r, c).Interior.Color 'A1セルから地（背景）の色を取得 baseColor = .Range("A1").Interior.Color 'あみだくじ実行 Call amidaDrive(True, r, c) 'ゴールに "eureka!" を表示 ' r と c は参照渡しされているため最後にいるセルの行と列に更新されています If .Cells(r + 1, c).Interior.Color = baseColor Then .Cells(r + 1, c).Value = "eureka!" End If End With End Sub 'あみだくじの実行プロシージャ '引数 <- goNext:次に行けるかどうか、r:行番号、c:列番号 '戻り値 -> 次に行けたかどうか Private Function amidaDrive(ByRef goNext As Boolean, ByRef r As Long, ByRef c As Long) As Boolean If Not goNext Then '次に行けてなければそのまま goNext を返す（goNext は False になっています） amidaDrive = goNext '（amidaDrive = False のほうが直感的にわかりやすいかも） Else With wsMain '動きをわかりやすくするためのウェイト Application.Wait [Now()+"00:00:00.2"] '自分のいるセルを自分の色で着色する .Cells(r, c).Interior.Color = myColor '次に行けるかどうかを判定（この時点では goNext は True で渡されてきています） If .Cells(r, c + 1).Interior.Color <> baseColor And .Cells(r, c + 1).Interior.Color <> myColor Then '右のセルの色が、地の色でない かつ 自分の色でない 場合（＝グレーか もしくは 自分以外のプレイヤーの色 の場合）は右に行く c = c + 1 ElseIf .Cells(r, c - 1).Interior.Color <> baseColor And .Cells(r, c - 1).Interior.Color <> myColor Then '右に行けなかった場合で、左のセルの色が、地の色でない かつ 自分の色でない 場合は左に行く c = c - 1 ElseIf .Cells(r + 1, c).Interior.Color <> baseColor And .Cells(r + 1, c).Interior.Color <> myColor Then '右にも左にも行けなかった場合で、下のセルの色が、地の色でない かつ 自分の色でない 場合は下に行く r = r + 1 Else '右にも左にも下にも行けない場合は次には行けないので goNext に False をセット goNext = False End If '上記の判定処理を元に自プロシージャを再帰呼び出し amidaDrive = amidaDrive(goNext, r, c) End With End If End Function Public Sub Click_復帰() Dim r As Long Dim c As Long Dim lastRow As Long Dim lastColumn As Long Dim lineColor As Long With wsMain 'A1セルから地（背景）の色を取得 baseColor = .Range("A1").Interior.Color 'A2セルから線の色を取得 lineColor = .Range("A2").Interior.Color 'あみだの範囲を取得する With .UsedRange lastRow = .Item(.Count).Row lastColumn = .Item(.Count).Column End With For r = 2 To lastRow For c = 3 To lastColumn If .Cells(r, c).Interior.Color <> baseColor Then .Cells(r, c).Interior.Color = lineColor End If Next Next .Rows(lastRow).ClearContents End With End Sub
ExcelVBAで強化学習（Q学習）を実装して迷路を解いてみる
※※ Qiitaの記事へのリンクと駄文です ※※
強化学習ことはじめ
強化学習の勉強を始めたものの何の話をしているのかいまいちよくわからなくなっていたところで、『つくりながら学ぶ！深層強化学習 -PyTorchによる実践プログラミング-』を手に取ってみたところ、実際に動くサンプルがあったためだんだんとイメージがつくようになってきました。で、いつものノリで、Python のコードを VBA で書きなおしてみようと思って書いてみたところ、より一層理解が深まったように思えたので、どうせならと思って記事にしてみました。Excel を使うと、見えにくい配列内の数値もセルに書き出して可視化することができるのでお勧めです。この記事の通りに作っていけば、VBA で簡単な迷路のルート探索を試すことができますが、詳しい理論的な話には言及していないので、上記書籍を手元に置いてコードを見比べながら進めていくとよりいいと思います。
その後
まぁ、実際にはその後、ディープラーニングの手法を取り入れた DQN（Deep Q Network）に話が進んでいってだんだんと複雑になってくるのですが、まずはとっかかりとして VBA でやってみるのもいいんじゃないかな？と思います。少なくともとっかかりができれば、それを足場になんとか進んでいける（ような気がする）ので。。よく言われる（？）ように、ディープラーニングが目の獲得だとすれば、強化学習で脳が獲得できるんじゃないかな？などと適当に思っているので、ディープラーニング＆強化学習（ってDQN？）ってなんだかとっても刺激的な気がします。あとは言語（意味/意図理解）か。。これ、どうなるんでしょうね…とはいえ、ヒト標準である必要はないと思うので、究極的には彼らにとっての意味/意図理解ができる仕組みができあがればいいんじゃないでしょうか。それプラス、ヒトとの意思疎通のためのプロトコルがあれば。
いずれにしても、強化学習の書籍はまだまだ少ないこともあって、スタートの敷居は画像処理や言語処理に比べて高いんじゃないでしょうか。書籍のジャンルは画像処理系に加えて徐々に言語処理系も増えてきているようにも感じるので、そろそろ強化学習関連も増えてきて欲しいなぁ。
