BP神经网络源代码(basic)

 Dim tempNum AsDouble

FactTimes = 0

For loopt = 0 To times - 1 '学习次数

      FactTimes= FactTimes + 1

tempNum = 0

If FactTimes < 2000 Then '学习率的变化前大后小

     alpha = 0.5

     beta = 0.5

Else

     IfFactTimes > 2000 And FactTimes < 5000 Then

           alpha= 0.4

           beta= 0.4

     Else

           alpha = 0.3

           beta= 0.3

     End If

End If

'开始神经网络计算

'/*---Beginning of neural computting---*/

For loopl = 1 To LearnExampleNums  '学习模式个数

      '/*forward computting */

      '/* inputlayer */

      For i = 1To InputUnitNums

           OutofInputLayer(i) = inDatas(loopl, i)

      Next i

      '/* hidelayer */

      For i = 1To HideUnitNums

          inival = CDbl(0)

           For j= 1 To InputUnitNums

                inival = inival + w_InputHide(i, j) * OutofInputLayer(j)

           Nextj

          inival = inival + Cw_Hide(i)

          OutofHideLayer(i) = Sigmf(inival)

      Next i

      '/* outputlayer */

      For i = 1To OutUnitNums

          inival = 0#

           For j= 1 To HideUnitNums

                 inival = inival + w_HideOut(i, j) *OutofHideLayer(j)

           Nextj

           inival = inival + Cw_Out(i)

           OutofOutLayer(i) = Sigmf(inival)

      Next i

      '/*---Backpropagation---*/

      '/* deltacaclculate*/

      Error = 0#

      For i = 1To OutUnitNums

                wk = OutofOutLayer(i)

                wkb = Teacher(loopl, i) - wk

                '计算每个学习模式中各个输出结点的误差平方和

                Error = Error + wkb * wkb

                 DEL_Out(i) = wkb * wk * (1# - wk)

      Next i

      '/* deltacaclculate*/

      For i = 1To HideUnitNums

           inival = 0#

            Forj = 1 To OutUnitNums

                 inival = inival + (DEL_Out(j) * w_HideOut(j, i))

            Nextj

            wk =OutofHideLayer(i)

           DEL_Hide(i) = inival * wk * (1# - wk)

      Next i

      '/*updating for weights from Hide Layer */

      For i = 1To OutUnitNums

           DCw_Out(i) = alpha * DEL_Out(i)

            Forj = 1 To HideUnitNums

                  Dw_HideOut(i, j) = alpha *DEL_Out(i) * OutofHideLayer(j)

               Next j

          Next i

          '/*updating for weights from Input Layer */

          For i= 1 To HideUnitNums

               DCw_Hide(i) = beta * DEL_Hide(i)

               For j = 1 To InputUnitNums

                     Dw_InputHide(i, j) = beta * DEL_Hide(i) * OutofInputLayer(j)

               Next j

          Next i

          '*input layer to hide layer

          For i= 1 To HideUnitNums

                wk = moment * OCw_Hide(i) +DCw_Hide(i)

               Cw_Hide(i) = Cw_Hide(i) + wk

               OCw_Hide(i) = wk

               For j = 1 To InputUnitNums

                     wk = moment * Ow_InputHide(i, j) + Dw_InputHide(i, j)

                      w_InputHide(i, j) =w_InputHide(i, j) + wk

                     Ow_InputHide(i, j) = wk

               Next j

          Next i

           '*hide layer to output layer

           For i= 1 To OutUnitNums

               wk = moment * OCw_Out(i) + DCw_Out(i)

               Cw_Out(i) = Cw_Out(i) + wk

               OCw_Out(i) = wk

               For j = 1 To HideUnitNums

                     wk = moment * Ow_HideOut(i, j) + Dw_HideOut(i, j)

                     w_HideOut(i, j) = w_HideOut(i, j) + wk

                     Ow_HideOut(i, j) = wk

               Next j

           Nexti

           '所有学习模式的误差总和

          tempNum = tempNum + Error

     Next loopl

     '如果达到了要求的误差范围，就可以退出循环

     If((tempNum / 2) <= ErLimit) Then

           ExitFor

     End If

Next loopt

List1.Clear

For i = 1 To OutUnitNums

     For j = iTo HideUnitNums

          List1.AddItem "w_HideOut(" & i & 

     Next j

    List1.AddItem "OutofOutLayer(" & i & ") "& OutofOutLayer(i)

Next i

For i = 1 To HideUnitNums

     For j = 1To InputUnitNums

          List1.AddItem "w_InputHide( " & i & ", "& j & ")=" & w_InputHide(i, j)

     Next j

    List1.AddItem "OutofHideLayer(" & i & ")="& OutofHideLayer(i)

Next i

List1.AddItem "全局误差=" & Format$(tempNum/ 2, "##.###,#")

List1.AddItem "预测误差=" &Format$(Sqr(tcmpNum / 2), "##.###")

List1.AddItem "循环次数=" & FactTimes

'cmdSave. Enabled= True

'cmdNetCal.Enabled = False

Beep

vsFlexArray3.Rows = HideUnitNums + 1

vsFlexArray3.Cols = InputUnitNums + 1

vsFlexArray5.Rows = HideUnitNums + 1

For i = 1 To HideUnitNums

    vsFlexArray5.TextMatrix(i, 1) = Cw_Hide(i)

     For j = 1To InputUnitNums

          vsFlexArray3.TextMatrix(i, j) = w_InputHide(i, j)

     Next j

Next i

vsFlexArray3.SaveGrid App.Path &"WeightlN_HD.dat", flexFileAll

vsFlexArray5.SaveGrid App.Path &"OffsetHIDE.dat", flexFileAll

vsFlexArray4.Rows = OutUnitNums + 1

vsFlexArray4.Cols = HideUnitNums + 1

vsFlexArray6.Rows = OutUnitNums + 1

For i = 1 To OutUnitNums

     vsFlexArray6.TextMatrix(i, 1) = Cw_Out(i)

      For j = 1To HideUnitNums

          vsFlexArray4.TextMatrix(i, j) = w_HideOut(i, j)

     Next j

Next i

vsFlexArray4.SaveGrid App.Path &"WeightHD_OT.dat", flexFileAll

vsFlexArray6.SaveGrid App.Path & "OffsetOUT.dat", flexFileAll

End Sub

Private Sub Command6_Click()

vsFlexArray1.Rows = 2

vsFlexArray1.Cols = Text1.Text + 1

vsFlexArray2.Rows = 2

vsFlexArray2.Cols = Text3.Text + 1

vsFlexArray3.Rows = Text2.Text + 1

vsFlexArray3.Cols = Text1.Text + 1

vsFlexArray4.Rows = Text3.Text + 1

vsFlexArray4.Cols = Text2.Text + 1

vsFlexArray5.Rows = Text2.Text + 1

vsFlexArray5.Cols = 2

vsFlexArray6.Rows = Text3.Text + 1

vsFlexArray6.Cols = 2

LearnExampleNums = 1 '每次只验证一个数据

vsFlexArray1.Clear

vsFlexArray2.Clear

vsFlexArray2.Enabled = False

vsFlexArray2.Editable = False

vsFlexArray1.SetFocus

MsgBox "请在学习样本网格中输入数据!"

End Sub

Private Sub Command7_Click()

Dim Nums() As Double

ReDim Nums(vsFlexArray1.Cols - 1)

For i = 1 To Text1.Text

      Nums(i) =vsFlexArray1.TextMatrix(1, i)

Next i

'读入 INPUT TO HIDE 权值文件

vsFlexArray3.LoadGrid App.Path &"WeightlN_ttD.dat", flexFileAll

'读入 HIDE TO OUTPUT 权值文件

vsFlexArray4.LoadGrid App.Path &"WeightHD_OT.dat", flexFileAll

'读入 HIDE 层偏置文件

vsFlexArray5.LoadGrid App.Path &"OffsetHIDE.dat", flexFileAll

'读入 OUTPUT 层偏置值文件

vsFlexArray6.LoadGrid App.Path &"OffsetOUT.dat", flexFileAll

'/* hide layer */

For i = 1 To HideUnitNums

     inival = 0#

     For j = 1To InputUnitNums

          inival = inival + vsFlexArray3.TextMatrix(i, j) * Nums(j)

     Next j

      inival =inival + vsFlexArray5.TextMatrix(i, 1)

    OutofHideLayer(i) = Sigmf(inival)

Next i

'/* output layer */

For i = 1 To OutUnitNums

      inival = 0#

      For j = 1To HideUnitNums

          inival = inival + vsFlexArray4.TextMatrix(i, j) * OutofHideLayer(j)

     Next j

      inival =inival + vsFlexArray6.TextMatrix(i, 1)

     OutofOutLayer(i) = Sigmf(inival)

     Label2.Caption = "验证结果:"

     vsFlexArray2.TextMatrix(1, i) = Format(OutofOutLayer(i),"#,###.###,#")

Next i

Command9.Enabled = True

End Sub

Private Sub Command8_Click()

End

End Sub