📄 xunlian.frm
字号:
VERSION 5.00
Begin VB.Form xunlian
Caption = "训练"
ClientHeight = 5145
ClientLeft = 60
ClientTop = 450
ClientWidth = 5340
LinkTopic = "Form1"
ScaleHeight = 5145
ScaleWidth = 5340
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtk
Height = 270
Left = 360
TabIndex = 15
Top = 480
Width = 375
End
Begin VB.Frame shuxin
Caption = "约简后的属性集"
Height = 3975
Left = 0
TabIndex = 5
Top = 960
Width = 2175
Begin VB.Frame Frame3
Caption = "C4"
Height = 615
Left = 120
TabIndex = 9
Top = 3120
Width = 2055
Begin VB.ComboBox cmbC4
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 12
Top = 240
Width = 1815
End
End
Begin VB.Frame Frame2
Caption = "C3"
Height = 615
Left = 120
TabIndex = 8
Top = 2160
Width = 2055
Begin VB.ComboBox cmbC3
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 11
Top = 240
Width = 1815
End
End
Begin VB.Frame Frame1
Caption = "C2"
Height = 615
Left = 120
TabIndex = 7
Top = 1200
Width = 2055
Begin VB.ComboBox cmbC2
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 10
Top = 240
Width = 1815
End
End
Begin VB.Frame C1
Caption = "C1"
Height = 735
Left = 120
TabIndex = 6
Top = 360
Width = 2055
Begin VB.ComboBox cmbC1
Height = 300
Left = 120
Style = 2 'Dropdown List
TabIndex = 13
Top = 240
Width = 1815
End
End
End
Begin VB.TextBox txtres
Height = 2775
Left = 2160
TabIndex = 3
Top = 2160
Width = 3015
End
Begin VB.CommandButton end
Caption = "退出"
Height = 375
Left = 4080
TabIndex = 2
Top = 1440
Width = 1095
End
Begin VB.CommandButton begin
Caption = "开始训练"
Height = 375
Left = 4080
TabIndex = 1
Top = 360
Width = 1095
End
Begin VB.CommandButton input
Caption = "输入"
Height = 375
Left = 2640
TabIndex = 0
Top = 360
Width = 1095
End
Begin VB.Label Label3
Caption = "次训练"
Height = 255
Left = 840
TabIndex = 16
Top = 480
Width = 855
End
Begin VB.Label Label2
Caption = "第"
Height = 255
Left = 120
TabIndex = 14
Top = 480
Width = 255
End
Begin VB.Label Label1
Caption = "输出为:"
Height = 255
Left = 2280
TabIndex = 4
Top = 1800
Width = 735
End
End
Attribute VB_Name = "xunlian"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim C(4) As Double, i, j As Integer
C(1) = cmbC1.Text: C(2) = cmbC2.Text: C(3) = cmbC3.Text: C(4) = cmbC4.Text
For i = 1 To 4
Dim strinput As String
strinput = C(i)
Select Case strinput
Case "瓦斯压力"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Case "巷道类型"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Case "倾角度数"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Case "放散速度"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Case "作业方式"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Case "煤的强度"
For j = 1 To 6
Dim m, n As Integer
m = 12
n = 60
w1(i, j) = m / n
Next j
For i = 1 To 6
For j = 1 To 4
w2(i, j) = 0.25
Next j
Next i
Private Sub begin_Click()
Dim X(1 To 4), Y(1 To 4), Y0(1 To 4) As Double
Dim w1(1 To 4, 1 To 6), w2(1 To 6, 1 To 4), w1(1 To 4, 1 To 6), w2(1 To 6, 1 To 4) As Double
Dim k, i, j As Integer
Dim s As Double
For k = 1 To 100
txtk.Text = k
X(1) = txtX1.Text: X(2) = txtX2.Text: X(3) = txtX3.Text: X(4) = txtX4.Text
Y0(1) = txtY01.Text: Y0(2) = txtY02.Text: Y0(3) = txtY03.Text: Y0(4) = txtY04.Text
f(X) = X
For i = 1 To 4
O1(i) = f(X(i))
Next i
For j = 1 To 6
s = 0
For i = 1 To 4
s = s - w1(i, j) * O1(i)
Next i
O2(j) = 1 / (1 + s)
Next j
For j = 1 To 4
s = 0
For i = 1 To 6
s = s - w2(i, j) * O2(i)
Next i
O3(j) = 1 / (1 + s)
Next j
For i = 1 To 4
Y(i) = O3(i)
E3(i) = Y(i) - Y0(i)
Next i
Dim e, u As Double
e = 0.01
u = 0.1
For i = 1 To 4
Dim max As Double
max = 0
If (max < E3(i)) Then max = E3(i)
End If
Next i
If (max < e) Then txtres.Text = "训练成功" & Chr(13)
For i = 1 To 4
For j = 1 To 6
txtres.Text = txtres.Text & w1(i, j) & " "
Next j
txtres.Text = txtres.Text & Chr(13)
Next i
For i = 1 To 6
For j = 1 To 4
txtres.Text = txtres.Text & w2(i, j) & " "
Next j
txtres.Text = txtres.Text & Chr(13)
Next i
txtres.Text = txtres.Text & "Y=" & Chr(13)
For i = 1 To 4
txtres.Text = txtres.Text & Y(i) & " "
Next i
For i = 1 To 6
For j = 1 To 4
v2(i, j) = u * E3(j) * O2(i)
w2(i, j) = w2(i, j) + v2(i, j)
s = s + w2(i, j) * E3(j)
Next j
E2(i) = O2(i) * (1 - O2(i)) * s
Next i
For i = 1 To 4
For j = 1 To 6
v1(i, j) = u * E2(j) * O1(i)
w1(i, j) = w1(i, j) + u1(i, j)
Next j
Next i
txtX1.Text = "": txtX2.Text = "": txtX3.Text = "": txtX4.Text = ""
txtY01.Text = "": txtY02.Text = "": txtY03.Text = "": txtY04.Text = ""
X1 = X2 = X3 = X4 = Y01 = Y02 = Y03 = Y04 = 0
Next k
End Sub
Private Sub end_Click()
Dim response As Integer
response = MsgBox("是否继续?", vbYesNo + vbQuestion, "结束")
If response = 6 Then
txtX1.Text = "": txtX2.Text = "": txtX3.Text = "": txtX4.Text = ""
txtY01.Text = "": txtY02.Text = "": txtY03.Text = "": txtY04.Text = ""
X1 = X2 = X3 = X4 = Y01 = Y02 = Y03 = Y04 = 0
Else
End
End If
End Sub
Private Sub Form_Load()
With cmbC1
.AddItem "瓦斯压力"
.AddItem "巷道类型"
.AddItem "倾角度数"
.AddItem "放散速度"
.AddItem "作业方式"
.AddItem "煤的强度"
End With
With cmbC2
.AddItem "瓦斯压力"
.AddItem "巷道类型"
.AddItem "倾角度数"
.AddItem "放散速度"
.AddItem "作业方式"
.AddItem "煤的强度"
End With
With cmbC3
.AddItem "瓦斯压力"
.AddItem "巷道类型"
.AddItem "倾角度数"
.AddItem "放散速度"
.AddItem "作业方式"
.AddItem "煤的强度"
End With
With cmbC4
.AddItem "瓦斯压力"
.AddItem "巷道类型"
.AddItem "倾角度数"
.AddItem "放散速度"
.AddItem "作业方式"
.AddItem "煤的强度"
End With
End Sub
Private Sub input_Click()
inputtext.Show
End Sub
Private Sub pause_Click()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -