?? 模糊識別f1.frm
字號:
VERSION 5.00
Begin VB.Form frmFile
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "識別模糊"
ClientHeight = 6645
ClientLeft = 60
ClientTop = 345
ClientWidth = 5760
LinkTopic = "Form1"
ScaleHeight = 6645
ScaleWidth = 5760
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "數據預處理"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1095
Left = 240
TabIndex = 18
Top = 4200
Width = 1815
Begin VB.CheckBox Check2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "極差變換"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 20
Top = 600
Value = 1 'Checked
Width = 1095
End
Begin VB.CheckBox Check1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "標準差變換"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 19
Top = 240
Width = 1335
End
End
Begin VB.TextBox txtResultFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 17
Top = 3720
Width = 5295
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "求貼近度方法"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 2295
Left = 2400
TabIndex = 10
Top = 4200
Width = 2295
Begin VB.OptionButton Option3
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "歐氏貼近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 15
Top = 1080
Width = 1335
End
Begin VB.OptionButton Option2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "海明貼近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 14
Top = 720
Width = 1335
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "格貼近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 13
Top = 360
Width = 1335
End
Begin VB.OptionButton Option5
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "算術平均最小貼近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 12
Top = 1800
Width = 2055
End
Begin VB.OptionButton Option4
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "最大最小貼近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 11
Top = 1440
Value = -1 'True
Width = 1935
End
End
Begin VB.TextBox txtFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 9
Top = 3000
Width = 5295
End
Begin VB.CommandButton cmdExit
Caption = "結束"
Height = 375
Left = 4920
TabIndex = 7
ToolTipText = "結束程序運行"
Top = 6120
Width = 615
End
Begin VB.CommandButton cmdOK
Caption = "確定"
Height = 375
Left = 4920
TabIndex = 6
ToolTipText = "選擇好文件并給出行數和列數后單擊"
Top = 5640
Width = 615
End
Begin VB.FileListBox File1
Appearance = 0 'Flat
Height = 1470
Left = 240
TabIndex = 2
Top = 1080
Width = 2655
End
Begin VB.DirListBox Dir1
Appearance = 0 'Flat
Height = 2190
Left = 3120
TabIndex = 1
Top = 360
Width = 2415
End
Begin VB.DriveListBox Drive1
Appearance = 0 'Flat
Height = 300
Left = 240
TabIndex = 0
Top = 360
Width = 2655
End
Begin VB.Label lblR
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "模糊識別結果文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1080
TabIndex = 16
Top = 3480
Width = 3735
End
Begin VB.Label lblFile
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "數據文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1440
TabIndex = 8
Top = 2760
Width = 3015
End
Begin VB.Label lblF
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "選擇數據文件"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 5
Top = 840
Width = 2655
End
Begin VB.Label lblC
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "選擇目錄"
ForeColor = &H80000008&
Height = 255
Left = 3120
TabIndex = 4
Top = 120
Width = 2415
End
Begin VB.Label lblD
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "選擇驅動器"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 3
Top = 120
Width = 2655
End
End
Attribute VB_Name = "frmFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'模糊識別
'文件窗體模塊
Option Explicit
Dim intI As Integer, intJ As Integer, intK As Integer
Dim intA As Integer
Dim intFileNumber As Integer '文件號
Dim strData As String '臨時保存數據
Private Sub Form_Load()
File1.Pattern = "*.dat" '只顯示數據文件
'求貼近度方法的缺省設置為最大最小法
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(4) = 1
End Sub
'選擇目錄
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
'選擇驅動器
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
'確定數據文件
Private Sub File1_Click()
txtFile.Text = Dir1.Path & "\" & File1.FileName
txtResultFile.Text = Dir1.Path & "\" & "識別_" & File1.FileName
strResultFile = txtResultFile.Text
End Sub
'選擇格貼近度
Private Sub Option1_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(1) = 1
End Sub
'選擇海明貼近度
Private Sub Option2_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(2) = 1
End Sub
'選擇歐氏貼近度
Private Sub Option3_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(3) = 1
End Sub
'選擇最大最小貼近度
Private Sub Option4_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(4) = 1
End Sub
'選擇算術平均最小貼近度
Private Sub Option5_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(5) = 1
End Sub
'確定，給出文件名和行數、列數后單擊
Private Sub cmdOK_Click()
Dim intR As Integer
If txtFile.Text = "" Then
MsgBox "必須先選定數據文件！", , "數據文件錯誤"
Exit Sub
End If
strFileName = txtFile.Text '文件名
intFileNumber = FreeFile '取得文件號碼
Open strFileName For Input As intFileNumber '打開文件
Input #intFileNumber, intRow, intCol '讀總行數、總列數
'XX是已知樣本和待定樣本數組；X是去除標志列的數組且做預處理
ReDim XX(1 To intRow, 1 To intCol), X(1 To intRow, 1 To intCol - 1)
ReDim X0(1 To intRow, 1 To intCol - 1) '原始數據不做預處理
For intI = 1 To intRow
For intJ = 1 To intCol
Input #intFileNumber, strData '讀數據
XX(intI, intJ) = Val(strData)
If intJ < intCol Then X(intI, intJ) = XX(intI, intJ)
If intJ < intCol Then X0(intI, intJ) = XX(intI, intJ)
Next intJ
Next intI
If Check1.Value Then Data_T1 X '標準差變換
If Check2.Value Then Data_T2 X '極差變換
'intRow1為已知樣本個數（用于形成標準模型）
'intRow2為待定樣本個數（用于識別）
intRow1 = 0: intRow2 = 0
For intI = 1 To intRow
If XX(intI, intCol) > 0 Then intRow1 = intRow1 + 1
If XX(intI, intCol) = 0 Then intRow2 = intRow2 + 1
Next intI
If intRow1 = 0 Then
MsgBox "將轉化為標準模型的已知樣本不能為0！", , "缺失已知樣本錯誤"
End
End If
If intRow2 = 0 Then
MsgBox "將用于識別的待定樣本不能為0！", , "缺失待定樣本錯誤"
End
End If
'X1是已知樣本數組；X2是待定樣本數組
ReDim X1(1 To intRow1, 1 To intCol - 1), X2(1 To intRow2, 1 To intCol - 1)
ReDim X20(1 To intRow2, 1 To intCol - 1) 'X20是待定樣本，不做預處理
ReDim SC(1 To intCol - 1) '某一標準模型
ReDim XC(1 To intCol - 1) '某一待定樣本
intRow1 = 0: intRow2 = 0
For intI = 1 To intRow
If XX(intI, intCol) > 0 Then
intRow1 = intRow1 + 1
For intJ = 1 To intCol - 1
X1(intRow1, intJ) = X(intI, intJ) '已知樣本數組
Next intJ
End If
If XX(intI, intCol) = 0 Then
intRow2 = intRow2 + 1
For intJ = 1 To intCol - 1
X2(intRow2, intJ) = X(intI, intJ) '待定樣本數組
X20(intRow2, intJ) = X0(intI, intJ) '待定樣本數組
Next intJ
End If
Next intI
intS = 0 'intS為標準模型的個數
For intI = 1 To intRow
If intS < XX(intI, intCol) Then intS = XX(intI, intCol)
Next intI
'檢查標準模型編號
'標準模型編號必須是連續的整數，即1，2，3，...，如果中間出現間斷則視為錯誤
For intI = 1 To intS
For intJ = 1 To intRow1
If XX(intJ, intCol) = intI Then GoTo 100
Next intJ
MsgBox "標準模型的標志必須是連續的整數！", , "標準模型標志錯誤"
End
100:
Next intI
ReDim XS(1 To intS, 1 To intCol - 1) '標準模型數組
ReDim XS0(1 To intS, 1 To intCol - 1) '標準模型數組，不做預處理
ReDim DS(1 To intS) '貼近度數組
'由已知樣本確定標準模型
For intI = 1 To intS
intA = 0
For intJ = 1 To intRow
If XX(intJ, intCol) = intI Then
intA = intA + 1 '同一模型樣本計數器
For intK = 1 To intCol - 1
XS(intI, intK) = XS(intI, intK) + X(intJ, intK)
XS0(intI, intK) = XS0(intI, intK) + X0(intJ, intK)
Next intK
End If
Next intJ
'intA為某一標準模型的樣本個數
'對屬于同一個標準模型的不同樣本的對應指標做算術平均
For intK = 1 To intCol - 1
XS(intI, intK) = XS(intI, intK) / intA
XS0(intI, intK) = XS0(intI, intK) / intA
Next intK
Next intI
Close
frmResu.Visible = True
End Sub
'結束運行
Private Sub cmdExit_Click()
Unload Me
End
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -