BP网络 程序

    后传播网络的学习方式通常采用有指导的学习方式，网络可以将应有的输出与实际输出数据进行比较，其学习规则采用梯度下降规则，改变处理单元间的连接权重来减小实际出与应有输出间的误差，并在学习的过程中保持误差曲线的梯度下降。

    网络训练过程即是网络中各权值不断调整的过程，这一过程分两步进行：第一步，输入信息前向传播，计算输出结果；第二步，误差信息反向传播，调整各权值，直至达到满意的结果。具体步骤如下：

    第一步：前向计算误差

    (1)、将输入变量进行归一化处理，转换为0~1内的数，传送到神经网络输入层节点。

    (2)、中间层计算

     ．计算输入层各节点对中间层各节点的权重和：

     ．计算中间层各节点的输出：

    (3)、输出层计算：

     ．计算中间层各节点对输出层节点的权重和：

     ．计算输出层节点的输出值：

     (4)、误差计算：

    将输出变量（汽油干点实际化验值）进行归一化处理，转换为0~1内的数值，比较神经网络实际的输出值与应有的输出值便可得出误差： 

    其中：

    gx1为输入层节点的输出

    W2为输入层各节点对中间层各节点的连结权值

    net2为输入层各节点对中间层各节点的权重和

    gx2为中间层节点的输出

    W3为中间层节点到输出层节点的连结权值

        E3输出层节点的输误差

     gx3输出层节点的输出计算值

     gx30输出层节点的输出期望值

     net3中间层各节点对输出层节点的权重和

    下标：i----输入层第i个节点

          j---中间层第j个节点

    上标：k---第k个样本

第二步：误差向后传播，修改各层权值

 (1)、计算输出层误差平方和

    修改中间层节点到输出层节点的权重

（2）、输入层节点到中间层节点的连接权重的修改

     其中：——学习速率

           ——动量因子

参考程序，主要关注红色字体部分：

Public Sub anns01_2()           '  ANNS网络模型二---批的规模为全部数据组 子程序

     Dim n01 As Integer         '  训练用数据库记录总数

     Dim n02 As Integer         '  检验用数据库记录总数

     Dim nn As Integer          '  中间层节点数

     Const nnn = 171           '  数据库记录总数, 在此定义是为了避免过多地声明动态数组而影响运行速度

     Dim gx2(10) As Double      '  隐节点4个

     Dim gx20(10) As Double

     Dim gx3 As Double         '  输出节点1个

     Dim gx30 As Double

     Dim gx21(10, nnn) As Double

     Dim gx22(10, nnn) As Double

     Dim gx31(nnn) As Double

     Dim gx32(nnn) As Double

     Dim gxx1(tt, nnn) As Double

     Dim gd1 As Double            '  实际输出值

     Dim aW1(tt, 10) As Double      '  增量形式

     Dim aW2(10) As Double        '  增量形式

     Dim aW10(tt, 10) As Double

     Dim aW20(10) As Double

     Dim k1 As Integer          '  计数器

     Dim k2 As Integer

     Dim i As Long

     Dim ii As Integer          '

     Dim ii1 As Integer         '

     Dim aE34(nnn) As Double    '  各个记录的最终误差（用于调权、送训练数据库）

     Dim aE340(nnn) As Double   '  各个记录的最终误差（用于送检验数据库）

     Dim E0(nnn) As Double      '  误差的平方（用于保存上一步的数值）

     Dim aE3  As Double         '  训练绝对值平均误差

     Dim aE2 As Double          '  检验绝对平均误差

     Dim E As Double            '  误差的平方和（目标函数）

     Dim E1 As Double           '  训练均方差

     Dim E2 As Double           '  检验均方差

     Dim EE As Double           '  检验误差平方和

     Dim EE1 As Double          '  寻找最小值(当前最小)

     Dim EE2 As Double          '  前一次最小

     Dim gdjs(nnn) As Double    '  各个记录的计算值（用于送训练数据库）

'     Dim gds As Double          '  训练时保存干点值以求平均

