cbpnet.cls

vb编的bp神经网络源程序!!很有代表性的!

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CBPNet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_fWeights(3, 3) As Single
Private Const BP_LEARNING = 0.5
Public Sub CBPNet()
    For J = 1 To 3
      For i = 1 To 3
         m_fWeights(J, i) = Round(Rnd() * 3 - 1, 5)
      Next
    Next
End Sub
Public Function Sigmoid(num As Single) As Single
Sigmoid = 1 / (1 + Exp(-num))
End Function
Public Sub Train(i1 As Single, i2 As Single, d As Single)
Dim net1 As Single, net2 As Single, i3 As Single, i4 As Single, out As Single
    net1 = 1 * m_fWeights(1, 1) + i1 * m_fWeights(2, 1) + _
          i2 * m_fWeights(3, 1)
    net2 = 1 * m_fWeights(1, 2) + i1 * m_fWeights(2, 2) + _
          i2 * m_fWeights(3, 2)

    ''使用S函数
    i3 = Sigmoid(net1)
    i4 = Sigmoid(net2)
    ''计算输出层的值
    net1 = 1 * m_fWeights(1, 3) + i3 * m_fWeights(2, 3) + _
          i4 * m_fWeights(3, 3)

    out = Sigmoid(net1)
    
    ''计算误差，反向传播
    Dim deltas(3) As Single
    
    deltas(3) = out * (1 - out) * (d - out)
    deltas(2) = i4 * (1 - i4) * (m_fWeights(3, 3)) * (deltas(3))
    deltas(1) = i3 * (1 - i3) * (m_fWeights(2, 3)) * (deltas(3))

    ''调整权值
    
    Dim v1 As Single
    Dim v2 As Single
    v1 = i1
    v2 = i2
    For i = 1 To 3
        '' 如果有必要，改变输出层的值
        If i = 2 Then
        
           'v1 = i3
            'v2 = i4
        End If
                
        m_fWeights(1, i) = m_fWeights(1, i) + BP_LEARNING * 1 * deltas(i)
        m_fWeights(2, i) = m_fWeights(2, i) + BP_LEARNING * v1 * deltas(i)
        m_fWeights(3, i) = m_fWeights(3, i) + BP_LEARNING * v2 * deltas(i)
    Next
End Sub
Public Function Run(i1 As Single, i2 As Single) As Single
Dim net1 As Single, net2 As Single, i3 As Single, i4 As Single, out As Single
    net1 = 1 * m_fWeights(1, 1) + i1 * m_fWeights(2, 1) + _
          i2 * m_fWeights(3, 1)
    net2 = 1 * m_fWeights(1, 2) + i1 * m_fWeights(2, 2) + _
          i2 * m_fWeights(3, 2)

    ''使用S函数
    i3 = Sigmoid(net1)
    i4 = Sigmoid(net2)
    ''计算输出层的值
    net1 = 1 * m_fWeights(1, 3) + i3 * m_fWeights(2, 3) + _
          i4 * m_fWeights(3, 3)

    Run = Round(Sigmoid(net1), 5)

End Function

Private Sub Class_Initialize()
CBPNet
End Sub