Open CommonDialog1.FileName For Output As #1

Print #1, Text1                                    '保存文件

Close #1
End Sub



Private Sub 測(cè)試網(wǎng)絡(luò)_Click()
 ATN_BP.Hide
  ATN_BP.Show
  If J = 0 Then PSet (5000, 4000): Print "請(qǐng)先訓(xùn)練網(wǎng)絡(luò)！??！": GoTo L16
  DrawWidth = 1
  Do
       
       Z = InputBox("     請(qǐng)輸入測(cè)試用輸入量（各輸入量用空格隔開(kāi)）", "輸入測(cè)試數(shù)據(jù)", , 3000, 100)
  Loop While Z = ""
  
   Call Ybsr_Paint
   For J = 1 To Xws: Xyb(J, 1) = Ybz(J): Next J
  
  PSet (2000, 800 + 200 * 4): Print "測(cè)試輸入："
For I = 1 To Xws: PSet (2000 + 1000 * I, 800 + 200 * 4): Print "   "; Xyb(I, 1): Next I

    For J = 1 To Zws       '隱層單元個(gè)數(shù)Zws
      ZJBL = 0           '中間變量清零
      For I = 1 To Xws     '輸入層單元個(gè)數(shù)Xws
          ZJBL = ZJBL + Wxz(J, I) * Xyb(I, 1) 'ZJBL=∑Wji*Xi,Xyb(i, 1)＝輸入樣本， Wxz(j, i) ＝連接權(quán)
      Next I
       Ezd(J) = ZJBL + Qz(J) 'Uj
       
       Zsc(J) = Bta * Atn(Ezd(J)) 'β*ATN
        
        'uj=∑Wji*Xi- θj，Qh(j)＝θj閾值，隱層輸出Hsc(j)
    Next J
    

'計(jì)算輸出層輸出
   For J = 1 To Yws                           ' 輸出層單元個(gè)數(shù)Yws
     ZJBL = 0                              '中間變量清零
        For I = 1 To Zws                        '隱層單元個(gè)數(shù)Zws
          ZJBL = ZJBL + Wzy(J, I) * Zsc(I) 'ZJBL=∑Wji*Zi， Wxz(j, i) ＝連接權(quán)
        Next I
      Eyd(J) = ZJBL + Qy(J) 'Uj
     Ysc(J) = Bta * Atn(Eyd(J)) 'β*ATN
        
   Next J
    

   
  PSet (6500, 800 + 200 * 4): Print " 實(shí)際輸出＝"; Ysc(1)
  
  
L16: End Sub

Private Sub 打開(kāi)樣本_Click()

CommonDialog1.Filter = "文檔文件(*.txt)|*.TXT|所有文件(*.*)|*.*"  '設(shè)置打開(kāi)、保存對(duì)話框的文件類型提示
Text1 = ""
CommonDialog1.ShowOpen                                            '顯示打開(kāi)對(duì)話框
Open CommonDialog1.FileName For Input As #1                       '打開(kāi)文件
Do

Line Input #1, tttt                                               '讀取一行給tttt,tttt As String
If tttt <> "" Then Text1 = Text1 + tttt + Chr(13) + Chr(10)       'Chr(13) + Chr(10)  行尾標(biāo)志
                                                                  'Text1:Scrbar=3-both滾動(dòng)條　Muline=True多行文本
Loop While Not EOF(1)                                             'Not EOF沒(méi)有到文件結(jié)尾就循環(huán)
  


Close #1



End Sub

Private Sub 測(cè)試?yán)L圖_Click()
If C + W = 0 Then PSet (5000, 3000): Print "請(qǐng)先訓(xùn)練網(wǎng)絡(luò)?。?！": GoTo L10
DrawWidth = 2
If J <> 0 Then

     For L = 0 To Max - Mim + 0.003 Step 0.003 * (Max - Mim)

     For K = 0 To Max - Mim + 0.004 Step 0.004 * (Max - Mim)
     Ysc(1) = 0
     Xyb(1, 0) = L + Mim: If Xws > 1 Then Xyb(2, 0) = K + Mim
     
     
     For J = 1 To Zws       '隱層單元個(gè)數(shù)Zws
       ZJBL = 0             '中間變量清零
       For I = 1 To Xws     '輸入層單元個(gè)數(shù)Xws
          ZJBL = ZJBL + Wxz(J, I) * Xyb(I, 0) 'ZJBL=∑Wji*Xi,Xyb(i, k)＝輸入樣本， Wxz(j, i) ＝連接權(quán)
       Next I
       Zsc(J) = Bta * Atn(ZJBL + Qz(J)) 'β*ATN
        'uj=∑Wji*Xi- θj，Qh(j)＝θj閾值，隱層輸出Hsc(j)
     Next J
    

   '計(jì)算輸出層輸出
    For J = 1 To Yws                           ' 輸出層單元個(gè)數(shù)Yws
     ZJBL = 0                              '中間變量清零
        For I = 1 To Zws                        '隱層單元個(gè)數(shù)Zws
          ZJBL = ZJBL + Wzy(J, I) * Zsc(I) 'ZJBL=∑Wji*Zi， Wxz(j, i) ＝連接權(quán)
        Next I
     Ysc(J) = Bta * Atn(ZJBL + Qy(J)) 'β*ATN
   Next J
    
      If BSht = 1 Then
   A = 13
   If Ysc(1) > 0.5 Then A = 14
   If Ysc(1) < 0.5 Then A = 11
