無限不可能性ドライブ

『ニューラルネットワーク自作入門』に刺激されてExcelVBAでニューラルネットワークを作ってみたものの、やっぱり数学やらなきゃと思い少しずつやってきたのもあって、自分の知識の整理とかそういった感じです。

【VBA編】ニューラルネットワーク（マクロの登録）

VBA ニューラルネットワーク

f:id:celaeno42:20181115232506p:plain

マクロの登録

各ボタンにマクロを登録します。

ボタン プロシージャ名
データ読み込み Click_データ読み込み
重みクリア Click_学習状況クリア
学習開始 Click_学習開始
テスト開始 Click_テスト開始

データ読み込み

C2セル、C3セルをダブルクリックして、データ用のCSVファイルを選択します。
【データ読み込み】ボタンを押下すると、CSVファイルのデータが読み込まれます。

学習開始

【学習開始】ボタンを押下すると、訓練データによる学習が開始されます。
ロスの値が学習終了判定値を下回るか、エポック数が最大エポック数を超えると学習を終了します。
学習が終了すると、正解数、正解率が計算されます。

テスト開始

【テスト開始】ボタンを押下すると、テストデータによるテストが実行されます。
学習に使われていないテストデータでどれくらい正解するかを調べ、正しく学習されていることを確認します。
なお、学習前に【テスト開始】をした場合、ニューラルネットワークはいいかげんな判断を行います。

重みクリア

学習により求められた重みの値をクリアします。
重みがクリアされるので、ニューラルネットワークは学習していない状態に戻ります。


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（mdlSupervisor）

VBA ニューラルネットワーク

スーパーバイザ

メインの処理となるモジュールです。

'[mdlSupervisor - 標準モジュール]
Option Explicit
Option Base 1

Dim mcInLayer As classInputLayer
Dim mcHLayer1 As classHiddenLayer
Dim mcHLayer2 As classHiddenLayer
Dim mcOutLayer As classOutputLayer

'ユニット数を設定する
'[引数] <- aWsInputData : Worksheet / 入力データのあるシート
'[戻り値] -> なし
Private Sub setUnitCount(ByRef aWsInputData As Worksheet)
    
    With aWsInputData
        G.UnitCount_IN = .Cells(RW.DATA_TITLE, Columns.count).End(xlToLeft).Column - 1
    End With
    
    G.UnitCount_H1 = 3
    G.UnitCount_H2 = 4
    
    G.UnitCount_OUT = 3
    
End Sub

'ユニットを作成する
'[引数] <-　なし
'[戻り値] -> なし
Private Sub makeUnit()
    Dim actHidden As Long
    Dim actOutput As Long
    
    Set mcInLayer = New classInputLayer
    Set mcHLayer1 = New classHiddenLayer
    Set mcHLayer2 = New classHiddenLayer
    Set mcOutLayer = New classOutputLayer
    
    With ws_Main
        actHidden = getActivationFunction(.Range(G.RNG_ACT_HIDDEN).Value)
        actOutput = getActivationFunction(.Range(G.RNG_ACT_OUTPUT).Value)
    End With

    Call mcHLayer1.Initialize(G.UnitCount_H1, G.UnitCount_IN, actHidden)
    Call mcHLayer2.Initialize(G.UnitCount_H2, G.UnitCount_H1, actHidden)
    Call mcOutLayer.Initialize(G.UnitCount_OUT, G.UnitCount_H2, actOutput)
    
End Sub

Public Sub Click_学習開始()
    Call StartTrain
End Sub

Public Sub Click_テスト開始()
    Call StartTest
End Sub

Public Sub Click_学習状況クリア()
    ws_W_H1.Cells.Clear
    ws_W_H2.Cells.Clear
    ws_W_Out.Cells.Clear
    
    Call clearResult
End Sub

