2019-03-02

勾配降下法を、いま一つ腹落ちしていない過去の自分にくどくどと説明してみる。

勾配降下法

このブログでは VBAでニューラルネットワークをフルスクラッチする連載をしてますが、数式編でやった通りパラメータ更新の式は手順を追って導出できたのですが、その理屈的なところがどうもしっくりいってなかったので、そんな自分でもわかるレベルで勾配降下法の説明をしてみる内容の記事にしてみました。
内容的にかなり長くなってしまったのと、このブログのいまのタイミングとちょっと合わないと思ったので今回は Qiita に投稿しています。
qiita.com

たぶん、実際に手を動かして計算したり Excel でグラフを作ったりすると理解しやすいかも。と思います。

恐ろしいことに、ずっとこのあたりがもやもやしていたのですが、この記事を書いたとたん（というか書く準備をしている時点で）なんでもやもやしていたのかがいまひとつ思い出せなくなりました。。「わかってしまうとなにがわからなかったかがわからなくなってしまう」というのは、なかなかの困った人間の性質です。。

2019-02-09

【VBA編】（順伝播）動作確認（２）

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

f:id:celaeno42:20181201115558p:plain

順伝播の実行

前回は順伝播の動作確認で必要な部分のコードを追加しました。
今回は、実際にデータを読み込んで順伝播の処理を行い、結果を表示させてみます。
celaeno42.hatenablog.com

データの準備

使用するデータは以前の記事で準備しています。

celaeno42.hatenablog.com
celaeno42.hatenablog.com

順伝播テストのコード

では、順伝播のテスト用コードを書いていきましょう。
流れとしては、読み込んだデータを入力層に渡し、入力層の出力結果を１つめの隠れ層に渡し、１つめの隠れ層の出力結果を２つめの隠れ層に渡し、２つめの隠れ層の出力結果を出力層に渡して、最終出力を得る。というものです。
各層はデータを受け取ると順伝播の計算を行って結果を出力するという設計にしているので、上記のように順番に層をつなげていくことでデータ入力から最終出力を得ることができるようになっています。

標準モジュール【mdlForwardTest】

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

Public Sub 順伝播テスト()
    Dim datas() As Double
    Dim r As Long
    Dim c As Long
    Dim eRow As Long
    Dim eCol As Long
    Dim label As String                 '正解
    Dim answer As String              'ニューラルネットワークが出した答え
    Dim count As Long
    Dim correctCount As Long        '正解数
    
    '[ 1 ] 入力層、隠れ層１、隠れ層２、出力層を宣言する
    '（入力層を省略した場合は cInputLayer の宣言等は不要）
    Dim cInputLayer As classInputLayer:             Set cInputLayer = New classInputLayer
    Dim cHiddenLayer1 As classHiddenLayer:      Set cHiddenLayer1 = New classHiddenLayer
    Dim cHiddenLayer2 As classHiddenLayer:      Set cHiddenLayer2 = New classHiddenLayer
    Dim cOutputLayer As classOutputLayer:        Set cOutputLayer = New classOutputLayer

    ws_Train_Result.Cells.Clear
    
    '[ 2 ] 入力データ用の配列を準備する
    With ws_Train_Data_Input
        eRow = .Cells(Rows.count, CL.DATA_LABEL).End(xlUp).Row
        eCol = .Cells(RW.DATA_START, Columns.count).End(xlToLeft).Column
        ReDim datas(eCol - 1)
    End With
    
    '[ 3 ] 隠れ層と出力層を初期化：ユニット数, 入力データの項目数, 活性化関数の種類
    Call cHiddenLayer1.Initialize(3, UBound(datas), ACT.ReLU)
    Call cHiddenLayer2.Initialize(4, 3, ACT.ReLU)
    Call cOutputLayer.Initialize(3, 4, ACT.Softmax)

    '[ 4 ] 入力データを順番に処理していく
    count = 0
    correctCount = 0
    For r = RW.DATA_START To eRow

        '[ 5 ] 入力データの配列に１つ分のデータをセットする
        For c = CL.DATA_START To eCol
            datas(c - 1) = ws_Train_Data_Input.Cells(r, c).Value
        Next
        '[ 6 ] ラベル（正解）をセットする
        label = ws_Train_Data_Input.Cells(r, 1).Value

        count = count + 1
        
        '[ 7 - 1 ] 順伝播を行う
        '----入力層を省略しない場合----
        '入力層にデータを渡す
        Call cInputLayer.DataInput(datas)
        '隠れ層１に入力層の出力値を渡して順伝播を行う
        Call cHiddenLayer1.Forward(cInputLayer.OutputDataList)
        '隠れ層２に隠れ層１の出力値を渡して順伝播を行う
        Call cHiddenLayer2.Forward(cHiddenLayer1.OutputDataList)
        '出力層に隠れ層２の出力値を渡して順伝播を行う
        Call cOutputLayer.Forward(cHiddenLayer2.OutputDataList)
        '----------------------------

        '[ 7 - 2 ] 順伝播を行う
        '----入力層を省略した場合----
