無限不可能性ドライブ

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

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

出力層クラス

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

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