求R语言 Min-apriori算法程序包

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

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

立即领取

感谢您参与论坛问题回答

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

+2 论坛币

请问各位大牛 哪里能找到关联规则 min-apriori算法的程序包

要找程序包可以到哪里搜？

扫码加我 拉你入群

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

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

分享0 收藏0 回帖

关键词：Apriori算法 Apriori Priori PRIOR Apr 程序

自己写了一个 供参考

1. ##function:nextlist
   
2. ## -input:频繁k-项集
   
3. ## -output:候选(k+1)-项集
   
4. nextlist <- function(old_list){
   
5.         z <- 1
   
6.         len <- length(old_list)
   
7.         new_list <- c()
   
8.         stgnum <- length(old_list[[1]])
   
9.         if(len==1) return(new_list)
   
10.         for (i in 1:(len-1)){
    
11.                 for(j in (i+1):len){
    
12.                         if(sum((old_list[[i]]==old_list[[j]])[1:(stgnum-1)])==(stgnum-1)){
    
13.                                 #仅当前k-1项相同,才合并两项
    
14.                                 temp <- unique(c(old_list[[i]],old_list[[j]]))
    
15.                                 if (subpart(temp,old_list)==1){
    
16.                                         new_list[[z]] <- temp
    
17.                                         z <- z + 1
    
18.                                         }
    
19.                                 #检查新产生的项是否包含非频繁项集
    
20.                                 }
    
21.                         }
    
22.                 }               
    
23.         new_list <- unique(new_list)
    
24.         return(new_list)
    
25.         }
    
26. 
    
27.        
    
28. #function:subpart
    
29. #-input:k-vector
    
30. #-output:if all (k-1)-subsets in orig_list
    
31. subpart <- function(vec,orig_list){
    
32.         len <- length(vec)
    
33.         vecsub <- c()
    
34.         if (len<=2) return(1)
    
35.         a <- 1
    
36.         for (i in 1:(len-2)){
    
37.                  temp <- ifinlist(vec[-i],orig_list)
    
38.                  if (temp==0) {
    
39.                         a <- 0
    
40.                         break
    
41.                         }
    
42.                 }
    
43.         return(a)
    
44.         }
    
45. 
    
46. #function:ifinlist
    
47. #-input:vector
    
48. #-output:if the vector in list
    
49. ifinlist <- function(vec,orig_list){
    
50.         len <- length(vec)
    
51.         a <- 0
    
52.         for (i in 1:length(orig_list)){
    
53.                 if (sum(vec==orig_list[[i]])==len){
    
54.                         a <- 1
    
55.                         break
    
56.                         }
    
57.                 }
    
58.         return(a)
    
59.         }       
    
60. 
    
61. 
    
62. SelecteData <- function(item,Base){
    
63.         if (length(item)==0){
    
64.                 print("warming:there's no selected data")
    
65.                 return(0)
    
66.                 }else{
    
67.                         len <- length(item)
    
68.                         selected_data <- c()
    
69.                         for (i in 1:len){
    
70.                                 tag <- match(item[[i]],names(Base))
    
71.                                 selected_data <- cbind(selected_data,Base[,tag])
    
72.                                 }
    
73.                         return(as.data.frame(selected_data))
    
74.                         }
    
75.         }
    
76.        
    
77.        
    
78. minApriori <- function(orig_list,Base,threshold_min){
    
79.         varnum <- dim(Base)[2]
    
80.         list1 <- orig_list
    
81.         #list1用于迭代
    
82.         #list2是符合阀值的list1
    
83.         stginfo <- c()
    
84.         z2 <- 1
    
85.         stgnum <- 1
    
86.         while (length(list1)>=1&stgnum<varnum){
    
87.                 list2 <- c()
    
88.                 list2_support <- c()
    
89.                 z <- 1
    
90.                 jishu <- 1   
    
91.                 for(i in list1){
    
92.                         stgnum <- length(i)
    
93.                         temp_data <- SelecteData(i,Base)
    
94.                         temp_support <- sum(apply(temp_data,1,min))
    
95.                         if (temp_support >= threshold_min){
    
96.                                 list2[[z]] <- i
    
97.                                 z <- z + 1
    
98.                                 list2_support <- c(list2_support,temp_support)
    
99.                                 }
    
100.                         jishu <- jishu + 1
     
101.                         print(jishu)
     
102.                         }
     
103.                 list3 <- matrix(unlist(list2),ncol=stgnum,byrow=T)
     
104.                
     
105.                 temp_stginfo <- cbind(list3,list2_support)
     
106.                 stginfo[[z2]] <- temp_stginfo
     
107.                
     
108.                 list1 <- nextlist(list2)
     
109.                 z2 <- z2 + 1
     
110.                 print(length(list1))
     
111.                 }
     
112.         return(stginfo)
     
113.         }
     
114.        

复制代码

suhui0723 发表于 2014-12-12 20:48
自己写了一个 供参考

要不要这么凶残，arules包里不是有么