frm_gendata.frm

vb apriori algorithm

     pointer.count = counts
     Do
      counts = counts + 1
     Set pointer = pointer.nextnode
      pointer.count = counts
      If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
                Exit Do
      End If
     Loop While Not pointer Is Nothing
   End If
End Sub

Private Sub konglianbiao_Click()
Set pointer = head
Do
    Set pointer = pointer.nextnode
    If ObjPtr(pointer.nextnode) = ObjPtr(head) Then
               Set pointer.nextnode = Nothing
               Set n = New node
               Set n = pointer
    End If
   DoEvents
Loop While Not pointer.nextnode Is Nothing
 Do
   Set pointer = head
   Set head = head.nextnode
  Set pointer = Nothing
    If ObjPtr(head) = ObjPtr(n) Then
           Set head = Nothing
           Set n = Nothing
    End If
    DoEvents
Loop While Not head Is Nothing
Form1.Cls
End Sub
Private Sub leave_Click()
End
End Sub
Private Sub print_Click()
Set pointer = head
If head Is Nothing Then
    MsgBox "链表为空"
Else
 While Not pointer Is Nothing
        Print pointer.x
        Set pointer = pointer.nextnode
        If ObjPtr(pointer) = ObjPtr(head) Then                 'objptr返回对象的地址
             Exit Sub                                          'strptr返回变长字符串的字符串数据地址
        End If                                                 'varptr返回变量的地址
        DoEvents                                               '用与获取变量地址，是函数。
Wend
End If
End Sub

Private Sub Command10_Click()

End Sub

Private Sub Command1_Click()
Dim TotalH2Num As Long
ConnectDMDB1000
Dim TransLenNum As Long
Dim TransItemString As String
Dim strlen As Long
Dim a As Integer
a = 0
Dim SpareTime1, SpareTime2 As String
strlen = 0
Gendata_rs.MoveFirst
TotalTransNum = 0
Dim L1Temp() As ItemNode
ReDim L1Temp(0 To ItemUpperBound - 1)
Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    TotalTransNum = TotalTransNum + 1
    TransItemString = Trim(TransItemString)
    If InStr(1, TransItemString, "I013") Then
        If InStr(1, TransItemString, "I012") Then
            a = a + 1
        End If
    End If
    Gendata_rs.MoveNext

Loop
MsgBox CStr(a)
End Sub


Private Sub AddRndItem_Click()
ConnectDMDB100000_250
RndGenItem 101, 250
End Sub

Private Sub Cmd1000to10002_Click()
ConnectDMDB100000_250
Gendata_rs.MoveFirst
Dim ID As Long
Dim TransItemStrOld As String
ID = 1
Do Until ID > 99000
ID = Gendata_rs!ID
TransItemStrOld = Gendata_rs!item
Gendata_rs_2.AddNew
Gendata_rs_2!item = TransItemStrOld
Gendata_rs_2.Update
Gendata_rs_2.MoveNext
Gendata_rs.MoveNext
Loop
MsgBox "123"
End Sub


Private Sub Command3_Click()
ConnectDMDB
Dim TransItemString As String
Gendata_rs.MoveFirst
Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    Gendata_rs.MoveNext
    ItemStringDecompose (TransItemString)
Loop
GenL1
GenC2
MsgBox "123"
End Sub
Private Sub Command6_Click()
Dim time1, time2 As Long
ConnectDMDB1000
Dim TransLenNum As Long
Dim TransItemString As String
Gendata_rs.MoveFirst
time1 = GetTickCount

Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    Gendata_rs.MoveNext
    TransItemString = Trim(TransItemString)
    TransLenNum = Len(TransItemString) / 4
    StrDecompose TransItemString, TransLenNum, 100
    If TransLenNum > 1 Then
        TransGen2Item TransItemString, TransLenNum
    End If
Loop

GenL1 (100)
time2 = GetTickCount
Sparetime = CStr((time2 - time1))
MsgBox Sparetime

