哪位仁兄有BP算法的VB源代码能共享一下吗？谢了！

Question

在论坛上找了好多都是其他语言的！
有没有现成的VB代码啊，小弟刚学！麻烦多多照顾！我的信箱是：[email protected]先谢谢各位了

Answer 1

类模块cNN.cls：
Private Type NNTr
  Ins() As Double
  Tas() As Double
End TypeDim TrNn() As NNTr, Upon As LongDim nI As Long, nH As Long, nO  As Long
Dim aI() As Double, aH() As Double, aO() As Double
Dim wI() As Double, wO() As Double, cI() As Double, cO() As Double'Class NN:
'    def __init__(self, ni, nh, no):
Public Function Init(sni, snh, sno) As Boolean
Dim i As Long, j As Long, k As Long
'        # number of input, hidden, and output nodes
'        self.ni = ni + 1 # +1 for bias node
  nI = sni + 1
'        self.nh = nh
  nH = snh
'        self.no = no
  nO = sno
'        # activations for nodes
'        self.ai = [1.0] * self.ni
  ReDim aI(0 To nI - 1)
  For i = 0 To nI - 1
    aI(i) = 1
  Next i
'        self.ah = [1.0] * self.nh
  ReDim aH(0 To nH - 1)
  For i = 0 To nH - 1
    aH(i) = 1
  Next i
'        self.ao = [1.0] * self.no
  ReDim aO(0 To nO - 1)
  For i = 0 To nO - 1
    aO(i) = 1
  Next i
'        # create weights
'        self.wi = makeMatrix(self.ni, self.nh)
  ReDim wI(0 To nI - 1, 0 To nH - 1)
'        self.wo = makeMatrix(self.nh, self.no)
  ReDim wO(0 To nH - 1, 0 To nO - 1)
'        # set them to random vaules
  Randomize
'        for i in range(self.ni):
  For i = 0 To nI - 1
'            for j in range(self.nh):
    For j = 0 To nH - 1
'                self.wi[i][j] = rand(-2.0, 2.0)
      wI(i, j) = Rnd * 4 - 2
    Next j
  Next i
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            for k in range(self.no):
    For k = 0 To nO - 1
'                self.wo[j][k] = rand(-2.0, 2.0)
      wO(j, k) = Rnd * 4 - 2
    Next k
  Next j
'        # last change in weights for momentum
'        self.ci = makeMatrix(self.ni, self.nh)
  ReDim cI(0 To nI - 1, 0 To nH - 1)
'        self.co = makeMatrix(self.nh, self.no)
  ReDim cO(0 To nH - 1, 0 To nO - 1)
  ReDim TrNn(0 To &HFF)
  Upon = -1
  
  Init = True
End Function
'    def Update(self, inputs):
Private Function UpDate(Inputs() As Double) As Double()
Dim i As Long, j As Long, k As Long, Sum As Double
'        if len(inputs) != self.ni-1:
  If UBound(Inputs) - LBound(Inputs) + 1 <> nI - 1 Then Exit Function
'            raise ValueError, 'wrong number of inputs'
'        # input activations
'        for i in range(self.ni-1):
  For i = 0 To nI - 2
'            #self.ai[i] = 1.0/(1.0+math.exp(-inputs[i]))
'            self.ai[i] = inputs[i]
    'aI(i) = 1 / (1 + Exp(-Inputs(i)))
    aI(i) = Inputs(i)
  Next i
'        # hidden activations
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            Sum = 0#
    Sum = 0
'            for i in range(self.ni):
    For i = 0 To nI - 1
'                sum = sum + self.ai[i] * self.wi[i][j]
      Sum = Sum + aI(i) * wI(i, j)
    Next i
'            self.ah [j] = 1# / (1# + Math.Exp(-Sum))
    aH(j) = 1 / (1 + Exp(-Sum))
  Next j
'
'        # output activations
'        for k in range(self.no):
  For k = 0 To nO - 1
'            Sum = 0#
    Sum = 0
'            for j in range(self.nh):
    For j = 0 To nH - 1
'                sum = sum + self.ah[j] * self.wo[j][k]
      Sum = Sum + aH(j) * wO(j, k)
    Next j
'            self.ao [k] = 1# / (1# + Math.Exp(-Sum))
    aO(k) = 1 / (1 + Exp(-Sum))
  Next k
'        return self.ao[:]
  UpDate = aO
End Function

Answer 2

