purrrとggplot2で各水準毎の図形を一度に保存する

分析を行っている中で、各水準毎に可視化を行い傾向の違いがあるかなどを確認することがあるかと思います。その場合、ggplot2ユーザーであれば以下のように`ggplot2::facet_wrap()`を使って一つのグラフで確認することが多いかと思います。

``` R
ggplot(mtcars, aes(disp, mpg)) +
  geom_point() +
  facet_wrap(~cyl)
```

![facet_wrap.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/162536/b8da2e83-2feb-875c-2e13-a595e6005752.png)

分析者が手元で傾向を確かめるだけなら十二分かなと思うのですが、レポートを行う時などに、どうしても各水準毎のグラフを保存したい時があったりします。(PowerPointに画像を添付するなんて恐ろしいことも時にはありますよね?)  

そんな時に各水準毎に繰り返しコードを書かずに、[purrr](https://purrr.tidyverse.org)で対応する方法を記載しようと思います。

## 準備

一応Rとパッケージのversionを掲載しつつ、必要なパッケージを読み込みます。

``` R
> R.version.string
[1] "R version 3.6.1 (2019-07-05)"
> packageVersion("purrr")
[1] ‘0.3.2’
> packageVersion("ggplot2")
[1] ‘3.2.1’

library(purrr)
library(ggplot2)
```

また、今回可視化にはRに標準で組み込まれている`mtcars`のデータセットを利用します。詳細は`?mtcars`で確認することができます。

## 結論

いきなり結論ですが、`split()`と`purrr::iwalk()`を組み合わせることでサクッと実現できます。

``` R
mtcars %>% 
  split(.$cyl) %>% 
  iwalk(~ ggplot(.x, aes(disp, mpg)) +
          geom_point() +
          ggtitle(paste0("cyl-", .y)) +
          ggsave(paste0("fig/cyl-", .y, ".png")))
```

## 解説

結論に記載したサンプルコードですが、`purrr::map()`くらいしか利用していなかった当時の自分には理解に時間がかかったので解説を記載しておこうと思います。

### なぜ`imap()`ではなく`iwalk()`なのか

#### `imap()`とは

`map2(x, names(x), ...)`もしくは`map2(x, seq_along(x), ...)`の短縮版です。
例えば以下のように利用することができます。

``` R
> imap_chr(mtcars, ~ paste0(.y, ": ", median(.x)))
          mpg           cyl          disp            hp          drat 
  "mpg: 19.2"      "cyl: 6" "disp: 196.3"     "hp: 123" "drat: 3.695" 
           wt          qsec            vs            am          gear 
  "wt: 3.325" "qsec: 17.71"       "vs: 0"       "am: 0"     "gear: 4" 
         carb 
    "carb: 2" 

# imap_chr()と同様の結果が得られる
> map2_chr(mtcars, names(mtcars), ~ paste0(.y, ": ", median(.x)))
          mpg           cyl          disp            hp          drat 
  "mpg: 19.2"      "cyl: 6" "disp: 196.3"     "hp: 123" "drat: 3.695" 
           wt          qsec            vs            am          gear 
  "wt: 3.325" "qsec: 17.71"       "vs: 0"       "am: 0"     "gear: 4" 
         carb 
    "carb: 2" 
```

#### `walk()`とは

多くの関数の場合、返り値を取得することは理に適っていますが、`cat()`や`write.csv()`などの関数に関して言えば副次的な効果が目的であり返り値を持たない方が適切な場合があります。
例えば[Advanced R 2nd edition](https://adv-r.hadley.nz/)の[9 Functionals](https://adv-r.hadley.nz/functionals.html#no-outputs-walk-and-friends)に具体例が載っているので引用します。

``` R
welcome <- function(x) {
  cat("Welcome ", x, "!\n", sep = "")
}
names <- c("Hadley", "Jenny")

# As well as generate the welcomes, it also shows 
# the return value of cat()
map(names, welcome)
#> Welcome Hadley!
#> Welcome Jenny!
#> [[1]]
#> NULL
#> 
#> [[2]]
#> NULL
```

上記のような場合だと`NULL`は不要なので、返り値を隠してくれる`walk()`の出番になります。

``` R
walk(names, welcome)
#> Welcome Hadley!
#> Welcome Jenny!
```

#### まとめ

画像の保存だけを行うのであれば、特に返り値としてグラフは必要でないので、`iwalk()`を利用します。
（ただし、RStudio上で出力を確認しておきたい場合などは`imap()`を利用したほうが手っ取り早いです）

### `~`は何者なのか

[こちら](https://adv-r.hadley.nz/functionals.html#purrr-shortcuts)に全て書いてあるので蛇足感しかありませんが、一応解説を記載しておきます。  

apply族やpurrrを利用していると、複数の関数を組み合わせたりするために以下のように無名関数を書くことが多くなります。

``` R
> map_dbl(mtcars, function(x) length(unique(x)))
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
  25    3   27   22   22   29   30    2    2    3    6 
```

無名関数は十分有用なのですが、やや冗長になってしまいがちです。そこでpurrrは`~`を利用したショートカットを提供しています。

``` R
> map_dbl(mtcars, ~ length(unique(.x)))
 mpg  cyl disp   hp drat   wt qsec   vs   am gear carb 
  25    3   27   22   22   29   30    2    2    3    6 
```

なので、結論に記載したショートカットを利用したコードを無名関数を利用して書き直すと以下のようになります。

``` R
mtcars %>% 
  split(.$cyl) %>% 
  iwalk(function(x, y) ggplot(x, aes(disp, mpg)) +
          geom_point() +
          ggtitle(paste0("cyl-", y)) +
          ggsave(paste0("fig/cyl-", y, ".png")))
```

ちなみに、`.x`となっているのは一般的な引数と被らないための工夫からです。（[こちら](https://adv-r.hadley.nz/functionals.html#argument-names)を読むと記載があります）  

誤っている部分やよりスマートに書く方法がある場合は是非ご指摘いただけますと幸いです。
Enjoy!

## 参考

- [purrr](https://purrr.tidyverse.org/index.html)
- [9 Functionals | Adcanced R](https://adv-r.hadley.nz/functionals.html)
- [purrrでdoせず楽をする](https://qiita.com/yutannihilation/items/356be6e104b6c3a93a87)