一、 实验目的：
使用逐层迭代方法基于候选产生找出频繁项集
二、 实验软件：
Rstudio
三、 源代码：
#1数据准备并统计数据频数
da1<-c("A","B","C","F","E")
da2<-c("B","C","E")
da3<-c("A","C","D")
listda<-list(da1,da2,da3)
data<-as.data.frame(table(unlist(listda)))
Apriori<-function(data,listda,min_sup){
#n项统计频数.....
test<-function(re,lis){
req<-c() #记录数据框中每行数据在整个列表中出现的频次
for(i in 1:nrow(re)){
count<-0 #记录数据框中每次每行数据出现的频次
for(j in 1:length(lis)){
if(all(as.vector(as.matrix(re[i,])) %in% lis[[j]])){ #判断给出的数据是每个列表数据的子集
count<-count+1
}
}
req[i]<-count
}
return(req)
}
#剪枝，即选取满足最小支持度数的项集
reduce<-function(data,min_sup){
test1<-subset(data,data[,ncol(data)]>min_sup)
}
#一项集剪枝
ad<-as.data.frame(data[,-ncol(data)])
re1<-test(ad,listda)
con1<-cbind(ad,re1)
con1<-reduce(con1,min_sup)
con1<-con1[order(con1[,1]),]
#一项自连接,并进行二项剪枝
ad2<-t(combn(con1[,-ncol(con1)],2))
re2<-test(ad2,listda)
aa<-as.data.frame(ad2)
con2<-cbind(aa,re2)
con2<-con2[1:nrow(ad2),]
con2<-reduce(con2,min_sup)
#二项自连接，并进行三项剪枝
ad3<-t(combn(con2[,-ncol(con2)],3))
ad3<-unique.matrix(ad3)
lis<-list()
norep<-function(ad3){
for(i in 1:nrow(ad3)){
if(length(unique(ad3[i,]))>=3){
lis[[i]]<-ad3[i,]
}
}
return(lis)
}
qq<-norep(ad3)
#寻找不为空的列表行数
l<-list()
nonull<-function(list){
index<-0
j<-1
for(i in 1:length(qq)){
if(is.null(qq[[i]])){
index[j]<-i
j<-j+1
}
}
index2<-(1:length(qq))[-index]
for(i in 1:length(index2)){
l[[i]]<-qq[[index2[i]]]
}
f<-as.data.frame(l)
names(f)<-c("v1","v2","v3","v4")
f<-as.data.frame(t(f))
return(f)
}
ad31<-nonull(qq)
ad31
#对三项集进行剪枝
re3<-test(ad31,listda)
ad3<-as.data.frame(ad31)
con3<-cbind(ad3,re3)
con3<-con3[1:nrow(ad3),]
con3<-reduce(con3,min_sup)
con1
con2
con3
#计算支持度,因最后只有一个数据集，支持度均一样
con1sup<-function(con3,list){
sup<-c()
for(i in 1:nrow(con3)){
sup[i]<-con3[i,ncol(con3)]/length(list)
}
return(sup)
}
consup<-con1sup(con3,listda)
#求可信度
dd<-con3[,-ncol(con3)]
d1<-cbind(dd[,1],"=>",dd[,2:3])
fj<-data.frame(dd[,1],dd[,3])
d2<-cbind(dd[,2],"=>",fj)
d3<-cbind(dd[,3],"=>",dd[,1:2])
f1<-cbind(dd[,2:3],"=>",dd[,1])
f2<-cbind(fj,"=>",dd[,2])
f3<-cbind(dd[,1:2],"=>",dd[,3])
names(d1)<-c("v1","v2","v3","v4")
names(d2)<-c("v1","v2","v3","v4")
names(d3)<-c("v1","v2","v3","v4")
names(f1)<-c("v1","v2","v3","v4")
names(f2)<-c("v1","v2","v3","v4")
names(f3)<-c("v1","v2","v3","v4")
resultframe<-rbind(d1,d2,d3,f1,f2,f3)
d1<-con3[,ncol(con3)]/con1[2,ncol(con1)]
d2<-con3[,ncol(con3)]/con1[3,ncol(con1)]
d3<-con3[,ncol(con3)]/con1[4,ncol(con1)]
f1<-con3[,ncol(con3)]/con2[2,ncol(con2)]
f2<-con3[,ncol(con3)]/con1[2,ncol(con2)]
f3<-con3[,ncol(con3)]/con1[2,ncol(con2)]
conf<-t(data.frame(d1,d2,d3,f1,f2,f3))
resultdata<-cbind(resultframe,consup,conf)
return(resultdata)
}
Apriori(data,listda,1)
运行结果：