GenC2
time1 = GetTickCount
Dim i, C2Turn As Long
'For i = 0 To C2TotalNum
    'C2turn =i
    'StrDecompose C2(i).ItemStr, 2
    Gendata_rs.MoveFirst
    Do Until (Gendata_rs.EOF)
        TransItemString = Gendata_rs!item
        For i = 0 To C2TotalNum                                 '''
            C2Turn = i                                          '''
            StrDecompose C2(i).ItemStr, 2, 100                      '''
            SubSet TransItemString, C2(i).ItemStr, C2Turn       '''
        Next i                                                  '''
        Gendata_rs.MoveNext
        'SubSet TransItemString, C2(i).ItemStr, C2Turn
    Loop
JudgeLargeItemSet
'Next i
WriteFile.Enabled = True
WriteFile.Show
End Sub
Private Sub Command7_Click()
ConnectDMDB
GenrndItem1920
End Sub

Private Sub Command8_Click()
Dim time1, time2 As Long
ConnectDMDB
Dim TransItemString As String
time1 = GetTickCount
Gendata_rs.MoveFirst
Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    Gendata_rs.MoveNext
    ItemStringDecompose (TransItemString)
Loop
time2 = GetTickCount
MsgBox CStr((time2 - time1) / 1000)

End Sub

Private Sub Command9_Click()

End Sub

Private Sub Form_Unload(Cancel As Integer)
Gendata_rs.Close
Gendata_cnn.Close
End Sub

Private Sub GenL2ByH2_Click()
Dim time1, time2, time3 As Long
Dim TotalH2Num As Long
ConnectDMDB1000
Dim TransLenNum As Long
Dim TransItemString As String
Dim strlen As Long
Dim SpareTime1, SpareTime2 As String
strlen = 0
Gendata_rs.MoveFirst
time1 = GetTickCount
TotalTransNum = 0
Dim L1Temp() As ItemNode
ReDim L1Temp(0 To ItemUpperBound - 1)
Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    TotalTransNum = TotalTransNum + 1
    Gendata_rs.MoveNext
    TransItemString = Trim(TransItemString)
    TransLenNum = Len(TransItemString) / 4
    StrDecompose TransItemString, TransLenNum, ItemUpperBound, L1Temp
    strlen = strlen + TransLenNum
    If TransLenNum > 1 Then
        TransGen2Item TransItemString, TransLenNum
    End If
Loop

GenL1 ItemUpperBound, L1Temp
time2 = GetTickCount
SpareTime1 = CStr((time2 - time1))
'MsgBox Sparetime
GenL2 ItemUpperBound, H2, TotalH2Num
time3 = GetTickCount
SpareTime2 = CStr((time3 - time2))
Dim i, j, k As Long
Dim filename As String
filename = "ResultFile" + CStr(ItemUpperBound) + CStr(TotalTransNum) + ".dat"
Open filename For Append As #1 ' 打开输出文件
Print #1, "this is a result file of Apiror"
Print #1, "threshhold1"; "     "; SupportThreshold1
Print #1, "threshhold2"; "     "; SupportThreshold2
Print #1, "confidence"; "     "; ConfidenceThreshold
Print #1, "Itemupperbound"; " "; ItemUpperBound
Print #1, "L1Num"; "          "; L1Num
Print #1, "L2Num"; "          "; L2Num
Print #1, "strlen"; "         "; strlen
Print #1, "sparetime1"; "      "; SpareTime1
Print #1, "sparetime2"; "      "; SpareTime2
Print #1, "TotalH2Num"; "      "; TotalH2Num
Print #1, "H2CountMax"; "      "; H2CountMax
Print #1, "TotalTransNum"; "   "; TotalTransNum
For j = 0 To ItemUpperBound - 1
    Print #1, j; "                "; L1Temp(j).ItemStr; "    "; L1Temp(j).ItemStrCount
Next j
For i = 0 To L1Num - 1
    Print #1, i; "                "; L1(i).ItemStr; "    "; L1(i).ItemStrCount
Next i
For k = 0 To L2Num - 1
    Print #1, k; "                "; L2(k).ItemStr; "    "; L2(k).ItemStrCount
Next k
Close #1
End Sub

Private Sub TestDBVisitTime_Click()
Dim time1, time2 As Long
ConnectDMDB
Dim TransItemString As String
time1 = GetTickCount
Gendata_rs.MoveFirst
Do Until (Gendata_rs.EOF)
    TransItemString = Gendata_rs!item
    Gendata_rs.MoveNext
    ItemStringDecompose (TransItemString)
Loop
time2 = GetTickCount
MsgBox CStr((time2 - time1) / 1000)

End Sub

Private Sub TestH2_Click()
Dim i, j, itemnum, H2num, firstnum, secondnum As Long
itemnum = 10
firstnum = 9
secondnum = 10
H2num = 0
For i = 2 To firstnum
    H2num = H2num + (itemnum - i + 1)
Next i
H2num = H2num + (secondnum - firstnum)
MsgBox CStr(H2num)
End Sub

Private Sub TestStrDecold_Click()
Dim item(1 To 100) As Long
Dim mystring, mychar As String
Dim beginpos, endpos, pos, strlen, Num As Long
mystring = "I2I6I12I21I23I45I56I66I77I80I99"
mychar = "I"
beginpos = 1 + 1
endpos = 1
strlen = Len(mystring)
Do While (InStr(beginpos, mystring, mychar, vbTextCompare))
    pos = InStr(beginpos, mystring, mychar, vbTextCompare)
    Num = Val(Mid(mystring, beginpos, (pos - beginpos)))
    item(Num) = item(Num) + 1
    beginpos = pos + 1
Loop
    Num = Val(Mid(mystring, beginpos, (strlen - beginpos)))
    item(Num) = item(Num) + 1

End Sub

Private Sub testStrDecompose_Click()
Dim string1 As String
string1 = "I2I3I5I15I20I23I34I45I56I67I79"
StrDecompose string1, 11
MsgBox "asdfasdf"
End Sub

Private Sub writedb1000_Click()
ConnectDMDB1000
NormalDistributing (1000)
'TotalTransNum = 0
GenrndItem (100)
MsgBox ""
End Sub

Private Sub writedb10000_Click()
ConnectDMDB10000
NormalDistributing (10000)
TotalTransNum = 0
GenrndItem (1000)

End Sub

Private Sub writeDB100000_Click()
ConnectDMDB100000
NormalDistributing (100000)
TotalTransNum = 0
GenrndItem (1000)
End Sub

Private Sub writedb100000250_Click()
ConnectDMDB100000_250
NormalDistributing (99900)
TotalTransNum = 0
GenrndItem (250)
End Sub