End If
If BSht = 0 Then
   If Ysc(1) < 0.1 Then A = 15
   If Ysc(1) < 0.2 And Ysc(1) > 0.1 Then A = 8
   If Ysc(1) < 0.3 And Ysc(1) > 0.2 Then A = 9
   If Ysc(1) < 0.4 And Ysc(1) > 0.3 Then A = 10
   If Ysc(1) < 0.5 And Ysc(1) > 0.4 Then A = 5
   If Ysc(1) < 0.6 And Ysc(1) > 0.5 Then A = 6
   If Ysc(1) < 0.7 And Ysc(1) > 0.6 Then A = 11
   If Ysc(1) < 0.8 And Ysc(1) > 0.7 Then A = 12
   If Ysc(1) < 0.9 And Ysc(1) > 0.8 Then A = 13
   If Ysc(1) > 0.9 Then A = 14
End If
   If Xws > 1 Then PSet (3500 + 4800 * L / (Max - Mim), 5330 - 4800 * K / (Max - Mim)), QBColor(A)
   If Xws = 1 Then PSet (3500 + 2000 * L / (Max - Mim), 5330 - 2000 * Ysc(1)), QBColor(13)



  Next K

  Next L

  If Xws > 1 Then
     For K = 1 To Kzs
     DrawWidth = 3
     PSet (3500 + 4800 * (Xyb(1, K) - Mim) / (Max - Mim), 5330 - 4800 * (Xyb(2, K) - Mim) / (Max - Mim)), QBColor(Tyb(1, K))
     Next K
   If BSht = 0 Then
   For K = 1 To 10
     DrawWidth = 9
      If K = 1 Then A = 15
      If K = 2 Then A = 8
      If K = 3 Then A = 9
      If K = 4 Then A = 10
      If K = 5 Then A = 5
      If K = 6 Then A = 6
      If K >= 7 Then A = K + 4
      PSet (11280, 300 * K), QBColor(A): Print K / 10
    Next K
    End If
 End If


   If Xws = 1 Then
     For K = 1 To Kzs
     DrawWidth = 3
      PSet (3500 + 2000 * (Xyb(1, K) - Mim) / (Max - Mim), 5330 - 2000 * Tyb(1, K)), QBColor(1)
    Next K
   End If
    

End If

BSht = 0
L10: End Sub
Private Sub BP_Paint()
Kzs = 0: W = 0: D = D + 1

FileName = FreeFile
CommonDialog1.FileName = App.Path + "\神經(jīng)網(wǎng)絡(luò)臨時(shí)文件.txt"
Open CommonDialog1.FileName For Output As #1

Print #1, Text1                                '保存文件
Close #1
'自動(dòng)求取樣本組數(shù)Ｋｚｓ：


Open CommonDialog1.FileName For Input As #1      '打開(kāi)文件
Do

Line Input #1, tttt                              '讀取一行給tttt,tttt As String
If tttt <> "" Then                               '空行不算
  W = W + 1
  If W = 1 Then Xws = CSng(tttt)
  If W = 2 Then Zws = CSng(tttt)
  If W = 3 Then Yws = CSng(tttt)
  If W = 4 Then Ncs = CSng(tttt)
  If W = 5 Then Jd = CSng(tttt)
  If W = 6 Then Bta = CSng(tttt) / 1.5708                 '輸出幅值
  
End If                                           'Text1:Scrbar=3-both滾動(dòng)條　Muline=True多行文本
Loop While Not EOF(1)
  
Kzs = W - 8

Close #1
'讀入數(shù)據(jù)：

   ReDim Zsc(Zws)       '隱層輸出
   ReDim Ysc(Yws)       '輸出層輸出
   ReDim Wxz(Zws, Xws), Wzy(Yws, Zws)
   ReDim Qz(Zws), Qy(Yws)
   ReDim Ey(Yws), Eyd(Yws), Ezd(Zws)
   ReDim Xyb(Xws, Kzs), Tyb(Yws, Kzs)
   ReDim Ybz(Xws + Yws + 1)
   ReDim Ei(Zws)