'     Dim gdy As Double          '  检验时保存干点值以求平均

     Dim gdjy(nnn) As Double    '  检验数据库记录的干点计算值（用于送检验数据库）

     Dim aM1(tt, 10) As Double   '  权值调节量

     Dim aM2(10) As Double

     Dim aE0 As Double          '  误差限

     Dim bb As Double           '  学习速率

     Dim bb0 As Double          '  学习速率系数

     Dim aa As Double           '  动量因子

     Dim aa0 As Double          '  动量因子

     Dim xx As Double           '  过渡变量

     Dim DouDl0 As Double       '  外加动量（数字形式）

     Dim intResult As Integer

     Dim sjk01 As Database

     Dim sjl01 As Recordset

     '    数据库1操作

     Set sjk01 = OpenDatabase("d:\\My Programs\\chen\\chen01.mdb")          ' 打开数据库

     Set sjl01 = sjk01.OpenRecordset("原始数据输入表_1", dbOpenDynaset)   ' 打开表

     With sjk01.OpenRecordset("原始数据输入表_1", dbOpenDynaset)

     If .EOF = True And .BOF = True Then

        intResult = MsgBox("没有数据用以训练！" + Chr(13) + Chr(13) + Chr(10) + _

            "输入数据吗？", vbApplicationModal + vbDefaultButton1 + vbQuestion _

            + vbYesNo, "无数据提示：")

        Select Case intResult

        Case vbYes

           MsgBox "输入数据，请按输入数据按扭。", vbApplicationModal + _

                    vbInformation, "输入数据提示:"

           Exit Sub

        Case vbNo

           MsgBox "很抱歉！没有数据，无法训练！", vbApplicationModal + vbInformation, _

                  "无数据提示："

           Exit Sub

        End Select

     End If

     .MoveFirst

     .MoveLast

     n01 = .RecordCount        ' 确定记录总数

'     n01 = 1 ' 20

     End With

     输入数据表.Data1.Recordset.MoveFirst

     '    数据库2操作

     Dim sjk02 As Database

     Dim sjl02 As Recordset

     Set sjk02 = OpenDatabase("d:\\My Programs\\chen\\chen02.mdb")        ' 打开数据库

     Set sjl02 = sjk02.OpenRecordset("网络检验数据表", dbOpenDynaset)    ' 打开表

     With sjk02.OpenRecordset("网络检验数据表", dbOpenDynaset)

     If .EOF = True And .BOF = True Then

        intResult = MsgBox("没有数据用以检验！" + Chr(13) + Chr(13) + Chr(10) + _

            "输入数据吗？", vbApplicationModal + vbDefaultButton1 + vbQuestion _

            + vbYesNo, "无数据提示：")

        Select Case intResult

        Case vbYes

           MsgBox "输入数据，请按输入数据按扭。", vbApplicationModal + _

                    vbInformation, "输入数据提示:"

           Exit Sub

        Case vbNo

           MsgBox "很抱歉！没有数据，无法检验！", vbApplicationModal + vbInformation, _

                  "无数据提示："

           Exit Sub

        End Select

     End If

     .MoveFirst

     .MoveLast

     n02 = .RecordCount        ' 确定记录总数

'     n02 = 20

     End With

     网络检验数据表.Data1.Recordset.MoveFirst

     EE2 = n02

  '   frm训练误差.Data1.Recordset.MoveFirst

  '   frm检1误差.Data1.Recordset.MoveFirst

     '    初始化处理

     myForm6.KeyPreview = True

     myForm6.Command8.Visible = False

     myForm6.Picture1.Cls

     Call csqz                              '    初始权值

     aE0 = Val(myForm6.Text1.Text)             '    误差限

     nn = Val(myForm6.Combo1.Text)             '    中间层节点数

     For i = 1 To nn:       aW2(i) = 0:    aW20(i) = 0:     Next i

     For i = 1 To tt

         For k1 = 1 To nn

             aW1(i, k1) = 0

            aW10(i, k1) = 0

         Next k1

     Next i

     kk2 = 0

     ii1 = 0

     myForm6.Label10.Visible = True

     myForm6.Label10.Caption = "程序正在运行，请稍候......;       终止运行按Esc键，     暂停按Pause。" + Chr(13) + Chr(13) _

         + Chr(10) + "增大学习速率按PageUP，减小按Home; 增大动量因子按PageDown，减小按End。"

     Call qzb_02(myForm6.Picture1, "训练过程")       '    画坐标

     bb = myForm6.HScroll1.Value / 1000              '    学习速率

     aa = myForm6.HScroll2.Value / 1000              '    动量因子

     bb0 = 1

     aa0 = 1

     myForm6.HScroll1.Value = 500

     myForm6.HScroll2.Value = 500

     myForm6.Label1.Caption = "学习速率系数:" & 1

     myForm6.Label2.Caption = "动量因子系数:" & 1

     Dim intResult1 As Integer

     Dim intResult2 As Integer

     Dim intt As Integer