Public Sub StartTrain()
    Dim r As Long
    Dim c As Long
    Dim eRow As Long
    Dim eCol As Long
    Dim label As String
    Dim t() As Long
    Dim datas() As Double
    Dim res() As Double
    Dim e As Double
    Dim sumE As Double
    Dim i As Long
    Dim epoc As Long
    Dim minLoss As Double
    Dim maxEpoc As Long
    Dim cnt As Long
    Dim ansIndex As Long
    Dim ansRate As Double

    Call setUnitCount(ws_Train_Data_Input)
    Call makeUnit
    
    With ws_Main
        G.LearningRate = CDbl(.Range(G.RNG_LEARNING_RATE).Value)
        minLoss = CDbl(.Range(G.RNG_MIN_LOSS).Value)
        maxEpoc = CLng(.Range(G.RNG_MAX_EPOCH).Value)
    
        If .Range(G.RNG_W_LOAD).Value = "はい" Then
            Call mcHLayer1.LoadWeight(ws_WI_H1)
            Call mcHLayer2.LoadWeight(ws_WI_H2)
            Call mcOutLayer.LoadWeight(ws_WI_Out)
        Else
            Call mcHLayer1.SaveWeight(ws_WI_H1)
            Call mcHLayer2.SaveWeight(ws_WI_H2)
            Call mcOutLayer.SaveWeight(ws_WI_Out)
        End If
    
    End With
    
    Call clearResult
    
    On Error GoTo ErrorLabel
    
    With ws_Train_Data_Input
    
        eRow = .Cells(Rows.count, 1).End(xlUp).Row
        eCol = .Cells(RW.DATA_TITLE, Columns.count).End(xlToLeft).Column
        
        ReDim datas(eCol - 1)

        Do
        
            epoc = epoc + 1
            
            If epoc > maxEpoc Then
                Exit Do
            End If
            
            sumE = 0
            cnt = 0
    
            For r = 2 To eRow
            
                cnt = cnt + 1
            
                For c = 2 To eCol
                    datas(c - 1) = .Cells(r, c).Value
                Next
            
                label = .Cells(r, CL.DATA_LABEL).Value
                t = getT(G.UnitCount_OUT, label)

                Call mcHLayer1.Forward(datas)
                Call mcHLayer2.Forward(mcHLayer1.OutputDataList)
                Call mcOutLayer.Forward(mcHLayer2.OutputDataList)
                
                ansIndex = mcOutLayer.GetAnswerIndex
                ansRate = mcOutLayer.GetAnswerRate(ansIndex)
                Call getAnswer(ws_Train_Result, r, ansIndex, ansRate, label)
                
                res = mcOutLayer.OutputDataList
            
                e = ML.crossEntropyError(t, res)
                sumE = sumE + e
                
                Call mcOutLayer.Backprop(t)
                
                For i = 1 To G.UnitCount_H2
                    Call mcHLayer2.Backprop(i, mcOutLayer.deltaList, mcOutLayer.GetWeightList(i))
                Next
                
                For i = 1 To G.UnitCount_H1
                    Call mcHLayer1.Backprop(i, mcHLayer2.deltaList, mcHLayer2.GetWeightList(i))
                Next
            
            Next

            With ws_Main
                DoEvents
                .Cells(epoc, CL.LOSS_).Value = (sumE / cnt)
                Application.Calculate
                .Cells(epoc, CL.LOSS_CORRECT).Value = .Range(G.RNG_TRAIN_CORRECT_COUNT).Value
                DoEvents
            End With
            
        Loop Until sumE / cnt < minLoss

    End With
    
    Call mcHLayer1.SaveWeight(ws_W_H1)
    Call mcHLayer2.SaveWeight(ws_W_H2)
    Call mcOutLayer.SaveWeight(ws_W_Out)
    
    Exit Sub
    
ErrorLabel:
    MsgBox "パラメータが発散しました。", vbOKOnly + vbExclamation

End Sub

Public Sub StartTest()
    Dim r As Long
    Dim c As Long
    Dim eRow As Long
    Dim eCol As Long
    Dim label As String
    Dim t() As Long
    Dim datas() As Double
    Dim ansIndex As Long
    Dim irisName As String
    Dim ansRate As Double

    Call setUnitCount(ws_Test_Data_Input)
    Call makeUnit
    
    Call mcHLayer1.LoadWeight(ws_W_H1)
    Call mcHLayer2.LoadWeight(ws_W_H2)
    Call mcOutLayer.LoadWeight(ws_W_Out)
        
    With ws_Test_Data_Input
    
        eRow = .Cells(Rows.count, 1).End(xlUp).Row
        eCol = .Cells(RW.DATA_TITLE, Columns.count).End(xlToLeft).Column
        
        ReDim datas(eCol - 1)
    
        For r = 2 To eRow
        
            For c = 2 To eCol
                datas(c - 1) = .Cells(r, c).Value
            Next
        
            label = .Cells(r, CL.DATA_LABEL).Value
            t = getT(G.UnitCount_OUT, label)
            
            Call mcHLayer1.Forward(datas)
            Call mcHLayer2.Forward(mcHLayer1.OutputDataList)
            Call mcOutLayer.Forward(mcHLayer2.OutputDataList)

            ansIndex = mcOutLayer.GetAnswerIndex
            ansRate = mcOutLayer.GetAnswerRate(ansIndex)
            
            Call getAnswer(ws_Test_Result, r, ansIndex, ansRate, label)
        
        Next
        
    End With