'        Call cHiddenLayer1.Forward(datas)
'        Call cHiddenLayer2.Forward(cHiddenLayer1.OutputDataList)
'        Call cOutputLayer.Forward(cHiddenLayer2.OutputDataList)
        '----------------------------
        
        '[ 8 ] 出力層の出した答えのインデックスを元に Iris の種類を answer に格納する
        Select Case cOutputLayer.GetAnswerIndex
            Case IRIS.SETOSA
                answer = G.VAL_SETOSA
            Case IRIS.VERSICOLOR
                answer = G.VAL_VERSICOLOR
            Case IRIS.VIRGINICA
                answer = G.VAL_VIRGINICA
        End Select

        '[ 9 ] 結果をシートに出力する
        With ws_Train_Result
            .Cells(r, 1).Value = label
            .Cells(r, 2).Value = answer
            .Cells(r, 3).Value = (.Cells(r, 1).Value = .Cells(r, 2).Value)
            If label = answer Then
                correctCount = correctCount + 1
            End If
        End With

    Next
    
    '[ 10 ] 正解数を出力する
    With ws_Train_Result
        .Cells(1, 1).Value = count
        .Cells(1, 2).Value = correctCount
        .Cells(1, 3).Value = correctCount / count
    End With
    
End Sub

コードの解説

[ Option Base 1 ] を宣言しているので注意してください。

[ 1 ] 入力層、隠れ層１、隠れ層２、出力層を宣言する

今回のニューラルネットワークは隠れ層を２層にしているので、隠れ層として２つのクラスを宣言しています。「入力層の作成」で入力層の作成を省略した場合は「cInputLayer」の宣言は不要です。

[ 2 ] 入力データ用の配列を準備する

「訓練データ（入力）」シートのデータをもとに、データの最終行（データの件数）を調べ、また、１件分のデータの項目数からデータ格納用の配列を準備しています。

[ 3 ] 隠れ層と出力層を初期化：ユニット数, 入力データ数, 活性化関数の種類

隠れ層と出力層のユニットを生成し、それぞれの層を構築します。引数はその層のユニット数、その層への入力データの項目数、活性化関数の種類です。例えば、２層めの隠れ層は上の図を見ると、ユニット数は4つで前の層からの各ユニットへの入力数は3つになっています。
なお、入力層については特に初期化は不要です。

[ 4 ] 入力データを順番に処理していく

「訓練データ（入力）」シートのデータを順番に処理していきます。

[ 5 ] 入力データの配列に１つ分のデータをセットする

データ格納用の配列 datas() に１つ分（１行分）のデータを格納していきます。
１列目はラベルなので、入力用のデータとしては２列目からです。
具体的には「がくの長さ」,「がくの幅」,「花弁の長さ」,「花弁の幅」の４つです。
f:id:celaeno42:20190303225656p:plain

[ 6 ] ラベル（正解）をセットする

ラベルを変数に格納します。

[ 7 ] 順伝播を行う

各層の Forward() を呼び出して順伝播を実行します。引数として前の層の出力のリストを渡します。
入力層を省略しなかった場合と省略した場合で若干異なります。

[ 8 ] 出力層の出した答えのインデックスを元に Iris の種類を answer に格納する

