はじめに

　このTipsでは、アソシエーション分析の結果を Gephi で描画する手順(注1)をご紹介します。アソシエーション分析とは、データから条件と結論の因果関係を見つけるための統計解析手法です。スーパーマーケットの買い物で一緒に買われる商品の組み合わせの発見に使われることから、バスケット分析とも言われています。多くのデータの組み合わせの中から、因果関係を効率的に見つけ出す事ができる「apriori(アプリオリ)」というアルゴリズムが一般的です。今回は、arules ライブラリの apriori を使用しました。詳しくは、CRAN のサイトを参照して下さい。Gephi は、ネットワーク解析及び可視化用オープンソースソフトウェアです。サポートされているグラフ形式が豊富で、簡単にデータをピンポートしてグラフ化することができます。詳しくは、Gephi のサイトを参照して下さい。

スーパーマーケットの買い物かごをアソシエーション分析してみる

利用するデータ

サンプルデータ「posdata.csv」

牛乳,食パン,ソーセージ,たまご
牛肉,サラダ油
せんべい
大福,お茶
幕の内弁当
レタス,トマト
牛肉,たまご,しらたき,春菊,豆腐,白菜,ねぎ,にんじん,しいたけ,えのきだけ,うどん,スープの素
牛肉,たまご,豆腐,白菜,にんじん,スープの素
もち,のり,お茶,梅干し
ガム
ハム,チーズ
バター,パスタ,オリーブ油,にんにく,コンソメ,鶏肉
ピーマン,アボカド
ビール,魚,オリーブ油,海藻,米,酢
魚, バター,パセリ,えのきだけ,キャベツ
～以下略～

アソシエーション分析

# 作業ディレクトリを指定する
setwd("作業ディレクトリ")
# アソシエーション分析のライブラリ(注2)を読み込む
library(arules)
# データが格納されたファイルの指定
posData <- "posdata.csv"
# スーパーマーケットの買い物かごのデータをトランザクションとして読み込む
tranPosData <- read.transactions(posData, sep=",", rm.duplicates=TRUE)
# apriori ファンクションを実行する
aprioriTranPosData <- apriori(tranPosData, parameter=list(supp=0.02, maxlen=3, confidence=0.8))

実行結果例

Parameter specification:
 confidence minval smax arem  aval originalSupport support minlen maxlen target   ext
        0.8    0.1    1 none FALSE            TRUE    0.02      1      3  rules FALSE

Algorithmic control:
 filter tree heap memopt load sort verbose
    0.1 TRUE TRUE  FALSE TRUE    2    TRUE

apriori - find association rules with the apriori algorithm
version 4.21 (2004.05.09)        (c) 1996-2004   Christian Borgelt
set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[104 item(s), 4183 transaction(s)] done [0.00s].
sorting and recoding items ... [61 item(s)] done [0.00s].
creating transaction tree ... done [0.00s].
checking subsets of size 1 2 3 done [0.00s].
writing ... [107 rule(s)] done [0.00s].
creating S4 object  ... done [0.00s].

# 分析結果の一部を参照する
inspect(head(sort(aprioriTranPosData, by="support"), n=100))

実行結果例(抜粋)

    lhs                  rhs            support     confidence lift
1   {バター}          => {魚}           0.06215635  0.8441558   9.267989
2   {パセリ}          => {えのきだけ}   0.05737509  1.0000000  10.353960
3   {パセリ}          => {キャベツ}     0.05355008  0.9333333  13.324687
4   {パセリ}          => { バター}      0.05355008  0.9333333  12.675758
5   {パセリ}          => {魚}           0.05355008  0.9333333  10.247069
6   {キャベツ,パセリ} => { バター}      0.05355008  1.0000000  13.581169
7   {バター,パセリ}   => {キャベツ}     0.05355008  1.0000000  14.276451
8   {バター,キャベツ} => {パセリ}       0.05355008  1.0000000  17.429167
9   {キャベツ,パセリ} => {魚}           0.05355008  1.0000000  10.979003
10  {パセリ,魚}       => {キャベツ}     0.05355008  1.0000000  14.276451

分析結果の説明

項目	説明
lhs	左辺を表す、left hand sideの略。条件部を意味します。
rhs	右辺を表す、right hand side の略。結論部を意味します。
support	支持度を表します。全トランザクションにおける条件と結論が同時に起こるケースの占める割合を意味します。
confidence	信頼度を表します。条件が起きたケースで結論が起きる割合を意味します。
lift	リフト値を表します。信頼度÷支持度であり、一般的に、リフト値＞ 1のケースで有効な因果関係があると見なします。

