背景
年の瀬だというのにだらだらネットサーフィンしていてたまたま見つけたPythonとSPSSでクロス集計する以下の記事の内容をRでやってみたところ思っていたより手強かったのでネットサーフィンの時間が無駄ではなかったと思い込むために備忘録として記事化。
- Python でデータ処理 - 併買パターン上位５種類の組み合わせを抽出 - https://qiita.com/makaishi2/items/7bbf4a7543d6da7e1883
- Modelerデータ加工Tips#21-併買パターン上位5種類の組み合わせを抽出する https://www.ibm.com/blogs/solutions/jp-ja/modeler-tips-21/
解答
ライブラリロード
R
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.5 ✔ purrr 0.3.4
## ✔ tibble 3.1.6 ✔ dplyr 1.0.7
## ✔ tidyr 1.1.4 ✔ stringr 1.4.0
## ✔ readr 2.1.1 ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
データ読み込み
R
df_read <- read_csv("https://raw.githubusercontent.com/yoichiro0903n/blue/main/sampledatacross2.csv")
## Rows: 1000 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (1): ID
## lgl (11): 果物･野菜, 肉, 日用雑貨, 缶詰野菜, 缶詰肉, 冷凍肉, ビール, ワイン, 清涼飲料, 魚, 菓子...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
ちゃんと読み込めていることとデータの中身を確認。
R
df_read |>
head() |>
knitr::kable()
| ID | 果物･野菜 | 肉 | 日用雑貨 | 缶詰野菜 | 缶詰肉 | 冷凍肉 | ビール | ワイン | 清涼飲料 | 魚 | 菓子 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | FALSE | TRUE | TRUE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | TRUE |
| 2 | FALSE | TRUE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | TRUE |
| 3 | FALSE | FALSE | FALSE | TRUE | FALSE | TRUE | TRUE | FALSE | FALSE | TRUE | FALSE |
| 4 | FALSE | FALSE | TRUE | FALSE | FALSE | FALSE | FALSE | TRUE | FALSE | FALSE | FALSE |
| 5 | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE | FALSE |
| 6 | FALSE | TRUE | FALSE | FALSE | FALSE | FALSE | FALSE | TRUE | FALSE | TRUE | FALSE |
共通処理部
この後クロス集計表を作成する際には見た目のために横持ちに変形するので、それより前の縦持ち状態のデータを保存しておく
追記：後述する別解の方が100倍早いので速度の気になる場合はそちらも参照。
R
df_cross <- df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
mutate(name_2 = name) |>
group_by(ID) |>
expand(name, name_2) |>
ungroup()
中身は↓のような感じ。
R
df_cross |>
head() |>
knitr::kable()
| ID | name | name_2 |
|---|---|---|
| 1 | 日用雑貨 | 日用雑貨 |
| 1 | 日用雑貨 | 肉 |
| 1 | 日用雑貨 | 菓子 |
| 1 | 肉 | 日用雑貨 |
| 1 | 肉 | 肉 |
| 1 | 肉 | 菓子 |
例題１：「併買パターンを集計する」
R
col_names <- df_read |>
names() |>
(\(x) x[-1])()
df_cross |>
filter(name != name_2) |>
pivot_wider(
id_cols = name,
names_from = name_2,
values_from = name_2,
values_fn = length
) |>
relocate(name, {{ col_names }}) |>
mutate(name = name |> factor(levels = col_names)) |>
arrange(name) |>
knitr::kable()
| name | 果物･野菜 | 肉 | 日用雑貨 | 缶詰野菜 | 缶詰肉 | 冷凍肉 | ビール | ワイン | 清涼飲料 | 魚 | 菓子 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 果物･野菜 | NA | 59 | 62 | 86 | 61 | 86 | 89 | 84 | 56 | 145 | 82 |
| 肉 | 59 | NA | 33 | 55 | 41 | 52 | 47 | 49 | 42 | 48 | 54 |
| 日用雑貨 | 62 | 33 | NA | 44 | 31 | 51 | 45 | 46 | 35 | 56 | 56 |
| 缶詰野菜 | 86 | 55 | 44 | NA | 73 | 173 | 167 | 97 | 63 | 89 | 71 |
| 缶詰肉 | 61 | 41 | 31 | 73 | NA | 75 | 60 | 54 | 42 | 63 | 54 |
| 冷凍肉 | 86 | 52 | 51 | 173 | 75 | NA | 170 | 71 | 54 | 90 | 66 |
| ビール | 89 | 47 | 45 | 167 | 60 | 170 | NA | 77 | 45 | 85 | 64 |
| ワイン | 84 | 49 | 46 | 97 | 54 | 71 | 77 | NA | 60 | 78 | 144 |
| 清涼飲料 | 56 | 42 | 35 | 63 | 42 | 54 | 45 | 60 | NA | 52 | 52 |
| 魚 | 145 | 48 | 56 | 89 | 63 | 90 | 85 | 78 | 52 | NA | 86 |
| 菓子 | 82 | 54 | 56 | 71 | 54 | 66 | 64 | 144 | 52 | 86 | NA |
例題２：「併買パターン上位５つのどれかに該当したレコードを抽出する」
R
df_cross |>
filter(name < name_2) |>
nest(data = ID) |>
mutate(n_row = map_int(data, nrow)) |>
slice_max(order_by = n_row, n = 5, with_ties = TRUE) |>
unnest(data) |>
distinct(ID) |>
left_join(df_read, by = "ID") |>
arrange(ID)
## # A tibble: 447 × 12
## ID `果物･野菜` 肉 日用雑貨 缶詰野菜 缶詰肉 冷凍肉 ビール ワイン
## <dbl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
## 1 3 FALSE FALSE FALSE TRUE FALSE TRUE TRUE FALSE
## 2 10 TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## 3 11 TRUE TRUE TRUE TRUE FALSE FALSE FALSE TRUE
## 4 12 TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## 5 15 TRUE FALSE TRUE FALSE FALSE FALSE FALSE FALSE
## 6 16 FALSE FALSE FALSE FALSE FALSE TRUE TRUE FALSE
## 7 17 TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE
## 8 20 TRUE FALSE FALSE TRUE FALSE FALSE FALSE TRUE
## 9 22 FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
## 10 24 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## # … with 437 more rows, and 3 more variables: 清涼飲料 <lgl>, 魚 <lgl>,
## # 菓子 <lgl>
考えたことのメモ
共通処理部のコツ
私はクロス集計表を作るということをほとんど行っていないので、それに適した関数も知らなかった。 なのでまずは「tidyverse cross」とかでインターネットを検索した。 「R cross」ではないのは、全てのRの関数がtidyverseというかパイプラインの中で使いやすいわけではないため。
するとtidyverseに含まれるpurrr::cross()やtidyr::crossing()、base::table()をtidyverseライクにしたjanitor::tabyl()の名前を見つけられた。
-
purrr::cross()https://purrr.tidyverse.org/reference/cross.html -
tidyr::crossing()https://tidyr.tidyverse.org/reference/expand.html -
janitor::tabyl()https://sfirke.github.io/janitor/reference/tabyl.html
この中からtidyr::crossing()と同じヘルプページに載っていたtidyr::expand()が良さそうに見えたので今回はそれを使用。 動かしてみるとtidyr::expand()は同じ列を二回引数に取れないことが分かったので4行目のdplyr::mutate()でname列を複製している。
R
df_cross <- df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
mutate(name_2 = name) |>
group_by(ID) |>
expand(name, name_2) |>
ungroup()
例題１：「併買パターンを集計する」のコツ
処理自体はtidyr::pivot_wider()を使う下記の部分で終わりなのだが、これだとNAが対角線に揃っておらず見栄えが悪い。
R
df_cross |>
filter(name != name_2) |>
pivot_wider(
id_cols = name,
names_from = name_2,
values_from = name_2,
values_fn = length
) |>
knitr::kable()
| name | 肉 | 菓子 | 日用雑貨 | 冷凍肉 | 缶詰野菜 | 魚 | ビール | ワイン | 清涼飲料 | 果物･野菜 | 缶詰肉 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 日用雑貨 | 33 | 56 | NA | 51 | 44 | 56 | 45 | 46 | 35 | 62 | 31 |
| 肉 | NA | 54 | 33 | 52 | 55 | 48 | 47 | 49 | 42 | 59 | 41 |
| 菓子 | 54 | NA | 56 | 66 | 71 | 86 | 64 | 144 | 52 | 82 | 54 |
| ビール | 47 | 64 | 45 | 170 | 167 | 85 | NA | 77 | 45 | 89 | 60 |
| 冷凍肉 | 52 | 66 | 51 | NA | 173 | 90 | 170 | 71 | 54 | 86 | 75 |
| 缶詰野菜 | 55 | 71 | 44 | 173 | NA | 89 | 167 | 97 | 63 | 86 | 73 |
| 魚 | 48 | 86 | 56 | 90 | 89 | NA | 85 | 78 | 52 | 145 | 63 |
| ワイン | 49 | 144 | 46 | 71 | 97 | 78 | 77 | NA | 60 | 84 | 54 |
| 果物･野菜 | 59 | 82 | 62 | 86 | 86 | 145 | 89 | 84 | 56 | NA | 61 |
| 清涼飲料 | 42 | 52 | 35 | 54 | 63 | 52 | 45 | 60 | NA | 56 | 42 |
| 缶詰肉 | 41 | 54 | 31 | 75 | 73 | 63 | 60 | 54 | 42 | 61 | NA |
そこで元のcsvファイルの列順に並び直させるために変形前のデータフレームから列名を抜き取ってベクトルにする。不要なID（一つ目の要素）は削除。
R
col_names <- df_read |>
names() |>
(\(x) x[-1])()
これはR4.1で追加された、ネイティブパイプ演算子を無名関数に繋げる書き方。以下のような書き方と同じ結果になる。
magrittrのパイプを使う場合
col_names <- df_read %>%
names() %>%
{
.[-1]
}
\(x)の代わりにfunction(x)を使う場合
col_names <- df_read |>
names() |>
(function(x) x[-1])()
このcol_namesというベクトルを使用してdplyr::relocate()で列を、dplyr::mutate()でID列をfactor型に変換した後にdplyr::arrange()で行を並び替えたら完成。
例題２：「併買パターン上位５つのどれかに該当したレコードを抽出する」のコツ
横持ちと化したクロス集計表をもう一度縦持ちに直すよりも縦持ちのまま集計し直した方が楽なのでtidyr::nest()とpurrr::map_int()を使用して併売パターン毎のレコード数を数え、dplyr::slice_max()で上位5レコードを抽出する。
R
df_cross |>
filter(name < name_2) |>
nest(data = ID) |>
mutate(n_row = map_int(data, nrow)) |>
slice_max(order_by = n_row, n = 5, with_ties = TRUE) |>
unnest(data) |>
distinct(ID) |>
left_join(df_read, by = "ID") |>
arrange(ID)
tidyr::expand()は前後違いを含めた順列を出力するので、2行目のdplyr::filter()で大小関係を比較して（？）組み合わせに変換している。 「文字列の大小関係を比較する」のは私としてはかなり奇妙な感覚だったが、文字列の並べ替え時には必ず順番が決定されるので、考えてみると確かに比較できるしどのように並び順が決定されても問題はないように思える。
R
tibble::tibble(
a = letters[1:3],
b = letters[1:3]
) |>
tidyr::expand(a, b) |>
knitr::kable()
| a | b |
|---|---|
| a | a |
| a | b |
| a | c |
| b | a |
| b | b |
| b | c |
| c | a |
| c | b |
| c | c |
R
tibble::tibble(
a = letters[1:3],
b = letters[1:3]
) |>
tidyr::expand(a, b) |>
dplyr::filter(a < b) |>
knitr::kable()
| a | b |
|---|---|
| a | b |
| a | c |
| b | c |
別解（2021/12/31追記）
tidyr::expand()が明らかに遅い（2～3秒かかる）ので代わりにdplyr::full_join()を使ってみる。（最初からこれで良かったのでは？）
共通処理部（dplyr::full_join使用）
df_cross <- df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
select(!value) |>
(\(x) full_join(x, x, by = "ID"))() |>
rename(name = name.x, name_2 = name.y)
速度比較
同じデータフレームを出力するように最後にdplyr::arrange()で行の並び替えを行う。dplyr::arrange(dplyr::across())はデフォルト引数が.cols = everything()なので全ての列を使って並び替える。
tidyr::pivot_longer()を使うメリットとしてdtplyr（dplyrやtidyrの関数を処理の早いdata.tableパッケージの構文に翻訳しdata.tableで処理を行うパッケージ）に全関数が対応するのでデータ量の多い場合には更なる高速化にも期待できる。なおarrowはpivot系関数にはバージョン6.0段階では未対応。
R
bm <- microbenchmark::microbenchmark(
"tidyr_expand" = {
df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
mutate(name_2 = name) |>
group_by(ID) |>
expand(name, name_2) |>
ungroup() |>
arrange(across())
},
"dplyr_full_join" = {
df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
select(!value) |>
(\(x) full_join(x, x, by = "ID"))() |>
rename(name = name.x, name_2 = name.y) |>
arrange(across())
},
"dtplyr_full_join" = {
df_read |>
dtplyr::lazy_dt() |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
select(!value) |>
(\(x) full_join(x, x, by = "ID"))() |>
rename(name = name.x, name_2 = name.y) |>
arrange(across()) |>
collect()
},
check = "equal",
times = 10
)
R
bm |>
print()
## Unit: milliseconds
## expr min lq mean median uq
## tidyr_expand 2767.98065 2920.27576 2990.47992 2968.76921 3023.73764
## dplyr_full_join 32.18431 35.83438 37.73849 36.57650 41.23570
## dtplyr_full_join 44.70434 51.42444 57.54262 59.08381 63.56593
## max neval
## 3257.39041 10
## 44.91822 10
## 67.37488 10
R
bm |>
autoplot()
100倍近い差がある模様。dtplyrの方が少し遅いのは変換のオーバーヘッドがあるから（あと(\(x) full_join(x, x, by = "ID"))()部分の翻訳があやしい、それより前の処理を二回行っている模様）で、データサイズが巨大な場合には逆転すると思われる。
というわけでdtplyr、dbplyrなどデータフレーム以外のバックエンドにも対応してる場合が多く行数も大して変わらないのでなるべくjoin系使う方が良さそう。
別解（2021/12/31追記2）
「そもそも行列の積使えば一発で同じ表を作れる」との指摘をいただきました。ありがとうございます。
例題1（行列計算の場合）
2行目は今回の例では不要だが、データフレームと異なりmatrixは全部の列の型が同じである必要があるのでこのように列を抽出すると安心してas.matrix()できる。
対角成分をNAにする部分をパイプラインの中でやるのはイマイチ。
R
df_read |>
select(where(is.logical)) |>
as.matrix() |>
(\(x) t(x) %*% x)() |>
(\(x) {
diag(x) <- NA
return(x)
})() |>
as_tibble(rownames = "name") |>
knitr::kable()
| name | 果物･野菜 | 肉 | 日用雑貨 | 缶詰野菜 | 缶詰肉 | 冷凍肉 | ビール | ワイン | 清涼飲料 | 魚 | 菓子 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 果物･野菜 | NA | 59 | 62 | 86 | 61 | 86 | 89 | 84 | 56 | 145 | 82 |
| 肉 | 59 | NA | 33 | 55 | 41 | 52 | 47 | 49 | 42 | 48 | 54 |
| 日用雑貨 | 62 | 33 | NA | 44 | 31 | 51 | 45 | 46 | 35 | 56 | 56 |
| 缶詰野菜 | 86 | 55 | 44 | NA | 73 | 173 | 167 | 97 | 63 | 89 | 71 |
| 缶詰肉 | 61 | 41 | 31 | 73 | NA | 75 | 60 | 54 | 42 | 63 | 54 |
| 冷凍肉 | 86 | 52 | 51 | 173 | 75 | NA | 170 | 71 | 54 | 90 | 66 |
| ビール | 89 | 47 | 45 | 167 | 60 | 170 | NA | 77 | 45 | 85 | 64 |
| ワイン | 84 | 49 | 46 | 97 | 54 | 71 | 77 | NA | 60 | 78 | 144 |
| 清涼飲料 | 56 | 42 | 35 | 63 | 42 | 54 | 45 | 60 | NA | 52 | 52 |
| 魚 | 145 | 48 | 56 | 89 | 63 | 90 | 85 | 78 | 52 | NA | 86 |
| 菓子 | 82 | 54 | 56 | 71 | 54 | 66 | 64 | 144 | 52 | 86 | NA |
速度比較
どう考えても余計な変形不要な行列計算の方が早いですがどのくらい早いのか。（最終的なデータフレームを完全に同一にするために列の値の型変換を入れてあります）
R
bm <- microbenchmark::microbenchmark(
"dplyr_full_join" = {
col_names <- df_read |>
names() |>
(\(x) x[-1])()
df_read |>
pivot_longer(cols = !ID) |>
filter(value == TRUE) |>
select(!value) |>
(\(x) full_join(x, x, by = "ID"))() |>
rename(name = name.x, name_2 = name.y) |>
arrange(across()) |>
filter(name != name_2) |>
pivot_wider(
id_cols = name,
names_from = name_2,
values_from = name_2,
values_fn = length
) |>
relocate(name, {{ col_names }}) |>
mutate(name = name |> factor(levels = col_names)) |>
arrange(name) |>
mutate(name = name |> as.character())
},
"matrix" = {
df_read |>
select(where(is.logical)) |>
as.matrix() |>
(\(x) t(x) %*% x)() |>
(\(x) {
diag(x) <- NA
return(x)
})() |>
as_tibble(rownames = "name") |>
mutate(across(where(is.double), as.integer))
},
check = "equal",
times = 10
)
R
bm |>
print()
## Unit: milliseconds
## expr min lq mean median uq max neval
## dplyr_full_join 62.66651 69.68215 72.60117 72.20606 76.28808 88.02446 10
## matrix 11.86232 15.91924 17.80401 18.32930 18.70141 24.74568 10
R
bm |>
autoplot()