[ 7 ] で実行した順伝播によって計算された答えのインデックスを元に Iris の種類「Iris-setosa」,「Iris-versicolor」,「Iris-virginica」を answer 変数に格納します。

[ 9 ] 結果をシートに出力する

ラベル、順伝播で出した答え、ラベルと答えがあっているかどうか（= True or False）をデータごとに「訓練結果」シートに出力します。
あわせて、正解数をカウントしています。

[ 10 ] 正解数を出力する

最後にデータ数、正解数、正解率を出力します。

テスト実行

では、「順伝播テスト()」プロシージャを実行してみましょう。
実行したら「訓練結果」シートを確認してみます。

f:id:celaeno42:20190208235105p:plain

１行目は左から、データ数、正解数、正解率です。32.6% くらいしか正解してないですね。というのも、このニューラルネットワークはまだぜんぜん学習していない（パラメータをランダムに決めただけ）なので、あてずっぽうに解答しているからです。本来はここから学習してだんだんと精度を上げていくのですが、まだ学習の機能（逆伝播）は実装していないので、今回は学習済みのパラメータをもちいて学習済みの状態でもテストをしてみようと思います。なお、パラメータはランダムで設定されるので、実行のたびに結果は変わります。当然、必ずしも上記結果と同じになるわけではありません。

コードの追加

シートから学習済みのパラメータを読み込むために「順伝播テスト()」プロシージャに以下のようにコードを追加します。

    '[ 3 ] 隠れ層と出力層を初期化：ユニット数, 入力データ数, 活性化関数の種類
    Call cHiddenLayer1.Initialize(3, UBound(datas), ACT.ReLU)
    Call cHiddenLayer2.Initialize(4, 3, ACT.ReLU)
    Call cOutputLayer.Initialize(3, 4, ACT.Softmax)
    
'----この部分を追加----
    'Initializeでいったんランダムな重みが設定されるがLoadWeightすることで、上書きされる
    Call cHiddenLayer1.LoadWeight(ws_WI_H1)
    Call cHiddenLayer2.LoadWeight(ws_WI_H2)
    Call cOutputLayer.LoadWeight(ws_WI_Out)
'--------ここまで--------

    '[ 4 ] 入力データを順番に処理していく
    count = 0
    correctCount = 0
    For r = RW.DATA_START To eRow

読み込み用パラメータの設定

学習済みのパラメータをそれぞれの層のパラメータ初期値格納用シートに設定します。１行が１ユニット分のパラメータで、１列目がバイアス、２列目以降が重みです。
今回設定する具体的な値は以下の通りです。

隠れ層１層め用初期パラメータ格納シート【wi_h1】
f:id:celaeno42:20190209004626p:plain

隠れ層２層め用初期パラメータ格納シート【wi_h2】
f:id:celaeno42:20190209005538p:plain

出力層用初期パラメータ格納シート【wi_out】
f:id:celaeno42:20190209005639p:plain

学習済みパラメータで再度テストを実行

では再度「順伝播テスト()」プロシージャを実行してみましょう。
実行したら「訓練結果」シートを確認してみます。

f:id:celaeno42:20190209010031p:plain

129 個中 126 個が正解で、正解率は 97.7% までになっていますね！先ほどの 32.6% とは大違いです。

このように、最適と思われるパラメータを調整で求めていくことを「学習する」といいます。学習するには逆伝播をおこなってパラメータを調整していく必要があります。

次回以降はいよいよ逆伝播を実装してニューラルネットワークが学習できるようにしていきます。

f:id:celaeno42:20181212233850p:plain

2019-01-26

【VBA編】（順伝播）動作確認（１）

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

f:id:celaeno42:20181201115558p:plain

動作確認

前回までで順伝播については入力から出力まで計算できるようになりました。

celaeno42.hatenablog.com

ここまででいったん正しく動作するかを確認してみましょう。
ただ、その前にコードをいくつか追加しておきます。
それぞれ「----追加----」の部分を追加してください。

標準モジュール【G】

'[G - 標準モジュール]
Option Explicit

Public Const RNG_TRAIN_DATA_PATH As String = "C2"   '訓練データのパスを格納するセル
Public Const RNG_TEST_DATA_PATH As String = "C3"    'テストデータのパスを格納するセル

