Public Sub anns01.docx

Public Sub anns01.docx

《Public Sub anns01.docx》由会员分享，可在线阅读，更多相关《Public Sub anns01.docx（26页珍藏版）》请在冰豆网上搜索。

PublicSubanns01

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）、输入层节点到中间层节点的连接权重的修改

其中：

——学习速率

——动量因子

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

PublicSubanns01_2（）'ANNS网络模型二---批的规模为全部数据组子程序

Dimn01AsInteger'训练用数据库记录总数

Dimn02AsInteger'检验用数据库记录总数

DimnnAsInteger'中间层节点数

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

Dimgx2（10）AsDouble'隐节点4个

Dimgx20（10）AsDouble

Dimgx3AsDouble'地节点（输出节点）1个

Dimgx30AsDouble

Dimgx21（10,nnn）AsDouble

Dimgx22（10,nnn）AsDouble

Dimgx31（nnn）AsDouble

Dimgx32（nnn）AsDouble

Dimgxx1（tt,nnn）AsDouble

Dimgd1AsDouble'实际输出值

DimaW1（tt,10）AsDouble'增量形式

DimaW2（10）AsDouble'增量形式

DimaW10（tt,10）AsDouble

DimaW20（10）AsDouble

Dimk1AsInteger'计数器

Dimk2AsInteger

DimiAsLong

DimiiAsInteger'

Dimii1AsInteger'

DimaE34（nnn）AsDouble'各个记录的最终误差（用于调权、送训练数据库）

DimaE340（nnn）AsDouble'各个记录的最终误差（用于送检验数据库）

DimE0（nnn）AsDouble'误差的平方（用于保存上一步的数值）

DimaE3AsDouble'训练绝对值平均误差

DimaE2AsDouble'检验绝对平均误差

DimEAsDouble'误差的平方和（目标函数）

DimE1AsDouble'训练均方差

DimE2AsDouble'检验均方差

DimEEAsDouble'检验误差平方和

DimEE1AsDouble'寻找最小值（当前最小）

DimEE2AsDouble'前一次最小

Dimgdjs（nnn）AsDouble'各个记录的计算值（用于送训练数据库）

'DimgdsAsDouble'训练时保存干点值以求平均

'DimgdyAsDouble'检验时保存干点值以求平均

Dimgdjy（nnn）AsDouble'检验数据库记录的干点计算值（用于送检验数据库）

DimaM1（tt,10）AsDouble'权值调节量

DimaM2（10）AsDouble

DimaE0AsDouble'误差限

DimbbAsDouble'学习速率

Dimbb0AsDouble'学习速率系数

DimaaAsDouble'动量因子

Dimaa0AsDouble'动量因子

DimxxAsDouble'过渡变量

DimDouDl0AsDouble'外加动量（数字形式）

DimintResultAsInteger

Dimsjk01AsDatabase

Dimsjl01AsRecordset

'数据库1操作

Setsjk01=OpenDatabase（"d:

\MyPrograms\chen\chen01.mdb"）'打开数据库

Setsjl01=sjk01.OpenRecordset（"原始数据输入表_1",dbOpenDynaset）'打开表

Withsjk01.OpenRecordset（"原始数据输入表_1",dbOpenDynaset）

If.EOF=TrueAnd.BOF=TrueThen

intResult=MsgBox（"没有数据用以训练！

"+Chr（13）+Chr（13）+Chr（10）+_

"输入数据吗？

",vbApplicationModal+vbDefaultButton1+vbQuestion_

+vbYesNo,"无数据提示：

"）

SelectCaseintResult

CasevbYes

MsgBox"输入数据，请按输入数据按扭。

",vbApplicationModal+_

vbInformation,"输入数据提示:

"

ExitSub

CasevbNo

MsgBox"很抱歉！

没有数据，无法训练！

",vbApplicationModal+vbInformation,_

"无数据提示：

"

ExitSub

EndSelect

EndIf

.MoveFirst

.MoveLast

n01=.RecordCount'确定记录总数

'n01=1'20

EndWith

输入数据表.Data1.Recordset.MoveFirst

'数据库2操作

Dimsjk02AsDatabase

Dimsjl02AsRecordset

Setsjk02=OpenDatabase（"d:

\MyPrograms\chen\chen02.mdb"）'打开数据库

Setsjl02=sjk02.OpenRecordset（"网络检验数据表",dbOpenDynaset）'打开表

Withsjk02.OpenRecordset（"网络检验数据表",dbOpenDynaset）

If.EOF=TrueAnd.BOF=TrueThen

intResult=MsgBox（"没有数据用以检验！

"+Chr（13）+Chr（13）+Chr（10）+_

"输入数据吗？

",vbApplicationModal+vbDefaultButton1+vbQuestion_

+vbYesNo,"无数据提示：

"）

SelectCaseintResult

CasevbYes

MsgBox"输入数据，请按输入数据按扭。

",vbApplicationModal+_

vbInformation,"输入数据提示:

"

ExitSub

CasevbNo

MsgBox"很抱歉！