'
'    def backPropagate(self, targets, N, M):
Private Function BackPropagate(Targets() As Double, N As Double, M As Double) As Double
Dim i As Long, j As Long, k As Long, Sum As Double, Change As Double
Dim ERROR As Double
Dim Output_Deltas() As Double, Hidden_Deltas() As Double
'        if len(targets) != self.no:
  If UBound(Targets) - LBound(Targets) + 1 <> nO Then Exit Function
'            raise ValueError, 'wrong number of target values'
'        # calculate error terms for output
'        output_deltas = [0.0] * self.no
  ReDim Output_Deltas(0 To nO - 1)
'        for k in range(self.no):
  For i = 0 To nO - 1
'            ao = self.ao[k]
'            output_deltas[k] = ao*(1-ao)*(targets[k]-ao)
    Output_Deltas(i) = aO(i) * (1 - aO(i)) * (Targets(i) - aO(i))
  Next i
'        # calculate error terms for hidden
'        hidden_deltas = [0.0] * self.nh
  ReDim Hidden_Deltas(0 To nH - 1)
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            Sum = 0#
    Sum = 0
'            for k in range(self.no):
    For k = 0 To nO - 1
'                sum = sum + output_deltas[k]*self.wo[j][k]
      Sum = Sum + Output_Deltas(k) * wO(j, k)
    Next k
'            hidden_deltas[j] = self.ah[j]*(1-self.ah[j])*sum
    Hidden_Deltas(j) = aH(j) * (1 - aH(j)) * Sum
  Next j
'        # update output weights
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            for k in range(self.no):
    For k = 0 To nO - 1
'                change = output_deltas[k]*self.ah[j]
      Change = Output_Deltas(k) * aH(j)
'                self.wo[j][k] = self.wo[j][k] + N*change + M*self.co[j][k]
      wO(j, k) = wO(j, k) + N * Change + M * cO(j, k)
'                self.co[j][k] = change
      cO(j, k) = Change
'                #print N*change, M*self.co[j][k]
      'Debug.Print "wo:" & CStr(wO(j, k))
    Next k
  Next j
'        # update input weights
'        for i in range(self.ni):
  For i = 0 To nI - 1
'            for j in range(self.nh):
    For j = 0 To nH - 1
'                change = hidden_deltas[j]*self.ai[i]
      Change = Hidden_Deltas(j) * aI(i)
'                self.wi[i][j] = self.wi[i][j] + N*change + M*self.ci[i][j]
      wI(i, j) = wI(i, j) + N * Change + M * cI(i, j)
'                self.ci[i][j] = change
      cI(i, j) = Change
      'Debug.Print "wi:" & CStr(wI(i, j))
    Next j
  Next i
'        # calculate error
'        Error = 0#
'        for k in range(len(targets)):
  ERROR = 0
  For i = LBound(Targets) To UBound(Targets)
'            error = error + 0.5*(targets[k]-self.ao[k])**2
    ERROR = ERROR + 0.5 * (Targets(i) - aO(i)) ^ 2
  Next i
'        return error
BackPropagate = ERROR
End Function
'
'
'    def test(self, patterns):
'        for p in patterns:
'            Print p; [0], '->', self.update(p[0])
'
'    def weights(self):
'        Print 'Input weights:'
'        for i in range(self.ni):
'            Print self.wi; [i]
'        Print
'        Print 'Output weights:'
'        for j in range(self.nh):
'            Print self.wo; [j]
'
'    def Train(self, patterns, iterations = 2000, N = 0.5, M = 0.1):
Public Function Train(Optional ByVal T As Long = 2000, Optional ByVal N As Double = 0.5, Optional ByVal M As Double = 0.1) As Boolean
Dim i As Long, ERROR As Double, j As Long
'        # N: learning rate
'        # M: momentum factor
'        for i in xrange(iterations):
'            Error = 0#
'            for p in patterns:
'                inputs = p[0]
'                targets = p[1]
'                self.Update (inputs)
For i = 1 To T
  ERROR = 0
  For j = 0 To Upon
    UpDate TrNn(j).Ins
'                Error = Error + self.backPropagate(targets, N, M)
    ERROR = ERROR + BackPropagate(TrNn(j).Tas, N, M)
  Next j
  'Debug.Print Error
Next i
  Debug.Print ERROR
'            if i % 100 == 0:
'                Print 'error %-14f' % errorEnd FunctionPublic Function LoadFile(StrFileName As String) As Boolean
On Error GoTo ERROR
Dim FileNum As Long, i As Long, j As Long, k As Long
StrFileName = StrFileName & ".bpnn"
FileNum = FreeFile
Open StrFileName For Binary As #FileNum
  For j = 0 To nH - 1
    For k = 0 To nO - 1
      Get #FileNum, , wO(j, k)
      Get #FileNum, , cO(j, k)
    Next k
  Next j
  For i = 0 To nI - 1
    For j = 0 To nH - 1
      Get #FileNum, , wI(i, j)
      Get #FileNum, , cI(i, j)
    Next j
  Next i