Public Enum RW
    DATA_TITLE = 1              'データのタイトル行
    DATA_START = 2             'データの開始行
End Enum

Public Enum CL
    DATA_LABEL = 1              'データのラベル列
    DATA_START = 2             'データの開始列
End Enum

'活性化関数
Public Enum ACT
    ReLU = 1
    Softmax = 2
End Enum

'----追加----
'Irisの種類名
Public Const VAL_SETOSA As String = "Iris-setosa"
Public Const VAL_VERSICOLOR As String = "Iris-versicolor"
Public Const VAL_VIRGINICA As String = "Iris-virginica"

'Irisの種類インデックス
Public Enum IRIS
    SETOSA = 1
    VERSICOLOR = 2
    VIRGINICA = 3
End Enum
'----ここまで----

Irisの種類名と種類インデックスを追加しています。

クラスモジュール【classUnit】

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

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

サブプロシージャ「SetBias()」「SetW()」を追加しています。

クラスモジュール【classHiddenLayer】

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

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

'自レイヤーのユニットを作成する
'[引数] <- 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
    
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

'----追加----
'重みとバイアスの値をシートから読み込む
'[引数] <- 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
'----ここまで----

モジュールレベル変数「mWeightCount」とInitializeプロシージャに[ mWeightCount = aInputCount ]、あとサブプロシージャ「LoadWeight()」を追加しています。「LoadWeight()」は（テスト用の）重みとバイアスの値をシートから読み込むためのプロシージャです。

クラスモジュール【classOutputLayer】

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

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

'自レイヤーのユニットを作成する
'[引数] <- 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
    
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 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

'----追加----
'重みとバイアスの値をシートから読み込む
'[引数] <- 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
'----ここまで----

classHiddenLayerと同じく、モジュールレベル変数「mWeightCount」とInitializeプロシージャに[ mWeightCount = aInputCount ]、あとサブプロシージャ「LoadWeight()」を追加しています。

次回は動作確認用のコードを書いていく予定です。

f:id:celaeno42:20181212233850p:plain

2019-01-20

【VBA】文字列をいい感じに改行してみる

VBA

面白そうなチャレンジだったのでやってみました。

ExcelのLENとかLENBって、全角も半角もおんなじだから、漢字とひらがなカタカナと半角英数が混じった文字をだいたい見た目同じあたりで改行するってコード書くのかなりめんどいのな。諦めた。
— fishb (@dampenedkid) January 18, 2019

Option Explicit

'メインのエントリポイントです。このプロシージャから実行してください。
Public Sub Main()
    Dim r As Long
    '一行あたりのバイト数（全角文字×2を指定のこと:全角10文字ごとに改行したい場合は20を指定）
    Const MAX_BYTE As Long = 20
    
    'A2～A5に対象の文字列を入力した状態で実行してください。
    '結果はB2～B5セルに出力されます。
    For r = 2 To 5
        Cells(r, 2).Value = いい感じに改行(Cells(r, 1).Value, MAX_BYTE)
    Next
    
End Sub

'なるべく一行が揃うように改行します。
'[引数] <- aStr : String / 対象の文字列, aMaxByte : Long / 一行あたりのバイト数
'[戻り値] -> String / 改行された文字列
Private Function いい感じに改行(ByRef aStr As String, ByRef aMaxByte As Long) As String
    Dim res As String
    Dim char1 As String
    Dim pos As Long
    Dim byteCount As Long
    Dim strLine As String

    '文字列を１文字ずつ取り出しつつ長さを計っていく
    For pos = 1 To Len(aStr)
        char1 = Mid(aStr, pos, 1)
        strLine = strLine & char1
        'vbのLenBの仕様上の都合により、StrConvで変換の上カウント
        byteCount = LenB(StrConv(strLine, vbFromUnicode))
        If byteCount >= (aMaxByte - 1) Then
            res = res & strLine & vbCrLf
            strLine = ""
        End If
    Next
    
    '最後に残った部分を追加
    res = res & strLine
    
    '末尾に改行がある場合は削除
    If Right(res, 2) = vbCrLf Then
        res = Left(res, Len(res) - 2)
    End If
    
    いい感じに改行 = res
     
