classbackpropneuron.cls

这是一种利用神经网络来进行人脸识别的算法。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassBackPropNeuron"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public NoOfInputs As Integer
Dim inputs() As ClassBackPropNeuron
Dim weights() As Single
Dim lastWeightChange() As Single

'bias value
Public bias As Single
Dim lastBiasChange As Single

'the backprop error
Public BPerror As Single

'the output value of this neuron
Public value As Single
Public desiredValue As Single

'ID number and layer for this neuron
Public ID As Integer
Public LayerID As Integer


Public Sub init(neuronID As Integer, Layer As Integer, No_Of_Inputs As Integer)
'initialises the neuron
  ID = neuronID
  LayerID = Layer
  NoOfInputs = No_Of_Inputs
  ReDim inputs(NoOfInputs)
  ReDim weights(NoOfInputs)
  ReDim lastWeightChange(NoOfInputs)
  Call initWeights
  desiredValue = -1
End Sub


Private Function af(x As Single) As Single
  af = (x * (1# - x))
End Function


Public Sub initWeights(Optional minVal As Variant, Optional maxVal As Variant)
'randomly initialises the weights within the given range
  Dim min As Single
  Dim max As Single
  Dim i As Integer
  
  min = -0.1
  max = 0.1
  
  If (Not IsMissing(minVal)) Then
    min = minVal
  End If
  
  If (Not IsMissing(maxVal)) Then
    max = maxVal
  End If
  
  'do the weights
  For i = 0 To NoOfInputs - 1
    weights(i) = min + (Abs(Rnd) * (max - min))
    lastWeightChange(i) = 0
  Next
  
  'dont forget the bias value
  bias = min + (Abs(Rnd) * (max - min))
  lastBiasChange = 0
  
End Sub


Public Sub addConnection(index As Integer, n As ClassBackPropNeuron)
'adds a connection to a neuron
  Set inputs(index) = n
End Sub


Public Sub feedForward(randomness As Single)
  Dim adder As Single
  Dim i As Integer
  
  adder = bias
  For i = 0 To NoOfInputs - 1
    adder = adder + (weights(i) * inputs(i).value)
  Next
  'adder = adder / NoOfInputs
  
  'add some random noise
  If (randomness > 0) Then
    adder = ((1 - randomness) * adder) + (randomness * Rnd)
  End If
  
  value = function_sigmoid(adder)
End Sub


Public Sub Backprop()
  Dim i As Integer
  Dim n As ClassBackPropNeuron
  Dim afact As Single
  
  If (desiredValue > -1) Then
    'output unit
    BPerror = desiredValue - value
  End If
  
  afact = af(value)
  
  For i = 0 To NoOfInputs - 1
    Set n = inputs(i)
    n.BPerror = n.BPerror + (BPerror * afact * weights(i))
  Next

End Sub


Public Sub learn(learningRate As Single)
'adjust the weights
  Dim i, j, w
  Dim afact As Single
  Dim e As Single
  Dim gradient As Single

  'hidden->output weights
  e = learningRate / (1# + NoOfInputs)
  afact = af(value)
  gradient = afact * BPerror
  lastBiasChange = e * (lastBiasChange + 1) * gradient
  bias = bias + lastBiasChange
  For i = 0 To NoOfInputs - 1
    lastWeightChange(i) = e * (lastWeightChange(i) + 1) * gradient * inputs(i).value
    weights(i) = weights(i) + lastWeightChange(i)
  Next
End Sub


Public Function getWeight(index As Integer) As Single
  getWeight = weights(index)
End Function


Public Sub save()
  Dim i As Integer
  
  Print #2, ID
  Print #2, LayerID
  Print #2, NoOfInputs
  Print #2, bias
  Print #2, BPerror
  Print #2, value
  Print #2, desiredValue
  
  For i = 0 To NoOfInputs - 1
    Print #2, weights(i)
  Next
End Sub


Public Sub load()
  Dim i As Integer
  
  Input #2, ID
  Input #2, LayerID
  Input #2, NoOfInputs
  Input #2, bias
  Input #2, BPerror
  Input #2, value
  Input #2, desiredValue
  
  For i = 0 To NoOfInputs - 1
    Input #2, weights(i)
  Next
End Sub