Close #FileNum
LoadFile = True
ERROR:
End FunctionPublic Function SaveFile(StrFileName As String) As Boolean
On Error GoTo ERROR
Dim FileNum As Long, i As Long, j As Long, k As Long
StrFileName = StrFileName & ".bpnn"
FileNum = FreeFile
Open StrFileName For Binary As #FileNum
  For j = 0 To nH - 1
    For k = 0 To nO - 1
      Put #FileNum, , wO(j, k)
      Put #FileNum, , cO(j, k)
    Next k
  Next j
  For i = 0 To nI - 1
    For j = 0 To nH - 1
      Put #FileNum, , wI(i, j)
      Put #FileNum, , cI(i, j)
    Next j
  Next i
Close #FileNum
SaveFile = True
ERROR:
End FunctionPublic Function Predict(Ins() As Double) As Double
Dim T() As Double
T = UpDate(Ins)
If T(0) <= 0.5 Then
  Predict = -1
Else
  Predict = 1
End If
End FunctionPublic Function AddToTrain(Ins() As Double, T As Double) As Boolean
Dim Tas(0) As Double
Upon = Upon + 1
If Upon > UBound(TrNn) Then ReDim Preserve TrNn(UBound(TrNn) + &HFF)
TrNn(Upon).Ins = Ins
If T < 0 Then Tas(0) = 0 Else Tas(0) = 1
TrNn(Upon).Tas = Tas
AddToTrain = True
End Function

Answer 3

'
'    def backPropagate(self, targets, N, M):
Private Function BackPropagate(Targets() As Double, N As Double, M As Double) As Double
Dim i As Long, j As Long, k As Long, Sum As Double, Change As Double
Dim ERROR As Double
Dim Output_Deltas() As Double, Hidden_Deltas() As Double
'        if len(targets) != self.no:
  If UBound(Targets) - LBound(Targets) + 1 <> nO Then Exit Function
'            raise ValueError, 'wrong number of target values'
'        # calculate error terms for output
'        output_deltas = [0.0] * self.no
  ReDim Output_Deltas(0 To nO - 1)
'        for k in range(self.no):
  For i = 0 To nO - 1
'            ao = self.ao[k]
'            output_deltas[k] = ao*(1-ao)*(targets[k]-ao)
    Output_Deltas(i) = aO(i) * (1 - aO(i)) * (Targets(i) - aO(i))
  Next i
'        # calculate error terms for hidden
'        hidden_deltas = [0.0] * self.nh
  ReDim Hidden_Deltas(0 To nH - 1)
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            Sum = 0#
    Sum = 0
'            for k in range(self.no):
    For k = 0 To nO - 1
'                sum = sum + output_deltas[k]*self.wo[j][k]
      Sum = Sum + Output_Deltas(k) * wO(j, k)
    Next k
'            hidden_deltas[j] = self.ah[j]*(1-self.ah[j])*sum
    Hidden_Deltas(j) = aH(j) * (1 - aH(j)) * Sum
  Next j
'        # update output weights
'        for j in range(self.nh):
  For j = 0 To nH - 1
'            for k in range(self.no):
    For k = 0 To nO - 1
'                change = output_deltas[k]*self.ah[j]
      Change = Output_Deltas(k) * aH(j)
'                self.wo[j][k] = self.wo[j][k] + N*change + M*self.co[j][k]
      wO(j, k) = wO(j, k) + N * Change + M * cO(j, k)
'                self.co[j][k] = change
      cO(j, k) = Change
'                #print N*change, M*self.co[j][k]
      'Debug.Print "wo:" & CStr(wO(j, k))
    Next k
  Next j
'        # update input weights
'        for i in range(self.ni):
  For i = 0 To nI - 1
'            for j in range(self.nh):
    For j = 0 To nH - 1
'                change = hidden_deltas[j]*self.ai[i]
      Change = Hidden_Deltas(j) * aI(i)
'                self.wi[i][j] = self.wi[i][j] + N*change + M*self.ci[i][j]
      wI(i, j) = wI(i, j) + N * Change + M * cI(i, j)
'                self.ci[i][j] = change
      cI(i, j) = Change
      'Debug.Print "wi:" & CStr(wI(i, j))
    Next j
  Next i