End Sub

Private Sub getAnswer(ByRef wsResult As Worksheet, ByRef tr As Long, ByRef ansIndex As Long, ByRef ansRate As Double, ByRef label As String)
    Dim irisName As String
    
        Select Case ansIndex
            Case IRIS.SETOSA
                irisName = G.VAL_SETOSA
            Case IRIS.VERSICOLOR
                irisName = G.VAL_VERSICOLOR
            Case IRIS.VIRGINICA
                irisName = G.VAL_VIRGINICA
        End Select
            
    With wsResult
            .Cells(tr, CL.RESULT_LABEL).Value = label
            .Cells(tr, CL.RESULT_ANSWER).Value = irisName
            .Cells(tr, CL.RESULT_RATE).Value = Format(ansRate, "0.0%")
            
            .Cells(tr, CL.RESULT_TF).Value = (irisName = label)
    End With
    
End Sub

Private Function getT(ByRef tCount As Long, ByRef label As String) As Long()
    Dim labels() As Long
    
    ReDim labels(tCount)
    
    Select Case label
        Case G.VAL_SETOSA
            labels(IRIS.SETOSA) = 1
        Case G.VAL_VERSICOLOR
            labels(IRIS.VERSICOLOR) = 1
        Case G.VAL_VIRGINICA
            labels(IRIS.VIRGINICA) = 1
    End Select
    
    getT = labels
    
End Function

Private Sub clearResult()

    With ws_Train_Result
        .Cells.Clear
        .Cells(1, CL.RESULT_LABEL).Value = "ラベル"
        .Cells(1, CL.RESULT_ANSWER).Value = "NNの答え"
        .Cells(1, CL.RESULT_RATE).Value = "自信度"
        .Cells(1, CL.RESULT_TF).Value = "判定"
    End With

    With ws_Test_Result
        .Cells.Clear
        .Cells(1, CL.RESULT_LABEL).Value = "ラベル"
        .Cells(1, CL.RESULT_ANSWER).Value = "NNの答え"
        .Cells(1, CL.RESULT_RATE).Value = "自信度"
        .Cells(1, CL.RESULT_TF).Value = "判定"
    End With
    
    With ws_Main
        .Range(.Columns(CL.LOSS_), .Columns(CL.LOSS_CORRECT)).Clear
    End With
    
End Sub

Private Function getActivationFunction(ByRef arg As String) As Long
    Dim res As Long
    
    Select Case arg
        Case G.VAL_ACT_ReLU
            res = ACT.ReLU
        Case G.VAL_ACT_Softmax
            res = ACT.Softmax
    End Select
    
    getActivationFunction = res
End Function


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（classOutputLayer）

VBA ニューラルネットワーク

出力層クラス

出力層のユニットを管理するクラスです。

'[classOutputLayer - 出力層クラス]
Option Explicit
Option Base 1

Dim mUnitList() As classUnit        'ユニット格納用リスト
Dim mUnitCount As Long              '自レイヤーのユニット数
Dim mAct As Long                        '活性関数の種類
Dim mWeightCount As Long            '自レイヤーに属するユニットが持つ重みの数
Dim mInputDataList() As Double
Dim mDeltaList() As Double

'自レイヤーのユニットを作成する
'[引数] <- aUnitCount : Long / ユニットの数, aInputCount : Long / 入力データの数, aActivationFunction : Long / 活性化関数の種類
Public Sub Initialize(ByRef aUnitCount As Long, ByRef aInputCount As Long, ByRef aActivationFunction As Long)
    Dim i As Long
    
    ReDim mUnitList(aUnitCount)
    
    '必要な数だけユニットを作成しユニット格納用リストに格納する
    For i = 1 To aUnitCount
        Set mUnitList(i) = New classUnit
        'Newしたユニットを初期化する
        Call mUnitList(i).Initialize(aInputCount)
    Next
    
    mUnitCount = aUnitCount
    mAct = aActivationFunction
    mWeightCount = aInputCount

