【R】Tidyverseの関数群でクロス集計表を作る

## 背景

年の瀬だというのにだらだらネットサーフィンしていてたまたま見つけた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: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: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: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: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:R
df_cross |>
  head() |>
  knitr::kable()
```

|  ID | name     | name_2   |
|----:|:---------|:---------|
|   1 | 日用雑貨 | 日用雑貨 |
|   1 | 日用雑貨 | 肉       |
|   1 | 日用雑貨 | 菓子     |
|   1 | 肉       | 日用雑貨 |
|   1 | 肉       | 肉       |
|   1 | 肉       | 菓子     |

### 例題１：「併買パターンを集計する」

```R: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: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: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: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:R
col_names <- df_read |>
  names() |>
  (\(x) x[-1])()
```

これはR4.1で追加された、ネイティブパイプ演算子を無名関数に繋げる書き方。以下のような書き方と同じ結果になる。

``` R:magrittrのパイプを使う場合
col_names <- df_read %>%
  names() %>%
  {
    .[-1]
  }
```

``` R:\(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: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: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: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使用）

``` r
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: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: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:R
bm |>
  autoplot()
```

![microbenchmark.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/675583/d4c375a4-94ba-284b-6a53-c3910a3adfdb.png)

100倍近い差がある模様。dtplyrの方が少し遅いのは変換のオーバーヘッドがあるから（あと`(\(x) full_join(x, x, by = "ID"))()`部分の翻訳があやしい、それより前の処理を二回行っている模様）で、データサイズが巨大な場合には逆転すると思われる。

というわけでdtplyr、dbplyrなどデータフレーム以外のバックエンドにも対応してる場合が多く行数も大して変わらないのでなるべくjoin系使う方が良さそう。


## 別解（2021/12/31追記2）

「そもそも行列の積使えば一発で同じ表を作れる」との指摘をいただきました。ありがとうございます。

https://qiita.com/StrawBerryMoon/items/d80b0a5004ec8941ed43

### 例題1（行列計算の場合）

2行目は今回の例では不要だが、データフレームと異なりmatrixは全部の列の型が同じである必要があるのでこのように列を抽出すると安心して`as.matrix()`できる。

対角成分を`NA`にする部分をパイプラインの中でやるのはイマイチ。

```R: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: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: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:R
bm |>
  autoplot()
```

![microbenchmark2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/675583/768587c4-8c41-5fa2-c1ed-595c9ac2a0d9.png)