form1.frm

这个程序是标准的BP神经网络

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.TextBox Text5 
      Height          =   375
      Left            =   2280
      TabIndex        =   17
      Text            =   "1"
      Top             =   3360
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      Height          =   7575
      Left            =   4080
      ScaleHeight     =   7515
      ScaleWidth      =   4155
      TabIndex        =   15
      Top             =   600
      Width           =   4215
   End
   Begin VB.TextBox Text8 
      Height          =   375
      Left            =   2280
      TabIndex        =   14
      Text            =   "0.1"
      Top             =   4800
      Width           =   1215
   End
   Begin VB.TextBox Text7 
      Height          =   375
      Left            =   2280
      TabIndex        =   13
      Text            =   "0.1"
      Top             =   4080
      Width           =   1215
   End
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   2280
      TabIndex        =   12
      Text            =   "15"
      Top             =   2640
      Width           =   1215
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   2280
      TabIndex        =   11
      Text            =   "3"
      Top             =   1920
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   2280
      TabIndex        =   10
      Text            =   "100"
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   2280
      TabIndex        =   9
      Text            =   "10"
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   615
      Left            =   2280
      TabIndex        =   1
      Top             =   6240
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "网络学习"
      Height          =   615
      Left            =   720
      TabIndex        =   0
      Top             =   6240
      Width           =   1095
   End
   Begin VB.Label Label9 
      Caption         =   "误差"
      Height          =   255
      Left            =   4080
      TabIndex        =   16
      Top             =   240
      Width           =   735
   End
   Begin VB.Label Label8 
      Caption         =   "阈值调节系数"
      Height          =   255
      Left            =   600
      TabIndex        =   8
      Top             =   4920
      Width           =   1335
   End
   Begin VB.Label Label7 
      Caption         =   "权调节系数"
      Height          =   375
      Left            =   600
      TabIndex        =   7
      Top             =   4200
      Width           =   1215
   End
   Begin VB.Label Label6 
      Caption         =   "学习次数"
      Height          =   375
      Left            =   600
      TabIndex        =   6
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label5 
      Caption         =   "输出层节点数"
      Height          =   375
      Left            =   600
      TabIndex        =   5
      Top             =   3480
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "第一隐层节点数"
      Height          =   375
      Left            =   600
      TabIndex        =   4
      Top             =   2760
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "输入层节点数"
      Height          =   375
      Left            =   600
      TabIndex        =   3
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label Label1 
      Caption         =   "学习模式数"
      Height          =   375
      Left            =   600
      TabIndex        =   2
      Top             =   600
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
  Dim W1(), W2() As Double '连接权
  Dim H1(), H2(), H3() As Double '学习步长
  Dim Q1(), Q2() As Double '阈值
  Dim o1(), o2(), o3() As Double '输入层、第一隐层、输出层输出
  Dim d() As Double '教师信号
  Dim N As Integer   '学习次数
  Dim NN As Integer  '教师信号数
  Dim Er As Double '总误差
  Dim Count1, Count2 As Integer '第Count1轮学习，第Count2个教师信号数
  Dim J1, J2, J3 As Integer '输入层、第一隐层、输出层节点数
  Dim Er1(), Er2() As Double '输出层、第一隐层各单元局部梯度
  Dim L1 As Double '权调节系数（学习步长）
  Dim L2 As Double '阈调节系数（学习步长）
  Dim i, j, k, t As Integer
  
  NN = Val(Text1.Text)
  N = Val(Text2.Text)
  J1 = Val(Text3.Text)
  J2 = Val(Text4.Text)
  J3 = Val(Text5.Text)
  L1 = Val(Text7.Text)
  L2 = Val(Text8.Text)
  
  ReDim W1(J1, J2), W2(J2, J3)
  ReDim Q1(J2), Q2(J3)
  ReDim o1(NN, J1), o2(NN, J2), o3(NN, J3)
  ReDim d(NN, J1)
  ReDim Er1(J3), Er2(J2)
  
 '提供教师信号
 ' d(1, 1) = 100: d(2, 1) = 60: d(3, 1) = 60: d(4, 1) = 100: d(5, 1) = 60
 ' o1(1, 1) = 54: o1(2, 1) = 50: o1(3, 1) = 65: o1(4, 1) = 42: o1(5, 1) = 52
 ' o1(1, 2) = 1.91: o1(2, 2) = 1.71: o1(3, 2) = 1.75: o1(4, 2) = 1.89: o1(5, 2) = 1.8
 ' o1(1, 3) = 1.43: o1(2, 3) = 1.45: o1(3, 3) = 1.44: o1(4, 3) = 1.35: o1(5, 3) = 1.36

 Dim Max As Double