End Sub

'順伝播：各ユニットのuとzを求める
'[引数] <- aInputDataList() : Double / 入力データのリスト
Public Sub Forward(ByRef aInputDataList() As Double)
    Dim i As Long
    
    'ユニットに入力値を渡して u を計算する
    For i = 1 To mUnitCount
        Call mUnitList(i).CalcU(aInputDataList)
    Next
    
    '活性化関数を適用して z を計算する
    Call activateU
    
    'バックプロパゲーション用に入力値を覚えておく
    mInputDataList = aInputDataList
    
End Sub

'次の層に渡すための出力リストを準備する
'[戻り値] -> OutputDataList() : Double / 自層の各ユニットの出力値のリスト
Public Function OutputDataList() As Double()
    Dim i As Long
    Dim outputDatas() As Double
    
    ReDim outputDatas(mUnitCount)
    
    For i = 1 To mUnitCount
        outputDatas(i) = mUnitList(i).Z
    Next
    
    OutputDataList = outputDatas()
    
End Function

'ユニットの u に活性化関数を適用する
Private Sub activateU()

    If mAct = ACT.Softmax Then
        Call activationSoftmax
    End If

End Sub

'ユニットの u にSoftmaxを適用する
Private Sub activationSoftmax()
    Dim i As Long
    Dim uList() As Double
    
    'Softmaxの計算には全出力値が必要となるため、配列に格納
    ReDim uList(mUnitCount)
    
    For i = 1 To mUnitCount
        uList(i) = mUnitList(i).U
    Next
    
    For i = 1 To mUnitCount
        mUnitList(i).Z = ML.actSoftmax(uList, i)
    Next
    
End Sub

Public Sub Backprop(ByRef aT() As Long)
    Dim i As Long
    Dim Z() As Double
    
    Z = OutputDataList
    
    ReDim mDeltaList(mUnitCount)
    For i = 1 To mUnitCount
        mDeltaList(i) = Z(i) - aT(i)
        
        'ユニットの重みを更新
        Call mUnitList(i).Backprop(mDeltaList(i), mInputDataList)

    Next
    
End Sub

Public Function deltaList() As Double()
    deltaList = mDeltaList
End Function

Public Function GetWeightList(ByRef aWeightIndex As Long) As Double()
    Dim i As Long
    Dim res() As Double
    
    ReDim res(mUnitCount)
    For i = 1 To mUnitCount
        res(i) = mUnitList(i).GetW(aWeightIndex)
    Next
    
    GetWeightList = res
    
End Function

'最も大きい出力値のユニットのインデックスを返す
Public Function GetAnswerIndex() As Long
    Dim i As Long
    Dim ans As Long
    
    ans = 1
    For i = 2 To mUnitCount
        If mUnitList(i).Z > mUnitList(ans).Z Then
            ans = i
        End If
    Next
    
    GetAnswerIndex = ans
    
End Function

Public Function GetAnswerRate(ByRef aIndex As Long) As Double
    GetAnswerRate = mUnitList(aIndex).Z
End Function

Public Sub SaveWeight(ByRef aSh As Worksheet)
    Dim i As Long
    Dim j As Long
    
    With aSh
        .Cells.Clear
        
        For i = 1 To mUnitCount
            .Cells(i, 1).Value = mUnitList(i).GetBias
            For j = 1 To mWeightCount
                .Cells(i, j + 1).Value = mUnitList(i).GetW(j)
            Next
        Next
    
    End With
    
End Sub

'重みとバイアスの値をシートから読み込む
'[引数] <- aSh : Worksheet / 読み込み先のシート
Public Sub LoadWeight(ByRef aSh As Worksheet)
    Dim i As Long
    Dim j As Long
    
    With aSh
        For i = 1 To mUnitCount
            Call mUnitList(i).SetBias(.Cells(i, 1).Value)
            For j = 1 To mWeightCount
                Call mUnitList(i).SetW(j, .Cells(i, j + 1).Value)
            Next
        Next
    
    End With
    
End Sub


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（classHiddenLayer）

