我的.txt

关于apriori算法的一个小程序

apriori的VB实现

(1)数据的收集与预处理
我们收集了l0o期彩票的开奖结果(即l00个事务)作为挖掘对象。如表l所示。

2l0l   03，I 2，20，25，26，3I，32，I5
2l00  04．I I，I 5，I8，20，25，34，35
2099 0I，09，17，28，29，33，36，23
根据算法的需要，我们在SQL Server 2000下建立了基于上表的事务数据表CP，该数据表包含两个字段tjd和tlist，tid表示期号，tlist表示每期的开奖号码组合，并按照表l的形式存储元组。
假定最小事务支持计数为5，即数字组合在事务数据库中出现5次以上即为频繁。进行上述预处理后，用VB 6．0和ADO数据对象进行了挖掘过程的具体实现。


(2)生成频繁l-项集Ll
首先在程序中用SQL语句生成了l-项集Ll，即：create table Il(t l char(5)，tcount integer)其中，tl表示项集中的每一项，tcount表示该项的支持度计数。扫描表cP的tlist字段，根据该字段的存储特点，需要将tlist字段各分量中以逗号分隔的数字取出并且通过模式匹配统计它们的个数，取消重复后分别存放到Ll表的tl和tcount字段中。


(3)逐层搜索迭代生成频繁侯选K-项集LK根据Apriori算法的思想，可以循环生成频繁K-项集，若生成的K．项集为空集，则算法结束，K-l项集便是所求的频繁项集。为此我们编写了如下的函数和过程：
1)函数l返回值为由K-l项集生成K项集的SQL语句
Public Function genkxj(k As Integer)As String Dim mysql As String
Ifk> I Then
mysqI="select"
For i= l To k-l
mysqI=mysql＆ "I" ＆ k-1 ＆ "．t"＆ i＆ "as  t"＆ i ＆ "，"
Next
mysqI= mysqI＆ ”I”＆ k-I＆ ”I．t”＆ k-I＆ ”as t”＆ k＆ ”，I”＆
k-1＆ “．tcount as tcount into l ”＆k ＆ “from I”＆ k-I＆ “，I” ＆ k-I ＆
“as l ”＆ k-1＆  "1 where”
Fori=I To k一2
mysqI=mysql＆ ”I”＆ k-I＆ "．t" ＆ i＆ "= I"＆ k-l＆ "1．t" ＆ i ＆ "and "
Next
mysql= mysql ＆ "l" ＆ k —l＆ "．t" ＆ k-1＆ "< l" ＆ k-l ＆ "1．t"
＆ k．I
Endlf
genkxj=mysql
End Function


2)过程l求K-项集中每项的支持度计数
Public Sub kxjcount(k As Integer)
Dim rstnew As New ADODB．Recordset
Dim rstnew I As New ADODB．Recordset
mysql ="select"
For i= I To k
lfj◇ k Then mysql=mysql& "t" & i & ","
Else
mysql=mysql& "t" & i
End If
Next
mysql=mysql & "from l" & k
rstnew．Open mysql，en，adOpenStatic
q=0
if Not rstnew．EOF Then
rstnew．MoveFirst
Do WhiIe Not rstnew．EOF
mysql=”select count(*) from cp where tlist like”
For i=0 To rstnew．Fields.Count一2
mysql=mysql & "'％" & Trim(rstnew(i)) & "％' and tlist like"
Next
mysql=mysql& "'％ " &Trim(rstnew(i)) & "％'"
rstnew I．Open mysql，cn，adOpenStatic
Ixcount=rstnew I(0)
rstnew I．CIose
mysql=”update I " & k & " set tcount=" & lxcount& " where"
for  i=0 To rsthew．Fields．Count-2
mysql=mysql& "t"& i+I & "like" & rstnew(i) & "and'"
Next
mysql=mysql& "t" & i+ I& "like"  & rstnew(i) & "'"
Cn. Execute mysql

rstnew.moveNext
Loop
mysql=“delete from l" & k & "where tcount<5”
cn．Execute mysql
Endlf
End Sub

3)函数2判断算法是否结束，若函数返回值为false，则
算法结束。
Public Function exeomot(k As Integer)As Boolean
Dim rSt As New ADODB．Recordset
exeomot=true
mysql="select  * from l" & k—I
rst．Open mysql，cn，adOpenStatic
lr rSt．EOF Then
exeomot=FaIse
EndIf

end function