form1.frm

基于bp算法的异或问题

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private WithEvents Spline As BP
Attribute Spline.VB_VarHelpID = -1
Private SplineP(54, 10) As Double
Private SplineT(54, 1) As Double

Private WithEvents SinBp As BP
Attribute SinBp.VB_VarHelpID = -1
Private SinP(54, 10) As Double
Private SinT(54, 1) As Double


Private Sub Command1_Click()
    Dim curSelFile As String
    
    CommonDlgOpenFile1.FileName = ""
    CommonDlgOpenFile1.Flags = 4096
    CommonDlgOpenFile1.Filter = "mdb|*.mdb"
    CommonDlgOpenFile1.DialogTitle = "打开数据库文件"
    CommonDlgOpenFile1.ShowOpen
    
    curSelFile = CommonDlgOpenFile1.FileName
    
    If IsNull(curSelFile) Or IsEmpty(curSelFile) Or curSelFile = "" Then
        Exit Sub
    End If
    'MsgBox curSelFile
    Text4.Text = curSelFile
    
    Set pConn = New ADODB.Connection
    
    '主连接
    theDataPath = curSelFile
    pConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & theDataPath & ";Persist Security Info=False"
    'MsgBox pConn.ConnectionString
    pConn.CursorLocation = adUseClient
    
    pConn.Open
    
    Dim rs As ADODB.Recordset
    Dim strSQL As String
    strSQL = "Select * From 2000年7月14日310罐185批训练2 where 编号 between 9 and 62"
    Set rs = New ADODB.Recordset
    rs.Open strSQL, pConn, adOpenForwardOnly
    i = 1
    While Not rs.EOF
        'MsgBox rs.Fields(0).Value
        For j = 1 To UBound(SplineP, 2)
            SplineP(i, j) = rs.Fields(j)
        Next
        SplineT(i, 1) = rs.Fields(11)
        i = i + 1
        rs.MoveNext
    Wend
    
    
    rs.MoveFirst
    i = 1
'    For i = 1 To 200            '原始数据
'        SplineP(1, i) = (i - 100) / 100 * 2
'        SplineT(1, i) = 3 * SplineP(1, i) ^ 4 - 7 * SplineP(1, i) ^ 2 - 0.5 * SplineP(1, i) + 6
'    Next
    
'    For i = 1 To 200
'        SinP(1, i) = (i - 100) / 100 * 7
'        SinT(1, i) = Sin(SinP(1, i))
'    Next
    While Not rs.EOF
        'MsgBox rs.Fields(0).Value
        For j = 1 To UBound(SinP, 2)
            SinP(i, j) = rs.Fields(j)
        Next
        SinT(i, 1) = rs.Fields(11)
        i = i + 1
        rs.MoveNext
    Wend
    
    rs.Close
    Set rs = Nothing
End Sub

Private Sub Command2_Click()
    Dim P(2, 4) As Double
    Dim T(1, 4) As Double
    Dim TT() As Double
    Dim Range(2, 2) As Double
    Dim s As New BP
    Range(1, 1) = 0: Range(1, 2) = 1
    Range(2, 1) = 0: Range(2, 2) = 1
    P(1, 1) = 0: P(2, 1) = 0
    P(1, 2) = 0: P(2, 2) = 1
    P(1, 3) = 1: P(2, 3) = 0
    P(1, 4) = 1: P(2, 4) = 1
    T(1, 1) = 0
    T(1, 2) = 1
    T(1, 3) = 1
    T(1, 4) = 0
    s.MinMax Range
    s.S1 = 2
    s.Lr = 0.3
    s.Gama = 0.3
    s.Goal = 0.00001
    s.MaxEpochs = 1000
    s.Train P, T
    TT = s.Sim(P)
    'MsgBox StringToMatrix(1, 4, TT, "0.00")

    s.DrawErrorCurve Picture2, vbRed
End Sub

Private Sub Exit_Click()
    MsgBox " 系统将退出"
    Unload Me
End Sub

Private Sub Form_Load()
    Form1.Hide
    frmSplash.Show
    Set Spline = New BP
    
    Set SinBp = New BP
'    For i = 1 To 200           '原始数据
'        SplineP(1, i) = (i - 100) / 100 * 2
'        SplineT(1, i) = 3 * SplineP(1, i) ^ 4 - 7 * SplineP(1, i) ^ 2 - 0.5 * SplineP(1, i) + 6
'    Next
'    Set SinBp = New BP
'    For i = 1 To 200
'        SinP(1, i) = (i - 100) / 100 * 7
'        SinT(1, i) = Sin(SinP(1, i))
'    Next
End Sub

Private Sub CmdSpline_Click()
    Dim s As New BP
    Dim TT() As Double, MinMax(10, 2) As Double