VBA ニューラルネットワーク

隠れ層

隠れ層のユニットを管理するクラスです。

'[classHiddenLayer - 隠れ層クラス]
Option Explicit
Option Base 1

Dim mUnitList() As classUnit        'ユニット格納用リスト
Dim mUnitCount As Long              '自レイヤーのユニット数
Dim mAct As Long                        '活性関数の種類
Dim mWeightCount As Long         '自レイヤーに属するユニットが持つ重みの数
Dim mInputDataList() As Double      '入力用データリスト
Dim mDeltaList() As Double              '逆伝播時の勾配格納用リスト

'自レイヤーのユニットを作成する
'[引数] <- aUnitCount : Long / ユニットの数, aInputCount : Long / 入力データの数, aActivationFunction : Long / 活性化関数の種類
Public Sub Initialize(ByRef aUnitCount As Long, ByRef aInputCount As Long, ByRef aActivationFunction As Long)
    Dim i As Long
    
    ReDim mUnitList(aUnitCount)
    ReDim mDeltaList(aUnitCount)
    
    '必要な数だけユニットを作成しユニット格納用リストに格納する
    For i = 1 To aUnitCount
        Set mUnitList(i) = New classUnit
        'Newしたユニットを初期化する
        Call mUnitList(i).Initialize(aInputCount)
    Next
    
    mUnitCount = aUnitCount
    mAct = aActivationFunction
    
    mWeightCount = aInputCount

End Sub

'順伝播：各ユニットのuとzを求める
'[引数] <- aInputDataList() : Double / 入力データのリスト
Public Sub Forward(ByRef aInputDataList() As Double)
    Dim i As Long
    
    'ユニットに入力値を渡して u を計算する
    For i = 1 To mUnitCount
        Call mUnitList(i).CalcU(aInputDataList)
    Next
    
    '活性化関数を適用して z を計算する
    Call activateU
    
'    バックプロパゲーション用に入力値を覚えておく
    mInputDataList = aInputDataList
    
End Sub

'次の層に渡すための出力リストを準備する
'[戻り値] -> OutputDataList() : Double / 自層の各ユニットの出力値のリスト
Public Function OutputDataList() As Double()
    Dim i As Long
    Dim outputDatas() As Double
    
    ReDim outputDatas(mUnitCount)
    
    For i = 1 To mUnitCount
        outputDatas(i) = mUnitList(i).Z
    Next
    
    OutputDataList = outputDatas()
    
End Function

'ユニットの u に活性化関数を適用する
Private Sub activateU()

    If mAct = ACT.ReLU Then
        Call activationReLU
    End If

End Sub

'ユニットの u にReLUを適用する
Private Sub activationReLU()
    Dim i As Long
    
    For i = 1 To mUnitCount
        mUnitList(i).Z = ML.actReLU(mUnitList(i).U)
    Next
    
End Sub

Private Function calcDiff(ByRef aU As Double) As Double
    Dim res As Double
    
    If mAct = ACT.ReLU Then
        res = diffReLU(aU)
    End If
    
    calcDiff = res

End Function

Private Function diffReLU(ByRef aU As Double) As Double
    Dim res As Double
    
    If aU > 0 Then
        res = 1#
    Else
        res = 0#
    End If
    
    diffReLU = res
End Function

Public Sub Backprop(ByRef aIndex As Long, ByRef aDeltaList() As Double, ByRef aWeightList() As Double)
    Dim i As Long
    Dim delta As Double
    
    For i = 1 To UBound(aDeltaList)
            
        delta = delta + (aDeltaList(i) * aWeightList(i) * calcDiff(mUnitList(aIndex).U))
            
    Next
    
    mDeltaList(aIndex) = delta
    
    'ユニットの重みを更新
    Call mUnitList(aIndex).Backprop(delta, mInputDataList)
    
End Sub

Public Function deltaList() As Double()
    deltaList = mDeltaList
End Function

Public Function GetWeightList(ByRef aWeightList As Long) As Double()
    Dim i As Long
    Dim res() As Double
    
    ReDim res(mUnitCount)
    For i = 1 To mUnitCount
        res(i) = mUnitList(i).GetW(aWeightList)
    Next
    
    GetWeightList = res
    
End Function