'     Dim Ik As Integer

     intt = 0

     inttt = 1

Do

  ' (1)、 神经网络训练部分

     If intt = 0 Then         '    bb, aa 滑块功能的设定

If myForm6.HScroll1.Value <> 500 Or myForm6.HScroll2.Value <> 500 Then

If myForm6.HScroll1.Value > 500 Then

                 bb0 = (1 + Abs((myForm6.HScroll1.Value - 500)) / 100) ^ 1

             Else

                 bb0 = (1 + Abs((myForm6.HScroll1.Value - 500)) / 100) ^ (-1)

             End If

If myForm6.HScroll2.Value > 500 Then

                 aa0 = (1 + Abs((myForm6.HScroll2.Value - 500)) / 100) ^ 1

             Else

                 aa0 = (1 + Abs((myForm6.HScroll2.Value - 500)) / 100) ^ (-1)

             End If

             bb0 = Format(bb0, "#####0.###")

             aa0 = Format(aa0, "#####0.###")

             myForm6.Label1.Caption = "学习速率系数:" & bb0

             myForm6.Label2.Caption = "动量因子系数:" & aa0

             intResult1 = MsgBox("你改变了学习速率系数或动量因子系数,确认改变吗?", _

                                  vbApplicationModal + vbQuestion + vbOKCancel, "提示")

             Select Case intResult1

             Case vbOK

                 bb = bb0 * bb:               aa = aa0 * aa

                 intResult2 = MsgBox("以后每一步都改变了学习速率系数或动量因子系数吗?" _

                              + Chr(13) + Chr(13) + Chr(10) + "确认请按YES,若仅下一步改变系数则按NO。", _

                                  vbApplicationModal + vbQuestion + vbYesNo, "提示")

                 Select Case intResult2

                 Case vbYes

                     intt = 1

                 Case vbNo

                     intt = 0

                     myForm6.Label1.Caption = "学习速率系数:" & 1

                     myForm6.Label2.Caption = "动量因子系数:" & 1

                     myForm6.HScroll1.Value = 500

                     myForm6.HScroll2.Value = 500

                 End Select

             Case vbCancel

                 myForm6.Label1.Caption = "学习速率系数:" & 1

                 myForm6.Label2.Caption = "动量因子系数:" & 1

                 myForm6.HScroll1.Value = 500

                 myForm6.HScroll2.Value = 500

                 bb = bb

                 aa = aa

             End Select

          Else

               bb = bb

               aa = aa

          End If

     Else

              bb0 = Format(bb0, "#####0.###")

              aa0 = Format(aa0, "####0.####")

              myForm6.Label1.Caption = "学习速率系数:" & bb0

              myForm6.Label2.Caption = "动量因子系数:" & aa0

              bb = bb * bb0

              aa = aa * aa0

     End If

     E = 0:     aE3 = 0:          E1 = 0

     '   从数据库取训练用数据

     For ii = 1 To n01

         gx1(1) = (输入数据表.Data1.Recordset.Fields("常顶压力") - 16) / 22

         gx1(2) = (输入数据表.Data1.Recordset.Fields("常顶温度") - 120) / 13

         gx1(3) = (输入数据表.Data1.Recordset.Fields("常顶回流温") - 23) / 18

         gx1(4) = (输入数据表.Data1.Recordset.Fields("回比进量") - 8.6) / 12

         gx1(5) = (输入数据表.Data1.Recordset.Fields("常一馏出温度") - 169) / 18

         gx1(6) = (输入数据表.Data1.Recordset.Fields("一线比进量") - 0.6) / 0.

         gx1(7) = (输入数据表.Data1.Recordset.Fields("一中比进热") - 85.1) / 65

         gx1(8) = (输入数据表.Data1.Recordset.Fields("常塔进料温度") - 365) / 18

         gx1(9) = (输入数据表.Data1.Recordset.Fields("常塔进料压力") - 52.8) / 24

         gx1(10) = (输入数据表.Data1.Recordset.Fields("组分因素") - 0.53) / 0.14

         For i = 1 To tt

            gxx1(i, ii) = gx1(i)

         Next i

        gd1 = (输入数据表.Data1.Recordset.Fields("汽油干点") - 176) / 20

        For i = 1 To tt                       '   检查输入数据是否有误?

