無限不可能性ドライブ

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

【VBA編】ニューラルネットワーク(classHiddenLayer)

隠れ層

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

'[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