【原创】R语言如何实现关联分析(附实现代码)

来源: 数据与算法之美 作者: 炫炫有牛腩 | 发布时间: 2016-05-04 17:45:00

在当问卷调查数据回收后,应该如何进行分析?


在当问卷调查数据回收后,应该如何进行分析?对于单变量,问卷调查软件一般都可以自动生成数据图表查看结果,例如问卷星等:


但是如果我们想分析多个变量之间的交叉影响时,应该怎么办,例如一线城市的人通常怎么认为支付宝的安全程度,或者认为支付宝相对安全的人大部分是怎样人群?


本文介绍R中用最经典的Apriori关联算法对问卷调查结果进行简单的关联分析,包括对规则的筛选,输出以及可视化。


关联规则初始用于解决购物篮问题,通常买这些商品的人还会买什么商品,同理,我们思考填问卷的人通常选择了这些选项的人会还有选择什么选项。


一.数据介绍

数据包含360份问卷对14个问题的答案,类似下表:



二.R语言实现代码

## 读取数据,转换成transaction格式

data <- read.csv("xxx.csv", stringsAsFactors= F)

transaction <- as.transaction(data[,-1],data[,1])

 

## 关联分析,设置support,confidence

rules <- apriori(transaction, parameter = list(support= 0.5,confidence = 0.7)) #提取支持度大于0.5,提升都大于0.7的规则

## 对结果按照lift排序

quality(rules) <- round(quality(rules), 3)

rules.sorted <- sort(rules, by="lift")

 

## 消除冗余项,自定义冗余,我的定义如下:

#类型一:同时存在 1){A,B}=>{D}   2){A,B,C}=>{D},则1)是冗余项

#类型二:同时存在 1){A,B}=>{C}   2){A,B,C}=>{D},则1)是冗余项

supersetLhs <- is.superset(rules.sorted@lhs,rules.sorted@lhs)  

supersetAll <- is.superset(rules.sorted, rules.sorted)

superset <- supersetLhs==supersetAll&supersetLhs==T&supersetAll==T

redundant <- colSums(superset, na.rm = T) == 1

rules.pruned <- rules.sorted[redundant]

inspect(rules.pruned)#查看结果

 

### 规则项的数据格式S6格式并不能直接转换成data.frame,自定义function: inspect.frame

### 转换成data.frame输出规则

RuleFrame <- inspect.frame(rules.pruned, itemSep=",")

write.csv(RuleFrame, "rstRuleFrame.csv")

 

## 有时我们想单独提取某个规则项,编写function: Rhs_Selecet,方便提取规则项,进行分析

## 如rhs=“相对安全”,然后对结果进行分析

rstRule <- Rhs_Select(rules.pruned, "相对安全")

inspect(rstRule )




三. 子函数

  • 数据处理:as.transaction

  • Rhs的提取函数:Rhs_Select

  • 将规则转换成数据框输出:inspect.frame

 

##数据转换,先转换成List格式,再转换成transaction格式。

as.transaction <- function(data,f){

  dataList <-split(data, f)

  dataList <-lapply(dataList, function(x){

    rst <-unlist(x)

    names(rst)<- NULL

    rst <-unique(rst)

    rst <-rst[-which(rst=="")]

    rst

    })

  transaction <-as(dataList, "transactions")

  transaction

}

 

##右提取规则

Rhs_Selecet <- function(rules.pruned,char){

  rhs <-rules.pruned@rhs@itemInfo[(rules.pruned@rhs@data@i)+1,]

  loc <-which(rhs == char)

  rules.pruned[loc]

}

 

##转换成data.frame格式,先提取Lhs,并连接成一个字符串

##再提取Rhs,quality,组成一个数据框

inspect.frame <- function(rules.pruned,itemSep = ","){

  ##Lhs处理

  #提取Lhs长度

  lhsNum <-diff(rules.pruned@lhs@data@p)

  #产生标签

  lhsRuleItemsLOC<- NULL

  for(i in1:length(lhsNum)){

    lhsRuleItemsLOC<- c(lhsRuleItemsLOC, rep(i, lhsNum[i]))

  }

  #提取Rhs,组合成字符串, 链接符号默认“,”

  lhsRuleItems <-rules.pruned@lhs@itemInfo[rules.pruned@lhs@data@i+1,]

  lhsRuleItemsList<- split(lhsRuleItems, lhsRuleItemsLOC)

  lhs <-sapply(lhsRuleItemsList, function(x){

    lhs <- x[1]

    if(length(x)>1){

      for(i in2:length(x)){

        lhs <-paste(lhs, x[i], sep=itemSep)

      }

    }

    lhs

  })

  ##lhs处理

  rhs <-rules.pruned@rhs@itemInfo[(rules.pruned@rhs@data@i)+1,]

  ##整理结果成数据框

  csq <-data.frame(lhs, rhs, rules.pruned@quality)

  csq

}


. 可视化

###全部规则,气泡图,大小表示support,颜色表示Lift

library(arulesViz)

plot(rules.pruned, method = "grouped")


###部分规则,项集有向图,大小表示support,颜色表示Lift

plot(rstRule, method = "graph",control=

         list(edgeCol="black",  main="rhs=`相对安全`"))    


本文为原创文章,转载请联系本公众号

作者:炫炫有牛腩


长按二维码关注,回复“精选”


呵呵,关注这个号的人运气不会太差

公众号导航