If gx1(i) < -1.05 Or gx1(i) > 1.05 Or gd1 < -1.05 Or gd1 > 1.05 Then

                intResult = MsgBox("网络训练输入数据中," & ii & "号记录不合理。" + Chr(13) + Chr(13) + Chr(10) + _

                       "需要检查输入数据吗？", vbApplicationModal + vbDefaultButton1 + vbQuestion _

                        + vbYesNo, "输入数据检错")

                Select Case intResult

                Case vbYes

                    Exit Sub

                Case vbNo

' If gx1(i) > 1 Then gx1(i) = 1 ' 错误处理

' If gx1(i) < 0 Then gx1(i) = 0

                End Select

            End If

        Next i

        '    前向计算误差

        For i = 1 To nn

            xx = w1(1, i) * gx1(1) + w1(2, i) * gx1(2) + w1(3, i) * gx1(3) _

               + w1(4, i) * gx1(4) + w1(5, i) * gx1(5) + w1(6, i) * gx1(6) _

               + w1(7, i) * gx1(7) + w1(8, i) * gx1(8) + w1(9, i) * gx1(9) _

               + w1(10, i) * gx1(10)

            gx2(i) = 1 / (1 + Exp(-xx))

            gx20(i) = gx2(i) * (1 - gx2(i)) '   gx2(i)导数

    '        ReDim Preserve gx21(8, ii)

            gx21(i, ii) = gx2(i)

   '         ReDim Preserve gx22(8, ii)

            gx22(i, ii) = gx20(i)                      '   gx2(i)导数

        Next i

        xx = 0

        For i = 1 To nn

            xx = xx + w2(i) * gx2(i)

        Next i

        gx3 = 1 / (1 + Exp(-xx))

        gx30 = gx3 * (1 - gx3)                '     gx3导数

 '       ReDim Preserve gx31(ii)

        gx31(ii) = gx3

   '     ReDim Preserve gx32(ii)

        gx32(ii) = gx30                        '     gx3导数

        E = E + (gd1 - gx3) ^ 2

        E1 = E1 + ((gd1 - gx3) * 20) ^ 2

        aE3 = aE3 + Abs(gd1 - gx3) * 20

  '      ReDim Preserve aE34(ii)             '     保存各个记录的误差值

        aE34(ii) = -(gd1 - gx3)

  '      ReDim Preserve gdjs(ii)             '     保存各个记录的计算值

        gdjs(ii) = gx3 * 20 + 176

If ii < n01 Then

           输入数据表.Data1.Recordset.MoveNext

        Else

           输入数据表.Data1.Recordset.MoveFirst

        End If

     Next ii

     '    动态显示

     kk2 = kk2 + 1

     E = E / 2

     ReDim Preserve gx0(kk2)

     gx0(kk2) = E

     aE3 = aE3 / n01

     E1 = E1 / n01

If E < Abs(aE0) Then Exit Do

     myForm6.Picture1.DrawWidth = 1

     myForm6.Picture1.DrawStyle = 1

     myForm6.Picture1.Line (800, 5250 - aE0 * 850)-(6900, _

                                 5250 - aE0 * 850), RGB(255, 255, 0)

     myForm6.Picture1.DrawWidth = 3

     myForm6.Picture1.DrawStyle = 0

     myForm6.Picture1.Line (797, 5250 - aE0 * 850)-(803, _

                                 5250 - aE0 * 850), RGB(0, 255, 255)

     myForm6.Picture1.DrawWidth = 2

     myForm6.Picture1.PSet (800 + kk2 * (6000 / (300 + ii1 * 300)), _

                                 5250 - gx0(kk2) * 850), RGB(255, 0, 0)

'     myForm6.Picture1.Line (800, 4400 - (Log(aE0) / Log(10)) * 850)-(6900, _

                                 4400 - (Log(aE0) / Log(10)) * 850), RGB(255, 255, 0)

'     myForm6.Picture1.DrawWidth = 3

'     myForm6.Picture1.DrawStyle = 0

'     myForm6.Picture1.Line (797, 4400 - (Log(aE0) / Log(10)) * 850)-(803, _

                                 4400 - (Log(aE0) / Log(10)) * 850), RGB(0, 255, 255)