For j = 1 To NN
 For k = 1 To J3
  For i = 1 To J1
   o1(j, i) = i / 2 + k / 3 + j / 4
   d(j, k) = d(j, k) + o1(j, i) ^ 2
  Next i
 Next k
Next j
For j = 1 To NN
 For k = 1 To J3
 If Max < d(j, k) Then
   Max = d(j, k)
 End If
 Next k
Next j
For j = 1 To NN
 For k = 1 To J3
 d(j, k) = d(j, k) / Max
 Next k
Next j
  
  '连接权、阈值初始化
  Randomize            '初始化随机数生成器
  '权
  For i = 1 To J1
    For j = 1 To J2
      W1(i, j) = 2 * Rnd - 1  '0到1之间的随机数
 '     W1(i, j) = 0.1
    Next j
  Next i
  For j = 1 To J2
    For k = 1 To J3
      W2(j, k) = 2 * Rnd - 1
    '  W2(j, k) = 0.1
    Next k
  Next j
  '阈值
  For i = 1 To J2
    Q1(i) = 2 * Rnd - 1
  '  Q1(i) = 0.05
  Next i
  For j = 1 To J3
    Q2(j) = 2 * Rnd - 1
  '  Q2(j) = 0.05
  Next j
  '学习
  N = 0
  Do
   Er = 0
   N = N + 1
'  For Count1 = 1 To N
   For Count2 = 1 To NN
    '计算第一隐层各单元的输入/输出
    Dim net1() As Double
    ReDim net1(J2)
    For j = 1 To J2
      For i = 1 To J1
        net1(j) = net1(j) + W1(i, j) * o1(Count2, i)
      Next i
      o2(Count2, j) = f(net1(j) - Q1(j))
    Next j
    '计算输出层各单元的输入/输出
    Dim net3() As Double
    ReDim net3(J3)
    For t = 1 To J3
      For k = 1 To J2
        net3(t) = net3(t) + W2(k, t) * o2(Count2, k)
      Next k
      o3(Count2, t) = f(net3(t) - Q2(t))
    Next t
    '计算输出层各单元的一般化误差（梯度）
    For k = 1 To J3
      Er1(k) = (d(Count2, k) - o3(Count2, k)) * o3(Count2, k) * (1 - o3(Count2, k))
      Er = Er + Abs((d(Count2, k) - o3(Count2, k)) / d(Count2, k))
    Next k
    '计算第一隐各单元的一般化误差（梯度）
    For j = 1 To J2
      For k = 1 To J3
        Er2(j) = Er2(j) + Er1(k) * W2(j, k)
      Next k
      Er2(j) = Er2(j) * o2(Count2, j) * (1 - o2(Count2, j))
    Next j
    
    '调节第一隐层至输出层之间的连接权及第二隐层节点的阈值
    For k = 1 To J3
      For j = 1 To J2
      W2(j, k) = W2(j, k) + L1 * Er1(k) * o2(Count2, j)
      Next j
      Q2(k) = Q2(k) - L2 * Er1(k)
    Next k
    '调节输入层至第一隐层的连接权及第一隐层节点的阈值
    For j = 1 To J2
      For i = 1 To J1
      W1(i, j) = W1(i, j) + L1 * Er2(j) * o1(Count2, i)
      Next i
      Q1(j) = Q1(j) - L2 * Er2(j)
    Next j
   Next Count2
   Er = Er / NN
'  Next Count1
   Loop Until Er < 0.05 Or N > 3000
   '打印
  For i = 1 To NN
    Picture1.Print d(i, 1), o3(i, 1)
  Next i
  Picture1.Print N
  Picture1.Print Er
End Sub
Private Function f(x As Double) As Double '激活函数
  f = 1 / (1 + Exp(-x))
End Function
Private Sub Command2_Click()
  Unload Me
End Sub