main.frm

knn分类器 基于Visual Basic实现

         Height          =   255
         Left            =   2280
         TabIndex        =   5
         Top             =   180
         Width           =   4215
      End
   End
   Begin VB.PictureBox Table 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   3495
      Left            =   120
      ScaleHeight     =   231
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   447
      TabIndex        =   0
      Top             =   120
      Width           =   6735
      Begin VB.Shape Highlighter 
         BackColor       =   &H00C0C0FF&
         BackStyle       =   1  'Opaque
         BorderStyle     =   0  'Transparent
         DrawMode        =   9  'Not Mask Pen
         Height          =   255
         Index           =   0
         Left            =   960
         Top             =   1560
         Visible         =   0   'False
         Width           =   495
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub EnableControls(Enabled As Boolean)
    Command1.Enabled = Enabled
    Command2.Enabled = Enabled
    Command3.Enabled = Enabled
    Command4.Enabled = Enabled
    For n = Combo.LBound To Combo.Ubound
        Combo(n).Enabled = Enabled
    Next n
    Label1.Enabled = Enabled
    Label2.Enabled = Enabled
    Check1.Enabled = Enabled
    Check2.Enabled = Enabled
    ComboNeighbors.Enabled = Enabled
End Sub

Private Sub Command1_Click()
    Call EnableControls(False)
    Call GetResult(Situation1, D, ComboNeighbors.ListIndex + 1)
    Call EnableControls(True)
End Sub

Private Sub Command2_Click()
    Call EnableControls(False)
    Call GetResult(Situation2, D, ComboNeighbors.ListIndex + 1)
    Call EnableControls(True)
End Sub

Private Sub Command3_Click()
    Dim CustomSituation As DayType
    Call EnableControls(False)
    Call SetDay(CustomSituation, Combo(0).ListIndex, Combo(1).ListIndex, Combo(2).ListIndex, Combo(3).ListIndex)
    Call GetResult(CustomSituation, D, ComboNeighbors.ListIndex + 1)
    Call EnableControls(True)
End Sub

Private Sub Command4_Click()
    Dim Best As Integer, Deviation As Double, ThisDeviation As Double, n As Integer, i As Integer, Expected As Double
    Dim Msg As String
    Deviation = -1
    
    Call EnableControls(False)
    
    Dim Deviations As New Collection
    Dim DeviationIndexes As New Collection
    
    Form1.Info.Text = ""
    AddInfo "Performing Forward Selection on data set..." & vbCrLf
    
    For n = 1 To nFeatures
        Msg = ""
        ThisDeviation = 0
        Call SetSelectionFeature(n)
        For i = LBound(D) To UBound(D)
            Cur = 1
            ReDim D2(LBound(D) To UBound(D) - 1)
            For j = LBound(D) To UBound(D)
                If i <> j Then
                    D2(Cur) = D(j)
                    Cur = Cur + 1
                End If
            Next j
            For j = LBound(D2) To UBound(D2)
                Call CreateScale(n, D2)
            Next j
            Expected = GetResult(D(i), D2, ComboNeighbors.ListIndex + 1, False)
            ThisDeviation = ThisDeviation + Abs(GetOutput(Output(i)) - Expected)
            DoEvents
        Next i
        For m = 1 To Deviations.Count
            If Deviations(m) > ThisDeviation Then
                DeviationIndexes.Add n, , m
                Deviations.Add ThisDeviation, , m
                GoTo NextFeature
            End If
        Next m
        DeviationIndexes.Add n
        Deviations.Add ThisDeviation
NextFeature:
        Msg = Msg & "Leaving out feature " & DispFeature(n) & " gives a total deviation of:" & vbCrLf & ThisDeviation & vbCrLf
        AddInfo Msg
    Next n
    
    Call SetSelectionFeature(0)
    
    AddInfo "Best features:"
    For n = 1 To DeviationIndexes.Count
        AddInfo "#" & n & ": " & DispFeature(DeviationIndexes(n))
    Next n
    
    Call EnableControls(True)
    
End Sub