'     myForm6.Picture1.DrawWidth = 2

'     myForm6.Picture1.PSet (800 + kk2 * (6000 / (300 + ii1 * 300)), _

                                 4400 - (Log(gx0(kk2)) / Log(10)) * 850), RGB(255, 0, 0)

     '    响应键盘事件

     DoEvents

     If INKey = 27 Then Exit Do                                     '   若按下Escape则终止计算,输出结果

     If INKey = 19 Then                                             '   若按下Pause则暂停

        INKey = 0

        intResult = MsgBox("现在暂停，要加一动量吗？", vbApplicationModal _

                    + vbDefaultButton2 + vbQuestion + vbYesNo, "暂停")

        Select Case intResult

        Case vbYes

           DouDl0 = Val(InputBox("请输入一动量（%）：", "输入动量：", "5", 2000, 2000)) / 100

        End Select

     End If

     '    每300步更新一次显示屏,并给出神经网络训练性能评价数据

If kk2 >= 290 And (kk2 Mod 300 = 0) Then ' 事件处理

        myForm6.Text2.Text = kk2                                    '   训练步数

        myForm6.Text3.Text = Format(E1, "##0.######")               '   训练均方差

        myForm6.Text5.Text = Format(E2, "##0.######")               '   检验均方差

        myForm6.Text4.Text = Format(aE3, "##0.######")              '   训练平均误差

        myForm6.Text6.Text = Format(aE2, "##0.######")              '   检验平均误差

        ii1 = ii1 + 1

        myForm6.Picture1.Cls

        Call qzb_02(myForm6.Picture1, (ii1 + 1) * 3 & "00步") '

        For i = 1 To kk2 - 1

           myForm6.Picture1.DrawWidth = 1:        myForm6.Picture1.DrawStyle = 1

           myForm6.Picture1.Line (800, 5250 - aE0 * 850)-(6900, _

                                 5250 - aE0 * 850), RGB(255, 255, 0)

           myForm6.Picture1.DrawWidth = 3:        myForm6.Picture1.DrawStyle = 0

           myForm6.Picture1.Line (797, 5250 - aE0 * 850)-(803, _

                                 5250 - aE0 * 850), RGB(0, 255, 255)

           myForm6.Picture1.DrawWidth = 2

           myForm6.Picture1.PSet (800 + i * (6000 / (300 + ii1 * 300)), _

                            5250 - gx0(i) * 850), RGB(255, 0, 0)             '   训练曲线

           myForm6.Picture1.PSet (800 + i * (6000 / (300 + ii1 * 300)), _

                            5250 - gx00(i) * 850), RGB(0, 0, 255)            '   检验曲线

'           myForm6.Picture1.Line (800, 4400 - (Log(aE0) / Log(10)) * 850)-(6900, _

                                 4400 - (Log(aE0) / Log(10)) * 850), RGB(255, 255, 0)

'           myForm6.Picture1.DrawWidth = 3:        myForm6.Picture1.DrawStyle = 0

'           myForm6.Picture1.Line (797, 4400 - (Log(aE0) / Log(10)) * 850)-(803, _

                                 4400 - (Log(aE0) / Log(10)) * 850), RGB(0, 255, 255)

'           myForm6.Picture1.DrawWidth = 2

'           myForm6.Picture1.PSet (800 + i * (6000 / (300 + ii1 * 300)), _

                            4400 - (Log(gx0(i)) / Log(10)) * 850), RGB(255, 0, 0)             '   训练曲线

