VB版4层结构BP神经网络类
Posted 苹果电脑管家
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了VB版4层结构BP神经网络类相关的知识，希望对你有一定的参考价值。
'--------------------------------------------------------------
'*.4层bp神经网
'*.动量项加速训练
'*.刺激函数为单向S极函数
'*.各神经元刺激函数引入偏离值B : f(sum(w*input))-->f(sum(w*input)+B),B在训练中也进行进化
'*.输入向量规一化处理
'*.输出向量误差方差作为收敛准则
'*.随机选择训练样本
'*.blue.pan@163.com
'--------------------------------------------------------------
'参数信息
Private mL1 As Long '输入层神经元个数 L1
Private mL2 As Long '第一隐含层的神经元个数 L2
Private mL3 As Long '第二隐含层层的神经元个数 L3
Private mL4 As Long '输出层的神经元个数 L4
Private mMinMax() As Double '输入向量的上下限,用于标准化 L1 X 2
Private Ts As Long '输入向量的总个数
'结构
'为了计算方便,我们把数组的第二维定义为第二层的编号
Private mW12() As Double '12层的权值 L2 X L1
Private mW23() As Double '23层的权值 L3 X L2
Private mW34() As Double '34层的权值 L4 X L3
'计算用
Private mB12() As Double '12层的偏移量 L2
Private mB23() As Double '23层的偏移量 L3
Private mB34() As Double '34层的偏移量 L4
'控制参数
Private mLr As Double '学习速度,改正的步长
Private mGama As Double '动量系数
Private mGoal As Double '收敛的精度
Private mMaxEpochs As Long '单个样本最大迭代次数
Private mIteration As Long '实际的训练次数 ,Iteration:重复, 重复地说 迭代法
Private Initialized As Boolean '是否已初始化
Private mEventtp As Long '训练事件触发步长
'T()
Private mTmin As Double '输出向量的最小值,用于绘图定坐标系Y范围
Private mTmax As Double '输出向量的最大值,用于绘图定坐标系Y范围
'--------------------------------------------------------------
'中间变量
'--------------------------------------------------------------
Private Pdealing() As Double '当前正在处理的输入
Private Tdealing() As Double '当前正在处理的输入对应的输出
'旧权值数组
Private OldW12() As Double
Private OldW23() As Double
Private OldW34() As Double
'旧偏移量数组
Private OldB12() As Double
Private OldB23() As Double
Private OldB34() As Double
Private Output2() As Double '隐含层的输出
Private Output3() As Double '隐含层的输出
Private Output4() As Double '输出层的输出
Private Err2() As Double '第一隐含层各神经元的误差
Private Err3() As Double '第二隐含层各神经元的误差
Private Err4() As Double '输出层各神经元的误差
Private mErr() As Double '各次输出层各神经元的误差的方差
Public Event Training() '定义一个事件
'----------------------------
'获取属性值
'----------------------------
Public Property Get L1() As Long
L1 = mL1
End Property
Public Property Get L2() As Long
L2 = mL2
End Property
Public Property Get L3() As Long
L3 = mL3
End Property
Public Property Get L4() As Long
L4 = mL4
End Property
Public Property Get Errlimit() As Double
Errlimit = mGoal
End Property
Public Property Get TrainPace() As Double
TrainPace = mLr
End Property
Public Property Get Gama() As Double
Gama = mGama
End Property
Public Property Get TrainMaxTimes() As Long
TrainMaxTimes = mMaxEpochs
End Property
Public Property Get Tmin() As Double
Tmin = mTmin
End Property
Public Property Get Tmax() As Double
Tmax = mTmax
End Property
'----------------------------
'设置属性值
'----------------------------
Public Property Let L1(Value As Long)
mL1 = Value
End Property
Public Property Let L2(Value As Long)
mL2 = Value
End Property
Public Property Let L3(Value As Long)
mL3 = Value
End Property
Public Property Let L4(Value As Long)
mL4 = Value
End Property
Public Property Let Errlimit(Value As Double)
mGoal = Value
End Property
Public Property Let TrainPace(Value As Double)
mLr = Value
End Property
Public Property Let Gama(Value As Double)
mGama = Value
End Property
Public Property Let TrainMaxTimes(Value As Long)
mMaxEpochs = Value
End Property
'训练事件触发步长
Public Property Let Eventtp(Value As Long)
mEventtp = Value
End Property
Public Property Get Eventtp() As Long
Eventtp = mEventtp
End Property
'--------------------------------------------------------------
'训练过程函数
'--------------------------------------------------------------
Public Sub Train(P() As Double, T() As Double)
Dim i As Long, j As Long, Index As Long
Dim NormalP() As Double '正规化样本数据
Ts = UBound(P, 2) '输入向量的个数
NormalP = CopyArray(P) '保留原始的P
Tminmax T() '取得T()的上下限,用于绘图时scale picturebox
NormalizeInput NormalP '归一化样本数据
Call IniParameters '初始化网络的权参数和数组
mIteration = 0
For i = 1 To mMaxEpochs
mIteration = mIteration + 1 '记录训练次数
'注意,这里不是顺序的每一个都拿出来训练,保证每个都收敛,而是随机取,看成一个样本的迭代训练
Index = Int(Rnd * Ts + 1) '随机选取一个输入向量作为训练样本，这样效果比按顺序循环要好
'1.取出一个训练
For j = 1 To mL1
Pdealing(j) = NormalP(j, Index) '此次用于训练的输入向量
Next
For j = 1 To mL4
Tdealing(j) = T(j, Index) '此次用于训练的输出向量
Next
'2.正向传播
Call LayerValue2 '第一隐层
Call LayerValue3 '第二隐层
Call LayerValue4 '输出层
'3.反向传播,'计算误差,修改权阵,偏置值
Call LayerError4
Call LayerError3
Call LayerError2
Call Update_W34B34
Call Update_W23B23
Call Update_W12B12
If mIteration Mod mEventtp = 0 Then
Frmmain.MyPBar1.getmove mIteration / mMaxEpochs * 100
DoEvents '处理外部事务
RaiseEvent Training '若是训练了 mEventtp次,触发外部的一个事件,进行仿真显示一下,'RaiseEvent在MSDN中的定义为：触发类、窗体或文档中在模块级声明的事件
End If
If mErr(mIteration) < mGoal Then
Exit Sub '达到要求，完成学习，退出
Frmmain.MyPBar1.getmove 100
End If
Next
Frmmain.MyPBar1.getmove 100
End Sub
'正向传播:
'--------------------------------------------------------------
'计算第一隐含层的数据
'--------------------------------------------------------------
Private Sub LayerValue2()
Dim i As Long, j As Long
Dim Sum As Double
For i = 1 To mL2
Sum = 0
For j = 1 To mL1
Sum = Sum + mW12(i, j) * Pdealing(j)
Next
Output2(i) = 1 / (1 + Exp(-(Sum + mB12(i))))
Next
End Sub
'--------------------------------------------------------------
'计算第二隐含层的数据
'--------------------------------------------------------------
Private Sub LayerValue3()
Dim i As Long, j As Long
Dim Sum As Double
On Error Resume Next
For i = 1 To mL3
Sum = 0
For j = 1 To mL2
Sum = Sum + mW23(i, j) * Output2(j)
Next
Output3(i) = 1 / (1 + Exp(-(Sum + mB23(i))))
Next
End Sub
'--------------------------------------------------------------
'计算输出层的数据
'--------------------------------------------------------------
Private Sub LayerValue4()
Dim i As Long, j As Long
Dim Sum As Double
For i = 1 To mL4
Sum = 0
For j = 1 To mL3
Sum = Sum + mW34(i, j) * Output3(j)
Next
Output4(i) = Sum + mB34(i)
Next
End Sub
'反向传播:
'权改正量:每条权线上:输入量与误差之积就是改正量
'--------------------------------------------------------------
'计第四层的误差,更新权值和偏移量
'--------------------------------------------------------------
Private Sub LayerError4()
Dim i As Long, j As Long, Mse As Double
Mse = 0
For i = 1 To mL4
Err4(i) = (Tdealing(i) - Output4(i))
Mse = Mse + Err4(i) * Err4(i)
Next
mErr(mIteration) = Sqr(Mse / mL4) '记录此次的均方误差
End Sub
Private Sub Update_W34B34()
Dim i As Long, j As Long
Dim temp As Double
For i = 1 To mL4
For j = 1 To mL3
temp = mLr * Err4(i) * Output3(j) + mGama * OldW34(i, j) '权改正量
mW34(i, j) = mW34(i, j) + temp '修正权
OldW34(i, j) = temp
Next
temp = mLr * Err4(i) + mGama * OldB34(i) '偏移量改正量
mB34(i) = mB34(i) + temp '修正偏移量
OldB34(i) = temp
Next
End Sub
'--------------------------------------------------------------
'计算第三层的误差和梯度,更新权值和偏移量
'--------------------------------------------------------------
Private Sub LayerError3()
Dim i As Long, j As Long
Dim Sum As Double
For i = 1 To mL3
Sum = 0
For j = 1 To mL4
Sum = Sum + Err4(j) * mW34(j, i) '误差的加权和
Next
Err3(i) = Sum * (Output3(i)) * (1 - Output3(i))
Next
End Sub
Private Sub Update_W23B23()
Dim i As Long, j As Long
Dim temp As Double
For i = 1 To mL3
For j = 1 To mL2
temp = mLr * Err3(i) * Output2(j) + mGama * OldW23(i, j) '权改正量
mW23(i, j) = mW23(i, j) + temp '修正权
OldW23(i, j) = temp
Next
temp = mLr * Err3(i) + mGama * OldB23(i) '偏移量改正量
mB23(i) = mB23(i) + temp '修正偏移量
OldB23(i) = temp
Next
End Sub
'--------------------------------------------------------------
'计算第二层的误差和梯度,更新权值和偏移量
'--------------------------------------------------------------
Private Sub LayerError2()
Dim i As Long, j As Long
Dim Sum As Double
For i = 1 To mL2
Sum = 0
For j = 1 To mL3
Sum = Sum + Err3(j) * mW23(j, i) '误差的加权和
Next
Err2(i) = Sum * (Output2(i)) * (1 - Output2(i)) '隐藏层的梯度
Next
End Sub
Private Sub Update_W12B12()
Dim i As Long, j As Long
Dim temp As Double
For i = 1 To mL2
For j = 1 To mL1
temp = mLr * Err2(i) * Pdealing(j) + mGama * OldW12(i, j) '权改正量//每条权线上:输入量与误差之积就是改正量
mW12(i, j) = mW12(i, j) + temp '修正权
OldW12(i, j) = temp
Next
temp = mLr * Err2(i) + mGama * OldB12(i) '偏移量改正量
mB12(i) = mB12(i) + temp '修正偏移量
OldB12(i) = temp
Next
End Sub
'--------------------------------------------------------------
'参数的默认值初始化
'--------------------------------------------------------------
Private Sub Class_Initialize()
mL2 = 10 '第一隐含层的神经元个数
mL3 = 10 '第二隐含层的神经元个数
mGoal = 0.00001 '精度要求
mGama = 0.8 '动量系数,取0.1-0.8适合,加快收敛而已
mMaxEpochs = 10000 '最多训练次数
mlen = 1 '正弦函数的幅度
mLr = 0.1 '学习速度,改正的步长
mEventtp = 100 '事件触发频率
End Sub
'--------------------------------以上是关于VB版4层结构BP神经网络类的主要内容，如果未能解决你的问题，请参考以下文章