在R中用最經典的Apriori關聯演算法對問卷調查結果進行簡單的關聯分析，包括對規則的篩選，輸出以及視覺化。

主流程

主流程包括4個部分，資料介紹，關聯分析主流程程式碼，主流程子程式碼，視覺化。

資料介紹

資料包含360份問卷對14個問題的答案，類似下表：

關聯分析主流程

##讀取資料，轉換成transaction格式
 

data <- read.csv("xxx.csv", stringsAsFactors = F)
transaction <- as.transaction(data[,-1],data[,1]) 

##關聯分析，設定support,confidence,對結果按照lift排序
rules <- apriori(transaction, parameter = list(support = 0.5, confidence = 0.7))
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([email protected], [email protected])   
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)#檢視結果

###轉換成data.frame輸出規則 
RuleFrame <- inspect.frame(rules.pruned, itemSep=",") 
write.csv(RuleFrame, "rstRuleFrame.csv")

##提取想要分析的RHS項，如rhs=“相對安全”，然後對結果進行分析
rstRule <- Rhs_Selecet(rules.pruned, "相對安全")
inspect(rstRule )
      lhs                           rhs       support confidence lift 
93  {安全性,線上購物支付}          => {相對安全} 0.506   0.809      1.087
168 {使用方便,線上購物支付,支付寶} => {相對安全} 0.503   0.757      1.017
32  {一線城市}                     => {相對安全} 0.511   0.745      1.001

主流程中的子函式

上述的主流程裡包含3個子函式：

• 資料處理：as.transaction；
• Rhs的提取函式：Rhs_Selecet；
• 將規則轉換成資料框格式輸出: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 <- [email protected]@itemInfo[([email protected]@[email protected])+1,]
  loc <- which(rhs == char)
  rules.pruned[loc]
}


##轉換成data.frame格式，先提取Lhs，並連線成一個字串
##再提取Rhs,quality,組成一個數據框
inspect.frame <- function(rules.pruned, itemSep = ","){
  ##Lhs處理
  #提取Lhs長度
  lhsNum <- diff([email protected]@[email protected])
  #產生標籤
  lhsRuleItemsLOC <- NULL
  for(i in 1:length(lhsNum)){
    lhsRuleItemsLOC <- c(lhsRuleItemsLOC, rep(i, lhsNum[i]))
  }
  #提取Rhs，組合成字串, 連結符號預設“，”
  lhsRuleItems <- [email protected]@itemInfo[[email protected]@[email protected]+1,]
  lhsRuleItemsList <- split(lhsRuleItems, lhsRuleItemsLOC)
  lhs <- sapply(lhsRuleItemsList, function(x){
    lhs <- x[1]
    if(length(x)>1){
      for(i in 2:length(x)){
        lhs <- paste(lhs, x[i], sep=itemSep)
      }
    }
    lhs
  })

  ##lhs處理
  rhs <- [email protected]@itemInfo[([email protected]@[email protected])+1,]

  ##整理結果成資料框
  csq <- data.frame(lhs, rhs, [email protected])
  csq
}

視覺化

全部規則的視覺化，以及預分析Rhs項的視覺化

###全部規則,氣泡圖，大小表示support，顏色表示Lift
library(arulesViz)
plot(rules.pruned, method = "grouped")

###部分規則,項集有向圖，大小表示support，顏色表示Lift
plot(rstRule, method = "graph",control = 
          list(edgeCol="black",  main="rhs=`相對安全`"))