全コードまとめ｜Excel VBAでMNIST機械学習

このページではこれまでに実装したモジュールやレイヤのコードをまとめておきます。
本ページ内のコードをコピペすることでMNIST学習を行うことができ、最終的にはVBAで手書き数字(0〜9)を認識することが可能になります。

Contents

1. モジュール作成
2. 実装コードまとめ
3. MNIST学習
4. まとめ

モジュール作成

今回のMNIST学習に使用するモジュールは下記の通りです。
コードをコピペする前に各モジュールを作成しておきましょう。

※画像には「Sigmoid_Layer」がありますが今回のMNIST学習では使用しないため不要です。

実装コードまとめ

上記モジュールのコードは下記の通りです。

csv_Functions (標準モジュール)

Option Explicit
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Function bmp_to_csv() As Long()

    Application.ScreenUpdating = False
    
    Dim FilePath As Variant
    FilePath = Application.GetOpenFilename
    If FilePath = False Then
        End
    End If

    Dim FileSize As Long
    FileSize = FileLen(FilePath)
    If FileSize = 0 Then
        MsgBox "選択したファイルは有効ではありません。"
        Exit Function
    End If

    
    Dim FileID As Integer
    FileID = FreeFile

    Open FilePath For Binary As #FileID

    Dim BinaryData() As Byte
    ReDim BinaryData(0 To FileSize - 1)

    Get #FileID, , BinaryData
    Close #FileID
    
    If Not (BinaryData(0) = 66 And BinaryData(1) = 77) Then
        MsgBox "bmp画像を選択してください。"
        Exit Function
    End If


    'バイナリデータからピクセル値データのみを抜き取る
    
    Dim i As Long
    Dim Data() As Long
    Dim RGBData() As Long
    Dim GrayData() As Long
    
    ReDim Data(UBound(BinaryData) - 53)
    ReDim RGBData(UBound(BinaryData) - 53) 'NNで使うため配列の1番目から値を格納(0番目は空にする)

    For i = 1 To UBound(RGBData)
        RGBData(i) = BinaryData(i + 53)
    Next i
    
    
    'RGBデータをグレースケールデータに変換(学習データと入力値を揃える)
    
    ReDim GrayData(UBound(RGBData) / 3) '0番目は空にする
    
    For i = 1 To UBound(GrayData)
            GrayData(i) = Abs((RGBData((i - 1) * 3 + 1) * 0.11 + _
                               RGBData((i - 1) * 3 + 1 + 1) * 0.59 + _
                               RGBData((i - 1) * 3 + 1 + 2) * 0.3) - 255)
    Next i
    
    Data = AlignBinaryData(GrayData)

    Application.ScreenUpdating = True
    
    bmp_to_csv = Data

End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Function AlignBinaryData(ByRef Data() As Long) As Long()

    Dim i As Long
    Dim j As Long
    Dim cnt As Long
    
    Dim out() As Long
    ReDim out(UBound(Data))
    
    cnt = 1
    For i = 28 To 1 Step -1
        For j = 27 To 0 Step -1
            out(cnt) = Data((i * 28) - j)
            cnt = cnt + 1
        Next j
    Next i
    
    AlignBinaryData = out

End Function

Functions (標準モジュール)

Option Explicit
Option Base 1
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function KeyPress() As Boolean
    Const KEY_PRESSED = -32768
    KeyPress = (GetAsyncKeyState(vbKeyF7) And KEY_PRESSED) = KEY_PRESSED
End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function GetRandomRow(ByRef DataCount As Long, MAX_DATA 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)
    
    For i = 1 To DataCount

        Randomize

        Do
            Num = Int((MAX_DATA - 1 + 1) * Rnd + 1)
        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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function zeros(ByRef input_size As Long) As Double()

    Dim i As Long
    Dim ZerosList() As Double
    
    ReDim ZerosList(input_size)

    For i = 1 To input_size
        ZerosList(i) = 0
    Next i
    
    zeros = ZerosList

End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function dot2(ByRef x() As Double, ByRef dout() As Double) As Double()
    
    Dim i As Long
    Dim j As Long
    Dim dW() As Double
    
    ReDim dW(UBound(x), UBound(dout))
    
    For i = 1 To UBound(dout)
        For j = 1 To UBound(x)
            dW(j, i) = x(j) * dout(i)
        Next j
    Next i
    
    dot2 = dW

