module1.bas

是关于MATALB 神经网络与VB的混合编程,希望对大家有所帮助

Attribute VB_Name = "Module1"
Public Sample_num As Integer '样本数
Public TSample_num As Integer '检验样本数
Public StopFlag As Boolean
Public p As Single     '步长
Public L As Single     '动量因子
Public Err_Up As Double '误差上限
Public Prac_Num As Long '检验次数
Public Flag As Integer
Public Fun As Integer   '用于选择函数
Public FunLabel As String  '函数标签
Public LayerNum As Integer '定义层数
Public LayerNodes() As Integer '定义每层的节点数
Public Type Layer     '定义层
    Num As Integer
    cNerve() As CNerveCell
    NodeErr() As Double
End Type
Public Type W         '定义每层的权值
    Value() As Double
    Err() As Double      '权值误差
    PreValue() As Double   '上次的权值（用于动量因子）
    PreErr() As Double     '上次的权值误差（用于动量因子）
End Type
Public Layers() As Layer '定义层
Public WValue() As W     '定义权值
Public dbI() As Double      '输入值
Public dbO() As Double      '输出值
Public dbTI() As Double     '检验输入值
Public dbTO() As Double     '检验输出值
Public dbRealO() As Double  '归一化后的输出值
Public dbI_1() As Double    '归一后的输入值
Public dbO_1() As Double    '归一后的输出值
Public dbTI_1() As Double   '归一后的检验输入值
Public dbTO_1() As Double   '归一后的检验输出值
Public OutMax() As Double   '各输出最大值
Public OutMin() As Double   '各输出最小值
Public InMax() As Double    '各输入最大值
Public InMin() As Double    '各输入最小值
'Public TOutMax() As Double   '各检验样本输出最大值
'Public TOutMin() As Double   '各检验样本输出最小值
'Public TInMax() As Double    '各检验样本输入最大值
'Public TInMin() As Double    '各检验样本输入最小值
Public E() As Double        '各输出值误差
Public TE() As Double       '各检验样本输出值误差
Public SaveFlag As Boolean  ' 保存标志
Public TSaveFlag As Boolean  '检验样本的保存标志
Public TrainFlag As Boolean  '训练完标志
Public FunctionNum As Integer  '神经元传递函数的位置
Public TFunctionNum() As Integer '选择哪个训练函数

Public Sub Init()

    Dim i As Integer, j As Integer, k As Integer
    ReDim Layers(LayerNum)
    If LayerNum > 0 Then
        ReDim WValue(LayerNum - 1)
        ReDim E(LayerNodes(LayerNum))
        ReDim TE(LayerNodes(LayerNum))
    End If
    For i = 1 To LayerNum
        Layers(i).Num = LayerNodes(i)
        If i > 1 Then
            ReDim WValue(i - 1).Value(LayerNodes(i - 1), LayerNodes(i))
            ReDim WValue(i - 1).Err(LayerNodes(i - 1), LayerNodes(i))
            ReDim WValue(i - 1).PreValue(LayerNodes(i - 1), LayerNodes(i))
            ReDim WValue(i - 1).PreErr(LayerNodes(i - 1), LayerNodes(i))
        End If
        ReDim Layers(i).cNerve(LayerNodes(i))
        ReDim Layers(i).NodeErr(LayerNodes(i))
    Next i
    For i = 1 To LayerNum
        For j = 1 To LayerNodes(i)
            Set Layers(i).cNerve(j) = New CNerveCell
        Next j
    Next i
    Form1.Sample.Clear
    For i = 1 To Sample_num
        For j = 1 To LayerNodes(1)
            Form1.Sample.AddItem "dbI(" & LTrim(Str(j)) & "," & LTrim(i) & ")=" & LTrim(Str(dbI(j, i)))
        Next j
        For j = 1 To LayerNodes(LayerNum)
            Form1.Sample.AddItem "dbO(" & LTrim(Str(j)) & "," & LTrim(i) & ")=" & LTrim(Str(dbO(j, i)))
        Next j
    Next i
    Form1.LW.Clear
    For i = 1 To LayerNum - 1
        For j = 1 To LayerNodes(i)
            For k = 1 To LayerNodes(i + 1)
                WValue(i).Value(j, k) = Rnd()
                Form1.LW.AddItem "W(" & LTrim(Str(i)) & "," & LTrim(Str(j)) & "," & LTrim(Str(k)) & ")=" & Str(WValue(i).Value(j, k))
                WValue(i).PreValue(j, k) = WValue(i).Value(j, k)
            Next k
        Next j
    Next i
    Form1.Frame1.Caption = "初始权值"
    Form1.Frame2.Caption = LTrim(Str(Sample_num)) & "组样本如下"
    
