全コードまとめ｜Excel VBAでIris分類問題
このページではこれまでに実装したモジュールやレイヤのコードをまとめておきます。
本ページ内のコードをコピペすることでIrisデータセットの学習を行うことができ、最終的には入力した4つの値から花の種類を識別することが可能になります。
Contents
モジュール作成
今回のIrisデータセットの学習に使用するモジュールは下記の通りです。
コードをコピペする前に各モジュールを作成しておきましょう。
実装コードまとめ
上記モジュールのコードは下記の通りです。
Functions (標準モジュール)
Option Explicit
Option Base 1
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：GetRandomRow
' 機能 ：指定範囲内でランダムで生成した行数(自然数)を返す
' 引数 ：DataCount 生成する値の数
' ：MaxDataCount 生成する値の上限値
' ：MinDataCount 生成する値の下限値(省略可/省略した場合は「1」となる)
'************************************************************************************
Public Function GetRandomRow(DataCount As Long, MaxDataCount As Long, Optional MinDataCount As Long) As Long()
Dim i As Long, Num As Long
Dim flag() As Boolean
Dim RndRows() As Long
ReDim flag(MaxDataCount)
ReDim RndRows(MaxDataCount)
Dim startDataCount As Long
If MinDataCount < 1 Then
startDataCount = 1
Else
startDataCount = MinDataCount
End If
For i = 1 To DataCount
Randomize
Do
Num = Int((MaxDataCount - startDataCount + 1) * Rnd + startDataCount)
Loop Until flag(Num) = False
RndRows(i) = Num
flag(Num) = True
Next i
ReDim Preserve flag(DataCount)
ReDim Preserve RndRows(DataCount)
GetRandomRow = RndRows
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：RandomWeight
' 機能 ：ランダム生成した数値の入った2次配列を返す
' 引数 ：size1 2次配列のサイズ(1次元目)
' ：size2 2次配列のサイズ(2次元目)
'************************************************************************************
Public Function RandomWeight(ByRef size1 As Long, ByRef size2 As Long) As Double()
Dim i As Long
Dim j As Long
Dim W As Double
Dim List() As Double
ReDim List(size1, size2)
For i = 1 To size1
For j = 1 To size2
Randomize
Do
W = (Rnd * 2) - 1
Loop Until W <> 0
List(i, j) = W
Next j
Next i
RandomWeight = List
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：Zeros
' 機能 ：0の入った1次配列を返す
' 引数 ：size1 1次配列のサイズ
'************************************************************************************
Public Function Zeros(ByRef size1 As Long) As Double()
Dim i As Long
Dim List() As Double
ReDim List(size1)
For i = 1 To size1
List(i) = 0
Next i
Zeros = List
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：dot
' 機能 ：2つの配列のドット積(内積)の計算結果が入った1次配列を返す
' 引数 ：x() 1次元配列
' ：W() 2次元配列
'************************************************************************************
Public Function dot(ByRef x() As Double, ByRef W() As Double) As Double()
Dim i As Long
Dim j As Long
Dim A() As Double
ReDim A(UBound(W, 2))
Dim sum As Double
For i = 1 To UBound(W, 2)
sum = 0
For j = 1 To UBound(x)
sum = sum + (x(j) * W(j, i))
Next j
A(i) = sum
Next i
dot = A
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：dot2
' 機能 ：2つの配列のドット積(内積)の計算結果が入った2次配列を返す
' 引数 ：xT() 1次元配列
' ：dout() 1次元配列
'************************************************************************************
Public Function dot2(ByRef xT() As Double, ByRef dout() As Double) As Double()
Dim i As Long
Dim j As Long
Dim dW() As Double
ReDim dW(UBound(xT), UBound(dout))
For i = 1 To UBound(dout)
For j = 1 To UBound(xT)
dW(j, i) = xT(j) * dout(i)
Next j
Next i
dot2 = dW
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：add
' 機能 ：配列内の要素同士の和が入った2次配列を返す
' 引数 ：xT() 1次元配列
' ：dout() 1次元配列
'************************************************************************************
Public Function add(ByRef x() As Double, ByRef Bias() As Double) As Double()
Dim i As Long
Dim A() As Double
ReDim A(UBound(x))
For i = 1 To UBound(x)
A(i) = x(i) + Bias(i)
Next i
add = A
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：Sigmoid
' 機能 ：入力した1次元配列に対してSigmoid関数を適用する
' 引数 ：A() 1次元配列
'************************************************************************************
Public Function Sigmoid(ByRef A() As Double) As Double()
Dim i As Long
Dim z() As Double
ReDim z(UBound(A))
For i = 1 To UBound(A)
z(i) = 1 / (1 + Exp(A(i) * -1))
Next i
Sigmoid = z
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：Softmax
' 機能 ：入力した1次元配列に対してSoftmax関数を適用する
' 引数 ：x() 1次元配列
'************************************************************************************
Public Function Softmax(ByRef x() As Double) As Double()
Dim i As Long
Dim max As Double
Dim sum As Double
Dim z() As Double
ReDim z(UBound(x))
max = x(1)
For i = 1 To UBound(x)
If x(i) > max Then
max = x(i)
End If
Next i
sum = 0
For i = 1 To UBound(x)
sum = sum + Exp(x(i) - max) 'オーバーフロー対策
Next i
For i = 1 To UBound(x)
z(i) = Exp(x(i) - max) / sum
Next i
Softmax = z
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：cross_entropy_error
' 機能 ：交差エントロピー誤差より損失(Loss)を求める
' 引数 ：y() 1次元配列(Softmax関数の出力値)
' ：t() 1次元配列(正解ラベル)
'************************************************************************************
Public Function cross_entropy_error(ByRef y() As Double, ByRef t() As Long)
Dim delta As Double
delta = 0.0000001 'infを発生させないため微小な数字を加算する
Dim i As Long
Dim sum As Double
sum = 0
For i = 1 To UBound(t)
sum = sum + (t(i) * Log(y(i) + delta))
Next
cross_entropy_error = sum * -1
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'************************************************************************************
' 関数名 ：one_hot_t
' 機能 ：正解ラベルをone-hot表現にした1次元配列を返す
' 引数 ：t_size 正解ラベルの総数(Iris分類の場合は３)
' ：label 正解ラベルのインデックス
'************************************************************************************
Public Function one_hot_t(ByRef t_size As Long, ByRef label As Integer) As Long()
Dim labels() As Long
ReDim labels(t_size)
labels(label) = 1
one_hot_t = labels
End Function
Main (標準モジュール)
Option Explicit
Option Base 1
'*********************************************************************
' ユーザ－設定(ハイパーパラメータ設定)
'*********************************************************************
'ユニット数の設定-----------------------------------------------------
Const input_size = 4 '入力層のユニット数 = 4 (ガクの長さ / ガクの幅 / 花弁の長さ / 花弁の幅)
Const hidden_size = 3 '隠れ層のユニット数設定(任意で変更可)
Const output_size = 3 '出力層のユニット数 = 3 (setosa / versicolor / virginica)
'学習終了条件---------------------------------------------------------
Const MinLoss = 0.03 '目標Loss値
Const MaxEpoc = 1000 '最大エポック数(学習回数)
'学習設定-------------------------------------------------------------
Const train_size = 120 '学習用データ数
Const test_size = 30 'テスト用データ数
Const LearningRate = 0.01 '学習率(デフォルト「0.01」)
Const batch_size = 100 'ミニバッチサイズ(※batch_size < train_size)
Public Const act_func = "Sigmoid" '活性化関数の種類(「ReLU」 or 「Sigmoid」)
Public ParamsSheet As Worksheet 'パラメータ書き出し用シート
Public Classification_mode As Boolean '分類モード(学習時は「True」、推論時は「False」)
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Sub Train()
Classification_mode = False
'パラメータ出力用シート定義
Dim ws As Worksheet
Dim flg As Boolean
Dim res As String
Dim ParamsSheet As Worksheet
For Each ws In Worksheets
If ws.Name = "Parameters" Then flg = True
Next ws
If flg = True Then
Set ParamsSheet = Worksheets.Item("Parameters")
ParamsSheet.Cells.Clear
Else
Set ParamsSheet = Worksheets.add(After:=Worksheets(1))
ParamsSheet.Name = "Parameters"
End If
'学習用データ定義
Dim ws_train_iris As Worksheet
Set ws_train_iris = Worksheets.Item("train_iris")
'テスト用データ定義
Dim ws_test_iris As Worksheet
Set ws_test_iris = Worksheets.Item("test_iris")
'ニューラルネットワークのインスタンス作成
Dim network As TwoLayerNet
Set network = New TwoLayerNet
'ニューラルネットワーク初期化(各レイヤのインスタンス作成)
Call network.Initialize(input_size, hidden_size, output_size, ParamsSheet)
Dim eRow As Long
Dim eCol As Long
Dim Datas() As Double
Dim c As Long
Dim r As Long
Dim i As Long
Dim epoc As Long
Dim sumE As Double
Dim sumAcc As Long
Dim cnt As Long
Dim label As Integer
Dim label_species As String
Dim t() As Long
Dim DataRows() As Long
'ニューラルネットワーク学習
With ws_train_iris
eRow = .Cells(rows.count, 1).End(xlUp).Row
eCol = .Cells(1, Columns.count).End(xlToLeft).Column
ReDim Datas(eCol - 1)
Do
'最大エポック数に到達したら学習終了
If epoc >= MaxEpoc Then Exit Do
sumAcc = 0
sumE = 0
cnt = 0
'学習データ行をランダム取得
ReDim DataRows(batch_size)
DataRows = Functions.GetRandomRow(batch_size, train_size, 2)
For r = 1 To UBound(DataRows)
cnt = cnt + 1
'入力データ取得
For c = 1 To 4
Datas(c) = .Cells(DataRows(r), c).Value
Next c
'正解ラベル取得
label_species = .Cells(DataRows(r), 5).Value
If label_species = "setosa" Then: label = 1
If label_species = "versicolor" Then: label = 2
If label_species = "virginica" Then: label = 3
'labelをone-hot化
t = Functions.one_hot_t(output_size, label)
'勾配を求める
Call network.gradient(Datas, t)
'Loss値を求める
sumE = sumE + network.E
'学習用データでの正解数カウント
If network.accuracy = True Then
sumAcc = sumAcc + 1
End If
'Affinレイヤの重み/バイアスパラメータを更新
Call network.ParamsUpdate(LearningRate)
Next r
epoc = epoc + 1
'テストデータ(未学習データ)で精度確認************************************************
Dim testData() As Double
Dim testLabel As Long
Dim testLabel_species As String
Dim testDataRows() As Long
Dim test_acc() As Double
Dim test_acc_size As Long
Dim test_cnt As Long
test_acc_size = 10
ReDim testData(input_size)
ReDim testDataRows(test_acc_size)
testDataRows = Functions.GetRandomRow(test_acc_size, test_size, 2)
test_cnt = 0
For r = 1 To UBound(testDataRows)
For c = 1 To 4
testData(c) = ws_test_iris.Cells(testDataRows(r), c).Value
Next c
testLabel_species = ws_test_iris.Cells(testDataRows(r), 5).Value
If testLabel_species = "setosa" Then: testLabel = 1
If testLabel_species = "versicolor" Then: testLabel = 2
If testLabel_species = "virginica" Then: testLabel = 3
If network.test_accuracy(testData, testLabel) = True Then
test_cnt = test_cnt + 1
End If
Next r
'************************************************************************************
'学習状況をイミディエイトウィンドウに出力
Debug.Print epoc & "回目: " & sumE / cnt & " 正解率: " & (sumAcc / cnt) * 100 & "% テスト正解率" & (test_cnt / test_acc_size) * 100 & "% "
Loop Until sumE / cnt < MinLoss
End With
Call network.ExportParameters(ParamsSheet)
MsgBox "学習終了" & vbLf & "学習結果はシート(Parameters)に書き出しました。"
End Sub
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Sub Classification_iris()
Dim Data() As Double
ReDim Data(input_size)
'*******************************************************
' irisデータセット正規化(平均：0 / 分散：1)
'*******************************************************
Dim DataCount As Long 'データ総数
Dim DataSum As Double 'データ合計値
Dim DataAve As Double 'データ平均値
Dim DataDev As Double 'データ偏差値
Dim DataDevSum As Double 'データ偏差の2乗合計値
Dim DataDevSta As Double 'データ標準偏差
Dim EndRow As Long
Dim EndCol As Long
Dim r As Integer
Dim c As Integer
With ws_iris_dataset
EndRow = .Cells(rows.count, 1).End(xlUp).Row
EndCol = .Cells(1, Columns.count).End(xlToLeft).Column
'データの合計数
DataCount = (EndRow - 1) * (EndCol - 1)
'データの合計値
For r = 2 To EndRow
For c = 1 To (EndCol - 1)
DataSum = DataSum + .Cells(r, c).Value
Next c
Next r
'データの平均値
DataAve = DataSum / DataCount
'データの偏差2乗の合計値
For r = 2 To EndRow
For c = 1 To (EndCol - 1)
DataDev = .Cells(r, c).Value - DataAve
DataDevSum = DataDevSum + (DataDev ^ 2)
Next c
Next r
'データの標準偏差
DataDevSta = Sqr(DataDevSum / DataCount)
For c = 1 To 4
DataDev = ws_Classification_iris.Cells(2, c).Value - DataAve
Data(c) = DataDev / DataDevSta
Next c
End With
Dim ModelSheet As Worksheet
Set ModelSheet = Worksheets.Item("Parameters")
Dim network As TwoLayerNet
Set network = New TwoLayerNet
Classification_mode = True
Call network.Initialize(input_size, hidden_size, output_size, ModelSheet)
Dim answer As Long
answer = network.answer(Data)
Dim answer_species As String
If answer = 1 Then: answer_species = "setosa"
If answer = 2 Then: answer_species = "versicolor"
If answer = 3 Then: answer_species = "virginica"
ws_Classification_iris.Cells(2, 5).Value = answer_species
End Sub
preprocess (標準モジュール)
Sub preprocess_standardization()
Dim ws As Worksheet
Dim flg As Boolean
Dim ws_iris_dataset As Worksheet
Dim ws_iris_dataset_standardization As Worksheet
'Irisデータセット定義
flg = False
For Each ws In Worksheets
If ws.Name = "iris_dataset" Then flg = True
Next ws
If flg = True Then
Set ws_iris_dataset = Worksheets.Item("iris_dataset")
Else
MsgBox "Irisデータセットが見つかりません。"
Exit Sub
End If
'正規化データ出力用のシート作成
flg = False
For Each ws In Worksheets
If ws.Name = "iris_dataset_standardization" Then flg = True
Next ws
If flg = True Then
Set ws_iris_dataset_standardization = Worksheets.Item("iris_dataset_standardization")
ws_iris_dataset_standardization.Cells.Clear
Else
Set ws_iris_dataset_standardization = Worksheets.add(After:=Worksheets(1))
ws_iris_dataset_standardization.Name = "iris_dataset_standardization"
End If
'irisデータセット転記
Dim r As Long
Dim c As Long
Dim EndRow As Long
Dim EndCol As Long
EndRow = ws_iris_dataset.Cells(rows.count, 1).End(xlUp).Row
EndCol = ws_iris_dataset.Cells(1, Columns.count).End(xlToLeft).Column
For r = 1 To EndRow
For c = 1 To EndCol
ws_iris_dataset_standardization.Cells(r, c).Value = ws_iris_dataset.Cells(r, c).Value
Next c
Next r
'*******************************************************
' irisデータセット正規化(平均：0 / 分散：1)
'*******************************************************
Dim DataCount As Long 'データ総数
Dim DataSum As Double 'データ合計値
Dim DataAve As Double 'データ平均値
Dim DataDev As Double 'データ偏差値
Dim DataDevSum As Double 'データ偏差の2乗合計値
Dim DataDevSta As Double 'データ標準偏差
'データの合計数
DataCount = (EndRow - 1) * (EndCol - 1)
'データの合計値
For r = 2 To EndRow
For c = 1 To (EndCol - 1)
DataSum = DataSum + ws_iris_dataset_standardization.Cells(r, c).Value
Next c
Next r
'データの平均値
DataAve = DataSum / DataCount
'データの偏差2乗の合計値
For r = 2 To EndRow
For c = 1 To (EndCol - 1)
DataDev = ws_iris_dataset_standardization.Cells(r, c).Value - DataAve
DataDevSum = DataDevSum + (DataDev ^ 2)
Next c
Next r
'データの標準偏差
DataDevSta = Sqr(DataDevSum / DataCount)
'データの正規化
For r = 2 To EndRow
For c = 1 To (EndCol - 1)
DataDev = ws_iris_dataset_standardization.Cells(r, c).Value - DataAve
ws_iris_dataset_standardization.Cells(r, c).Value = DataDev / DataDevSta
Next c
Next r
End Sub
Sub preprocess_split_data()
Const train_size = 120 '学習用データ数
Const test_size = 150 - train_size 'テスト用データ数
'無作為にtrain_size個の行数を取得(学習用データに使用する行数を取得)
Dim TrainRows() As Long
ReDim TrainRows(train_size)
TrainRows = Functions.GetRandomRow(train_size, 151, 2)
Dim ws As Worksheet
Dim flg As Boolean
Dim ws_train_iris As Worksheet
Dim ws_test_iris As Worksheet
'学習用データ出力用のシート作成
flg = False
For Each ws In Worksheets
If ws.Name = "train_iris" Then flg = True
Next ws
If flg = True Then
Set ws_train_iris = Worksheets.Item("train_iris")
ws_train_iris.Cells.Clear
Else
Set ws_train_iris = Worksheets.add(After:=Worksheets(1))
ws_train_iris.Name = "train_iris"
End If
'テスト用データ出力用のシート作成
flg = False
For Each ws In Worksheets
If ws.Name = "test_iris" Then flg = True
Next ws
If flg = True Then
Set ws_test_iris = Worksheets.Item("test_iris")
ws_test_iris.Cells.Clear
Else
Set ws_test_iris = Worksheets.add(After:=Worksheets(1))
ws_test_iris.Name = "test_iris"
End If
'ベースデータ定義
flg = False
For Each ws In Worksheets
If ws.Name = "test_iris" Then flg = True
Next ws
Dim ws_iris_dataset_stand As Worksheet
Set ws_iris_dataset_stand = Worksheets.Item("iris_dataset_standardization")
'学習用データ出力
Dim i As Long
Dim j As Integer
Dim EndRow As Long
For j = 1 To 5
ws_train_iris.Cells(1, j).Value = ws_iris_dataset_stand.Cells(1, j).Value
Next j
For i = 1 To train_size
EndRow = ws_train_iris.Cells(rows.count, 1).End(xlUp).Row
For j = 1 To 5
ws_train_iris.Cells(EndRow + 1, j).Value = ws_iris_dataset_stand.Cells(TrainRows(i), j).Value
Next j
Next i
'テスト用データの行数取得(学習用データで使われない行数をすべて取得)
Dim TestRows() As Long
Dim k As Long
Dim cnt As Long
Dim chk As Integer: chk = 0
For i = 2 To 151
flg = False
'TrainRowsの要素確認
For j = 1 To UBound(TrainRows)
If i = TrainRows(j) Then
flg = True
End If
Next j
'TrainRowsの要素以外の値を取得/格納
If flg = False Then
If chk = 0 Then
ReDim Preserve TestRows(1)
Else
ReDim Preserve TestRows(UBound(TestRows) + 1)
End If
chk = chk + 1
TestRows(UBound(TestRows)) = i
End If
Next i
'テスト用データ出力
For j = 1 To 5
ws_test_iris.Cells(1, j).Value = ws_iris_dataset_stand.Cells(1, j).Value
Next j
For i = 1 To test_size
EndRow = ws_test_iris.Cells(rows.count, 1).End(xlUp).Row
For j = 1 To 5
ws_test_iris.Cells(EndRow + 1, j).Value = ws_iris_dataset_stand.Cells(TestRows(i), j).Value
Next j
Next i
End Sub
'************************************************************************************
' 関数名 ：GetRandomRow
' 機能 ：指定範囲内でランダムで生成した行数(自然数)を返す
' 引数 ：DataCount 生成する値の数
' ：MAX_DATA 生成する値の上限値
' ：minDataCount 生成する値の下限値(省略可/省略した場合は「1」となる)
'************************************************************************************
Public Function GetRandomRow(DataCount As Long, MAX_DATA As Long, Optional MinDataCount As Long) As Long()
Dim i As Long, Num As Long
Dim flag() As Boolean
Dim RndRows() As Long
ReDim flag(MAX_DATA)
ReDim RndRows(MAX_DATA)
Dim startDataCount As Long
If MinDataCount < 1 Then
startDataCount = 1
Else
startDataCount = MinDataCount
End If
For i = 1 To DataCount
Randomize
Do
Num = Int((MAX_DATA - startDataCount + 1) * Rnd + startDataCount)
Loop Until flag(Num) = False
RndRows(i) = Num
flag(Num) = True
Next i
ReDim Preserve flag(DataCount)
ReDim Preserve RndRows(DataCount)
GetRandomRow = RndRows
End Function
Affine_Layer (クラスモジュール)
Option Explicit
Option Base 1
Dim W() As Double
Dim b() As Double
Dim x() As Double
Dim dW() As Double
Dim db() As Double
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function init(ByRef input_W() As Double, ByRef input_b() As Double)
Dim i As Long
Dim j As Long
ReDim W(UBound(input_W, 1), UBound(input_W, 2))
For i = 1 To UBound(input_W, 1)
For j = 1 To UBound(input_W, 2)
W(i, j) = input_W(i, j)
Next j
Next i
ReDim b(UBound(input_b))
For i = 1 To UBound(input_b)
b(i) = input_b(i)
Next i
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function forward(ByRef input_x() As Double) As Double()
Dim i As Long
Dim out() As Double
ReDim x(UBound(input_x))
ReDim out(UBound(input_x))
For i = 1 To UBound(input_x)
x(i) = input_x(i)
Next i
out = Functions.dot(x, W) '重み付き入力値の総和
out = Functions.add(out, b) 'バイアス加算
forward = out
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function backward(ByRef dout() As Double)
Dim i As Long
Dim j As Long
Dim WT() As Double
Dim dx() As Double
ReDim WT(UBound(W, 2), UBound(W, 1))
For i = 1 To UBound(W, 1)
For j = 1 To UBound(W, 2)
WT(j, i) = W(i, j)
Next j
Next i
ReDim dx(UBound(W, 1))
dx = Functions.dot(dout, WT)
ReDim dW(UBound(W, 1), UBound(W, 2))
dW = Functions.dot2(x, dout)
ReDim db(UBound(W, 2))
db = dout
backward = dx
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function ParamsUpdate(ByRef LearningRate As Double)
'Wの更新
Dim i As Long
Dim j As Long
For i = 1 To UBound(W, 1)
For j = 1 To UBound(W, 2)
W(i, j) = W(i, j) - (LearningRate * dW(i, j))
Next j
Next i
'bの更新
For i = 1 To UBound(b)
b(i) = b(i) - (LearningRate * db(i))
Next i
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Property Get Weight()
Weight = W
End Property
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Property Get Bias()
Bias = b
End Property
ReLU_Layer (クラスモジュール)
Option Explicit
Option Base 1
Dim mask() As Boolean
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function forward(ByRef x() As Double) As Double()
Dim i As Long
Dim out() As Double
ReDim out(UBound(x))
ReDim mask(UBound(x))
For i = 1 To UBound(x)
If x(i) <= 0 Then
out(i) = 0
mask(i) = True
Else
out(i) = x(i)
mask(i) = False
End If
Next i
forward = out
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function backward(ByRef dout() As Double) As Double()
Dim i As Long
Dim dx() As Double
ReDim dx(UBound(dout))
For i = 1 To UBound(dout)
If mask(i) = True Then
dx(i) = 0
Else
dx(i) = dout(i)
End If
Next i
backward = dx
End Function
Sigmoid_Layer (クラスモジュール)
Option Explicit
Option Base 1
Dim out() As Double
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function forward(ByRef x() As Double) As Double()
Dim i As Long
ReDim out(UBound(x))
For i = 1 To UBound(x)
out(i) = 1 / (1 + Exp(x(i) * -1))
Next i
forward = out
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function backward(ByRef dout() As Double) As Double()
Dim i As Long
Dim dx() As Double
ReDim dx(UBound(dout))
For i = 1 To UBound(dout)
dx(i) = dout(i) * (1 - out(i)) * out(i)
Next i
backward = dx
End Function
SoftmaxWithLoss_Layer (クラスモジュール)
Option Explicit
Option Base 1
Dim loss As Double
Dim y() As Double
Dim t() As Long
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function forward(ByRef x() As Double, ByRef input_t() As Long) As Double
Dim i As Long
ReDim t(UBound(input_t))
For i = 1 To UBound(input_t)
t(i) = input_t(i)
Next i
ReDim y(UBound(x))
y = Functions.Softmax(x)
loss = Functions.cross_entropy_error(y, t)
forward = loss
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function backward(ByRef dout As Double) As Double()
Dim dx() As Double
Dim i As Long
ReDim dx(UBound(t))
For i = 1 To UBound(t)
dx(i) = (y(i) - t(i))
Next
backward = dx
End Function
TwoLayerNet (クラスモジュール)
Option Explicit
Option Base 1
Dim Affine1 As Affine_Layer
Dim ReLU As ReLU_Layer
Dim Sigmoid As Sigmoid_Layer
Dim Affine2 As Affine_Layer
Dim SoftmaxWithLoss As SoftmaxWithLoss_Layer
Dim class_loss As Double
Dim class_accuracy As Boolean
Dim class_input_size As Long '入力層ニューロン数
Dim class_hidden_size As Long '隠れ層ニューロン数
Dim class_output_size As Long '出力層ニューロン数
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
'重み/バイアスの初期化
Public Sub Initialize(ByRef input_size As Long, ByRef hidden_size As Long, ByRef output_size As Long, ByRef Sheet As Worksheet)
Dim WeightList1() As Double
Dim WeightList2() As Double
Dim BiasList1() As Double
Dim BiasList2() As Double
ReDim WeightList1(input_size, hidden_size) 'W1
ReDim WeightList2(hidden_size, output_size) 'W2
ReDim BiasList1(hidden_size) 'b1
ReDim BiasList2(output_size) 'b2
class_input_size = input_size
class_hidden_size = hidden_size
class_output_size = output_size
Dim i As Long
Dim j As Long
'**************************************************
' W1,b1の作成と初期化(読み込み)
'**************************************************
If Classification_mode = False Then
WeightList1 = Functions.RandomWeight(input_size, hidden_size) '引数の数だけランダムの重みを作成してリストに格納
BiasList1 = Functions.Zeros(hidden_size)
Else
For i = 1 To UBound(WeightList1, 1)
For j = 1 To UBound(WeightList1, 2)
WeightList1(i, j) = Sheet.Cells(i, j)
Next j
Next i
For i = 1 To UBound(BiasList1)
BiasList1(i) = Sheet.Cells(UBound(WeightList1, 1) + 1, i)
Next i
End If
'**************************************************
' W2,b2の作成と初期化(読み込み)
'**************************************************
If Classification_mode = False Then
WeightList2 = Functions.RandomWeight(hidden_size, output_size) '引数の数だけランダムの重みを作成してリストに格納
BiasList2 = Functions.Zeros(output_size)
Else
For i = 1 To UBound(WeightList2, 1)
For j = 1 To UBound(WeightList2, 2)
WeightList2(i, j) = Sheet.Cells(UBound(WeightList1, 1) + 1 + i, j)
Next j
Next i
For i = 1 To UBound(BiasList2)
BiasList2(i) = Sheet.Cells(UBound(WeightList1, 1) + 1 + UBound(WeightList2, 1) + 1, i)
Next i
End If
'**************************************************
' レイヤーの生成
'**************************************************
Set Affine1 = New Affine_Layer
Call Affine1.init(WeightList1, BiasList1)
Set ReLU = New ReLU_Layer
Set Sigmoid = New Sigmoid_Layer
Set Affine2 = New Affine_Layer
Call Affine2.init(WeightList2, BiasList2)
Set SoftmaxWithLoss = New SoftmaxWithLoss_Layer
End Sub
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function predict(ByRef x() As Double) As Double()
Dim a1() As Double '活性化前重み付き入力値の総和(input→hidden)
Dim a2() As Double '活性化前重み付き入力値の総和(hidden→output)
Dim z1() As Double 'a1の活性化後の値(ReLU関数)
a1 = Affine1.forward(x)
If act_func = "ReLU" Then
z1 = ReLU.forward(a1)
ElseIf act_func = "Sigmoid" Then
z1 = Sigmoid.forward(a1)
End If
a2 = Affine2.forward(z1)
predict = a2 'Softmax前までの入力値の総和
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function loss(ByRef x() As Double, ByRef t() As Long)
Dim i As Integer
Dim max_t_index As Integer
Dim max_y As Double
Dim max_y_index As Integer
Dim y() As Double
ReDim y(class_output_size)
y = predict(x)
class_loss = SoftmaxWithLoss.forward(y, t)
loss = class_loss
't(正解ラベル)が「1」のインデックスを取得
For i = 1 To UBound(t)
If t(i) = 1 Then
max_t_index = i
End If
Next i
'y(softmax出力値)が最大値のインデックスを取得
max_y = y(1)
max_y_index = 1
For i = 1 To UBound(y)
If y(i) > max_y Then
max_y = y(i)
max_y_index = i
End If
Next i
If max_t_index = max_y_index Then
class_accuracy = True
Else
class_accuracy = False
End If
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Property Get E()
E = class_loss
End Property
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Property Get accuracy() As Boolean
accuracy = class_accuracy
End Property
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function gradient(ByRef x() As Double, ByRef t() As Long)
'forward
Call loss(x, t)
'backward
Dim dout As Double
Dim dx() As Double
dout = 1
ReDim dx(UBound(t))
dx = SoftmaxWithLoss.backward(dout)
Dim da1() As Double '活性化前重み付き入力値の総和(input→hidden)
Dim da2() As Double '活性化前重み付き入力値の総和(hidden→output)
Dim dz1() As Double 'a1の活性化後の値(ReLU関数)
da2 = Affine2.backward(dx)
If act_func = "ReLU" Then
dz1 = ReLU.backward(da2)
ElseIf act_func = "Sigmoid" Then
dz1 = Sigmoid.backward(da2)
End If
da1 = Affine1.backward(dz1)
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function ParamsUpdate(ByRef LearningRate As Double)
Call Affine1.ParamsUpdate(LearningRate)
Call Affine2.ParamsUpdate(LearningRate)
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function ExportParameters(ByRef ExportSheet As Worksheet)
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim W1() As Double
Dim b1() As Double
Dim W2() As Double
Dim b2() As Double
ReDim W1(class_input_size, class_hidden_size)
ReDim b1(class_hidden_size)
ReDim W2(class_hidden_size, class_output_size)
ReDim b2(class_output_size)
W1 = Affine1.Weight
b1 = Affine1.Bias
W2 = Affine2.Weight
b2 = Affine2.Bias
With ExportSheet
.Cells.ClearContents
For i = 1 To UBound(W1, 1) '784
For j = 1 To UBound(W1, 2)
.Cells(i, j).Value = W1(i, j)
Next j
Next i
For i = 1 To UBound(b1)
.Cells(UBound(W1, 1) + 1, i).Value = b1(i)
Next i
For i = 1 To UBound(W2, 1)
For j = 1 To UBound(W2, 2)
.Cells(UBound(W1, 1) + 1 + i, j).Value = W2(i, j)
Next j
Next i
For i = 1 To UBound(b2)
.Cells(UBound(W1, 1) + 1 + UBound(W2, 1) + 1, i).Value = b2(i)
Next i
End With
Application.ScreenUpdating = True
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function test_accuracy(ByRef x() As Double, ByRef t As Long) As Boolean
Dim i As Long
Dim ans As Long
Dim tmp_a As Double
Dim tmp_t As Long
Dim A() As Double
ReDim A(10)
A = predict(x)
tmp_a = A(1)
ans = 1
For i = 1 To UBound(A)
If tmp_a < A(i) Then
tmp_a = A(i)
ans = i
End If
Next i
If ans = t Then
test_accuracy = True
Else
test_accuracy = False
End If
End Function
'―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function answer(ByRef x() As Double) As Long
Dim i As Long
Dim ans As Long
Dim tmp_a As Double
Dim A() As Double
ReDim A(class_output_size)
A = predict(x)
tmp_a = A(1)
ans = 1
For i = 1 To UBound(A)
If tmp_a < A(i) Then
tmp_a = A(i)
ans = i
End If
Next i
answer = ans
End Function
Irisデータセットの学習
上記コードをコピペしたら下記の手順を行うことで手書き文字が認識できるようになります。
1. Irisデータセットを学習させてみよう ニューラルネットワークの学習
2. 入力された値からIrisの種類を分類してみよう ニューラルネットワークによる推論
まとめ
このページでは「Excel VBAでニューラルネットワークを再現｜Irisデータセット分類問題」で実装したモジュールのVBAコードをまとめて紹介しました。コードで何を行なっているのか詳しく知りたい方は下記リンクを参照してください。
標準モジュール
・Functionsモジュールの実装
・メインモジュールの実装
・Irisデータの前処理 (preprocessモジュール)
クラスモジュール
・Affineレイヤの実装
・ReLUレイヤの実装
・Sigmoidレイヤの実装
・Softmax-with-Lossレイヤの実装
・TwoLayerNetクラスの実装
