form1.vb

vs2005开发的apriori算法程序

Imports system.IO
Public Class Form1
    Private Structure sBest
        Dim sArray() As String '数组
        Dim supCount As Integer '支持度计数
        Dim sCount As Integer '数组大小
    End Structure
    Dim minSup As Integer, minConf As Double '最小支持度和最小置信度
    Dim sData(20) As sBest, sNum As Integer '数据集大小
    Dim sFlg As Boolean = False

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click '数据读取
        Dim myStr As String, myData() As String, i As Integer, t As Integer
        myStr = ""
        If OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            Dim objReader As New StreamReader(OpenFileDialog1.FileName)
            ListBox1.Items.Clear()
            t = 0
            Do
                myStr = objReader.ReadLine()
                If Not myStr Is Nothing Then
                    myData = Split(myStr, ",")
                    ReDim sData(t).sArray(UBound(myData))
                    sData(t).sCount = UBound(myData)
                    For i = 0 To sData(t).sCount
                        sData(t).sArray(i) = myData(i)
                    Next
                    ListBox1.Items.Add(myStr)
                    t = t + 1
                End If
            Loop Until myStr Is Nothing
            sNum = t - 1
            objReader.Close()
        End If
        sFlg = True
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim i As Integer
        ComboBox1.Text = 2
        ComboBox2.Text = 0.6
        For i = 1 To 9
            ComboBox1.Items.Add(i + 1)
        Next
        ComboBox2.Items.Add(0.6)
        ComboBox2.Items.Add(0.7)
        For i = 8 To 10
            ComboBox2.Items.Add(0.1 * i)
        Next i
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        End
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim fSet(120) As sBest, ck(120) As sBest, lk(120) As sBest, fPos As Integer
        Dim i As Integer, j As Integer, k As Integer, tch As Integer, si As Integer, ckPos As Integer, lkPos As Integer
        Dim myStr As String, sConf As Double, mStr As String, ckCount As Integer, lkCount As Integer
        ''''''''''''''''''''''''''''''''''''''''''''''
        If sFlg = False Then
            MessageBox.Show("请首先打开文件！")
            Exit Sub
        End If
        tch = 0
        si = 0
        minSup = Val(ComboBox1.Text)
        minConf = Val(ComboBox2.Text)
        ListBox2.Items.Clear()
        ListBox3.Items.Clear()
        ListBox4.Items.Clear()
        For i = 0 To UBound(fSet)
            ReDim fSet(i).sArray(20)
            ReDim ck(i).sArray(20)
            ReDim lk(i).sArray(20)
        Next
        ck(0).sArray(0) = sData(0).sArray(0)
        ckPos = 0
        ck(0).supCount = 0        
        ''''''''''''''''''''''''''''''''''''''''''''''
        For i = 0 To sNum
            For j = 0 To sData(i).sCount
                For k = 0 To ckPos
                    If sData(i).sArray(j) = ck(k).sArray(0) Then '''''''''扫描数据集，获取候选一项集
                        tch = tch + 1
                    End If
                Next
                If tch = 0 Then
                    ckPos = ckPos + 1
                    ck(ckPos).sArray(0) = sData(i).sArray(j)
                    ck(ckPos).supCount = 0
                End If
                tch = 0
            Next
        Next
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ListBox2.Items.Add("1项集,共" & ckPos + 1 & "个")
        ckCount = 0
        lkPos = 0
        lkCount = 0
        For i = 0 To ckPos
            For j = 0 To sNum
                If isIn(ck(i).sArray, sData(j).sArray, ckCount, sData(j).sCount) = True Then
                    ck(i).supCount = ck(i).supCount + 1
                End If
            Next
            ListBox2.Items.Add(ck(i).sArray(0) & "     " & ck(i).supCount) '''''''''计算支持度，获取频繁一项集
            If ck(i).supCount >= minSup Then
                lk(lkPos).sArray(0) = ck(i).sArray(0)
                lk(lkPos).supCount = ck(i).supCount
                lkPos = lkPos + 1
            End If
        Next
        ListBox3.Items.Add("1项集,共" & lkPos & "个")
        fPos = lkPos - 1
        For i = 0 To fPos
            ListBox3.Items.Add(lk(i).sArray(0) & "     " & lk(i).supCount) ''''''''''''''''保存获取的频繁集
            fSet(i).sArray(0) = lk(i).sArray(0)
            fSet(i).sCount = lkCount
            fSet(i).supCount = lk(i).supCount
        Next
        Do
            ckPos = 0
            ckCount = lkCount + 1
            For i = 0 To lkPos - 2
                For j = i + 1 To lkPos - 1
                    If ckPos > UBound(fSet) Then
                        ListBox2.Items.Clear()
                        ListBox3.Items.Clear()
                        ListBox4.Items.Clear()
                        MessageBox.Show("参数选的太小！")
                        Exit Sub
                    End If
                    If canJoin(lk(i).sArray, lk(j).sArray, lkCount) Then
                        sJoin(lk(i).sArray, lk(j).sArray, ck(ckPos).sArray, lkCount) ''''''''''连接，产生新的候选集
                        ckPos = ckPos + 1
                    End If
                Next
            Next
            lkCount = ckCount
            lkPos = 0
            If ckPos > 0 Then
                ListBox2.Items.Add(ckCount + 1 & "项集,共" & ckPos & "个")
            End If
            For i = 0 To ckPos - 1
                ck(i).supCount = 0
                For j = 0 To sNum
                    If isIn(ck(i).sArray, sData(j).sArray, ckCount, sData(j).sCount) = True Then '''''''''计算支持度
                        ck(i).supCount = ck(i).supCount + 1
                    End If
                Next
                myStr = ""
                For j = 0 To ckCount
                    myStr = myStr & ck(i).sArray(j)
                Next
                ListBox2.Items.Add(myStr & "     " & ck(i).supCount) '''''''获取频繁集
                If ck(i).supCount >= minSup Then
                    For j = 0 To lkCount
                        lk(lkPos).sArray(j) = ck(i).sArray(j)
                        lk(lkPos).supCount = ck(i).supCount
                    Next
                    lkPos = lkPos + 1
                End If
            Next
            If lkPos > 0 Then
                ListBox3.Items.Add(lkCount + 1 & "项集,共" & lkPos & "个")
            End If
            For i = 0 To lkPos - 1
                myStr = ""
                For j = 0 To lkCount
                    myStr = myStr & lk(i).sArray(j)
                Next
                ListBox3.Items.Add(myStr & "     " & lk(i).supCount)
            Next
            For i = 0 To lkPos - 1
                fPos = fPos + 1
                If fPos > UBound(fSet) Then
                    ListBox2.Items.Clear()
                    ListBox3.Items.Clear()
                    ListBox4.Items.Clear()
                    MessageBox.Show("参数选的太小！")
                    Exit Sub
                End If
                For j = 0 To lkCount
                    fSet(fPos).sArray(j) = lk(i).sArray(j) '''''保存获取的频繁集
                Next
                fSet(fPos).supCount = lk(i).supCount
                fSet(fPos).sCount = lkCount
            Next
        Loop While lkPos > 0
        For i = 0 To fPos - 1
            For j = i + 1 To fPos
                If isIn(fSet(i).sArray, fSet(j).sArray, fSet(i).sCount, fSet(j).sCount) And fSet(j).sCount > fSet(i).sCount And fSet(j).supCount / fSet(i).supCount >= minConf Then
                    sConf = fSet(j).supCount / fSet(i).supCount
                    mStr = ""
                    For k = 0 To fSet(j).sCount
                        If tIn(fSet(j).sArray(k), fSet(i).sArray, fSet(i).sCount) = False Then '''''提取关联规则
                            mStr = mStr & fSet(j).sArray(k)
                        End If
                    Next
                    myStr = ""
                    For k = 0 To fSet(i).sCount
                        myStr = myStr & fSet(i).sArray(k)
                    Next
                    ListBox4.Items.Add(myStr & "=>" & mStr & "           " & 100 * Format(sConf, "###.0000") & "%")
                    si = si + 1
                End If
            Next
        Next
        If si > 0 Then
            ListBox4.Items.Add("共有" & si & "条规则")
        Else
            ListBox4.Items.Add("没有规则")
        End If
    End Sub
    Private Function isIn(ByVal a() As String, ByVal b() As String, ByVal m As Integer, ByVal n As Integer) As Boolean '判断a是否包含于b
        Dim s As Integer, i As Integer, j As Integer
        s = 0
        For i = 0 To m
            For j = 0 To n
                If a(i) = b(j) Then
                    s = s + 1
                End If
            Next
        Next
        If s = m + 1 Then
            isIn = True
        Else
            isIn = False
        End If
    End Function
    Private Function canJoin(ByVal a() As String, ByVal b() As String, ByVal m As Integer) As Boolean '判断是否能连接
        Dim s As Integer, i As Integer
        s = 0
        If m = 0 Then
            canJoin = True
        Else
            For i = 0 To m - 1
                If a(i) = b(i) Then
                    s = s + 1
                End If
            Next
            If s = m Then
                canJoin = True
            Else
                canJoin = False
            End If
        End If
    End Function
    Private Sub sJoin(ByVal a() As String, ByVal b() As String, ByVal c() As String, ByVal m As Integer) '连接
        Dim i As Integer
        If m = 0 Then
            c(0) = a(0)
            c(1) = b(0)
        Else
            For i = 0 To m
                c(i) = a(i)
            Next
            c(m + 1) = b(m)
        End If
    End Sub
    Private Function tIn(ByVal a As String, ByVal b() As String, ByVal m As Integer) As Boolean
        Dim i As Integer, s As Integer
        s = 0
        For i = 0 To m
            If a = b(i) Then
                s = s + 1
            End If
        Next
        If s = 0 Then
            tIn = False
        Else
            tIn = True
        End If
    End Function
End Class