W = 0
Open CommonDialog1.FileName For Input As #1      '打開(kāi)文件

Do

  Line Input #1, tttt                              '讀取一行給tttt,tttt As String
  If tttt <> "" Then                               '空行不算
     W = W + 1
     If W = 7 Then
          Z = tttt: Call Ybsr_Paint
          Mim = Ybz(1): Max = Ybz(2)
     End If
     
     
     If W = 8 Then
          Z = tttt: Call Ybsr_Paint
          Kpo = Ybz(1) / 10: Ki = 0: Kdz = Ybz(3)
     End If
     
     If W > 8 Then
           Z = tttt: Call Ybsr_Paint
           For J = 1 To Xws: Xyb(J, W - 8) = Ybz(J): Next J
           For J = Xws + 1 To Yws + Xws: Tyb(J - Xws, W - 8) = Ybz(J): Next J
     End If
  End If
Loop While Not EOF(1)
  
Close #1
   
   

'設(shè)置初始權(quán)值、閾值。。隱層
    For J = 1 To Zws          '隱層單元個(gè)數(shù)Zws
        Qz(J) = Rnd()        '取閾值為隨機(jī)值
      For I = 1 To Xws        '輸入層單元個(gè)數(shù)Xws
         Wxz(J, I) = Rnd()     '取權(quán)值為隨機(jī)值
      Next I
    Next J
'設(shè)置初始權(quán)值、閾值。。輸出層
   For J = 1 To Yws          '隱層單元個(gè)數(shù)Zws
        Qy(J) = Rnd()          '取閾值為隨機(jī)值
      For I = 1 To Zws        '輸入層單元個(gè)數(shù)Xws
         Wzy(J, I) = Rnd()     '取權(quán)值為隨機(jī)值
      Next I
   Next J
W = 0
Do
 A = Ez: Ez = 0: W = W + 1
 Screen.MousePointer = 11
 '隨機(jī)選擇樣本，開(kāi)始訓(xùn)練
Kp = Kpo

 '算法改進(jìn)：變步長(zhǎng)

 If ZNPID = 3 Then Kp = Kpo * (1 - Exp(-W / 1000)) + Kpo / 10

'算法改進(jìn)：變步長(zhǎng)




  For K = 1 To Kzs
    Call xlwl
  Next K


'算法改進(jìn)：權(quán)值突變法
If ZNPID = 1 Then
  If Abs(A - Ez) < 0.1 Then
    Wxz(1, 1) = Wxz(1, 1) + 8000: If Wxz(1, 1) > -9 Then Wxz(1, 1) = -9
  End If
End If

'算法改進(jìn)：權(quán)值突變法


Call DYYN_Paint
Loop While W < Ncs And Ez > Jd
  Screen.MousePointer = 0
PSet (4000, 500 + D * 200), QBColor(15 - 1 * D): Print " ∑(t-y)^2＝"; Ez; " N="; W

End Sub

Private Sub 基礎(chǔ)BP_Click()
ZNPID = 0: Call BP_Paint
End Sub



Private Sub 另存為_(kāi)Click()
For K = 1 To Kzs
PSet (2000, 800 + 200 * K): Print " K＝"; K; "樣本："
For I = 1 To Xws: PSet (2500 + 1000 * I, 800 + 200 * K): Print "   "; Xyb(I, K): Next I
For A = 1 To Yws: PSet (4000 + 1000 * Xws + 1300 * A, 800 + 200 * K): Print Tyb(A, K): Next A
Next K
   
End Sub



Private Sub 刷新屏幕_Click()
ATN_BP.Hide
ATN_BP.Show

End Sub

Private Sub 退出_Click()
End
End Sub

Private Sub 新建樣本_Click()
Text1 = ""
End Sub
Public Sub xlwl()  '訓(xùn)練網(wǎng)絡(luò)子程序
'信號(hào)正向傳播 計(jì)算隱層輸出

    For J = 1 To Zws       '隱層單元個(gè)數(shù)Zws
      ZJBL = 0           '中間變量清零
      For I = 1 To Xws     '輸入層單元個(gè)數(shù)Xws
          ZJBL = ZJBL + Wxz(J, I) * Xyb(I, K) 'ZJBL=∑Wji*Xi,Xyb(i, k)＝輸入樣本， Wxz(j, i) ＝連接權(quán)
      Next I
       Ezd(J) = ZJBL + Qz(J) 'Uj
       
       Zsc(J) = Bta * Atn(Ezd(J)) 'β*ATN
        
        'uj=∑Wji*Xi- θj，Qh(j)＝θj閾值，隱層輸出Hsc(j)
    Next J
    

