3层bp神经网络
Posted 苹果电脑管家
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了3层bp神经网络相关的知识，希望对你有一定的参考价值。
Option Explicit
Public V(), W() As Double '连接权
Public R(), Q() As Double '阈值
Public z() As Double '输入层输出
Public y() As Double '中间层输出
Public o() As Double '输出层输出
Public d() As Double '教师信号
Public N As Integer '学习次数
Public NN As Integer '教师信号数
Public Count As Integer '第Count个教师信号数
Public II As Integer '输入层节点数
Public JJ As Integer '中间层节点数
Public KK As Integer '输出层节点
Public Er1() As Double '输出层各单元一般化误差
Public Er2() As Double '中间层各单元一般化误差
Public L1 As Double '权调节系数
Public L2 As Double '阈调节系数
Public Sub StudyMain() '学习过程
Dim i, j, k As Integer
For Count = 1 To NN
Call MidLayer '计算中间层各单元的输入/输出
Call OutLayer '计算输出层各单元的输入/输出
Call OutError '计算输出层各单元的一般化误差
Call MidError '计算中间层各单元的一般化误差
Call Modify_Mid_Out '调节中间层至输出层之间的连接权及输出层节点的阈值
Call Modify_In_Mid '调节输入层至中间层的连接权及中间层节点的阈值
Next Count
End Sub
Public Sub Initial() '连接权、阈值初始化
Dim i, j, k As Integer
Randomize
For j = 1 To JJ
For i = 1 To II
V(j, i) = 2 * Rnd - 1
Next i
Next j
For k = 1 To KK
For j = 1 To JJ
W(k, j) = 2 * Rnd - 1
Next j
Next k
For j = 1 To JJ
R(j) = 2 * Rnd - 1
Next j
For k = 1 To KK
Q(k) = 2 * Rnd - 1
Next k
End Sub
Public Sub Teacher() '提供教师信号
Dim i, j, k As Integer
Dim Max As Double
For j = 1 To NN
For k = 1 To KK
For i = 1 To II
z(j, i) = i / 2 + k / 3 + j / 4
d(j, k) = d(j, k) + z(j, i) ^ 2
Next i
Next k
Next j
For j = 1 To NN
For k = 1 To KK
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 KK
d(j, k) = d(j, k) / Max
Next k
Next j
End Sub
Public Sub MidLayer() '计算中间层各单元的输入/输出
Dim i, j As Integer
Dim net() As Double
ReDim net(JJ)
For j = 1 To JJ
For i = 1 To II
net(j) = net(j) + V(j, i) * z(Count, i)
Next i
y(Count, j) = f(net(j) - R(j))
Next j
End Sub
Public Sub OutLayer() '计算输出层各单元的输入/输出
Dim j, k As Integer
Dim net() As Double
ReDim net(KK)
For k = 1 To KK
For j = 1 To JJ
net(k) = net(k) + W(k, j) * y(Count, j)
Next j
o(Count, k) = f(net(k) - Q(k))
Next k
End Sub
Public Sub OutError() '计算输出层各单元的一般化误差
Dim k As Integer
For k = 1 To KK
Er1(k) = (d(Count, k) - o(Count, k)) * o(Count, k) * (1 - o(Count, k))
Next k
End Sub
Public Sub MidError() '计算中间层各单元的一般化误差
Dim j, k As Integer
For j = 1 To JJ
For k = 1 To KK
Er2(j) = Er2(j) + Er1(k) * W(k, j)
Next k
Er2(j) = Er2(j) * y(Count, j) * (1 - y(Count, j))
Next j
End Sub
Public Sub Modify_Mid_Out() '调节中间层至输出层之间的连接权及输出层节点的阈值
Dim k, j As Integer
For k = 1 To KK
For j = 1 To JJ
W(k, j) = W(k, j) + L1 * Er1(k) * y(Count, j)
Next j
Q(k) = Q(k) - L2 * Er1(k)
Next k
End Sub
Public Sub Modify_In_Mid() '调节输入层至中间层的连接权及中间层节点的阈值
Dim i, j As Integer
For j = 1 To JJ
For i = 1 To II
V(j, i) = V(j, i) + L1 * Er2(j) * z(Count, i)
Next i
R(j) = R(j) - L2 * Er2(j)
Next j
End Sub
Public Function f(x As Double) As Double
f = 1 / (1 + Exp(-x))
End Function
Option Explicit
Dim Memory, CmdMark As Integer
Dim OY As Double
Private Sub Command1_Click()
Dim i, j, k As Integer
N = Val(Text6.Text)
L1 = Val(Text7.Text)
L2 = Val(Text8.Text)
Call Read_z_d
For j = 1 To NN
For i = 1 To KK
Err = Err + (d(j, i) - o(j, i)) ^ 2
Next i
Next j
Line3(0).X1 = 0
If CmdMark = 0 Then
Line3(0).Y1 = Picture15.Height / 2 - Err * 500
Line3(0).Y2 = Picture15.Height / 2 - Err * 500
Else
Line3(0).Y1 = OY
Line3(0).Y2 = OY
End If
Line3(0).X2 = 0
Call Erase_e
For k = 1 To N
Call StudyMain
Call Draw_e(k)
Call Write_o
Next k
OY = Line3(N).Y2
Call Write_Weight
Call Write_Key
Memory = N
CmdMark = 1
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Memory = 0
CmdMark = 0
ReDim V(JJ, II)
ReDim W(KK, JJ)
ReDim R(JJ)
ReDim Q(KK)
ReDim z(NN, II)
ReDim y(NN, JJ)
ReDim o(NN, KK)
ReDim d(NN, KK)
ReDim Er1(KK)
ReDim Er2(JJ)
Call Pic1Redraw
Call Text1Load
Call Pic3Redraw
Call Text2Load
Call Pic5Redraw
Call text3Load
Call Pic7Redraw
Call text4Load
Call Pic9Redraw
Call text5Load
Call Pic11Redraw
Call text9Load
Call Pic13Redraw
Call Text10Load
Line4.X1 = 0
Line4.Y1 = Picture15.Height / 2
Line4.X2 = Picture15.Width
Line4.Y2 = Picture15.Height / 2
Call Teacher
Call Write_z_d
Call Initial
Call Write_Weight
Call Write_Key
End Sub
Private Sub Write_z_d()
Dim i, j, k As Integer
For j = 1 To NN
For i = 1 To II
Text1((j - 1) * II + i).Text = z(j, i)
Next i
Next j
For j = 1 To NN
For k = 1 To KK
Text3((j - 1) * KK + k).Text = d(j, k)
Next k
Next j
End Sub
Private Sub Read_z_d()
Dim i, j, k As Integer
For j = 1 To NN
For i = 1 To II
z(j, i) = Val(Text1((j - 1) * II + i).Text)
Next i
Next j
For j = 1 To NN
For k = 1 To KK
d(j, k) = Val(Text3((j - 1) * KK + k).Text)
Next k
Next j
End Sub
Private Sub Write_Weight()
Dim i, j, k As Integer
For j = 1 To JJ
For i = 1 To II
Text5((j - 1) * II + i).Text = V(j, i)
Next i
Next j
For k = 1 To KK
For j = 1 To JJ
Text4((k - 1) * JJ + j).Text = W(k, j)
Next j
Next k
End Sub
Private Sub Write_Key()
Dim i, j, k As Integer
For j = 1 To JJ
Text9(j).Text = R(j)
Next j
For k = 1 To KK
Text10(k).Text = Q(k)
Next k
End Sub
Private Sub Write_o()
Dim j, k As Integer
For j = 1 To NN
For k = 1 To KK
Text2((j - 1) * KK + k).Text = o(j, k)
Next k
Next j
End Sub
Private Sub Draw_e(L As Integer) '画线
Dim Err As Double
Err = 0
Dim i, j, k As Integer
For j = 1 To NN
For k = 1 To KK
Err = Err + (d(j, k) - o(j, k)) ^ 2
Next k
Next j
Err = Err / 2
Load Line3(L)
Line3(L).Visible = True
Line3(L).X1 = Line3(L - 1).X2
Line3(L).Y1 = Line3(L - 1).Y2
Line3(L).X2 = Line3(L - 1).X2 + Picture15.Width / N * L
Line3(L).Y2 = Picture15.Height / 2 - 500 * Err
End Sub
Private Sub Erase_e() '擦除画线
Dim i As Integer
For i = 1 To Memory
Unload Line3(i)
Next
End Sub
Private Sub Pic1Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture2.Width = II * Text1(0).Width + 50
Picture2.Height = NN * Text1(0).Height + 50
'判断滚动条出现的不同情况
If Picture1.Width < Picture2.Width + Picture2.Left * 2 _
And Picture1.Height < Picture2.Height + Picture2.Top * 2 Then
'水平、垂直滚动条都出现
HScroll1.Left = 0
HScroll1.Top = Picture1.Height - HScroll1.Height
HScroll1.Width = Picture1.Width
HScroll1.Max = Picture2.Width + 2 * Picture2.Left - Picture1.Width
HScroll1.Min = 0
VScroll1.Top = 0
VScroll1.Left = Picture1.Width - VScroll1.Width
VScroll1.Height = Picture1.Height - HScroll1.Height
VScroll1.Max = Picture2.Height + 2 * Picture2.Top - Picture1.Height
VScroll1.Min = 0
HScroll1.Visible = True
VScroll1.Visible = True
ElseIf Picture1.Width < Picture2.Width + Picture2.Left * 2 Then
'只出现水平滚动条
HScroll1.Left = 0
HScroll1.Top = Picture1.Height - HScroll1.Height
HScroll1.Width = Picture1.Width
HScroll1.Max = Picture2.Width + 2 * Picture2.Left - Picture1.Width
HScroll1.Min = 0
HScroll1.Visible = True
VScroll1.Visible = False
ElseIf Picture1.Height < Picture2.Height + Picture2.Top * 2 Then
'只出现垂直滚动条
VScroll1.Top = 0
VScroll1.Left = Picture1.Width - VScroll1.Width
VScroll1.Height = Picture1.Height
VScroll1.Max = Picture2.Height + 2 * Picture2.Top - Picture1.Height
VScroll1.Min = 0
HScroll1.Visible = False
VScroll1.Visible = True
Else
HScroll1.Visible = False
VScroll1.Visible = False
End If
HScroll1.SmallChange = 20
HScroll1.LargeChange = (HScroll1.Max - HScroll1.Min) / 10
HScroll1.Value = 0
VScroll1.SmallChange = 20
VScroll1.LargeChange = (VScroll1.Max - VScroll1.Min) / 10
VScroll1.Value = 0
End Sub
Private Sub HScroll1_Change() '水平滚动条变化
Picture2.Left = 0 - HScroll1.Value
End Sub
Private Sub Text1Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To NN - 1 '调入水平表格中的各个文本框
For j = 1 To II '调入垂直表格中的各个文本框
Load Text1(i * II + j)
Text1(i * II + j).Visible = True
Text1(i * II + j).Left = Text1(0).Width * (j - 1)
Text1(i * II + j).Top = Text1(0).Height * i
Text1(i * II + j).Text = ""
Next j
Next i
End Sub
Private Sub VScroll1_Change() '垂直滚动条
Picture2.Top = 0 - VScroll1.Value
End Sub
Private Sub Pic3Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture4.Width = KK * Text2(0).Width + 50
Picture4.Height = NN * Text2(0).Height + 50
'判断滚动条出现的不同情况
If Picture3.Width < Picture4.Width + Picture4.Left * 2 _
And Picture3.Height < Picture4.Height + Picture4.Top * 2 Then
'水平、垂直滚动条都出现
HScroll2.Left = 0
HScroll2.Top = Picture3.Height - HScroll2.Height
HScroll2.Width = Picture3.Width
HScroll2.Max = Picture4.Width + 2 * Picture4.Left - Picture3.Width
HScroll2.Min = 0
VScroll2.Top = 0
VScroll2.Left = Picture3.Width - VScroll2.Width
VScroll2.Height = Picture3.Height - HScroll2.Height
VScroll2.Max = Picture4.Height + 2 * Picture4.Top - Picture3.Height
VScroll2.Min = 0
HScroll2.Visible = True
VScroll2.Visible = True
ElseIf Picture3.Width < Picture4.Width + Picture4.Left * 2 Then
'只出现水平滚动条
HScroll2.Left = 0
HScroll2.Top = Picture3.Height - HScroll2.Height
HScroll2.Width = Picture3.Width
HScroll2.Max = Picture4.Width + 2 * Picture4.Left - Picture3.Width
HScroll2.Min = 0
HScroll2.Visible = True
VScroll2.Visible = False
ElseIf Picture3.Height < Picture4.Height + Picture4.Top * 2 Then
'只出现垂直滚动条
VScroll2.Top = 0
VScroll2.Left = Picture3.Width - VScroll2.Width
VScroll2.Height = Picture3.Height
VScroll2.Max = Picture4.Height + 2 * Picture4.Top - Picture3.Height
VScroll2.Min = 0
HScroll2.Visible = False
VScroll2.Visible = True
Else
HScroll2.Visible = False
VScroll2.Visible = False
End If
HScroll2.SmallChange = 20
HScroll2.LargeChange = (HScroll2.Max - HScroll2.Min) / 10
HScroll2.Value = 0
VScroll2.SmallChange = 20
VScroll2.LargeChange = (VScroll2.Max - VScroll2.Min) / 10
VScroll2.Value = 0
End Sub
Private Sub HScroll2_Change() '水平滚动条变化
Picture4.Left = 0 - HScroll2.Value
End Sub
Private Sub Text2Load() '调入文本框控件
Dim i, j As Integer
For i = 0 To NN - 1 '调入水平表格中的各个文本框
For j = 1 To KK '调入垂直表格中的各个文本框
Load Text2(i * KK + j)
Text2(i * KK + j).Visible = True
Text2(i * KK + j).Left = Text2(0).Width * (j - 1)
Text2(i * KK + j).Top = Text2(0).Height * i
Text2(i * KK + j).Text = ""
Next j
Next i
End Sub
Private Sub VScroll2_Change() '垂直滚动条
Picture4.Top = 0 - VScroll2.Value
End Sub
Private Sub Pic5Redraw() '视窗图片重绘子程序
'设置表格载体图片控件的属性
Picture6.Width = KK * Text3(0).Width + 50
Picture6MATLAB中BP神经网络的训练算法具体是怎么样的