form1.frm

非常不错的神经网络源程序

shuchu As Double
End Type
Dim hider(20) As bpnet
Dim output(20) As bpnet
Dim inputer(20) As bpnet
Dim simple(20) As yangben
Dim n1 As Integer, n2 As Integer, m As Integer, n As Integer, gen As Long
Dim thigmak(20) As Double, thigmaj(20) As Double, sch(20) As Double, chd As Double
Dim alfa As Double, belta As Double, e As Double, ep As Double

Private Sub Command1_Click()
Dim pos As Integer
Do
ep = 0
pos = 0
Do
For i = 0 To n1 - 1
inputer(i).shuchu = simple(pos).X(i)
Next i
sch(pos) = 0
For i = 0 To n2 - 1
chd = 0
For j = 0 To n1 - 1
chd = chd + inputer(j).shuchu * inputer(j).W(i)
Next j
hider(i).shuchu = hanshu(chd - hider(i).thita)
Next i
For i = 0 To m - 1
chd = 0
For j = 0 To n2 - 1
chd = chd + hider(j).shuchu * hider(j).W(i)
Next j
output(i).shuchu = hanshu(chd - output(i).thita)
Next i
For i = 0 To m - 1
thigmak(i) = (simple(pos).T(i) - output(i).shuchu) * output(i).shuchu * (1 - output(i).shuchu)
Next i
For j = 0 To n2 - 1
chd = 0
For k = 0 To m - 1
chd = chd + thigmak(k) * hider(j).W(k)
Next k
thigmaj(j) = hider(j).shuchu * (1 - hider(j).shuchu) * chd
Next j
For k = 0 To m - 1
output(k).thita = output(k).thita + belta * thigmak(k)
MSFlexGrid4.Row = 2
MSFlexGrid4.Col = k + 1
If output(k).thita >= 0 And output(k).thita < 1 Then
MSFlexGrid4.Text = 0 & Format(output(k).thita, "###.00000")
ElseIf output(k).thita >= -1 And output(k).thita < 0 Then
MSFlexGrid4.Text = "-" & 0 & Abs(Format(output(k).thita, "###.00000"))
Else
MSFlexGrid4.Text = Format(output(k).thita, "###.00000")
End If
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
Next k
For j = 0 To n2 - 1
For k = 0 To m - 1
hider(j).W(k) = hider(j).W(k) + alfa * thigmak(k) * hider(j).shuchu
Next k
Next j
For i = 0 To n2 - 1
hider(i).thita = hider(i).thita + alfa * thigmaj(i)
MSFlexGrid4.Row = 1
MSFlexGrid4.Col = i + 1
If hider(i).thita >= 0 And hider(i).thita < 1 Then
MSFlexGrid4.Text = 0 & Format(hider(i).thita, "###.00000")
ElseIf hider(i).thita >= -1 And hider(i).thita < 0 Then
MSFlexGrid4.Text = "-" & 0 & Abs(Format(hider(i).thita, "###.00000"))
Else
MSFlexGrid4.Text = Format(hider(i).thita, "###.00000")
End If
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
Next i
For i = 0 To n1 - 1
For j = 0 To n2 - 1
inputer(i).W(i) = inputer(i).W(i) + alfa * thigmaj(j) * inputer(i).shuchu
Next j
Next i
For i = 0 To m - 1
sch(pos) = sch(pos) + (simple(pos).T(i) - output(i).shuchu) * (simple(pos).T(i) - output(i).shuchu)
Next i
sch(pos) = sch(pos) / 2
pos = pos + 1
Loop While pos < n
For i = 0 To pos - 1
ep = ep + sch(i)
Next i
gen = gen + 1
MSFlexGrid5.Row = 1
MSFlexGrid5.Col = 1
MSFlexGrid5.Text = gen
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
MSFlexGrid5.Row = 1
MSFlexGrid5.Col = 2
MSFlexGrid5.Text = ep
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
Loop While ep >= e
For j = 0 To n2 - 1
For k = 0 To m - 1
MSFlexGrid3.Row = 1 + j
MSFlexGrid3.Col = 1 + k
If hider(j).W(k) >= 0 And hider(j).W(k) < 1 Then
MSFlexGrid3.Text = 0 & Format(hider(j).W(k), "###.00000")
ElseIf hider(j).W(k) >= -1 And hider(j).W(k) < 0 Then
MSFlexGrid3.Text = "-" & 0 & Abs(Format(hider(j).W(k), "###.00000"))
Else
MSFlexGrid3.Text = Format(hider(j).W(k), "###.00000")
End If
MSFlexGrid3.CellAlignment = 4
MSFlexGrid3.CellFontBold = True
Next k
Next j
For i = 0 To n1 - 1
For j = 0 To n2 - 1
MSFlexGrid2.Row = 1 + i
MSFlexGrid2.Col = 1 + j
If inputer(i).W(j) >= 0 And inputer(i).W(j) < 1 Then
MSFlexGrid2.Text = 0 & Format(inputer(i).W(j), "###.00000")
ElseIf inputer(i).W(j) >= -1 And inputer(i).W(j) < 0 Then
MSFlexGrid2.Text = "-" & 0 & Abs(Format(inputer(i).W(j), "###.00000"))
Else
MSFlexGrid2.Text = Format(inputer(i).W(j), "###.00000")
End If
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
Next j
Next i
End Sub