'計(jì)算輸出層輸出
   For J = 1 To Yws                           ' 輸出層單元個(gè)數(shù)Yws
     ZJBL = 0                              '中間變量清零
        For I = 1 To Zws                        '隱層單元個(gè)數(shù)Zws
          ZJBL = ZJBL + Wzy(J, I) * Zsc(I) 'ZJBL=∑Wji*Zi， Wxz(j, i) ＝連接權(quán)
        Next I
      Eyd(J) = ZJBL + Qy(J) 'Uj
     Ysc(J) = Bta * Atn(Eyd(J)) 'β*ATN(x)
        
   Next J
    
 '計(jì)算輸出層誤差及訓(xùn)練誤差
    For J = 1 To Yws
      Ey(J) = Tyb(J, K) - Ysc(J) 'e=(t-y)
      Ez = Ez + Ey(J) * Ey(J)  '2*E= (∑(t-y)^2)
      Eyd(J) = Ey(J) / (1 + Eyd(J) * Eyd(J)) 'δ= e×1/ (1 + x^2)
       Ei(J) = Ei(J) + Ey(J)
    
    Next J
    
    
 '計(jì)算隱層誤差及訓(xùn)練誤差
    For J = 1 To Zws       '隱層j
      ZJBL = 0
        For I = 1 To Yws     '所有輸出層
            ZJBL = ZJBL + Wzy(I, J) * Eyd(I)      'ZJBL=∑δi*Wij
        Next I
       Ezd(J) = ZJBL / (1 + Ezd(J) * Ezd(J)) 'δ= z*(1-z)∑δ*W，Zsc(j)隱層輸出
    Next J
    

   '修改隱層至輸出層權(quán)值
    
     For J = 1 To Zws
        For I = 1 To Yws
           Wzy(I, J) = Wzy(I, J) + (Kp + Ki * Ei(J)) * Eyd(I) * Zsc(J)
           '修改隱層至輸出層連接權(quán)值Wij＝Wij+ηδy*Z(j)
        Next I
     Next J
  
  '修改輸出層閥值θy
    For J = 1 To Yws
    
       Qy(J) = Qy(J) + (Kp + Ki * Ei(J)) * Eyd(J) '修改輸出層閥值θ＝θ+ηδ
    Next J

   '修改輸入層至隱層權(quán)值
      
     For J = 1 To Xws
        For I = 1 To Zws
           Wxz(I, J) = Wxz(I, J) + (Kp + Ki * 0) * Ezd(I) * Xyb(J, K)
          
        Next I
     Next J
  
  '修改隱層閥值θz
    For J = 1 To Zws
    
       Qz(J) = Qz(J) + (Kp + Ki * 0) * Ezd(J)
    Next J
 
     
End Sub
Private Sub DYYN_Paint()
DrawWidth = 2
G = Int(5330 - 2160 * Ez): U = Int(W * 10000 / Ncs + 600) 'G－y坐標(biāo)；U－x坐標(biāo)
If D = 7 Then D = 8
If D = 14 Then D = 0
PSet (U, G), QBColor(15 - 1 * D)
End Sub
Private Sub Ybsr_Paint()
For I = 1 To Xws + Yws: Ybz(I) = 0: Next I
  
  Y = Len(Z): C = 0: B = 0: A = 1
  
  For X = 1 To Y
      If Mid(Z, X, 1) = " " Then
         C = B: B = X
         If B - C > 1 Then Ybz(A) = CSng(Mid(Z, C + 1, B - C - 1)): A = A + 1
      End If
  Next X
  If Y - B > 0 Then Ybz(A) = CSng(Mid(Z, B + 1, Y - B))

End Sub

Private Sub PID_Click()
ZNPID = 1: Call BP_Paint
End Sub
Private Sub SISO系統(tǒng)_Click()
ATN_BP.Hide
單變量系統(tǒng).Show
End Sub

Private Sub 多變量系統(tǒng)_Click()
ATN_BP.Hide
Form0.Show
End Sub

Private Sub 返回主頁(yè)_Click()
ATN_BP.Hide
Form10.Show
End Sub
Private Sub 最優(yōu)控制_Click()
ATN_BP.Hide
最優(yōu)說(shuō)明.Show
End Sub
Private Sub 人工智能_Click()
ATN_BP.Hide
智能控制.Show
End Sub

Private Sub 數(shù)學(xué)2工具_(dá)Click()
ATN_BP.Hide
數(shù)學(xué)工具.Show
End Sub