Attribute VB_Name = "Module1"
Public inLayer_R As Long '輸入層神經(jīng)元數(shù)目
Public outLayer_S As Long '輸出層神經(jīng)元數(shù)目
Public midLayerNum As Long '隱層的層數(shù)
Public midLayer_S() As Long   '各隱含層的神經(jīng)元數(shù)目

Public alpha As Double     '學習因子
Public gamma As Double   '動量矩
Public maxErr As Double   '允許的最大全局誤差
Public maxStudyNum As Long   '最大學習次數(shù)
Public StudyNum As Long   '當前學習次數(shù)

Public P() As Double  '樣本輸入數(shù)據(jù)
Public T() As Double '樣本教師數(shù)據(jù)
Public W() As Double '輸入層、隱層、輸出層權(quán)值
Public A() As Double '隱層、輸出層的輸入
Public n() As Double '各層的輸出中間值
Public B() As Double '各層的閾值
Public dB() As Double '各層的閾值變化量
Public E() As Double '每次迭代的誤差值
Public dW() As Double '各層各單元權(quán)值的變化量

Public sampleNum As Long '學習的樣本個數(shù)
Public stopstudy As Boolean
Public Const InLayer_RMax As Long = 20 '輸入層神經(jīng)元數(shù)目最大值
Public Const outLayer_SMax As Long = 20  '輸出層神經(jīng)元數(shù)目最大值
Public Const midLayerNumMax As Long = 9 '隱層的層數(shù)最大值
Public Const midLayer_SMax As Long = 20 '各隱層的神經(jīng)元數(shù)目最大值
Public inputDataTag As Boolean  '數(shù)據(jù)是倒入的
'Public checktag As Boolean '檢測狀態(tài)

Public Sub Read_Sample() '讀入例子
Dim i, j, k, m, n As Long
Dim tempstr() As Long
sampleNum = 0
For k = 1 To Len(mainFrm.Text1.Text) Step 1
    tempchar = Mid(mainFrm.Text1.Text, k, 1)
    If tempchar = Chr(13) Then
        sampleNum = sampleNum + 1
    End If
Next k

ReDim P(1 To sampleNum, 1 To inLayer_R) As Double
ReDim T(1 To sampleNum, 1 To outLayer_S) As Double
ReDim tempstr(1 To sampleNum, 1 To inLayer_R + outLayer_S)
j = 1
k = 1
For i = 1 To Len(mainFrm.Text1.Text) Step 1
      If Mid(mainFrm.Text1.Text, i, 1) = Chr(13) Then
         j = j + 1
         k = 1
      End If
      If Mid(mainFrm.Text1.Text, i, 1) <> "," And Mid(mainFrm.Text1.Text, i, 1) <> Chr(13) And Mid(mainFrm.Text1.Text, i, 1) <> Chr(10) Then
          tempstr(j, k) = Mid(mainFrm.Text1.Text, i, 1)
          k = k + 1
      End If
Next i
For j = 1 To sampleNum Step 1
    For m = 1 To inLayer_R Step 1
        P(j, m) = tempstr(j, m)
    Next m
    For n = 1 To outLayer_S Step 1
        T(j, n) = tempstr(j, n + inLayer_R)
    Next n
Next j
End Sub
Public Sub Read_Data() '讀入例子
Dim i, j, k, m, n As Long
Dim tempstr() As Long
sampleNum = 1
'For k = 1 To Len(mainFrm.Text1.Text) Step 1
'    tempchar = Mid(mainFrm.Text1.Text, k, 1)
'    If tempchar = Chr(13) Then
'        sampleNum = sampleNum + 1
'    End If
'Next k

ReDim P(1 To sampleNum, 1 To inLayer_R) As Double
'ReDim T(1 To sampleNum, 1 To outLayer_S) As Double
'ReDim tempstr(1 To sampleNum, 1 To inLayer_R)
j = 1
k = 1
For i = 1 To Len(mainFrm.Text1.Text) Step 1
      If Mid(mainFrm.Text1.Text, i, 1) = Chr(13) Then
         j = j + 1
         k = 1
      End If
      If Mid(mainFrm.Text1.Text, i, 1) <> "," And Mid(mainFrm.Text1.Text, i, 1) <> Chr(13) And Mid(mainFrm.Text1.Text, i, 1) <> Chr(10) Then
          P(j, k) = Mid(mainFrm.Text1.Text, i, 1)
          k = k + 1
      End If
Next i
End Sub
Public Sub setupNetwork() '建構(gòu)網(wǎng)絡模型


   '///////////隱層、輸出層權(quán)值、閾值的初始化//////////
   Dim i As Long
   Dim j As Long
   Dim k As Long
    ReDim dW(1 To midLayerNum + 1, 0 To midLayer_SMax, 0 To midLayer_SMax) As Double
    ReDim W(1 To midLayerNum + 1, 0 To midLayer_SMax, 0 To midLayer_SMax) As Double
          '隱層、輸出層權(quán)值, 每一層的第一個數(shù)據(jù)存該層的神經(jīng)元數(shù)目
    ReDim A(0 To midLayerNumMax + 1, 1 To midLayer_SMax) As Double '隱層、輸出層的輸入
    ReDim n(1 To midLayerNumMax + 1, 1 To midLayer_SMax) As Double '各層的輸出中間值
    ReDim B(1 To midLayerNumMax + 1, 1 To midLayer_SMax) As Double '各層的閾值
    ReDim dB(1 To midLayerNumMax + 1, 1 To midLayer_SMax) As Double '各層的閾值
  
   For i = 1 To midLayerNum + 1
       If i = midLayerNum + 1 Then
          W(i, 0, 0) = outLayer_S    '記錄輸出層有多少神經(jīng)元
       Else
            W(i, 0, 0) = midLayer_S(i) '記錄第i層有多少神經(jīng)元
       End If
            For j = 1 To W(i, 0, 0)
               If i = 1 Then
                   W(i, j, 0) = inLayer_R '記錄第一個個神經(jīng)元的權(quán)值的維數(shù)
               Else
                   
                   W(i, j, 0) = midLayer_S(i - 1) '記錄每個神經(jīng)元的權(quán)值的維數(shù)
                      
               End If
            Next j
       
       
       
   Next i
   End Sub
  Public Sub initwb() '初始化權(quán)值、閾值


   '///////////隱層、輸出層權(quán)值、閾值的初始化//////////
   Dim i As Long
   Dim j As Long
   Dim k As Long

   
    '///////////隱層、輸出層權(quán)值、閾值的初始化//////////
    For i = 1 To midLayerNum + 1
        For j = 1 To W(i, 0, 0)
            Randomize
            B(i, j) = Rnd()
        For k = 1 To W(i, j, 0)
            Randomize
            W(i, j, k) = Rnd()
        Next k
        Next j
   
    Next i
  
  End Sub