'        # calculate error
'        Error = 0#
'        for k in range(len(targets)):
  ERROR = 0
  For i = LBound(Targets) To UBound(Targets)
'            error = error + 0.5*(targets[k]-self.ao[k])**2
    ERROR = ERROR + 0.5 * (Targets(i) - aO(i)) ^ 2
  Next i
'        return error
BackPropagate = ERROR
End Function
'
'
'    def test(self, patterns):
'        for p in patterns:
'            Print p; [0], '->', self.update(p[0])
'
'    def weights(self):
'        Print 'Input weights:'
'        for i in range(self.ni):
'            Print self.wi; [i]
'        Print
'        Print 'Output weights:'
'        for j in range(self.nh):
'            Print self.wo; [j]
'
'    def Train(self, patterns, iterations = 2000, N = 0.5, M = 0.1):
Public Function Train(Optional ByVal T As Long = 2000, Optional ByVal N As Double = 0.5, Optional ByVal M As Double = 0.1) As Boolean
Dim i As Long, ERROR As Double, j As Long
'        # N: learning rate
'        # M: momentum factor
'        for i in xrange(iterations):
'            Error = 0#
'            for p in patterns:
'                inputs = p[0]
'                targets = p[1]
'                self.Update (inputs)
For i = 1 To T
  ERROR = 0
  For j = 0 To Upon
    UpDate TrNn(j).Ins
'                Error = Error + self.backPropagate(targets, N, M)
    ERROR = ERROR + BackPropagate(TrNn(j).Tas, N, M)
  Next j
  'Debug.Print Error
Next i
  Debug.Print ERROR
'            if i % 100 == 0:
'                Print 'error %-14f' % errorEnd FunctionPublic Function LoadFile(StrFileName As String) As Boolean
On Error GoTo ERROR
Dim FileNum As Long, i As Long, j As Long, k As Long
StrFileName = StrFileName & ".bpnn"
FileNum = FreeFile
Open StrFileName For Binary As #FileNum
  For j = 0 To nH - 1
    For k = 0 To nO - 1
      Get #FileNum, , wO(j, k)
      Get #FileNum, , cO(j, k)
    Next k
  Next j
  For i = 0 To nI - 1
    For j = 0 To nH - 1
      Get #FileNum, , wI(i, j)
      Get #FileNum, , cI(i, j)
    Next j
  Next i
Close #FileNum
LoadFile = True
ERROR:
End FunctionPublic Function SaveFile(StrFileName As String) As Boolean
On Error GoTo ERROR
Dim FileNum As Long, i As Long, j As Long, k As Long
StrFileName = StrFileName & ".bpnn"
FileNum = FreeFile
Open StrFileName For Binary As #FileNum
  For j = 0 To nH - 1
    For k = 0 To nO - 1
      Put #FileNum, , wO(j, k)
      Put #FileNum, , cO(j, k)
    Next k
  Next j
  For i = 0 To nI - 1
    For j = 0 To nH - 1
      Put #FileNum, , wI(i, j)
      Put #FileNum, , cI(i, j)
    Next j
  Next i
Close #FileNum
SaveFile = True
ERROR:
End FunctionPublic Function Predict(Ins() As Double) As Double
Dim T() As Double
T = UpDate(Ins)
If T(0) <= 0.5 Then
  Predict = -1
Else
  Predict = 1
End If
End FunctionPublic Function AddToTrain(Ins() As Double, T As Double) As Boolean
Dim Tas(0) As Double
Upon = Upon + 1
If Upon > UBound(TrNn) Then ReDim Preserve TrNn(UBound(TrNn) + &HFF)
TrNn(Upon).Ins = Ins
If T < 0 Then Tas(0) = 0 Else Tas(0) = 1
TrNn(Upon).Tas = Tas
AddToTrain = True
End Function

Answer 4

贴重复了，是改的一个python代码，没有现在用pascal写的好，不能定义隐层神经元结构

Answer 5

很好，封装成类了，有空用一下，谢谢thirdapple(.:RNPA:.陨落雕-努力不一定有回报)。

Answer 6

请问thirdapple：
类里面的cI和cO代表的是什么？
例如：wI(i, j) = wI(i, j) + N * Change + M * cI(i, j)
我就不知道这个* cI(i, j)有什么意义？还有这个Hidden_Deltas(j)和Output_Deltas(i)的计算
为什么要这么写？？
能指点一二吗？

Answer 7

thirdapple帮个忙啊？？
先谢谢了！

Answer 8

c是惯性参数，具体内容可以看书，这是个简单的三层前向神经网络用BP算法训练的