shihanshu.frm

VB可视化程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8970
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9675
   LinkTopic       =   "Form1"
   ScaleHeight     =   8970
   ScaleWidth      =   9675
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "退出"
      Height          =   495
      Left            =   7200
      TabIndex        =   3
      Top             =   8280
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "最大最小距离算法"
      Height          =   495
      Left            =   4320
      TabIndex        =   2
      Top             =   8280
      Width           =   2535
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FFFFFF&
      Height          =   8000
      Left            =   1560
      ScaleHeight     =   7935
      ScaleWidth      =   7935
      TabIndex        =   1
      Top             =   120
      Width           =   8000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "默认样本"
      Height          =   495
      Left            =   1800
      TabIndex        =   0
      Top             =   8280
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const N = 10
Const BEI = 700
Dim center(0 To 19) As Integer
Dim s(0 To 1, 0 To 9) As Double
Dim D(0 To 19, 0 To N) As Double
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 justsea()
    '默认样本数据
    s(0, 0) = 0: s(0, 1) = 3: s(0, 2) = 2: s(0, 3) = 1: s(0, 4) = 5: s(0, 5) = 4: s(0, 6) = 6: s(0, 7) = 5: s(0, 8) = 6: s(0, 9) = 7
    s(1, 0) = 0: s(1, 1) = 8: s(1, 2) = 2: s(1, 3) = 1: s(1, 4) = 3: s(1, 5) = 8: s(1, 6) = 3: s(1, 7) = 4: s(1, 8) = 4: s(1, 9) = 5
    theta = 0.5: D12 = 0#: tmp = 0
    index = 0: k = 0
    center(0) = 0
    For j = 0 To N - 1 Step 1
        Picture1.Circle (s(0, j) * BEI, s(1, j) * BEI), 27, vbBlue
    Next j
    For j = 0 To N - 1 Step 1
        tmp = (s(0, j) - s(0, 0)) ^ 2 + (s(1, j) - s(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
    center(1) = index
    k = 1
    index = 0
    theshold = D12
    While (theshold > theta * D12)
        For j = 0 To N - 1 Step 1
            tmp = (s(0, j) - s(0, center(k))) ^ 2 + (s(1, j) - s(1, center(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: center(k) = index
        End If
        theshold = max
    Wend
    For j = 0 To N - 1 Step 1
        clas(j) = minindex(j)
    Next j
    
    'For i = 0 To 1 Step 1
    Print "样本："
        For j = 0 To N - 1 Step 1
            Print "(" & s(0, j) & "," & s(1, j) & ")"
        Next j
    'Next i
    Print "获得分类k=" & k + 1 & " "
    Print "center(s):"
    For l = 0 To k Step 1
        Picture1.Circle (s(0, center(l)) * BEI, s(1, center(l)) * BEI), 77, vbRed
        Print center(l) + 1
    Next l

    Print "样本类别："
    For j = 0 To N - 1
        Print clas(j) + 1
    Next j
End Sub

Private Sub Command1_Click()
Form1.Cls
Command2.Enabled = True
Call justsea
End Sub

Private Sub Command2_Click()
    For j = 0 To N - 1
        If clas(j) = 0 Then
        Picture1.Circle (s(0, j) * BEI, s(1, j) * BEI), 127, vbRed
        End If
        If clas(j) = 1 Then
        Picture1.Circle (s(0, j) * BEI, s(1, j) * BEI), 127, vbCyan
        End If
        If clas(j) = 2 Then
        Picture1.Circle (s(0, j) * BEI, s(1, j) * BEI), 127, vbYellow
        End If
    Next j
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
Form1.Show
Picture1.Scale (-1000, 7000)-(7000, -1000)
Call init
End Sub
Sub init()
Command2.Enabled = False
Picture1.Line (0, -900)-(0, 6900)
Picture1.Line (100, 6700)-(0, 6900)
Picture1.Line (-100, 6700)-(0, 6900)

Picture1.Line (-900, 0)-(6900, 0)
Picture1.Line (6700, 100)-(6900, 0)
Picture1.Line (6700, -100)-(6900, 0)
Picture1.CurrentX = 27: Picture1.CurrentY = -27
Picture1.Print 0
Dim i As Integer
For i = 0 To 8
Picture1.CurrentX = (i + 1) * BEI + 27: Picture1.CurrentY = -27
Picture1.Print i + 1
Picture1.Line ((i + 1) * BEI, 100)-((i + 1) * BEI, -100), vbBlack

Picture1.CurrentX = -277: Picture1.CurrentY = (i + 1) * BEI + 27
Picture1.Print i + 1
Picture1.Line (-100, (i + 1) * BEI)-(100, (i + 1) * BEI), vbBlack
Next i
Picture1.CurrentX = 1000: Picture1.CurrentY = 6700
Picture1.Print "说明： 最小的兰色圆点为样本坐标"
Picture1.CurrentX = 800: Picture1.CurrentY = 6500
Picture1.Print "红色中等圆圈指示中心点（聚点）位置"
Picture1.CurrentX = 800: Picture1.CurrentY = 6300
Picture1.Print "最大的圆圈，同一类别的样本将有相同的颜色"
End Sub