全コードまとめ｜Excel VBAでIris分類問題

このページではこれまでに実装したモジュールやレイヤのコードをまとめておきます。
本ページ内のコードをコピペすることでIrisデータセットの学習を行うことができ、最終的には入力した4つの値から花の種類を識別することが可能になります。

1. モジュール作成
2. 実装コードまとめ
3. Irisデータセットの学習
4. まとめ

モジュール作成

今回の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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

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

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

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))

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

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)

'最大エポック数に到達したら学習終了

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

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

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

100

101

102

103

104

105

106

107

108

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

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

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

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))

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

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コードをまとめて紹介しました。コードで何を行なっているのか詳しく知りたい方は下記リンクを参照してください。

created by Rinker

2021年6月14日AI, Deep Learning, Excel, VBA

Posted by Lic

全コードまとめ｜Excel VBAでIris分類問題

モジュール作成

実装コードまとめ

Functions (標準モジュール)

Main (標準モジュール)

preprocess (標準モジュール)

Affine_Layer (クラスモジュール)

ReLU_Layer (クラスモジュール)

Sigmoid_Layer (クラスモジュール)

SoftmaxWithLoss_Layer (クラスモジュール)

TwoLayerNet (クラスモジュール)

Irisデータセットの学習

まとめ

標準モジュール

クラスモジュール

icon-book 参考書籍

参考書籍