End Function
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
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
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Public Function one_hot_t(ByRef t_size As Long, ByRef label As Integer) As Long()
    
    Dim labels() As Long
    
    ReDim labels(t_size)
    
    If label = 0 Then
        labels(10) = 1  '※Option Base 1でlabels(0)が存在しないためlabels(10)を使用
    Else
        labels(label) = 1
    End If
    
    one_hot_t = labels
    
End Function

Main (標準モジュール)

Option Explicit
Option Base 1
 
#If Win64 Then
    Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#Else
    Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
#End If

Dim input_size As Long         '入力層のニューロン数
Dim hidden_size As Long        '隠れ層のニューロン数
Dim output_size As Long        '出力層のニューロン数

Dim MinLoss As Double          '最小Loss値
Dim MaxEpoc As Long            '最大エポック数

Dim LearningRate As Double      '学習率
Dim batch_size As Long          'ミニバッチサイズ

Dim train_size As Long          'mnist_trainの総データ数(default:60000)
Dim test_size As Long           'mnist_testの総データ数(default:10000)

Public ParamsSheet As Worksheet '書き出し用シート

Public ParamsCheck As Boolean   'シート確認用変数
'――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
Sub Train()

'**********************************************************************
'
'        ユーザ－設定(ハイパーパラメータ設定)
'
'**********************************************************************

    
    'ユニット数の設定(Input:784 / Output:10は変更不可)
    
    input_size = 784   '28x28(px)
    hidden_size = 64   '学習結果に応じて変更可
    output_size = 10   '0～9
    
    
    '学習設定
    
    batch_size = 100     'バッチサイズ(Default:100)
    LearningRate = 0.01  '学習率(Default:0.01)
    
    train_size = ws_mnist_train.Cells(Rows.count, 1).End(xlUp).Row   'mnist_trainの総データ数(default:60000)
    test_size = ws_mnist_test.Cells(Rows.count, 1).End(xlUp).Row     'mnist_testの総データ数(default:10000)
    
    
    '学習終了条件
    
    MinLoss = 0.01    '目標Loss値
    MaxEpoc = 500     '最大エポック数(学習回数)


    
    
'**********************************************************************
'
'   　　　　　　 学習開始
'
'**********************************************************************
    
    
'学習途中データの確認-----------------------------------------------------

    ParamsCheck = False  
    
    Dim ws As Worksheet
    Dim flag As Boolean
    Dim res As String
    Dim msg As String
    
    msg = "学習モデルのデータがあります。" & vbLf & _
          "続きから学習を始めますか？" & vbLf & vbLf & _
          "[いいえ]を押すと新規モデルとして学習を始めます。"
    
    
    For Each ws In Worksheets
        If ws.Name = "Parameters" Then flag = True
    Next ws
    
    If flag = True Then
    
        res = MsgBox(msg, vbYesNoCancel + vbInformation, "学習データの再利用")
        
        If res = vbYes Then
            ParamsCheck = True
            Set ParamsSheet = Worksheets.Item("Parameters")
            
        ElseIf res = vbNo Then
            ParamsCheck = False
            flag = False
                  
label1:
            Dim SheetName As String
            SheetName = InputBox("既存のモデル(シート)名を入力して下さい。", "モデル名変更")
            If StrPtr(SheetName) = 0 Then
                MsgBox "キャンセルします。"
                Exit Sub
            ElseIf SheetName = "" Then
                MsgBox "モデル名を入力して下さい。"
                GoTo label1
            End If
            
            For Each ws In Worksheets
                If ws.Name = SheetName Then flag = True
            Next ws
            If flag = True Then
                MsgBox "「" & SheetName & "」は既に存在します。" & vbLf & "別の名称を入力し直してください。"
                GoTo label1
            End If
            
            Worksheets.Item("Parameters").Name = SheetName
            
            Set ParamsSheet = Worksheets.add(After:=Worksheets(1))
            ParamsSheet.Name = "Parameters"
        ElseIf res = vbCancel Then
            MsgBox "キャンセルします。"
            Exit Sub
        End If
        
    Else
    
        Set ParamsSheet = Worksheets.add(After:=Worksheets(1))
        ParamsSheet.Name = "Parameters"
        
    End If