Public Sub SaveWeight(ByRef aSh As Worksheet)
    Dim i As Long
    Dim j As Long
    
    With aSh
        .Cells.Clear
        
        For i = 1 To mUnitCount
            .Cells(i, 1).Value = mUnitList(i).GetBias
            For j = 1 To mWeightCount
                .Cells(i, j + 1).Value = mUnitList(i).GetW(j)
            Next
        Next
    
    End With
    
End Sub

'重みとバイアスの値をシートから読み込む
'[引数] <- aSh : Worksheet / 読み込み先のシート
Public Sub LoadWeight(ByRef aSh As Worksheet)
    Dim i As Long
    Dim j As Long
    
    With aSh
        For i = 1 To mUnitCount
            Call mUnitList(i).SetBias(.Cells(i, 1).Value)
            For j = 1 To mWeightCount
                Call mUnitList(i).SetW(j, .Cells(i, j + 1).Value)
            Next
        Next
    
    End With
    
End Sub


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（classInputLayer）

VBA ニューラルネットワーク

入力層のユニット管理

入力層のユニットを管理するためのクラスです。

'[classInputLayer - 入力層のユニットを管理するためのクラス]
Option Explicit
Option Base 1

Dim mInUnitList() As classInputUnit     'ユニット格納用リスト
Dim mInUnitCount As Long                  '入力層のユニット数

'入力層のユニットに入力値を格納する
'[引数] <- aInputDataList() : Double / 入力値のリスト
Public Sub DataInput(ByRef aInputDataList() As Double)
    Dim i As Long
    Dim cInUnit As classInputUnit
    
    mInUnitCount = UBound(aInputDataList)
    
    ReDim mInUnitList(mInUnitCount)
    
    For i = 1 To mInUnitCount
        Set mInUnitList(i) = New classInputUnit
        mInUnitList(i).X = aInputDataList(i)
    Next
    
End Sub

'入力層のユニットの出力値を得る
'[戻り値] -> OutputDataList() : Double / 出力値のリスト
Public Function OutputDataList() As Double()
    Dim i As Long
    Dim outputDatas() As Double
    
    ReDim outputDatas(mInUnitCount)
    
    For i = 1 To mInUnitCount
        outputDatas(i) = mInUnitList(i).X
    Next
    
    OutputDataList = outputDatas()
    
End Function


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（classInputUnit, classUnit）

VBA ニューラルネットワーク

入力層のユニットクラス

入力層のみ実装が異なります。

'[classInputUnit - 入力層のユニットクラス]
Option Explicit

Dim mX As Double

'入力データをセットする
'[引数] <- inputData : Double / 入力データ
Public Property Let X(ByRef aInputData As Double)
    mX = aInputData
End Property

'入力データを返す
'[戻り値] -> X : Double / 入力データ
Public Property Get X() As Double
    X = mX
End Property

ユニットクラス

ユニットクラスの実装です。

'[classUnit - ユニットクラス]
Option Explicit
Option Base 1

Dim mWeightList() As Double         '重みのリスト
Dim mBias As Double                 'バイアス
Dim mU As Double                    '活性化関数適用前の合計値
Dim mZ As Double                    '出力値

'パラメータ（重みとバイアス）を初期化する
'[引数] <- aWeightCount : Long / 重みの数
Public Sub Initialize(ByRef aWeightCount As Long)
    Dim i As Long
    
    ReDim mWeightList(aWeightCount)
    '各重みをランダム値で初期化
    For i = 1 To aWeightCount
        mWeightList(i) = ML.getRandom()
    Next
    
    'バイアスを0で初期化
    mBias = 0
    
End Sub

'活性化関数適用前の合計値を計算する
'入力値にそれぞれの重みを掛けてバイアス値を加える
'[引数] <- aInputDataList() : Double / 入力値のリスト
Public Sub CalcU(ByRef aInputDataList() As Double)
    Dim i As Long

    mU = mBias
    For i = 1 To UBound(aInputDataList)
        mU = mU + (mWeightList(i) * aInputDataList(i))
    Next
    
End Sub

'活性化関数適用前の合計値を返す
'[戻り値] -> U : Double / 活性化関数適用前の合計値
Public Property Get U() As Double
    U = mU
End Property

'出力値を格納する
'[引数] <- aActivatedU : Double / 活性化関数適用後の合計値
Public Property Let Z(ByRef aActivatedU As Double)
    mZ = aActivatedU
