Mining Associations with Apriori Algorithm using R

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

1. #clean the workspace and memory
   
2. rm( list=ls() )
   
3. gc()
   
4. 
   
5. tbl <- read.csv("data/itemsets001.csv", header=FALSE)
   
6. tbl <- as.matrix(tbl)
   
7. colnames(tbl) <- NULL
   
8. itemsets <- tbl
   
9. items <- c(1,2,3,4,5)
   
10. min_sup <- 0.22*nrow(itemsets)
    
11. 
    
12. #######
    
13. #        Algorithm: Apriori,
    
14. #                generate the frequent itemsets from the input datasets with the specified support
    
15. #        Input:
    
16. #                data, MATRIX
    
17. #                base_items, VECTOR
    
18. #                MIN_SUP, FLOAT
    
19. #                parameter,
    
20. #######
    
21. Apriori <- function(data,base_items,MIN_SUP,parameter=NULL){
    
22.         f <- InitCandidateSet(data,base_items)
    
23.         c <- list()
    
24.         c[[1]] <- FindFrequentItemset(f,base_items,1,MIN_SUP)
    
25.         k <- 2
    
26.         len4data <- GetDatasetSize(data)
    
27.         while( !IsEmpty(c,k-1) ){
    
28.                 f[[k]] <- AprioriGen(c,k-1)
    
29.                 if(length(f)==k){
    
30.                         f[[k]] <- IncreaseSupportCount(f[[k]],data)
    
31.                         c[[k]] <- FindFrequentItemset(f,base_items,k,MIN_SUP)               
    
32.                 }else{break}
    
33.                 k <- k+1
    
34.         }
    
35.         c
    
36. }
    
37. 
    
38. AprioriGen <- function(c,k){
    
39.         ck <- c[[k]][,-ncol(c[[k]])]
    
40.         f <- NULL
    
41.         len <- nrow(ck)
    
42.         for(idx in seq(nrow(ck))){
    
43.                 jdx <- idx+1
    
44.                 while(idx<jdx && jdx<=len){
    
45.                         a <- ck[idx,]
    
46.                         b <- ck[jdx,]
    
47.                         if( k==1 || identical(a[1:(k-1)],b[1:(k-1)]) ){
    
48.                                         ab <- ifelse(a+b,1,0)
    
49.                                         if( !NeedPrune(ck,ab,k) ){
    
50.                                                 f <- rbind(f,ab)
    
51.                                         }else{
    
52.                                                 #print("Pruned")
    
53.                                         }
    
54.                         }
    
55.                         jdx <- jdx + 1
    
56.                 }
    
57.         }
    
58. 
    
59.         if(length(f)){
    
60.                  f <- cbind(f,rep(0,dim(f)[1]))
    
61.                  rownames(f) <- NULL
    
62.         }
    
63.         return(f)
    
64. }
    
65. 
    
66. NeedPrune <- function(ck,ab,k){
    
67.         ck <- rbind(ck,ab)
    
68.         len <- dim(ck)[1]
    
69.         for(idx in which(ab>0)){
    
70.                 temp <- ab
    
71.                 temp[idx] <- 0
    
72.                 for(idx in seq(len)){
    
73.                         if(identical(temp,ck[idx,]))break
    
74.                 }
    
75.                 if(idx==len)return(TRUE)
    
76.         }
    
77.         return(FALSE)
    
78. }
    
79. 
    
80. IncreaseSupportCount <- function(fk,data){
    
81.         w4f <- ncol(fk)
    
82.         len4f <- nrow(fk)
    
83.         len4d <- nrow(data)
    
84.         for(idx in seq(len4d)){
    
85.                 for(jdx in seq(len4f)){
    
86.                         if(identical(fk[jdx,-w4f],fk[jdx,-w4f]*data[idx,])){
    
87.                                 fk[jdx,w4f] <- fk[jdx,w4f] + 1
    
88.                         }
    
89.                 }
    
90.         }
    
91.         return(fk)
    
92. }
    
93. 
    
94. IsEmpty <- function(ck,k){
    
95.         return(ifelse(nrow(ck[[k]])>0,FALSE,TRUE))
    
96. }
    
97. 
    
98. GetDatasetSize <- function(data){
    
99.         return( nrow(data) )
    
100. }
     
101. 
     
102. InitCandidateSet <- function(data,base_items){
     
103.         list(cbind(diag(length(base_items)),apply(data,2,sum)))
     
104. }
     
105. 
     
106. FindFrequentItemset <- function(fk,base_items,k,MIN_SUP){
     
107.         data <- fk[[k]]
     
108.         return(data[data[,dim(data)[2]]>MIN_SUP,])
     
109. }
     
110. 
     
111. frequent_itemsets <- Apriori(itemsets,items,min_sup)
     
112. print(frequent_itemsets)

复制代码

Reference

• Learning Data Mining with R
• Bater Makhabel
• Published 2015-01-31
  

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：associations Association Algorithm Apriori Priori

1. > #clean the workspace and memory
   
2. > rm( list=ls() )
   
3. > gc()
   
4.          used (Mb) gc trigger (Mb) max used (Mb)
   
5. Ncells 266431 14.3     407500 21.8   350000 18.7
   
6. Vcells 476429  3.7     905753  7.0   786396  6.0
   
7. >
   
8. > tbl <- read.csv("data/itemsets001.csv", header=FALSE)
   
9. > tbl <- as.matrix(tbl)
   
10. > colnames(tbl) <- NULL
    
11. > itemsets <- tbl
    
12. > items <- c(1,2,3,4,5)
    
13. > min_sup <- 0.22*nrow(itemsets)
    
