classtraining.cls

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

    isUnderTolerance = False
End If

sumsquaredError(counter) = (error / 2)
End Function
'*****************************training ***********************************
'   to be called from outside class
'*************************************************************************
'*******feedforward***********************
'======step 4===========
Public Function calc_z_in()
    Dim j As Integer
    For j = 1 To HIDDEN_LAYER
        z_inArray(j) = z_in(j)
    Next j
End Function

Public Function calcZ()
    Dim j As Integer
    For j = 1 To HIDDEN_LAYER
        z(j) = sigmoid(z_inArray(j))
    Next j
End Function

'========step 5==========
Public Function calc_y_in()
    Dim k As Integer
    For k = 1 To OUTPUT_LAYER
        y_inArray(k) = y_in(k)
    Next k
End Function

Public Function calcY()
    Dim k As Integer
    For k = 1 To OUTPUT_LAYER
        y(k) = sigmoid(y_inArray(k))
    Next k
End Function

'************backpropagation of error**************
'=====step 6======
Public Function calc_deltaY()
Dim k As Integer
For k = 1 To OUTPUT_LAYER
    deltaYArray(k) = deltaY(k)
Next k
End Function

Public Function calc_WeightChanges_w()
Dim j As Integer
Dim k As Integer
For j = 1 To HIDDEN_LAYER
    For k = 1 To OUTPUT_LAYER
        w_changes(j, k) = WeightChanges_w(j, k)
    Next k
Next j
End Function

Public Function calc_BiasChanges_w()
Dim k As Integer
For k = 1 To OUTPUT_LAYER
    wB_changes(k) = BiasChanges_w(k)
Next k
End Function

'=======step 7==========
Public Function calc_deltaZ_in()
Dim j As Integer
For j = 1 To HIDDEN_LAYER
    deltaZ_inArray(j) = deltaZ_in(j)
Next j
End Function

Public Function calc_deltaZ()
Dim j As Integer
For j = 1 To HIDDEN_LAYER
    deltaZArray(j) = deltaZ(j)
Next j
End Function

Public Function calc_WeightChanges_v()
Dim i As Integer
Dim j As Integer
For i = 1 To INPUT_LAYER
    For j = 1 To HIDDEN_LAYER
        v_changes(i, j) = WeightChanges_v(i, j)
    Next j
Next i
End Function

Public Function calc_BiasChanges_v()
Dim j As Integer
For j = 1 To HIDDEN_LAYER
    vB_changes(j) = BiasChanges_v(j)
Next j
End Function

'========step 8=========
Public Function update()
Call updateW
Call updateV
End Function

'==========================Property for input/output of array==============================
Public Property Get getW(j As Integer, k As Integer) As Single 'allow other to get w(j,k), w(hidden_layer, output_layer)
getW = w(j, k) 'w(0,k) is bias
End Property

Public Property Get getV(i As Integer, j As Integer) As Single 'get v(i, j), v(input_layer, hidden_layer)
getV = v(i, j) 'v(0,j) is bias
End Property


'***************************step 3, function to set training pair***********************
'set training pair x-t
'***************************************************************************************

Public Property Let setInput(i As Integer, inData As Single) 'load training input, i= 1 to input_layer
    x(i) = inData
End Property

    
Public Property Let setTarget(k As Integer, inData As Single) 'set target for training input , k = 1 to output_unit
    t(k) = inData
End Property

'=========================End of Property========================================

'=============================
Public Function ExportWeights() 'w(j,k) , b = w(0,k), v(i, j ), b =v(0,j)
'Export w
addSheet '---------------------------------------------------------------------------------------------
objSheet.Cells(1, 1) = "Weights and bias between hidden nodes and output nodes, w(j,k)" '----------------------EXCEL----
Dim j As Integer '----------------------------------------------------------------------------------------
Dim i As Integer
Dim k As Integer
Dim no As Integer
no = 2
objSheet.Cells(row, column) = "W(z(j) , y(k))"
row = 3
column = 2

For j = 1 To HIDDEN_LAYER
    objSheet.Cells(no + 1, 1) = "z" & no - 1
    column = 2
    For k = 1 To OUTPUT_LAYER
        objSheet.Cells(row, column) = w(j, k)
        column = column + 1
    Next k
    no = no + 1
    row = row + 1
Next j
For no = 1 To OUTPUT_LAYER
        objSheet.Cells(2, no + 1) = "y" & no
Next no

row = row + 1
    objSheet.Cells(row, 1) = "Bias of w , w(0, y(k)):"
column = 2
row = row + 1
    objSheet.Cells(row, 1) = "z0"
For k = 1 To OUTPUT_LAYER 'bias
    objSheet.Cells(row, column) = w(0, k)
    column = column + 1
Next k

'export v
no = 2
row = 3
column = 2
Set objSheet = objWorkBook.Sheets(2)  '----------------------Export to sheet2 in a same document/workbook---------
objSheet.Cells(1, 1) = "Weights and bias between input nodes and hidden nodes, v(i , j)"
objSheet.Cells(2, 1) = "V (x(i) , z(j))"

'export weights
For i = 1 To INPUT_LAYER
    objSheet.Cells(no + 1, 1) = "x" & no - 1
    column = 2
    For j = 1 To HIDDEN_LAYER
        objSheet.Cells(row, column) = v(i, j)
        column = column + 1
    Next j
    row = row + 1
    no = no + 1
Next i

For no = 1 To HIDDEN_LAYER
        objSheet.Cells(2, no + 1) = "z" & no
Next no

'export bias

row = row + 1
    objSheet.Cells(row, 1) = "Bias of v , v(0, z(j)):"
column = 2
row = row + 1
    objSheet.Cells(row, 1) = "x0"
For j = 1 To HIDDEN_LAYER 'bias
    objSheet.Cells(row, column) = v(0, j)
    column = column + 1
Next j
Call showExcel
End Function

'*******************************other functions******************************************
Public Function exportExcel()
Set objExcel = New Excel.Application
'Call addSheet
'objSheet.cells(row, column) = value
'Call showExcel
'closing
Set objSheet = Nothing
End Function
Public Function addSheet() 'create a new sheet and set to objSheet
row = 2
column = 1
Set objWorkBook = objExcel.Workbooks.Add
Set objSheet = objWorkBook.Sheets(1)
End Function

Public Function showExcel()
objExcel.Visible = True
End Function
'---------output sum-squared error-----

Public Function exportError()
Call addSheet
objSheet.Cells(1, 1) = "Sum-squared error for each epoch"
Dim errorRow As Integer
Dim errorColumn As Integer
Dim counter As Integer
objSheet.Cells(2, 1) = "Epoch"
objSheet.Cells(2, 2) = "error"
errorRow = 3
errorColumn = 2
For counter = 1 To epochRunned - 1
objSheet.Cells(errorRow, errorColumn) = sumsquaredError(counter)
objSheet.Cells(errorRow, errorColumn - 1) = counter
errorRow = errorRow + 1
Next counter
objSheet.Cells(errorRow + 1, 1) = "The sum-squared error tends to increase after this epoch, so I let the training stop."


End Function


Private Function random_number() As Single
'generate random number with range of  [LOWER_LIMIT , UPPER_LIMIT]
Randomize  'ref: http://www.thescripts.com/forum/thread519216.html
random_number = Rnd * (UPPER_LIMIT - LOWER_LIMIT) + LOWER_LIMIT
End Function