classtraining.cls

bp, backpropagation 神经网络 简单认字 错误开发实例。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassTraining"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'class for training page295


'-----------------------------Export to excel ability----------------------------
Dim objExcel As Excel.Application
Dim objWorkBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim row As Integer
Dim column As Integer
'******************************************Define constant**************************************
Const INPUT_LAYER = 63            'total input nodes
Const HIDDEN_LAYER = 4       'total hidden nodes
Const OUTPUT_LAYER = 26         'total output nodes
Const TOLERANCE = 0.5          'accepted level of sum squared error
Const ALPHA = 0.02            'learning rate
Const LOWER_LIMIT = -0.5        'minimum value for random weights
Const UPPER_LIMIT = 0.5           'maximum value for random weights
Const MAXLOOP = 5000          'maximum epoch for each training set

'*****************************************Declare neuron array****************************************
Dim x(1 To INPUT_LAYER) As Single   'input layer     x(i) , max i = INPUT_LAYER
Dim z(1 To HIDDEN_LAYER) As Single 'hidden layer   z(j),  max j = HIDDEN_LAYER
Dim y(1 To OUTPUT_LAYER) As Single 'output layer   y(k), max k = OUTPUT_LAYER
Dim t(1 To OUTPUT_LAYER) As Single     'target, t(k), max k = OUTPUT_LAYER

'******************************************Declare weights array***************************************
Dim v(INPUT_LAYER, 1 To HIDDEN_LAYER) As Single        'to store V(i,j), weight between input and hidden layers
'v(0, 1), v(0,2)....v(0, j) to store bias for z(j)
Dim w(HIDDEN_LAYER, 1 To OUTPUT_LAYER) As Single     'to store W(j,k). weights between input and hidden layers
'w(0,1), w(0,2)...w(0,k) to store bias for y(k)

'****************************************Declare weights+bias changes array********************************
Dim v_changes(1 To INPUT_LAYER, 1 To HIDDEN_LAYER) As Single   'store weight changes of v
Dim w_changes(1 To HIDDEN_LAYER, 1 To OUTPUT_LAYER) As Single 'store weight changes of w
Dim wB_changes(1 To OUTPUT_LAYER) As Single 'store bias changes of w
Dim vB_changes(1 To HIDDEN_LAYER) As Single 'store bias changes of v

'******************************Array to store input signal, z_in and y_in*********************************
Dim z_inArray(1 To HIDDEN_LAYER) As Single 'input signal of hidden units
Dim y_inArray(1 To OUTPUT_LAYER) As Single 'input signal of output units

'*********************************Array to store delta value********************************
Dim deltaYArray(1 To OUTPUT_LAYER) As Single
Dim deltaZ_inArray(1 To HIDDEN_LAYER)  As Single
Dim deltaZArray(1 To HIDDEN_LAYER) As Single

Dim sumsquaredError(1 To MAXLOOP + 1) As Single
Dim epochRunned As Integer
'***************************************************initialize***********************************************************
'initialize weights with random, initial bias to 1, step 0
'***********************************************************************************************************************
Public Function Initialize()
Dim i As Integer
Dim j As Integer
Dim k As Integer

'***initialize bias to 1 for v, w***
    For j = 1 To HIDDEN_LAYER
        v(0, j) = 1
    Next j

    For k = 1 To OUTPUT_LAYER
        w(0, k) = 1
    Next k
    
    'objSheet.Cells(1, 1) = "Random numbers used as initial weights, for v(i,j) and w(j,k)" '-------------------
    'objSheet.Cells(row, column) = "Random numbers: " '-----------------------------EXCEL-----------
    'column = column + 1 '--------------------------------------------------------------------
    'objSheet.Cells(row, column) = "V" '------------------------------------------EXCEL------------
    'row = row + 1 '--------------------------------------------------------------------------
'***initialize weights to random****
    For i = 1 To INPUT_LAYER   'v(i,j)
        For j = 1 To HIDDEN_LAYER
            v(i, j) = random_number
            'objSheet.Cells(row, column) = v(i, j) ' ----------------------------------------------------
'row = row + 1 '----------------------------------------------------------------------------
        Next j
    Next i
'row = 2 '---------------------------------------------------------------------------------
'column = column + 1 '--------------------------uncomment ALL to show random data in EXCEL-------
'objSheet.Cells(row, column) = "W"  '------------------------------------------------------------
'row = row + 1
    For j = 1 To HIDDEN_LAYER 'w(j,k)
        For k = 1 To OUTPUT_LAYER
            w(j, k) = random_number
            'objSheet.Cells(row, column) = w(j, k) '-----------------------------------------------------
'row = row + 1 '----------------------------------------------------------------------------
        Next k
    Next j
        
End Function


'*********************functions to calc z_in(j), y_in(k), step 4, step 5*********************

Private Function z_in(j As Integer) As Single 'return z_in(j) , use z_inArray to store calculated value
'z_in(j) = v(0, j) + summation(i=1 to n)[x(i)*v(i,j)]
Dim sum As Single
Dim i As Integer
'sum = v(0,j) = bias
sum = v(0, j)
'sum = sum  + summation(i=1 to n)[x(i)*v(i,j)]
For i = 1 To INPUT_LAYER
    sum = sum + (x(i) * v(i, j))