'           myForm6.Picture1.PSet (800 + i * (6000 / (300 + ii1 * 300)), _

                            4400 - (Log(gx00(i)) / Log(10)) * 850), RGB(0, 0, 255)            '   检验曲线

        Next i

     End If

        '    反向修正各权值

        For i = 1 To nn

            aM2(i) = 0

        Next i

        For i = 1 To nn

            For k1 = 1 To n01

                aM2(i) = aM2(i) - gx32(k1) * aE34(k1) * gx21(i, k1)

            Next k1

        Next i

        For i = 1 To tt

            For k1 = 1 To 8

                aM1(i, k1) = 0

            Next k1

        Next i

        For i = 1 To tt

            For k1 = 1 To nn

                For k2 = 1 To n01

                    aM1(i, k1) = aM1(i, k1) - gxx1(i, k2) * gx22(k1, k2) * aE34(k2) * gx32(k2) * w2(k1)

                Next k2

            Next k1

        Next i

        ii = 130

        For i = 1 To nn

            aW2(i) = bb * aM2(i) + aa * aW20(i) + DouDl0

            aW20(i) = aW2(i)

            w2(i) = w2(i) + aW2(i)

 '           w2(i) = Val(myForm4.Combol(ii).Text) * w2(i)

            ii = ii + 1

        Next i

        ii = 0

        For i = 1 To tt

                For k1 = 1 To nn

                    aW1(i, k1) = bb * aM1(i, k1) + aa * aW10(i, k1) + DouDl0

                    aW10(i, k1) = aW1(i, k1)

                    w1(i, k1) = w1(i, k1) + aW1(i, k1)

            '        w1(i, k1) = Val(myForm4.Combol(ii).Text) * w1(i, k1)

                    ii = ii + 1

                Next k1

           ii = i * 10

        Next i

     '   观察过程中的权值变化情况

' If kk2 <= 30 Then

   '     myForm6.Picture1.CurrentX = 5500

   '     myForm6.Picture1.CurrentY = 200 + kk2 * 200

   '     myForm6.Picture1.Print w2(1)

   '  End If

   ' (2)、 神经网络检验部分

       '   从数据库2取神经网络检验用数据

     EE = 0:        aE2 = 0:          E2 = 0

     For ii = 1 To n02

        gx1(1) = (网络检验数据表.Data1.Recordset.Fields("常顶压力") - 16) / 22

        gx1(2) = (网络检验数据表.Data1.Recordset.Fields("常顶温度") - 120) / 13

        gx1(3) = (网络检验数据表.Data1.Recordset.Fields("常顶回流温") - 23) / 18

        gx1(4) = (网络检验数据表.Data1.Recordset.Fields("回比进量") - 8.6) / 12

        gx1(5) = (网络检验数据表.Data1.Recordset.Fields("常一馏出温度") - 169) / 18

        gx1(6) = (网络检验数据表.Data1.Recordset.Fields("一线比进量") - 0.6) / 0.

        gx1(7) = (网络检验数据表.Data1.Recordset.Fields("一中比进热") - 85.1) / 65

        gx1(8) = (网络检验数据表.Data1.Recordset.Fields("常塔进料温度") - 365) / 18

        gx1(9) = (网络检验数据表.Data1.Recordset.Fields("常塔进料压力") - 52.8) / 24

        gx1(10) = (网络检验数据表.Data1.Recordset.Fields("组分因素") - 0.53) / 0.14

        gd1 = (网络检验数据表.Data1.Recordset.Fields("汽油干点") - 176) / 20

        For i = 1 To tt                       '   检查输入数据是否有误?

If gx1(i) < -1.05 Or gx1(i) > 1.05 Or gd1 < -1.05 Or gd1 > 1.05 Then

                intResult = MsgBox("神经网络检验输入数据中," & ii & "号记录不合理。" + Chr(13) + Chr(13) + Chr(10) + _

                       "需要检查输入数据吗？", vbApplicationModal + vbDefaultButton1 + vbQuestion _

                        + vbYesNo, "输入数据检错")

                Select Case intResult

                Case vbYes

                    Exit Sub

                Case vbNo

' If gx1(i) > 1 Then gx1(i) = 1 ' 错误处理

' If gx1(i) < 0 Then gx1(i) = 0

                End Select

            End If

        Next i

          '    前向计算误差

        For i = 1 To nn

            xx = w1(1, i) * gx1(1) + w1(2, i) * gx1(2) + w1(3, i) * gx1(3) _

               + w1(4, i) * gx1(4) + w1(5, i) * gx1(5) + w1(6, i) * gx1(6) _

               + w1(7, i) * gx1(7) + w1(8, i) * gx1(8) + w1(9, i) * gx1(9) _

               + w1(10, i) * gx1(10)

            gx2(i) = 1 / (1 + Exp(-xx))

        Next i

        xx = 0

        For i = 1 To nn

            xx = xx + w2(i) * gx2(i)

        Next i

        gx3 = 1 / (1 + Exp(-xx))

        EE = EE + (gd1 - gx3) ^ 2

        E2 = E2 + ((gd1 - gx3) * 20) ^ 2

        aE2 = aE2 + Abs(gd1 - gx3) * 20

  '      ReDim Preserve aE34(ii)             '     保存各个记录的误差值

        aE340(ii) = -(gd1 - gx3)

  '      ReDim Preserve gdjs(ii)             '     保存各个记录的计算值

        gdjy(ii) = gx3 * 20 + 176

