数据挖掘实验（三）：Apriori算法 R语言

一、 实验目的：

使用逐层迭代方法基于候选产生找出频繁项集

二、 实验软件：

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)

运行结果：