End Function

f:id:celaeno42:20190120000103p:plain

だいたいいい感じのところで改行できてるようですね。

2019-01-18

【VBA】画像ファイルを（意図的に）壊して不慮の事故を防ぐあるいは暗号化してみる（２）

VBA

f:id:celaeno42:20181227232104p:plain

前回は１つのファイルだけを書き換えましたが、今回はフォルダ内の画像を一括変換する処理を書いていきましょう。

celaeno42.hatenablog.com

なお、ここでは「ファイルを壊す」ことを（説明の都合上）「暗号化」と表現することにします。

まずはフォルダの選択

今回はフォルダ内の複数の画像ファイルを一括して暗号化したいので、まずはフォルダ選択の処理を作成します。
Sheet1 の A1 セルをダブルクリックするとフォルダ選択ダイアログが開いて、フォルダを選択すると A1 セルにパスが格納されます。

【Sheet1】

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim dirPath As String
    
    If Target = Range("A1") Then
        
        Cancel = True
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                Range("A1").Value = .SelectedItems(1)
            End If
        End With
        
    End If
End Sub

ファイル一覧の取得

選択したフォルダ内の画像ファイルを取得します。今回は「.jpg」ファイルのみを対象としていますが、そのあたりは必要に応じて適当に変えてみてください。
取得したファイルのパスは（通常であれば）Sheet1 の A2 セルから順番に格納されていきます。

【標準モジュール】

Option Explicit

Public Sub Click_ファイル一覧取得()
    Dim dirPath As String
    Dim fileName As String
    Dim r As Long
    
    r = 2
    dirPath = Range("A1").Value & "\"
    fileName = Dir(dirPath & "*.jpg", vbNormal)

    While fileName <> ""
        Cells(r, 1).Value = dirPath & fileName
        r = r + 1
        fileName = Dir()
    Wend
    
    MsgBox "ファイル一覧を取得しました"
    
End Sub

これで処理すべき対象ファイルのパスがわかりました。

どう暗号化するか？

前回は先頭 1byte を 16進数の「89」から「90」に書き換えましたが、今回は複数のファイルを一括変換したいので、何らかのルールにもとづいて書き換えを実行した方がよさそうです。ルールを設定しておけば元に戻す場合も簡単です。
前回みたように、今回の処理では、ファイルをバイナリモードで読み込んでByte型の配列変数に格納しています。Byte型は「0～255」までの整数を扱いますが、「Not」演算子を使うことで値を反転させることができます。例えば変数 a が Byte型で値が 0 だった場合、 [ Not a ] とすると 255 が戻ります。また、a が 1 のときは 254、a が 253 のときは 2 が戻ります。今回はこれを利用して暗号化、復号化の処理を実装しましょう。なお、真ん中あたりの数値、a が 127 のときは 128, a が 128 のときは 127 になるので「Not」演算子で必ず自分とは別の値が戻ることは保証されます（同じ値が戻ってしまうと暗号化できませんので…）。

暗号化（エンコード）

では、実際に暗号化の処理を書いていきましょう。復号化の場合も暗号化と逆の処理（「Not」演算子で反転）をしているだけなので、プロシージャを分ける必要はありません。なので、プロシージャ名は「encode_decode()」としています。
また、引数としてファイルのパスを受け取るようにしています。なお、配列変数の「buffer」は Byte の配列であることに注意してください。

【標準モジュール】

'ファイルを暗号化（復号化）する
Private Sub encode_decode(ByRef filePath As String)
    Dim fileNo As Long
    Dim buffer() As Byte
    
    fileNo = FreeFile
    'ファイルをバイナリモードで開いてbuffer配列に格納する
    Open filePath For Binary As #fileNo
        ReDim buffer(LOF(fileNo))
        Get #fileNo, , buffer
    Close #fileNo
    
    '先頭 1byte を反転させる
    buffer(0) = Not buffer(0)
    
    fileNo = FreeFile
    'buffer配列をファイルとして書き出す
    Open filePath For Binary As #fileNo
        Put #fileNo, , buffer
    Close #fileNo
    