没有数据，无法检验！

",vbApplicationModal+vbInformation,_

"无数据提示：

"

ExitSub

EndSelect

EndIf

.MoveFirst

.MoveLast

n02=.RecordCount'确定记录总数

'n02=20

EndWith

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

EE2=n02

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

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

'初始化处理

myForm6.KeyPreview=True

myForm6.Command8.Visible=False

myForm6.Picture1.Cls

Callcsqz'初始权值

aE0=Val（myForm6.Text1.Text）'误差限

nn=Val（myForm6.Combo1.Text）'中间层节点数

Fori=1Tonn:

aW2（i）=0:

aW20（i）=0:

Nexti

Fori=1Tott

Fork1=1Tonn

aW1（i,k1）=0

aW10（i,k1）=0

Nextk1

Nexti

kk2=0

ii1=0

myForm6.Label10.Visible=True

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

"+Chr（13）+Chr（13）_

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

"

Callqzb_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

DimintResult1AsInteger

DimintResult2AsInteger

DiminttAsInteger

'DimIkAsInteger

intt=0

inttt=1

Do

'

（1）、神经网络训练部分

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

IfmyForm6.HScroll1.Value<>500OrmyForm6.HScroll2.Value<>500Then

IfmyForm6.HScroll1.Value>500Then

bb0=（1+Abs（（myForm6.HScroll1.Value-500））/100）^1

Else

bb0=（1+Abs（（myForm6.HScroll1.Value-500））/100）^（-1）

EndIf

IfmyForm6.HScroll2.Value>500Then

aa0=（1+Abs（（myForm6.HScroll2.Value-500））/100）^1

Else

aa0=（1+Abs（（myForm6.HScroll2.Value-500））/100）^（-1）

EndIf

bb0=Format（bb0,"#####0.###"）

aa0=Format（aa0,"#####0.###"）

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

"&bb0

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

"&aa0

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

",_

vbApplicationModal+vbQuestion+vbOKCancel,"提示"）

SelectCaseintResult1

CasevbOK

bb=bb0*bb:

aa=aa0*aa

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

"_

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

",_

vbApplicationModal+vbQuestion+vbYesNo,"提示"）

SelectCaseintResult2

CasevbYes

intt=1

CasevbNo

intt=0

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

"&1

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

"&1

myForm6.HScroll1.Value=500

myForm6.HScroll2.Value=500

EndSelect

CasevbCancel

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

"&1

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

"&1

myForm6.HScroll1.Value=500

myForm6.HScroll2.Value=500

bb=bb

aa=aa

EndSelect

Else

bb=bb

aa=aa

EndIf

Else

bb0=Format（bb0,"#####0.###"）

aa0=Format（aa0,"####0.####"）

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

"&bb0

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

"&aa0

bb=bb*bb0

aa=aa*aa0

EndIf

E=0:

aE3=0:

E1=0

'从数据库取训练用数据

Forii=1Ton01

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.64

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

Fori=1Tott

gxx1（i,ii）=gx1（i）

Nexti

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

Fori=1Tott'检查输入数据是否有误?

Ifgx1（i）<-1.05Orgx1（i）>1.05Orgd1<-1.05Orgd1>1.05Then

intResult=MsgBox（"网络训练输入数据中,"&ii&"号记录不合理。

"+Chr（13）+Chr（13）+Chr（10）+_

"需要检查输入数据吗？

",vbApplicationModal+vbDefaultButton1+vbQuestion_

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

SelectCaseintResult

CasevbYes

ExitSub

CasevbNo

'Ifgx1（i）>1Thengx1（i）=1'错误处理

'Ifgx1（i）<0Thengx1（i）=0

EndSelect

EndIf

Nexti

'前向计算误差

Fori=1Tonn

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）导数

'ReDimPreservegx21（8,ii）

gx21（i,ii）=gx2（i）

'ReDimPreservegx22（8,ii）

gx22（i,ii）=gx20（i）'gx2（i）导数

Nexti

xx=0

Fori=1Tonn

xx=xx+w2（i）*gx2（i）

Nexti

gx3=1/（1+Exp（-xx））

gx30=gx3*（1-gx3）'gx3导数

'ReDimPreservegx31（ii）

gx31（ii）=gx3

'ReDimPreservegx32（ii）

gx32（ii）=gx30'gx3导数

E=E+（gd1-gx3）^2

E1=E1+（（gd1-gx3）*20）^2

aE3=aE3+Abs（gd1-gx3）*20

'ReDimPreserveaE34（ii）'保存各个记录的误差值

aE34（ii）=-（gd1-gx3）

'ReDimPreservegdjs（ii）'保存各个记录的计算值

gdjs（ii）=gx3*20+176

Ifii

输入数据表.Data1.Recordset.MoveNext

Else

输入数据表.Data1.Recordset.MoveFirst

EndIf

Nextii

'动态显示

kk2=kk2+1

E=E/2

ReDimPreservegx0（kk2）

gx0（kk2）=E

aE3=aE3/n01

E1=E1/n01

IfE

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.Pictu