'----------------------------------------------------------------------    
    
    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 t() As Long
    
    Dim DataRows() As Long
    
    
    With ws_mnist_train
        
        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)
        
        
            For r = 1 To UBound(DataRows)
                
                cnt = cnt + 1
                
                For c = 2 To eCol
                    Datas(c - 1) = .Cells(DataRows(r), c).Value / 255  '正規化
                Next c
                
                label = .Cells(DataRows(r), 1).Value
                t = Functions.one_hot_t(output_size, label)     'labelをone-hot化
                
                
                Call network.gradient(Datas, t)                 '重み/バイアスパラメータの勾配を求める
                
                sumE = sumE + network.E
                
                If network.accuracy = True Then                
                    sumAcc = sumAcc + 1
                End If
                
                Call network.ParamsUpdate(LearningRate)         'Affinレイヤの重み/バイアスパラメータを更新
                
                
                '[F7]キーが押下されたら学習終了
                If Functions.KeyPress = True Then
                    Call network.ExportParameters(ParamsSheet)
                    MsgBox "学習終了" & vbLf & "学習結果はシート(Parameters)に書き出しました。"
                    Exit Sub
                End If
                
                DoEvents
            Next r
            
            epoc = epoc + 1
            
      'テストデータ(未学習データ)で精度確認-------------------------------------------------------------
            
            Dim testData() As Double
            Dim testLabel As Long
            Dim testDataRows() As Long
            Dim test_acc() As Double
            Dim test_acc_size As Long
            Dim test_cnt As Long
            
            test_acc_size = 100
            ReDim testData(input_size)
            
            ReDim testDataRows(test_acc_size)
            testDataRows = Functions.GetRandomRow(test_acc_size, test_size)
            
            test_cnt = 0
            
            For r = 1 To UBound(testDataRows)
                For c = 2 To eCol
                    testData(c - 1) = ws_mnist_test.Cells(testDataRows(r), c).Value / 255  '正規化
                Next c
                
                testLabel = ws_mnist_test.Cells(testDataRows(r), 1).Value
                
                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_MNIST()

    input_size = 784   '28x28ピクセル
    hidden_size = 64   '学習結果に応じて変更可(※必ず学習時の構成と揃えること)
    output_size = 10   '0～9

    Dim i As Long
    Dim j As Long
    Dim InputImageData() As Long
    Dim Data() As Double
    
    ReDim InputImageData(input_size)
    ReDim Data(input_size)
    
    InputImageData = csv_Functions.bmp_to_csv
    
    For i = 1 To input_size
        Data(i) = InputImageData(i) / 255
    Next i
    
    Dim ExportSheet As Worksheet
    Set ExportSheet = Worksheets.Item("Sheet1")
    
    ExportSheet.Cells.ClearContents
    Dim cnt As Long
    Application.ScreenUpdating = False
    cnt = 1
    For i = 1 To 28
        For j = 1 To 28
            ExportSheet.Cells(i, j) = InputImageData(cnt)
            cnt = cnt + 1
        Next j
    Next i
    Application.ScreenUpdating = True
    
    Dim ModelSheet As Worksheet
    Set ModelSheet = Worksheets.Item("Parameters_Comp")
    
    Dim network As TwoLayerNet
    Set network = New TwoLayerNet
    

    ParamsCheck = True 'ModelSheetのパラメータを使用する
    
    Call network.Initialize(input_size, hidden_size, output_size, ModelSheet)

    Dim answer As Long
    answer = network.answer(Data)
    
   MsgBox answer

End Sub

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

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 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 ParamsCheck = 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 ParamsCheck = 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 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)
    z1 = ReLU.forward(a1)
    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 da2() As Double 'output→hiddenの逆伝播の値
    Dim dz1() As Double 'ReLU関数の逆伝播の値
    Dim da1() As Double 'hidden→inputの逆伝播の値

    da2 = Affine2.backward(dx)
    dz1 = ReLU.backward(da2)
    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 ans2 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 = 10 Then
        ans = 0
    End If

    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

    If ans = 10 Then
        ans = 0
    End If

    answer = ans

End Function