R {arules} によるアソシエーション分析をちょっと詳しく <2>
こちらの続き。
データの作り方 (承前)
単体の list や data.frame から arules::transactions インスタンスを作る方法は前回まとめた。
加えて、一般のデータでありえそうな 正規化された形を考える。サンプルは コンビニのPOSデータをイメージして、
の 2 テーブルからなるデータとする。必要な部分だけ抜き出すと、例えばこんな形。
library(arules) tran.df = data.frame(日時 = paste0('2014-12-22 ', seq(9, 20, 1), ':00'), レジ番号 = rep(1, 12), レシート番号 = seq(1, 12), 年齢層 = rep(c('30代', '20代', '10代'), 4)) goods.df = data.frame(レシート番号 = c(1, 2, 2, 3, 4, 4, 5, 6, 6, 6, 7, 7, 8, 8, 9, 9, 10, 10, 11, 12, 12), 購入商品 = c('おにぎり', 'コーラ', 'サンドイッチ', 'お茶', 'おにぎり', 'お茶', 'お茶', 'コーラ', 'サンドイッチ', 'お茶', 'おにぎり', 'サンドイッチ', 'おにぎり', 'お茶', 'サンドイッチ', 'コーラ', 'おにぎり', 'サンドイッチ', 'おにぎり', 'コーラ', 'サンドイッチ')) tran.df # 日時 レジ番号 レシート番号 年齢層 # 1 2014-12-22 9:00 1 1 30代 # 2 2014-12-22 10:00 1 2 20代 # 3 2014-12-22 11:00 1 3 10代 # 4 2014-12-22 12:00 1 4 30代 # 5 2014-12-22 13:00 1 5 20代 # 6 2014-12-22 14:00 1 6 10代 # 7 2014-12-22 15:00 1 7 30代 # 8 2014-12-22 16:00 1 8 20代 # 9 2014-12-22 17:00 1 9 10代 # 10 2014-12-22 18:00 1 10 30代 # 11 2014-12-22 19:00 1 11 20代 # 12 2014-12-22 20:00 1 12 10代 # レシート番号 購入商品 # 1 1 おにぎり # 2 2 コーラ # 3 2 サンドイッチ # 4 3 お茶 # 5 4 おにぎり # 6 4 お茶 # 7 5 お茶 # 8 6 コーラ # 9 6 サンドイッチ # 10 6 お茶 # 11 7 おにぎり # 12 7 サンドイッチ # 13 8 おにぎり # 14 8 お茶 # 15 9 サンドイッチ # 16 9 コーラ # 17 10 おにぎり # 18 10 サンドイッチ # 19 11 おにぎり # 20 12 コーラ # 21 12 サンドイッチ
これを 1 トランザクション = レシート番号ごとに集計して arules::transactions インスタンスにしたい。
まず goods.df を トランザクション形式にするためには、各アイテムをレシート番号単位でまとめたリストに変換 -> transactions 化すればよいので、以下のような関数 decanonicalize を作って、
library(magrittr) library(dplyr) decanonicalize <- function(row, rdf){ details <- rdf %>% dplyr::filter(レシート番号 == row$レシート番号) %>% magrittr::extract2('購入商品') %>% as.vector() } tran.list <- split(tran.df, rownames(tran.df)) tran <- lapply(tran.list, decanonicalize, goods.df) tran # $`1` # [1] "おにぎり" # ..... # $`12` # [1] "コーラ" "サンドイッチ" tran <- as(tran, 'transactions') LIST(tran) # $`1` # [1] "おにぎり" # ..... # $`12` # [1] "コーラ" "サンドイッチ"
さらに マスタの顧客属性 (ここでは年齢層のみ) を紐付けたい、なんて場合はそれぞれを arules::transactions にしてから merge。
tran.base <- as(select(tran.df, 年齢層), 'transactions') tran <- merge(tran.base, tran) LIST(tran) # [[1]] # [1] "年齢層=30代" "おにぎり" # ..... # [[12]] # [1] "年齢層=10代" "コーラ" "サンドイッチ"
補足 原則、何か前処理したい場合は arules::transactions 化する前に行って merge したほうが楽。例外は arules::addComplement (後述)。
補足 縦方向にトランザクションを追加したい場合は c(tran1, tran2)
ルール抽出時の前処理
arules::transactions インスタンスができたので、前回と同じく arules::apriori で普通のルール抽出ができるようになった。
# 経過出力を抑制 control <- list(verbose = FALSE) rules <- apriori(tran, parameter = list(support = 0.2), control = control) inspect(rules) # lhs rhs support confidence lift # 1 {コーラ} => {サンドイッチ} 0.3333333 1 2
ここで、あるアイテムを "含まない" 場合のルールを抽出したいことがある。そんなときは arules::addComplement を使って、トランザクションにダミーアイテムを追加してルール抽出すればよい。トランザクションに "コーラを含まない" 場合のダミーアイテム "!コーラ" を追加してルール抽出すると、
tran <- addComplement(tran, 'コーラ', '!コーラ') rules <- apriori(tran, parameter=list(support=0.2), control = control) inspect(rules) # lhs rhs support confidence lift # 1 {コーラ} => {サンドイッチ} 0.3333333 1.0 2.0 # 2 {お茶} => {!コーラ} 0.3333333 0.8 1.2 # ..... # 5 {年齢層=30代, # !コーラ} => {おにぎり} 0.2500000 1.0 2.0
2番目のルールのように "お茶を買った人はコーラを同時に買いにくい" という画期的な発見がもたらされることがある。
頻出アイテムセットの取得
また 条件 -> 結論の形にこだわらず頻出アイテムセットを取り出したい場合は arules::eclat
isets <- eclat(tran, parameter=list(support=0.3)) class(isets) inspect(isets) # items support # 1 {コーラ, # サンドイッチ} 0.3333333 # ..... # 11 {コーラ} 0.3333333
arules::apriori で抽出したルールに含まれる アイテムセットを取得するには arules::generatingItemsets。ルールとして絞られた結果からアイテムセットを取り出すため、上の結果とは一致しない。重複した アイテムセットを削除したい場合は unique。
inspect(unique(generatingItemsets(rules))) # items support # 1 {コーラ, # サンドイッチ} 0.3333333 # ..... # 4 {年齢層=30代, # おにぎり, # !コーラ} 0.2500000
また、アイテムセットに対してはいくつかの集合演算が定義されている。各アイテムセットが それぞれ 最大の頻出アイテムセットかどうか (自分自身を含むほかの頻出アイテムセットがないかどうか) を調べるには arules::is.maximal
# ラベルを一覧表示するため data.frame に変換 as(isets, 'data.frame')$items # [1] {コーラ,サンドイッチ} {お茶,!コーラ} {おにぎり,!コーラ} {!コーラ} # [5] {おにぎり} {サンドイッチ} {お茶} {年齢層=30代} # [9] {年齢層=20代} {年齢層=10代} {コーラ} # 11 Levels: {!コーラ} {おにぎり,!コーラ} {おにぎり} {お茶,!コーラ} {お茶} {コーラ,サンドイッチ} ... {年齢層=30代} is.maximal(isets) # [1] TRUE TRUE TRUE FALSE FALSE FALSE FALSE TRUE TRUE TRUE FALSE
また、抽出した頻出アイテムセットについて元データ (トランザクション) を確認したい場合は arules::supportingTransactions でトランザクション IDを拾ってスライス。
LIST(supportingTransactions(isets[1], tran)) # $`{コーラ,サンドイッチ}` # [1] 4 5 9 12 LIST(tran[LIST(supportingTransactions(isets[1], tran))[[1]]]) # [[1]] # [1] "年齢層=30代" "コーラ" "サンドイッチ" # ..... # [[4]] # [1] "年齢層=10代" "コーラ" "サンドイッチ"
ファイルへの書き込み / 読み込み
arules::transactions をファイルに保存する形式として basket 形式と single 形式の二通りがある。それぞれ、
basket形式: 1 トランザクションを 1 行に保存する形式single形式: 1 アイテム 1 行に保存する形式 (アイテムごとに正規化した形式)
arules 内での処理を考えた場合、 basket 形式 のほうが使い勝手はよい。
basket 形式
まず書き込みは arules::write でファイル名 + フォーマットを指定すればよい。
write(tran, file = 'basket.tsv', format = 'basket')
書き込まれたファイルの中身はこんな感じになる。
年齢層=30代 おにぎり !コーラ 年齢層=20代 おにぎり サンドイッチ !コーラ ..... 年齢層=10代 コーラ サンドイッチ
読み込みは arules::read.transactions で、同じくファイル名 + フォーマットを指定。
LIST(read.transactions('basket.tsv', format='basket')) # [[1]] # [1] "!コーラ" "おにぎり" "年齢層=30代" # ..... # [[12]] # [1] "コーラ" "サンドイッチ" "年齢層=10代"
single 形式
single で保存する場合は、各トランザクションに含まれる アイテムの個数が一致していない場合はエラーになるようだ。
write(tran, file = 'single.tsv', format = 'single') # Error in data.frame(transactionID = rep(names(l), lapply(l, length)), : # arguments imply differing number of rows: 0, 41
別のサンプルデータを使って挙動をみる。
df <- data.frame(x = c(TRUE, FALSE, TRUE), y = c(TRUE, TRUE, FALSE), z = c(TRUE, TRUE, FALSE)) tran.single <- as(df, 'transactions') write(tran.single, file='single.tsv', format='single')
書き込まれたファイルの中身にはヘッダがついている。
transactionID item 1 1 x=TRUE 2 1 y=TRUE 3 1 z=TRUE 4 2 x=FALSE ..... 9 3 z=FALSE
single 形式での読み取りの際には、 cols オプションで "トランザクションIDを含む列", "アイテム名を含む列" を vector として指定する必要がある。
また、read.transactions には、read.tableのようにヘッダをスキップするオプションがない、、、。そのままだとヘッダ部分もトランザクションとして読まれてしまい、あまりうれしくない。
LIST(read.transactions('single.tsv', format='single', cols=c(2, 3))) # $`1` # [1] "y=TRUE" "z=TRUE" # ..... # $`3` # [1] "x=TRUE" "y=FALSE" "z=FALSE" # # $item # [1] "1"
遺された謎、、、itemsetInfo
arules::transactions は @itemsetInfo というプロパティを持っており、これは arules::itemsetInfo で参照できる。が、{arules} のソースをみても このプロパティを ルール抽出 / 頻出アイテムセット抽出に使っている様子はない。何に使うんだこれは、、、？
itemsetInfo(tran) # data frame with 0 columns and 0 rows
とりあえず以下のようにすれば データに @itemsetInfo プロパティを持たせられることはわかった。単純に アイテムをカテゴリ分けするためのものなのだろうか。
m = list(飲料=c('コーラ', 'お茶'), 食品=c('おにぎり', 'サンドイッチ')) m # $飲料 # [1] "コーラ" "お茶" # # $食品 # [1] "おにぎり" "サンドイッチ" im <- as(as.data.frame(m), 'itemMatrix') itemsetInfo(im) # itemsetID # 1 飲料 # 2 食品 im['飲料'] # itemMatrix in sparse format with # 1 rows (elements/transactions) and # 4 columns (items) LIST(im['飲料']) # $飲料 # [1] "お茶" "コーラ"
まとめ
{arules}でのトランザクションデータ作成 / 前処理などをざっとまとめた。- 次回以降は 系列パターンマイニングを行う
{arulesSequences}の予定。