分析結果を、Gephi で描画する

# arules 型オブジェクトを、data.frame型に変換する
dataframeTranPosData <- as(aprioriTranPosData, "data.frame")
# ruleの内容を取り出して、ネットワークグラフのnodeオブジェクトを生成
rules <- dataframeTranPosData$rules
# データ型をcharacter型に型変換
rules <- as.character(rules)
# 条件部 {lhs} と 結果部 {rhs} を切り出して、別々のデータオブジェクトにする
rulesList <- strsplit(rules, "=>")
# for文のループ処理の中で、条件部 {lhs} と 結果部 {rhs} を分けて格納する変数を作成
# 初期値として値は0（ゼロ）を設定
nodeLabels <- as.data.frame(matrix(0, nrow=length(rulesList),ncol=2))
for(i in 1:length(rulesList)){
     nodeLabels[i,1] <-  rulesList[[i]][1]
     nodeLabels[i,2] <-  rulesList[[i]][2]
}
# nodeのID番号を採番する
nodesLhs <- rep(0, as.numeric(nrow(nodeLabels)))
nodesRhs <- rep(0, as.numeric(nrow(nodeLabels)))
for(i in 1:nrow(nodeLabels)){
     nodesLhs[i]  <- nodeLabels[i,1]
     nodesRhs[i]  <- nodeLabels[i,2]
}
#全ての条件部 {lhs} / 結果部 {rhs} を集めて、重複値を排除（一意集合をつくる）
nodesUnique <- unique(c(nodesLhs, nodesRhs))
nodesIDList <- data.frame(ID.NO=as.numeric(1:length(nodesUnique)), label=nodesUnique)
# ノード間の 条件部 {lhs} ⇒ 結果部 {rhs} ペアを、ノードID番号の数字ペアの行列データセットにする
nodesLhs <- data.frame(dummy=rep("X",length(nodesLhs)), label=as.vector(nodesLhs))
nodesRhs <- data.frame(dummy=rep("Y",length(nodesRhs)), label=as.vector(nodesRhs))
lhsNodes <- merge(nodesLhs, nodesIDList, by="label")
rhsNodes <- merge(nodesRhs, nodesIDList, by="label")
# dummy列を切り落として、ノードをつなぐエッジのデータを作成する
lhsNodes <- lhsNodes[,-2]
rhsNodes <- rhsNodes[,-2]
relations <- cbind(lhsNodes, rhsNodes)
# 条件部 {lhs} と 結果部 {rhs} のID.NOのみ取り出す
relations <- relations[ , c(-1,-3)]
# edgeの重み行列の生成
# 重み（weight）：　arules()関数 返り値の confidence 値 と定義
# support 値は小数点2桁に丸める
confidence <- dataframeTranPosData$confidence
weight <- round(confidence, 2)
support <- dataframeTranPosData$support
support <- round(support*20000000,1)
lift <- as.integer(order(dataframeTranPosData$lift)*1.5)

# GEXF ファイル出力のライブラリ(注3)を読み込む
library(rgexf)
# write.gexf() ファンクションを実行
Sys.setlocale('LC_ALL','C') 
nodesIDList2 <- nodesIDList
nodesIDList2[,2] <- iconv(nodesIDList2[,2],'SHIFT_JIS','UTF-8')
gexf.file <- write.gexf(nodes=nodesIDList2, edges=relations, edgesWeight=support)
# sink()関数で現在の作業ディレクトリにファイル出力
demogexf <- "demo.gexf"
sink(file=demogexf)
print(gexf.file)
sink()

　「demo.gexf」ファイルを Gephi で描画したグラフは次の通りです。スーパーマーケットの買い物かごデータであれば、同時に購入しているものの相関を分析することができます。(本 Tips では、ダミーデータのため、描画内容に意味はありません)

注釈

注1 GEXF ファイルの出力は、Ｒのアソシエーション分析結果をGephiでネットワーク描画を活用させて頂きました。ありがとうございました。
注2 arules のバージョンは、1.1-6 を使用しています。
注3 rgexf のバージョンは、0.14.3.11 を使用しています。

R言語 - アソシエーション分析 + Gephi描画