Private Sub Command2_Click()
Text1.Text = renyi(8, 10)
Text2.Text = renyi(6, 10)
Text3.Text = renyi(2, 4)
e = 10 ^ (-renyi(3, 5))
Text4.Text = 0 & e
n = 1
gen = 0
chd = 0
alfa = 0.2
belta = 0.3
n1 = Val(Text1.Text)
n2 = Val(Text2.Text)
m = Val(Text3.Text)
MSFlexGrid1.Cols = n1 + m + 1
MSFlexGrid1.Rows = n + 1
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = "样本"
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
For i = 0 To n1 - 1
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = i + 1
MSFlexGrid1.Text = "x" & (i + 1)
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
Next i
For i = 0 To m - 1
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = n1 + 1 + i
MSFlexGrid1.Text = "T" & (i + 1)
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
Next i
For i = 0 To n - 1
MSFlexGrid1.Row = 1 + i
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = i + 1
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
Next i
For k = 0 To n - 1
For i = 0 To n1 - 1
simple(k).X(i) = suiji()
MSFlexGrid1.Row = 1 + k
MSFlexGrid1.Col = i + 1
MSFlexGrid1.Text = 0 & Format(simple(k).X(i), "###.00000")
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
Next i
For j = 0 To m - 1
simple(k).T(j) = suiji()
MSFlexGrid1.Row = 1 + k
MSFlexGrid1.Col = j + 1 + n1
MSFlexGrid1.Text = 0 & Format(simple(k).T(j), "###.00000")
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.CellFontBold = True
Next j
Next k
MSFlexGrid2.Cols = n2 + 1
MSFlexGrid2.Rows = n1 + 1
MSFlexGrid2.Row = 0
MSFlexGrid2.Col = 0
MSFlexGrid2.Text = "W(i,j)"
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
For i = 0 To n1 - 1
MSFlexGrid2.Row = 1 + i
MSFlexGrid2.Col = 0
MSFlexGrid2.Text = 1 + i
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
Next i
For i = 0 To n2 - 1
MSFlexGrid2.Row = 0
MSFlexGrid2.Col = 1 + i
MSFlexGrid2.Text = 1 + i
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
Next i
For i = 0 To n1 - 1
For j = 0 To n2 - 1
inputer(i).W(j) = suiji()
MSFlexGrid2.Row = 1 + i
MSFlexGrid2.Col = 1 + j
MSFlexGrid2.Text = 0 & Format(inputer(i).W(j), "###.00000")
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
Next j
Next i
MSFlexGrid3.Cols = m + 1
MSFlexGrid3.Rows = n2 + 1
MSFlexGrid3.Row = 0
MSFlexGrid3.Col = 0
MSFlexGrid3.Text = "W(j,k)"
MSFlexGrid3.CellAlignment = 4
MSFlexGrid3.CellFontBold = True
For i = 0 To n2 - 1
MSFlexGrid3.Row = 1 + i
MSFlexGrid3.Col = 0
MSFlexGrid3.Text = 1 + i
MSFlexGrid3.CellAlignment = 4
MSFlexGrid3.CellFontBold = True
Next i
For i = 0 To m - 1
MSFlexGrid3.Row = 0
MSFlexGrid3.Col = 1 + i
MSFlexGrid3.Text = 1 + i
MSFlexGrid3.CellAlignment = 4
MSFlexGrid3.CellFontBold = True
Next i
If n2 > m Then
MSFlexGrid4.Cols = n2 + 1
Else
MSFlexGrid4.Cols = m + 1
End If
MSFlexGrid4.Rows = 3
MSFlexGrid4.Row = 0
MSFlexGrid4.Col = 0
MSFlexGrid4.Text = "闽值"
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
MSFlexGrid4.Row = 1
MSFlexGrid4.Col = 0
MSFlexGrid4.Text = "隐层"
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
MSFlexGrid4.Row = 2
MSFlexGrid4.Col = 0
MSFlexGrid4.Text = "输出层"
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
If n2 > m Then
For i = 0 To n2 - 1
MSFlexGrid4.Row = 0
MSFlexGrid4.Col = 1 + i
MSFlexGrid4.Text = 1 + i
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
Next i
Else
For i = 0 To m - 1
MSFlexGrid4.Row = 0
MSFlexGrid4.Col = 1 + i
MSFlexGrid4.Text = 1 + i
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
Next i
End If
For i = 0 To n2 - 1
hider(i).thita = suiji()
MSFlexGrid4.Row = 1
MSFlexGrid4.Col = i + 1
MSFlexGrid4.Text = 0 & Format(hider(i).thita, "###.00000")
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
For j = 0 To m - 1
hider(i).W(j) = suiji()
MSFlexGrid3.Row = 1 + i
MSFlexGrid3.Col = 1 + j
MSFlexGrid3.ColWidth(1 + j) = 2000
MSFlexGrid3.Text = 0 & Format(hider(i).W(j), "###.0000000")
MSFlexGrid3.CellAlignment = 4
MSFlexGrid3.CellFontBold = True
Next j
Next i
For i = 0 To m - 1
output(i).thita = suiji()
MSFlexGrid4.Row = 2
MSFlexGrid4.Col = i + 1
MSFlexGrid4.Text = 0 & Format(output(i).thita, "###.00000")
MSFlexGrid4.CellAlignment = 4
MSFlexGrid4.CellFontBold = True
Next i
MSFlexGrid5.Rows = 2
MSFlexGrid5.Cols = 3
MSFlexGrid5.Row = 0
MSFlexGrid5.Col = 0
MSFlexGrid5.Text = "Error"
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
MSFlexGrid5.Row = 0
MSFlexGrid5.Col = 1
MSFlexGrid5.ColWidth(1) = 3400
MSFlexGrid5.Text = "训练次数"
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
MSFlexGrid5.Row = 0
MSFlexGrid5.Col = 2
MSFlexGrid5.ColWidth(2) = 3350
MSFlexGrid5.Text = "网络误差"
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
MSFlexGrid5.Row = 1
MSFlexGrid5.Col = 0
MSFlexGrid5.Text = "训练结果"
MSFlexGrid5.CellAlignment = 4
MSFlexGrid5.CellFontBold = True
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Command4_Click()
MSFlexGrid1.Clear
MSFlexGrid2.Clear
MSFlexGrid3.Clear
MSFlexGrid4.Clear
MSFlexGrid5.Clear
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub

Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Me.WindowState = vbMaximized
Picture2.Picture = LoadPicture(App.Path + "\zwf.gif")
End Sub
Private Function hanshu(X As Double)
Dim funct As Double
funct = 1 / (1 + Exp(-X))
hanshu = funct
End Function
Private Function renyi(a As Integer, b As Integer)
Dim s As Integer
Randomize
s = Int((b - a + 1) * Rnd + a)
renyi = s
End Function
Private Function suiji()
Dim s As Double
Randomize
s = Rnd
suiji = s
End Function
Private Sub Picture2_DragDrop(Source As Control, X As Single, Y As Single)
If Picture2.Height > Picture1.Height Then
Ac = VScroll1.Value
If Ac <= 0 Then
Ac = 0
End If
If Ac >= VScroll1.Max Then
Ac = VScroll1.Max
End If
VScroll1.Value = Ac
End If
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
Picture2.SetFocus
End Sub