'    MinMax(1, 1) = -2: MinMax(1, 2) = 2     '输入的上下限
    MinMax(1, 1) = 30: MinMax(1, 2) = 250     '输入的上下限
    MinMax(2, 1) = 6: MinMax(2, 2) = 6.6      '输入的上下限
    MinMax(3, 1) = 130: MinMax(3, 2) = 175     '输入的上下限
    MinMax(4, 1) = 2: MinMax(4, 2) = 32     '输入的上下限
    MinMax(5, 1) = 7: MinMax(5, 2) = 18     '输入的上下限
    MinMax(6, 1) = 20: MinMax(6, 2) = 210    '输入的上下限
    MinMax(7, 1) = 6650: MinMax(7, 2) = 8000    '输入的上下限
    MinMax(8, 1) = 410: MinMax(8, 2) = 490     '输入的上下限
    MinMax(9, 1) = 24: MinMax(9, 2) = 30     '输入的上下限
    MinMax(10, 1) = 5600: MinMax(10, 2) = 59000     '输入的上下限
    Picture1.Scale (-2.5, 30)-(2.5, 0)
    'Spline.Lr = 0.02
    Spline.MinMax MinMax
    Spline.S1 = Slider5.Value * 2                   '隐含层神经元个数
    Spline.Lr = Slider1.Value * 0.1                 '学习速率
    Spline.Goal = Slider4.Value * 0.0001            '收敛精度
    Spline.Gama = Slider2.Value * 0.1               '动量系数
    Spline.MaxEpochs = Slider3.Value * 1000         '最大迭代次数
    Spline.Train SplineP, SplineT
    Spline.DrawErrorCurve Picture2, vbRed
End Sub


Private Sub CmdSin_Click()
    Dim TT() As Double, MinMax(10, 2) As Double
    Picture1.Scale (-10, 2)-(10, -2)
'    MinMax(1, 1) = -1
'    MinMax(1, 2) = 1
    MinMax(1, 1) = 30: MinMax(1, 2) = 250     '输入的上下限
    MinMax(2, 1) = 6: MinMax(2, 2) = 6.6      '输入的上下限
    MinMax(3, 1) = 130: MinMax(3, 2) = 175     '输入的上下限
    MinMax(4, 1) = 2: MinMax(4, 2) = 32     '输入的上下限
    MinMax(5, 1) = 7: MinMax(5, 2) = 18     '输入的上下限
    MinMax(6, 1) = 20: MinMax(6, 2) = 210    '输入的上下限
    MinMax(7, 1) = 6650: MinMax(7, 2) = 8000    '输入的上下限
    MinMax(8, 1) = 410: MinMax(8, 2) = 490     '输入的上下限
    MinMax(9, 1) = 24: MinMax(9, 2) = 30     '输入的上下限
    MinMax(10, 1) = 5600: MinMax(10, 2) = 59000     '输入的上下限
    SinBp.MinMax MinMax
    'SinBp.S1 = Slider5.Value * 2                    '隐含层神经元个数
    'SinBp.Lr = Slider1.Value * 0.1                  '学习速率
    'SinBp.Goal = Slider4.Value * 0.0001             '收敛精度
    'SinBp.Gama = Slider2.Value * 0.1                '动量系数
    'SinBp.MaxEpochs = Slider3.Value * 1000          '最大迭代次数
    SinBp.S1 = Val(Text3.Text)                  '隐含层神经元个数
    SinBp.Lr = Val(Text1.Text)                  '学习速率
    SinBp.Goal = Val(Text7.Text)                '收敛精度
    SinBp.Gama = Val(Text2.Text)                '动量系数
    SinBp.MaxEpochs = Val(Text6.Text)           '最大迭代次数
    SinBp.Train SinP, SinT
    SinBp.DrawErrorCurve Picture2, vbRed
End Sub


Private Sub SinBp_Update(iteration As Variant)
    Dim i As Integer, TT() As Double
    Picture1.Cls
    TT = SinBp.Sim(SinP)       '仿真
    For i = 1 To 54 - 1
        Picture1.Line ((i / 100 - 1) * 7, SinT(i, 1))-(((i + 1) / 100 - 1) * 7, SinT(i + 1, 1)), vbRed
    Next
    For i = 1 To 54 - 1
        Picture1.Line ((i / 100 - 1) * 7, TT(i, 1))-(((i + 1) / 100 - 1) * 7, TT(i + 1, 1)), vbBlue
    Next
    Picture1.Refresh
End Sub


'Private Sub Slider1_Click(Index As Integer)    '学习速率
'    mLr = Slider1.Index * 0.1
'End Sub
'
'Private Sub Slider2_Click(Index As Integer)     '动量系数
'    mGama = Slider2.Index * 0.1
'End Sub
'
'Private Sub Slider3_Click(Index As Integer)                    '最大迭代次数
'    mMaxEpochs = Slider3.Index * 1000
'End Sub
'
'Private Sub Slider4_Click(Index As Integer)                    '收敛精度
'    mGoal = Slider4.Index * 0.0001
'End Sub
'
'Private Sub Slider5_Click(Index As Integer)                    '隐含层神经元个数
'    mS1 = Slider5.Index * 2
'End Sub

Private Sub Spline_Update(iteration As Variant)
    Dim i As Integer, TT() As Double
    Picture1.Cls
    TT = Spline.Sim(SplineP)       '仿真
    For i = 1 To 199
        Picture1.Line ((i / 100 - 1) * 2, SplineT(1, i))-(((i + 1) / 100 - 1) * 2, SplineT(1, i + 1)), vbRed
    Next
    For i = 1 To 199
        Picture1.Line ((i / 100 - 1) * 2, TT(1, i))-(((i + 1) / 100 - 1) * 2, TT(1, i + 1)), vbBlue
    Next
    Picture1.Refresh
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set Spline = Nothing
    Set SinBp = Nothing
End Sub