14. >
    
15. > #######
    
16. > #        Algorithm: Apriori,
    
17. > #                generate the frequent itemsets from the input datasets with the specified support
    
18. > #        Input:
    
19. > #                data, MATRIX
    
20. > #                base_items, VECTOR
    
21. > #                MIN_SUP, FLOAT
    
22. > #                parameter,
    
23. > #######
    
24. > Apriori <- function(data,base_items,MIN_SUP,parameter=NULL){
    
25. +         f <- InitCandidateSet(data,base_items)
    
26. +         c <- list()
    
27. +         c[[1]] <- FindFrequentItemset(f,base_items,1,MIN_SUP)
    
28. +         k <- 2
    
29. +         len4data <- GetDatasetSize(data)
    
30. +         while( !IsEmpty(c,k-1) ){
    
31. +                 f[[k]] <- AprioriGen(c,k-1)
    
32. +                 if(length(f)==k){
    
33. +                         f[[k]] <- IncreaseSupportCount(f[[k]],data)
    
34. +                         c[[k]] <- FindFrequentItemset(f,base_items,k,MIN_SUP)               
    
35. +                 }else{break}
    
36. +                 k <- k+1
    
37. +         }
    
38. +         c
    
39. + }
    
40. >
    
41. > AprioriGen <- function(c,k){
    
42. +         ck <- c[[k]][,-ncol(c[[k]])]
    
43. +         f <- NULL
    
44. +         len <- nrow(ck)
    
45. +         for(idx in seq(nrow(ck))){
    
46. +                 jdx <- idx+1
    
47. +                 while(idx<jdx && jdx<=len){
    
48. +                         a <- ck[idx,]
    
49. +                         b <- ck[jdx,]
    
50. +                         if( k==1 || identical(a[1:(k-1)],b[1:(k-1)]) ){
    
51. +                                         ab <- ifelse(a+b,1,0)
    
52. +                                         if( !NeedPrune(ck,ab,k) ){
    
53. +                                                 f <- rbind(f,ab)
    
54. +                                         }else{
    
55. +                                                 #print("Pruned")
    
56. +                                         }
    
57. +                         }
    
58. +                         jdx <- jdx + 1
    
59. +                 }
    
60. +         }
    
61. +
    
62. +         if(length(f)){
    
63. +                  f <- cbind(f,rep(0,dim(f)[1]))
    
64. +                  rownames(f) <- NULL
    
65. +         }
    
66. +         return(f)
    
67. + }
    
68. >
    
69. > NeedPrune <- function(ck,ab,k){
    
70. +         ck <- rbind(ck,ab)
    
71. +         len <- dim(ck)[1]
    
72. +         for(idx in which(ab>0)){
    
73. +                 temp <- ab
    
74. +                 temp[idx] <- 0
    
75. +                 for(idx in seq(len)){
    
76. +                         if(identical(temp,ck[idx,]))break
    
77. +                 }
    
78. +                 if(idx==len)return(TRUE)
    
79. +         }
    
80. +         return(FALSE)
    
81. + }
    
82. >
    
83. > IncreaseSupportCount <- function(fk,data){
    
84. +         w4f <- ncol(fk)
    
85. +         len4f <- nrow(fk)
    
86. +         len4d <- nrow(data)
    
87. +         for(idx in seq(len4d)){
    
88. +                 for(jdx in seq(len4f)){
    
89. +                         if(identical(fk[jdx,-w4f],fk[jdx,-w4f]*data[idx,])){
    
90. +                                 fk[jdx,w4f] <- fk[jdx,w4f] + 1
    
91. +                         }
    
92. +                 }
    
93. +         }
    
94. +         return(fk)
    
95. + }
    
96. >
    
97. > IsEmpty <- function(ck,k){
    
98. +         return(ifelse(nrow(ck[[k]])>0,FALSE,TRUE))
    
99. + }
    
100. >
     
101. > GetDatasetSize <- function(data){
     
102. +         return( nrow(data) )
     
103. + }
     
104. >
     
105. > InitCandidateSet <- function(data,base_items){
     
106. +         list(cbind(diag(length(base_items)),apply(data,2,sum)))
     
107. + }
     
108. >
     
109. > FindFrequentItemset <- function(fk,base_items,k,MIN_SUP){
     
110. +         data <- fk[[k]]
     
111. +         return(data[data[,dim(data)[2]]>MIN_SUP,])
     
112. + }
     
113. >
     
114. > frequent_itemsets <- Apriori(itemsets,items,min_sup)
     
115. > print(frequent_itemsets)
     
116. [[1]]
     
117.      [,1] [,2] [,3] [,4] [,5] [,6]
     
118. [1,]    1    0    0    0    0    6
     
119. [2,]    0    1    0    0    0    7
     
120. [3,]    0    0    1    0    0    6
     
121. [4,]    0    0    0    1    0    2
     
122. [5,]    0    0    0    0    1    2
     
123. 
     
124. [[2]]
     
125.      [,1] [,2] [,3] [,4] [,5] [,6]
     
126. [1,]    1    1    0    0    0    4
     
127. [2,]    1    0    1    0    0    4
     
128. [3,]    1    0    0    0    1    2
     
129. [4,]    0    1    1    0    0    4
     
130. [5,]    0    1    0    1    0    2
     
131. [6,]    0    1    0    0    1    2
     
132. 
     
133. [[3]]
     
134.      [,1] [,2] [,3] [,4] [,5] [,6]
     
135. [1,]    1    1    1    0    0    2
     
136. [2,]    1    1    0    0    1    2
     
137. 
     
138. >

复制代码