End Sub
Public Sub Get_OutPut(SampleCount As Integer)

    Dim i As Integer, j As Integer, k As Integer
    For i = 1 To LayerNodes(1)
        Layers(1).cNerve(i).u = dbI_1(i, SampleCount)
        Layers(1).cNerve(i).v = Layers(1).cNerve(i).u
    Next i
    For i = 2 To LayerNum
        For j = 1 To LayerNodes(i)
            Layers(i).cNerve(j).u = 0
            For k = 1 To LayerNodes(i - 1)
                Layers(i).cNerve(j).u = Layers(i).cNerve(j).u _
                    + Layers(i - 1).cNerve(k).v _
                    * WValue(i - 1).Value(k, j)
            Next k
            Layers(i).cNerve(j).v = Layers(i).cNerve(j).f
        Next j
    Next i
    
End Sub
Public Sub Get_OutPutT(SampleCount As Integer)

    Dim i As Integer, j As Integer, k As Integer
    For i = 1 To LayerNodes(1)
        Layers(1).cNerve(i).u = dbTI_1(i, SampleCount)
        Layers(1).cNerve(i).v = Layers(1).cNerve(i).u
    Next i
    For i = 2 To LayerNum
        For j = 1 To LayerNodes(i)
            Layers(i).cNerve(j).u = 0
            For k = 1 To LayerNodes(i - 1)
                Layers(i).cNerve(j).u = Layers(i).cNerve(j).u _
                    + Layers(i - 1).cNerve(k).v _
                    * WValue(i - 1).Value(k, j)
            Next k
            Layers(i).cNerve(j).v = Layers(i).cNerve(j).f
        Next j
    Next i
    
End Sub

Public Sub Back(SampleCount As Integer)

    Dim i As Integer, j As Integer, k As Integer
    For i = 1 To LayerNodes(LayerNum)
        Layers(LayerNum).NodeErr(i) = (Layers(LayerNum).cNerve(i).v _
            - dbO_1(i, SampleCount)) * Layers(LayerNum).cNerve(i).DaoShu
    Next i
    For i = LayerNum - 1 To 2 Step -1
        For j = 1 To LayerNodes(i)
            Layers(i).NodeErr(j) = 0
            For k = 1 To LayerNodes(i + 1)
                Layers(i).NodeErr(j) = Layers(i).NodeErr(j) _
                    + Layers(i + 1).NodeErr(k) * WValue(i).Value(j, k) _
                    * Layers(i).cNerve(j).v * (1 - Layers(i).cNerve(j).v)
            Next k
        Next j
    Next i
    For i = 1 To LayerNum - 1
        For j = 1 To LayerNodes(i)
            For k = 1 To LayerNodes(i + 1)
                If Flag = 2 Then
                    WValue(i).Err(j, k) = Layers(i + 1).NodeErr(k) _
                        * Layers(i).cNerve(j).v + WValue(i).Err(j, k)
                ElseIf Flag = 1 Then
                    WValue(i).Err(j, k) = Layers(i + 1).NodeErr(k) _
                        * Layers(i).cNerve(j).v
                End If
            Next k
        Next j
    Next i
    
End Sub

Public Sub GetNewW()

    Dim i As Integer, j As Integer, k As Integer
    For i = 1 To LayerNum - 1
        For j = 1 To LayerNodes(i)
            For k = 1 To LayerNodes(i + 1)
                WValue(i).Value(j, k) = WValue(i).Value(j, k) _
                    - p * WValue(i).Err(j, k) + L * WValue(i).PreErr(j, k)
                WValue(i).PreErr(j, k) = WValue(i).Value(j, k) - WValue(i).PreValue(j, k)
                WValue(i).PreValue(j, k) = WValue(i).Value(j, k)
                WValue(i).Err(j, k) = 0
            Next k
        Next j
    Next i
    For i = 1 To LayerNodes(LayerNum)
        E(i) = 0
        TE(i) = 0
    Next i
    