If ii < n02 Then

           网络检验数据表.Data1.Recordset.MoveNext

        Else

           网络检验数据表.Data1.Recordset.MoveFirst

        End If

     Next ii

     '    动态显示

     EE = EE / 2

     E2 = E2 / n02

     aE2 = aE2 / n02

     ReDim Preserve gx00(kk2)

     gx00(kk2) = EE

     myForm6.Picture1.DrawWidth = 2

     myForm6.Picture1.PSet (800 + kk2 * (6000 / (300 + ii1 * 300)), _

                  5250 - gx00(kk2) * 850), RGB(0, 0, 255)

'     myForm6.Picture1.PSet (800 + kk2 * (6000 / (300 + ii1 * 300)), _

                  4400 - (Log(gx00(kk2)) / Log(10)) * 850), RGB(0, 0, 255)

     '    找最小点

' If kk2 > 1 And EE > EE1 And EE2 > EE1 Then ' 网络检验最小点寻找

  '       EE2 = EE1

  '       Dim intResult22 As Integer

  '       intResult22 = MsgBox("检验网络误差平方和到一最小点，还要继续运行吗？", vbApplicationModal + vbDefaultButton2 _

  '                    + vbQuestion + vbYesNo, "提示")

  '       Select Case intResult22

  '       Case vbNo

  '            kk2 = kk2 - 1

  '            EE = EE1

  '            Exit Do

  '       End Select

  '   End If

  '   EE1 = EE

Loop While Abs(aE0) <= E ' Or kk2 <= 12000

' Loop While kk2 <= 5000

     ' 输出结果

     inttt = 0

     bb = Format(bb, "####0.###")

     aa = Format(aa, "####0.###")

     myForm6.Label1.Caption = "学习速率:" & bb

     myForm6.Label2.Caption = "动量因子:" & aa

     myForm6.HScroll1.Value = bb * 1000

     myForm6.HScroll2.Value = aa * 1000

     INKey = 0

     myForm6.Command8.Visible = True

     myForm6.Text2.Text = kk2

     myForm6.Text3.Text = Format(E1, "###0.######")

     myForm6.Text5.Text = Format(E2, "###0.######")

     myForm6.Text4.Text = Format(aE3, "###0.######")

     myForm6.Text6.Text = Format(aE2, "###0.######")

     myForm6.Label10.Caption = "BP网络最终平方和误差为：" & E

     ' 给数据库送数

     intResult = MsgBox("把这次训练及检验的结果送入数据库吗?", vbApplicationModal _

                + vbQuestion + vbDefaultButton2 + vbYesNo, "提示")

     Select Case intResult

        Case vbYes

            '    训练用数据库送数

            输入数据表.Data1.Recordset.MoveFirst

            For i = 1 To n01

               输入数据表.Data1.Recordset.Edit

               输入数据表.Data1.Recordset.Fields("干点计算") = gdjs(i)

               输入数据表.Data1.Recordset.Fields("误差") = aE34(i) * 20

               输入数据表.Data1.Recordset.Update

               输入数据表.Data1.Recordset.MoveNext

            Next i

            '    检验用数据库送数

            网络检验数据表.Data1.Recordset.MoveFirst

            For i = 1 To n02

               网络检验数据表.Data1.Recordset.Edit

               网络检验数据表.Data1.Recordset.Fields("干点计算") = gdjy(i)

               网络检验数据表.Data1.Recordset.Fields("误差") = aE340(i) * 20

               网络检验数据表.Data1.Recordset.Update

               网络检验数据表.Data1.Recordset.MoveNext

            Next i

     End Select

     ' 给最终权值表送数

     ii = 0

     For i = 1 To tt

        For k1 = 1 To nn

           最终权值.Text(ii).Text = w1(i, k1)

           ii = ii + 1

        Next k1

        ii = i * 10

     Next i

     ii = 130

     For i = 1 To nn

        最终权值.Text(ii).Text = w2(i)

        ii = ii + 1

     Next i

End Sub

RBFNN:

X=0:0.1:5;

y=sqrt(x);

net=newrb(x,y,0,0.5,20,5);

t=sim(net,x);

plot(x, y-t, ‘*-‘)