End Property

'出力値を返す
'[戻り値] -> Z : Double / 出力値
Public Property Get Z() As Double
    Z = mZ
End Property

'バイアス値をセットする
'[引数] <- aBias : Double / バイアス値
Public Sub SetBias(ByRef aBias As Double)
    mBias = aBias
End Sub

'バイアス値を返す
'[戻り値] -> GetBias : Double / バイアス値
Public Function GetBias() As Double
    GetBias = mBias
End Function

'重みをセットする
'[引数] <- aIndex : Long / インデックス, aW : Double / 重み
Public Sub SetW(ByRef aIndex As Long, ByRef aW As Double)
    mWeightList(aIndex) = aW
End Sub

'重みを返す
'[引数] <- aIndex : Long / インデックス
'[戻り値] -> GetW : Double / 重み
Public Function GetW(ByRef aIndex As Long) As Double
    GetW = mWeightList(aIndex)
End Function

'バックプロパゲーション（重みを更新する）
'（学習率 × 勾配 × 入力値）の計算結果を重みから引いて、重みを更新する
'バイアスも同様に計算する（ただし、バイアスの入力値は 1）
'[引数] <- aDelta : Double / 勾配の計算結果, aInputDataList() : Double / 入力値のリスト
'Public Sub UpdateWeight(ByRef aDelta As Double, ByRef aInputDataList() As Double)
Public Sub Backprop(ByRef aDelta As Double, ByRef aInputDataList() As Double)
    Dim i As Long
    
    For i = 1 To UBound(mWeightList)
        mWeightList(i) = mWeightList(i) - (G.LearningRate * aDelta * aInputDataList(i))
    Next
    
    mBias = mBias - (G.LearningRate * aDelta * 1)
    
End Sub


f:id:celaeno42:20181212233850p:plain

【VBA編】ニューラルネットワーク（ML）

VBA ニューラルネットワーク

演算用モジュール

活性化関数や損失関数を実装します。

'[ML - マシンラーニング演算用モジュール]
Option Explicit
Option Base 1

'活性化関数 ReLU
'[引数] <- aU : Double / ユニットの u
'[戻り値] -> actReLU : Double / ReLU適用後の値
Public Function actReLU(ByVal aU As Double) As Double

    actReLU = WorksheetFunction.max(aU, 0)

End Function

'活性化関数 Softmax
'[引数] <- aUList() : Double / 出力層のすべての出力値のリスト, aIndex : Long / 対象のユニットのインデックス
'[戻り値] -> actSoftmax : Double / Softmax適用後の値
Public Function actSoftmax(ByRef aUList() As Double, ByRef aIndex As Long) As Double
    Dim i As Long
    Dim max As Double
    Dim sum As Double

    'オーバーフロー対策ですべての出力値から最大値を引く必要があるため最大値を求めておく
    max = WorksheetFunction.max(aUList)
    
    '分母部分の計算
    sum = 0
    For i = 1 To UBound(aUList)
        sum = sum + Exp(aUList(i) - max)
    Next

    '該当ユニットの出力値を全出力値で割る
    actSoftmax = Exp(aUList(aIndex) - max) / sum
    
End Function

'-1 < num < 1 で0以外のランダム値を返す
'[戻り値] -> getRandom() : Double / -1 より大きく 1 より小さいランダム値（0以外）
Public Function getRandom() As Double
    Dim i As Long
    Dim res As Double
    
    Randomize
        
    Do
        res = (Rnd * 2) - 1
    Loop Until res <> 0
    
    getRandom = res

End Function

'損失関数　クロスエントロピーエラー
'[引数] <- aT() : Long / 正解ラベル（one-hot表現された教師データ）,
'　　　　　　　　aZ : Double / ニューラルネットワークの出した予想確率（出力層ユニットの出力値）
'[戻り値] -> crossEntropyError : Double / crossEntropyErrorの値
Public Function crossEntropyError(ByRef aT() As Long, ByRef aZ() As Double) As Double
    Dim i As Long
    Dim res As Double

    res = 0
    For i = 1 To UBound(aT)
        res = res + (aT(i) * Log(aZ(i) + 0.0000001))        'エラー回避のために微小な値を足している
    Next

    res = res * -1

    crossEntropyError = res
End Function


f:id:celaeno42:20181212233850p:plain