End Sub

Public Sub Get_E(SampleNum As Integer)
    
    Dim i As Integer
    For i = 1 To LayerNodes(LayerNum)
        E(i) = E(i) + 0.5 * (Layers(LayerNum).cNerve(i).v - dbO_1(i, SampleNum)) ^ 2
    Next i
    
End Sub
Public Sub Get_TE(SampleNum As Integer)
    
    Dim i As Integer
    For i = 1 To LayerNodes(LayerNum)
        TE(i) = TE(i) + 0.5 * (Layers(LayerNum).cNerve(i).v - dbTO_1(i, SampleNum)) ^ 2
    Next i
    
End Sub

Public Sub InitGuiYi()
    
    Dim i As Integer, j As Integer
    ReDim dbRealO(LayerNodes(LayerNum))
    ReDim OutMax(LayerNodes(LayerNum))
    ReDim OutMin(LayerNodes(LayerNum))
'    ReDim TOutMax(LayerNodes(LayerNum))
'    ReDim TOutMin(LayerNodes(LayerNum))
    ReDim dbI_1(LayerNodes(1), Sample_num)
    ReDim dbO_1(LayerNodes(LayerNum), Sample_num)
    ReDim dbTI_1(LayerNodes(1), Sample_num)
    ReDim dbTO_1(LayerNodes(LayerNum), Sample_num)
    ReDim InMax(LayerNodes(1))
    ReDim InMin(LayerNodes(1))
'    ReDim TInMax(LayerNodes(1))
'    ReDim TInMin(LayerNodes(1))
    For i = 1 To LayerNodes(1)
        InMin(i) = dbI(i, 1)
        For j = 1 To Sample_num
            If dbI(i, j) > InMax(i) Then
                InMax(i) = dbI(i, j)
            End If
            If dbI(i, j) < InMin(i) Then
                InMin(i) = dbI(i, j)
            End If
        Next j
'        For j = 1 To TSample_num
'            If dbTI(i, j) > TInMax(i) Then
'                TInMax(i) = dbTI(i, j)
'            ElseIf dbTI(i, j) < TInMin(i) Then
'                TInMin(i) = dbTI(i, j)
'            End If
'        Next j
    Next i
    For i = 1 To LayerNodes(LayerNum)
        OutMin(i) = dbO(i, 1)
        For j = 1 To Sample_num
            If dbO(i, j) > OutMax(i) Then
                OutMax(i) = dbO(i, j)
            End If
            If dbO(i, j) < OutMin(i) Then
                OutMin(i) = dbO(i, j)
            End If
        Next j
'        For j = 1 To TSample_num
'            If dbTO(i, j) > TOutMax(i) Then
'                TOutMax(i) = dbTO(i, j)
'            ElseIf dbTO(i, j) < TOutMin(i) Then
'                TOutMin(i) = dbTO(i, j)
'            End If
'        Next j
    Next i
    For i = 1 To LayerNodes(1)
        For j = 1 To Sample_num
            dbI_1(i, j) = (dbI(i, j) - InMin(i)) / (InMax(i) - InMin(i))
        Next j
        For j = 1 To TSample_num
            dbTI_1(i, j) = (dbTI(i, j) - InMin(i)) / (InMax(i) - InMin(i))
        Next j
    Next i
    For i = 1 To LayerNodes(LayerNum)
        For j = 1 To Sample_num
            dbO_1(i, j) = (dbO(i, j) - OutMin(i)) / (OutMax(i) - OutMin(i))
        Next j
        For j = 1 To TSample_num
            dbTO_1(i, j) = (dbTO(i, j) - OutMin(i)) / (OutMax(i) - OutMin(i))
        Next j
    Next i
    
End Sub

Public Function ReverseGuiYi(Value As Double, Num As Integer)

      dbRealO(Num) = Value * (OutMax(Num) - OutMin(Num)) + OutMin(Num)
      ReverseGuiYi = dbRealO(Num)
      
End Function