Private Sub Form_Load()
    Dim n As Integer
    
    Call SetD(1, Sunny, Hot, High, Weak, False)
    Call SetD(2, Sunny, Hot, High, Strong, False)
    Call SetD(3, Overcast, Hot, High, Weak, True)
    Call SetD(4, Rain, Mild, High, Weak, True)
    Call SetD(5, Rain, Cool, Normal, Weak, True)
    Call SetD(6, Rain, Cool, Normal, Strong, False)
    Call SetD(7, Overcast, Cool, Normal, Strong, True)
    Call SetD(8, Sunny, Mild, High, Weak, False)
    Call SetD(9, Sunny, Cool, Normal, Weak, True)
    Call SetD(10, Rain, Mild, Normal, Weak, True)
    Call SetD(11, Sunny, Mild, Normal, Strong, True)
    Call SetD(12, Overcast, Mild, High, Strong, True)
    Call SetD(13, Overcast, Hot, Normal, Weak, True)
    Call SetD(14, Rain, Mild, High, Strong, False)
    
    Call SetDay(Situation1, Sunny, Cool, High, Strong)
    Call SetDay(Situation2, Rain, Hot, Normal, Weak)
    
    Label1.Caption = "Situation1 = (" & DispDay(Situation1) & ")"
    Label2.Caption = "Situation2 = (" & DispDay(Situation2) & ")"
    
    Dim i As Integer, AllFeatures As Double
    Check2.Value = 1
    For n = LBound(D) To UBound(D)
        Call CreateScale(n, D)
    Next n
    
    Combo(0).AddItem "Rain"
    Combo(0).AddItem "Overcast"
    Combo(0).AddItem "Sunny"
    Combo(0).ListIndex = 0
    Combo(1).AddItem "Cool"
    Combo(1).AddItem "Mild"
    Combo(1).AddItem "Hot"
    Combo(1).ListIndex = 0
    Combo(2).AddItem "Normal"
    Combo(2).AddItem "High"
    Combo(2).ListIndex = 0
    Combo(3).AddItem "Weak"
    Combo(3).AddItem "Strong"
    Combo(3).ListIndex = 0
    
    ComboNeighbors.AddItem "1 neighbor"
    ComboNeighbors.AddItem "2 neighbors"
    ComboNeighbors.AddItem "3 neighbors"
    ComboNeighbors.AddItem "4 neighbors"
    ComboNeighbors.AddItem "5 neighbors"
    ComboNeighbors.ListIndex = 2
    
    Me.Show
    Table.Height = (UBound(D) - LBound(D) + 2) * 18 + 10
    Table.Width = 420
    Info.Left = Table.Left + Table.Width + 8
    ButtonBox.Move 8, Table.Top + Table.Height + 8, Table.Width
    Me.Width = (((Me.Width / Screen.TwipsPerPixelX) - Me.ScaleWidth) + Info.Left + Info.Width + 8) * Screen.TwipsPerPixelX
    Me.Height = (((Me.Height / Screen.TwipsPerPixelY) - Me.ScaleHeight) + ButtonBox.Top + ButtonBox.Height + 8) * Screen.TwipsPerPixelY
    Info.Height = Me.ScaleHeight - Info.Top - 8
    Table.AutoRedraw = True
    y = 0
    For n = LBound(D) - 1 To UBound(D)
        y = y + 1
        If n < LBound(D) Then
            Table.Line (0, (y * 18) + 3)-(Table.Width, (y * 18) + 3)
            Table.Line (53, 0)-(53, Table.Height)
            Table.Line (343, 0)-(343, Table.Height)
        End If
        Table.CurrentX = 7
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "Days"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print "Day " & n;
        End If
        Table.CurrentX = 65
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "Outlook"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print ShowOutlook(D(n).Outlook)
        End If
        Table.CurrentX = 135
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "Temperature"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print ShowTemperature(D(n).Temperature)
        End If
        Table.CurrentX = 205
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "Humidity"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print ShowHumidity(D(n).Humidity)
        End If
        Table.CurrentX = 275
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "Wind"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print ShowWind(D(n).Wind)
        End If
        Table.CurrentX = 355
        If n < LBound(D) Then
            Table.CurrentY = (y * 18) - 14
            Table.Print "PlayTennis"
        Else
            Table.CurrentY = (y * 18) - 10
            Table.Print ShowOutput(Output(n))
        End If
    Next n
    
End Sub