End Sub

暗号化処理の呼び出し

上で作った暗号化処理を呼び出しましょう。取得したファイル一覧を元に、「encode_decode()」プロシージャに順番にパスを渡していきます。
「Not」演算子で値を反転させているだけなので、暗号化されていない場合は暗号化が、暗号化されている場合は暗号化解除（復号化）が行われます。

【標準モジュール】

Public Sub Click_暗号化_暗号化解除()
    Dim r As Long
    Dim eRow As Long

    eRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For r = 2 To eRow
        Call encode_decode(Cells(r, 1).Value)
    Next
    
    MsgBox "終了しました"
    
End Sub

動作確認

これで「Click_暗号化_暗号化解除()」プロシージャを実行すればこのとおり。
サムネイルが表示されなくなる（ファイルが壊れる）ので誰かに勝手にフォルダを開けられても安心ですね。
f:id:celaeno42:20181228010152p:plain

もう一度実行すればこのとおり。ちゃんと元に戻ります。
f:id:celaeno42:20181228010211p:plain

あっ！… orz

※今回使用した（かわいい）画像は「V☆カツ」で作成しました。

f:id:celaeno42:20181212233850p:plain

2019-01-11

【VBA】画像ファイルを（意図的に）壊して不慮の事故を防ぐあるいは暗号化してみる（１）

VBA

f:id:celaeno42:20181227232104p:plain

俺の嫁フォルダががが…

あ！ちょっ…そのフォルダは開けちゃだめ！！なんてことがあったりなかったりするかもしれませんが、そういう場合に慌てないようにあまり見られたくない画像ファイルなんかは暗号化とかしておくとそういった不慮の事故が防げるかもしれませんね。まぁ、すでにひらきなおってる人はそんな必要はありませんが（私）。
今回は VBA で画像ファイルを意図的に壊しちゃいましょうというお話です。ある意味、暗号化といっていいかもしれません。

バイナリ

コンピュータは 0 と 1 ですべて処理をしているという話はどこかで聞いたことがあるかもしれません。ファイルだってそうなんです。

f:id:celaeno42:20181227232720p:plain

たとえばこの（かわいい）PNG画像ですが、バイナリエディタというちょっと特殊なエディタで開くとこんな感じになっています。

f:id:celaeno42:20181227233136p:plain

0 と 1 ではありませんね。それは 16進数で表示されているからです。これを 2進数で表示してみましょう。

f:id:celaeno42:20181227233613p:plain

上の画像では先頭が「89」になっていますが、下の画像では「1000 1001」になっています。
16進数の「8」は 2進数では「1000」、16進数の「9」は 2進数では「1001」なので、ちゃんと対応していますね。

このように、ファイルの実体は膨大な 0 と 1 の羅列になっています。
ちなみに、8bit で 1byte となるので、2進数の「1000 1001」が 1byte に相当します（1, 0 それぞれが 1bit です）。
16進数では「89」が 1byte ですね。

ファイルを壊してみる

ではちょっといたずらをして 2進数の先頭の 1 を 0 に書き換えてみましょう。

【いたずら前】
f:id:celaeno42:20181227234551p:plain
（かわいい）サムネイル画像がちゃんと表示されてますね。

【いたずら後】
f:id:celaeno42:20181227234758p:plain
（かわいい）サムネイル画像が表示されなくなってしまいました。
さらに…

f:id:celaeno42:20181227234940p:plain:w320

たった１か所、わずか 1bit を書き換えただけでファイルが壊れてしまいました。mjk…

まぁ、今回は書き換えた場所がわかっているので、元に戻せばちゃんとファイルも直ります。
f:id:celaeno42:20181227234551p:plain

かわいいですね。

このようにちょっとでもデータを書き換えるとファイルが壊れてしまいます。
さて、どうすればファイルが壊れるかがわかったのでこれを VBA で実装できればよさそうです。

バイナリモードで開く

先ほどはバイナリエディタで開きましたが、これと同じように VBA で読み込みができればいいですね。VBA ではバイナリモードで開くことで実現できます。

【標準モジュール】

Public Sub ReadBinary()
    Dim filePath As String
    Dim fileNo As Long
    Dim i As Long
    Dim buffer() As Byte        'バイナリデータ格納用の配列
    
    filePath = "C:\Users\xxxx\Desktop\ファイル暗号化\新しいフォルダー\image01.png"
    
    fileNo = FreeFile
    'ファイルをバイナリモードで開いてbuffer配列に格納する
    Open filePath For Binary As #fileNo
        ReDim buffer(LOF(fileNo))
        Get #fileNo, , buffer
    Close #fileNo
    
    '先頭8バイトだけ表示する
    For i = 0 To 7
        Cells(1, i + 1).Value = i + 1
        Cells(2, i + 1).Value = buffer(i)
    Next

End Sub

ファイルのデータを格納する配列変数「buffer」を宣言します。変数の型が Byte型になっていることに注意してください。
通常テキストファイルを開く場合は、[ Open filePath For Input As #fileNo ] のような書き方をすると思います。今回は画像ファイルをバイナリモードで開きたいので、[ Input ] の部分が [ Binary ] となっています。
ファイルを開いたら、データを格納する配列変数「buffer」のサイズを「ReDim」で設定し、「Get」で読み込んだデータを「buffer」に格納しています。「#fileNo」と「buffer」の間のカンマが 2つになっていることに注意してください（引数が一つ省略されています）。

読み込んだデータの先頭 8byte だけをシートに表示させています。

f:id:celaeno42:20181228222327p:plain

バイナリエディタで開いたものと比較してみましょう。

f:id:celaeno42:20181228222908p:plain

なんかちょっと違いますね。
エクセルの方は「137 80 78 71 …」となってますが、バイナリエディタでは「89 50 4E 47 …」となっています。
これはエクセルの方が 10進数で表示されているためなので、16進数に変換してみましょう。
ワークシート関数の「=DEC2HEX()」を使うと、10進数を16進数に変換できます。

f:id:celaeno42:20181228223222p:plain

バイナリエディタで開いたものと同じになりました（1桁のところは頭の0が省略されていると考えてください）。

バイナリデータを書き換える

バイナリモードで読み込むことができたので、これをちょっと書き換えて保存しなおしてみます。

Public Sub ReadWriteBinary()
    Dim filePath As String
    Dim fileNo As Long
    Dim i As Long
    Dim buffer() As Byte
    
    filePath = "C:\Users\celae\Desktop\ファイル暗号化\新しいフォルダー\image01.png"
    
    fileNo = FreeFile
    'ファイルをバイナリモードで開いてbuffer配列に格納する
    Open filePath For Binary As #fileNo
        ReDim buffer(LOF(fileNo))
        Get #fileNo, , buffer
    Close #fileNo
    
    '先頭8バイトだけ表示する
    For i = 0 To 7
        Cells(1, i + 1).Value = i + 1
        Cells(2, i + 1).Value = buffer(i)
    Next

'----追加----

    '先頭の1byteを16進数で90に書き換える
    buffer(0) = &H90
    
    fileNo = FreeFile
    'buffer配列をファイルとして書き出す
    Open filePath For Binary As #fileNo
        Put #fileNo, , buffer
    Close #fileNo
    
'------------

End Sub

先頭の 1byte のみを書き換えてみました。16進数として扱いたいので「&H」を付けています。
書き換えた内容をファイルとして書き出します。読み込み時は「Get」を使いましたが、今回は「Put」を使います。こちらも「#fileNo」と「buffer」の間のカンマが 2つになっていることに注意してください（引数が一つ省略されています）。

では、書き換えたファイルをバイナリエディタで開いた内容を見てみましょう。

f:id:celaeno42:20181228225558p:plain

先頭が「90」に書き換わり、画像が表示されなくなっていますね。
先頭を「89」に書き換えればまた正しく表示されるようになります。

f:id:celaeno42:20181228232225p:plain

かわいいですね。

今回は 1ファイルだけを扱いましたが、次回はフォルダ内の画像ファイルをまとめて変換する処理を書いていく予定です。

※バイナリエディタは「TSXBIN」を使わせていただきました。
※今回使用した（かわいい）画像は「V☆カツ」で作成しました。

f:id:celaeno42:20181212233850p:plain

2019-01-07

【VBA編】（順伝播）出力層の作成

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

f:id:celaeno42:20181201115558p:plain

出力層

前回は隠れ層のクラスを作成しました。今回は出力層用のクラスを作成します。なお、今回のコードは隠れ層とほとんど同じです。
celaeno42.hatenablog.com

出力層の初期化

隠れ層同様、初期化処理を作ります。コードは「classOutputLayer」に記述します。なお、内容は「classHiddenLayer」と同じです。

クラスモジュール【classOutputLayer】

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

Dim mUnitList() As classUnit        'ユニット格納用リスト
Dim mUnitCount As Long              '自レイヤーのユニット数
Dim mAct As Long                    '活性関数の種類

'自レイヤーのユニットを作成する
'[引数] <- 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
    
End Sub

順伝播

順伝播の処理も隠れ層と同様です。

クラスモジュール【classOutputLayer】

'順伝播：各ユニットの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
    
End Sub

活性化関数

今回の出力層では活性化関数として Softmax を適用します。
例えば出力層1つめのユニットの出力値を求める Softmax の計算式は以下の通りです。

$\displaystyle z_1^4 = Softmax(u_1^4) = \frac{\exp(u_1^4)}{\sum_{k=1}^3 \exp(u_k^4)} = \frac{\exp(u_1^4)}{\exp(u_1^4) + \exp(u_2^4) + \exp(u_3^4)}$

これをもとに【ML】モジュールに実装します。
なお、忘れずに [ Option Base 1 ] を宣言しておいてください。

標準モジュール【ML】

Option Explicit
Option Base 1

'活性化関数 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

計算式では、すべてのユニットの出力（を $\exp()$ したもの）の合計を求めて、該当のユニットの出力（の $\exp()$ ）をその合計で割っていますが、実装の際にはオーバーフローに気をつける必要があります。
$\exp(u_1^4)$ は $e^{u_1^4}$ で e は約 2.71828… のため、u が大きいとすぐにオーバーフローしてしまいます。そこで、実装時には出力層のユニットの u の最大値をそれぞれの出力値から引いて値を小さくすることで、オーバーフローを防ぐようにします。
ちなみに、活性化関数の適用をレイヤークラスで行うようにしているのは、Softmax の計算でその層の全ユニットの出力値が必要になるためです。自ユニットは他のユニットの出力値を知る必要がないため、あえてユニットクラスでは実装しないようにしました。ReLUなどの自ユニットの出力値だけが引数になっているものであれば、ユニットクラスに実装してもよいかと思います。

では、【classOutputLayer】に戻って、いま実装した「actSoftmax()」を呼び出す処理を書きましょう。

クラスモジュール【classOutputLayer】

'ユニットの 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

「actSoftmax()」の引数として渡すため、出力層のすべてのユニットの出力値をいったん配列に格納しています。

ニューラルネットワークの推測

出力層の各ユニットの z（最終出力値）が求まったので、出力値が最も大きいユニット（のインデックス）をニューラルネットワークが推測した答えとします。
今回のニューラルネットワークでは、最も出力値の大きいユニットが1番目のユニットであれば「Irsi-Setosa」、2番目のユニットであれば「Iris-Versicolor」、3番目のユニットであれば「Iris-Virginica」と推測したとします。最終的な判断は「mdlSupervisor」モジュールで行うため、ここではインデックスを返す処理のみを実装しています。

'最も大きい出力値のユニットのインデックスを返す
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

出力値リスト

各ユニットの z をリスト化（配列化）しておきます。隠れ層と違い次の層に渡すことはないのですが、損失関数の計算を行う際に必要となるので、隠れ層同様の処理をしておきます。
コードは隠れ層のものと同じです。

'次の層に渡すための出力リストを準備する
'[戻り値] -> 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

さて、これでニューラルネットワークの入力から推測までの実装ができました。ただ、パラメータを更新する機能は未実装なので、まだ学習はできません。この後は、いったん動作確認した後で、バックプロパゲーションによる学習機能を実装していく予定です。

f:id:celaeno42:20181212233850p:plain