Next i
'return sum
z_in = sum
End Function

Private Function y_in(k As Integer) As Single 'return y_in(k), use y_inArray to store calculated value
'y_in(j) = w(0, k) + summation(j=1 to p)[z(j)*v(j,k)]
Dim sum As Single
Dim j As Integer
sum = w(0, k)
For j = 1 To HIDDEN_LAYER
    sum = sum + (z(j) * w(j, k))
Next j
y_in = sum
End Function

'**********************functions to compute error info term deltaY(k), error of output layer, step 6************************

Private Function deltaY(k As Integer) As Single 'return deltaY(k), use deltaYArray to store calculated value
'deltaY(k) = (t(k) - y(k)) * f ' (y_in(k))
Dim error As Single
error = t(k) - y(k)
error = error - revSigmoid(y_inArray(k))
'return error
deltaY = error
End Function

'*******************function to calc weight correction term, step 6***********************

Private Function WeightChanges_w(j As Integer, k As Integer) As Single 'return Weightchanges_w(j,k), store calculated value in w_changes(j,k)
'#w(j,k) = alpha * delta(k) * z(j) , # mean changes/delta, alpha is learning rate

WeightChanges_w = ALPHA * deltaYArray(k) * z(j)

End Function

'****************function to calc bias correction term, step 6*********************************
Private Function BiasChanges_w(k As Integer) As Single 'return BiasChanges_w(0,k), store calculated value in wB_changes(k)
BiasChanges_w = ALPHA * deltaYArray(k)
End Function

'********************function to sum delta inputs for each hidden units, step 7*****************
Private Function deltaZ_in(j As Integer) As Single 'return deltaZ_in(j), store calculated value in deltaZ_inArray
'd_in(j) = summation(k=1 to m)[deltaY(k) * w(j,k)]
Dim delta As Single
Dim k As Integer
delta = 0

For k = 1 To OUTPUT_LAYER
    delta = delta + deltaYArray(k) * w(j, k)
Next k
deltaZ_in = delta
End Function

'*******************function to calc error info term for hidden unit, step 7*************************
Private Function deltaZ(j As Integer) As Single 'return deltaZ(j), use deltaZArray to store calculated value
'd(j) = d_in(j) * f ' (z_in(j))
Dim delta As Single
delta = (deltaZ_in(j) * revSigmoid(z_inArray(j)))
deltaZ = delta
End Function

'***************************function to calc weight correction term of hidden unit, step 7************************
Private Function WeightChanges_v(i As Integer, j As Integer) As Single 'return Weightchanges_v(i,j), store calculated value in v_changes(i,j)
WeightChanges_v = ALPHA * deltaZArray(j) * x(i)
End Function

'************************function to calc bias correction term for hidden units, step 7**********************
Private Function BiasChanges_v(j As Integer) As Single 'return BiasChanges_v(0,j), store calculated value in vB_changes(j)
BiasChanges_v = ALPHA * deltaZArray(j)
End Function

'*************************function to update weights and bias, step 8***********************************

Private Function updateW() 'update w(j,k) and bias
Dim j As Integer
Dim k As Integer
For j = 1 To HIDDEN_LAYER 'update weights. w(j,K)
    For k = 1 To OUTPUT_LAYER
        w(j, k) = w(j, k) + w_changes(j, k)
    Next k
Next j

For k = 1 To OUTPUT_LAYER 'update bias, w(0,k)
    w(0, k) = w(0, k) + wB_changes(k)
Next k

End Function

Private Function updateV() 'update v(i,k)
Dim i As Integer
Dim j As Integer

For i = 1 To INPUT_LAYER 'update weights, v(i,j)
    For j = 1 To HIDDEN_LAYER
        v(i, j) = v(i, j) + v_changes(i, j)
    Next j
Next i

For j = 1 To HIDDEN_LAYER 'update bias v(0,j)
    v(0, j) = v(0, j) + vB_changes(j)
Next j
End Function

'**************************step 9, test stop condition*************************



Public Function isUnderTolerance(counter As Long) As Boolean 'return true if sum-squared error is less than tolerance
'http://www.cse.unsw.edu.au/~billw/mldict.html#TSS
'total sum-squared error (TSS)
'Given a training pattern, its squared error is obtained by squaring the difference between the target output of an
'output neuron and the actual output.

'actual output stored in y_inArray(k), k =1 to 26
'target output stored in t(k), k = 1 to 26

Dim error As Single
Dim k As Integer
error = 0

For k = 1 To OUTPUT_LAYER
    error = error + (t(k) - y_inArray(k)) ^ 2
Next k
If counter > 1 Then
    If error / 2 > sumsquaredError(counter - 1) Then
        isUnderTolerance = True
        epochRunned = counter
        Exit Function
    End If
End If

If error / 2 < TOLERANCE Then  'formula from http://www.compapp.dcu.ie/~humphrys/Notes/Neural/backprop.html E=0.5*[t(k) -y(k)]^2
    isUnderTolerance = True
Else