?? exp2.frm
字號:
VERSION 5.00
Begin VB.Form FrmMain
AutoRedraw = -1 'True
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Caption = "模式識別實驗"
ClientHeight = 7155
ClientLeft = 45
ClientTop = 435
ClientWidth = 8925
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7155
ScaleMode = 0 'User
ScaleWidth = 8925
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Cmd_exit
Caption = "退 出"
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6960
TabIndex = 4
Top = 6000
Width = 1695
End
Begin VB.CommandButton Cmd_init
Caption = "初始化"
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6960
TabIndex = 3
Top = 4920
Width = 1695
End
Begin VB.CommandButton Cmd_sf
Caption = "距離算法"
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6960
TabIndex = 2
Top = 1800
Width = 1695
End
Begin VB.CommandButton Cmd_yb
Caption = "顯示樣本"
BeginProperty Font
Name = "楷體_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 6960
TabIndex = 1
Top = 720
Width = 1695
End
Begin VB.PictureBox Piczb
AutoRedraw = -1 'True
BackColor = &H00C0FFFF&
Height = 5910
Left = 240
ScaleHeight = -15
ScaleLeft = -3
ScaleMode = 0 'User
ScaleTop = 12
ScaleWidth = 15
TabIndex = 0
Top = 720
Width = 6400
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00C0FFFF&
Caption = "最大最小結聚類"
BeginProperty Font
Name = "隸書"
Size = 24
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1440
TabIndex = 5
Top = 0
Width = 3615
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim yb(0 To 1, 0 To 9) As Double
Const N = 10
Dim D(0 To 19, 0 To N) As Double
Dim cen(0 To 19) As Integer
Dim theshold, theta, D12, tmp, min(0 To N) As Double
Dim minindex(0 To N), clas(0 To N), index, i, k, j, l As Double
Sub zb()
' x
Piczb.Line (-2.5, 0)-(11.5, 0)
Piczb.Line (11.2, 0.2)-(11.5, 0)
Piczb.Line (11.2, -0.2)-(11.5, 0)
For i = -2 To 10 Step 1
Piczb.Circle (i, 0), 0.02
Piczb.CurrentX = i - 0.3: Piczb.CurrentY = -0.2
Piczb.Print i
Next
Piczb.CurrentX = 11.3: Piczb.CurrentY = -0.2
Piczb.Print "x"
'y
Piczb.Line (0, -2.5)-(0, 11.5)
Piczb.Line (0.2, 11.2)-(0, 11.5)
Piczb.Line (-0.2, 11.2)-(0, 11.5)
For i = 1 To 10 Step 1
Piczb.Circle (0, i), 0.03
Piczb.CurrentX = -0.7: Piczb.CurrentY = i + 0.25
Piczb.Print i
Next
For i = -2 To -1 Step 1
Piczb.Circle (0, i), 0.03
Piczb.CurrentX = -0.7: Piczb.CurrentY = i + 0.25
Piczb.Print i
Next
Piczb.CurrentX = -0.7: Piczb.CurrentY = 11.5
Piczb.Print "y"
End Sub
Sub max_min()
'默認樣本數據
yb(0, 0) = 0: yb(0, 1) = 3: yb(0, 2) = 2: yb(0, 3) = 5: yb(0, 4) = 4: yb(0, 5) = 6: yb(0, 6) = 5: yb(0, 7) = 6: yb(0, 8) = 7: yb(0, 9) = 5
yb(1, 0) = 0: yb(1, 1) = 8: yb(1, 2) = 2: yb(1, 3) = 1: yb(1, 4) = 1: yb(1, 5) = 3: yb(1, 6) = 8: yb(1, 7) = 3: yb(1, 8) = 4: yb(1, 9) = 4
theta = 0.5: D12 = 0#: tmp = 0
index = 0: k = 0
cen(0) = 0
For j = 0 To N - 1 Step 1
Piczb.Circle (yb(0, j), yb(1, j)), 0.02, vbBlack
Piczb.Circle (yb(0, j), yb(1, j)), 0.03, vbBlack
Piczb.CurrentX = yb(0, j) - 0.5: Piczb.CurrentY = yb(1, j) + 0.6
Piczb.Print "(" & yb(0, j) & "," & yb(1, j) & ")"
Next j
For j = 0 To N - 1 Step 1
tmp = (yb(0, j) - yb(0, 0)) ^ 2 + (yb(1, j) - yb(1, 0)) ^ 2
D(0, j) = Sqr(CDbl(tmp))
If D(0, j) > D12 Then
D12 = D(0, j): index = j
End If
Next j
cen(1) = index
k = 1
index = 0
theshold = D12
While (theshold > theta * D12)
For j = 0 To N - 1 Step 1
tmp = (yb(0, j) - yb(0, cen(k))) ^ 2 + (yb(1, j) - yb(1, cen(k))) ^ 2
D(k, j) = Sqr(CDbl(tmp))
Next j
For j = 0 To N - 1 Step 1
tmp = D12
For l = 0 To k Step 1
If (D(l, j) < tmp) Then
tmp = D(l, j): index = l
End If
Next l
min(j) = tmp: minindex(j) = index
Next j
Dim max As Double
max = 0
index = 0
For j = 0 To N - 1 Step 1
If (min(j) > max) Then
max = min(j): index = j
End If
Next j
If (max > theta * D12) Then
k = k + 1: cen(k) = index
End If
theshold = max
Wend
For j = 0 To N - 1 Step 1
clas(j) = minindex(j)
Next j
For l = 0 To k Step 1
Piczb.Circle (yb(0, cen(l)), yb(1, cen(l))), 0.03, vbRed
Next l
End Sub
Private Sub Cmd_exit_Click()
End
End Sub
Private Sub Cmd_init_Click()
Piczb.Picture = LoadPicture()
Call zb
Cmd_yb.Enabled = True
End Sub
Private Sub Cmd_sf_Click()
Call max_min
Dim a, b, c, aa, bb, ccc As Integer
Dim max_x, min_x, max_y, min_y As Double
a = b = c = 0
aa = bb = ccc = 0
For j = 0 To N - 1
If clas(j) = 0 Then
a = a + 1
End If
If clas(j) = 1 Then
b = b + 1
End If
If clas(j) = 2 Then
c = c + 1
End If
Next j
ReDim ca(0 To 1, 0 To a) As Double
ReDim cb(0 To 1, 0 To b) As Double
ReDim cc(0 To 1, 0 To c) As Double
For j = 0 To N - 1
If clas(j) = 0 Then
ca(0, aa) = yb(0, j)
ca(1, aa) = yb(1, j)
aa = aa + 1
End If
If clas(j) = 1 Then
cb(0, bb) = yb(0, j)
cb(1, bb) = yb(1, j)
bb = bb + 1
End If
If clas(j) = 2 Then
cc(0, ccc) = yb(0, j)
cc(1, ccc) = yb(1, j)
ccc = ccc + 1
End If
Next j
'c1
max_x = ca(0, 0)
min_x = ca(0, 0)
max_y = ca(1, 0)
min_y = ca(1, 0)
For i = 0 To a - 1 Step 1
'max_x
If max_x < ca(0, i) Then
max_x = ca(0, i)
End If
'min_x
If min_x > ca(0, i) Then
min_x = ca(0, i)
End If
'max_y
If max_y < ca(1, i) Then
max_y = ca(0, i)
End If
'min_y
If min_y > ca(1, i) Then
min_y = ca(0, i)
End If
Next
Piczb.Line (min_x - 0.3, min_y - 0.3)-(max_x + 0.3, min_y - 0.3), vbBlack
Piczb.Line (max_x + 0.3, min_y - 0.3)-(max_x + 0.3, max_y + 0.3), vbBlack
Piczb.Line (max_x + 0.3, max_y + 0.3)-(min_x - 0.3, max_y + 0.3), vbBlack
Piczb.Line (min_x - 0.3, max_y + 0.3)-(min_x - 0.3, min_y - 0.3), vbBlack
'c2
max_x = cb(0, 0)
min_x = cb(0, 0)
max_y = cb(1, 0)
min_y = cb(1, 0)
For i = 1 To b - 1 Step 1
'max_x
If max_x < cb(0, i) Then
max_x = cb(0, i)
End If
'min_x
If min_x > cb(0, i) Then
min_x = cb(0, i)
End If
'max_y
If max_y < cb(1, i) Then
max_y = cb(1, i)
End If
'min_y
If min_y > cb(1, i) Then
min_y = cb(1, i)
End If
Next
Piczb.Line (min_x - 0.3, min_y - 0.3)-(max_x + 0.3, min_y - 0.3), vbBlack
Piczb.Line (max_x + 0.3, min_y - 0.3)-(max_x + 0.3, max_y + 0.3), vbBlack
Piczb.Line (max_x + 0.3, max_y + 0.3)-(min_x - 0.3, max_y + 0.3), vbBlack
Piczb.Line (min_x - 0.3, max_y + 0.3)-(min_x - 0.3, min_y - 0.3), vbBlack
'c3
max_x = cc(0, 0)
min_x = cc(0, 0)
max_y = cc(1, 0)
min_y = cc(1, 0)
For i = 0 To c - 1 Step 1
' lbl1(i).Caption = ca(0, i) & " " & ca(1, i)
'max_x
If max_x < cc(0, i) Then
max_x = cc(0, i)
End If
'min_x
If min_x > cc(0, i) Then
min_x = cc(0, i)
End If
'max_y
If max_y < cc(1, i) Then
max_y = cc(1, i)
End If
'min_y
If min_y > cc(1, i) Then
min_y = cc(1, i)
End If
Next
Piczb.Line (min_x - 0.3, min_y - 0.3)-(max_x + 0.3, min_y - 0.3), vbBlack
Piczb.Line (max_x + 0.3, min_y - 0.3)-(max_x + 0.3, max_y + 0.3), vbBlack
Piczb.Line (max_x + 0.3, max_y + 0.3)-(min_x - 0.3, max_y + 0.3), vbBlack
Piczb.Line (min_x - 0.3, max_y + 0.3)-(min_x - 0.3, min_y - 0.3), vbBlack
End Sub
Private Sub Cmd_yb_Click()
'Call max_min
Cmd_sf.Enabled = True
Cmd_yb.Enabled = False
yb(0, 0) = 0: yb(0, 1) = 3: yb(0, 2) = 2: yb(0, 3) = 5: yb(0, 4) = 4: yb(0, 5) = 6: yb(0, 6) = 5: yb(0, 7) = 6: yb(0, 8) = 7: yb(0, 9) = 5
yb(1, 0) = 0: yb(1, 1) = 8: yb(1, 2) = 2: yb(1, 3) = 1: yb(1, 4) = 1: yb(1, 5) = 3: yb(1, 6) = 8: yb(1, 7) = 3: yb(1, 8) = 4: yb(1, 9) = 4
For j = 0 To N - 1 Step 1
Piczb.Circle (yb(0, j), yb(1, j)), 0.03, vbRed
Piczb.Circle (yb(0, j), yb(1, j)), 0.02, vbRed
Piczb.CurrentX = yb(0, j) - 0.5: Piczb.CurrentY = yb(1, j) + 0.6
Piczb.Print "(" & yb(0, j) & "," & yb(1, j) & ")"
Next j
End Sub
Private Sub Form_Load()
'Piczb.Picture = LoadPicture("bg.jpg")
Cmd_yb.Enabled = False
Cmd_sf.Enabled = False
End Sub
Private Sub Label2_Click()
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -