ggplot2 + gridパッケージでpar(new=T)的に2軸プロットを作る

この文章は[DATUM STUDIO Advent Calendar 2017](https://qiita.com/advent-calendar/2017/datumstudio)の25日目です。  


### はじめに

皆さんRのgridパッケージをご存知ですか？ 
`gridExtra::grid.arrange()`なら知っているけど…、という人が多いのではないでしょうか。 
gridパッケージは何でも (!?) できます、しかし何をやるにも手間がかかります。 
はっきり言って万人向けではありません。 
ggplot2は、そのようなgridパッケージを扱いやすくラップしてくれているパッケージ、とも言えます。 

ただし使いやすい反面、自由度に制限がかかっているのも事実です。 
やりたいことができない！、という状況に出くわした際に、　
少しgridパッケージについて知っていれば、ggplot2パッケージの限界を突破することが可能です。 
  
今回は、<b>左右に異なるy軸を用いた2データのプロット (以下2軸プロット)</b> を例に、 
ggplot2 + gridパッケージの一端を紹介したいと思います。 
<br><br><br>

### ggplot2の2軸プロットの不便なところ

パッケージ作者のHadley氏は2軸プロットを推奨しておらず、ggplot2にはそのような機能が有りません。 
version 2.2.0で右側y軸を作成することが可能となりましたが、 
これはあくまで一つのデータに対し、左y軸はcm、右y軸はinch、といった用途を恐らく想定しており、 
グラフの描写は左y軸を用いて行われます。 
  
そのためggplot2のみで2軸プロットを行う場合には、右y軸データの左y軸へのリスケーリングが必要です。
(そのような方法は、nozma様のQiitaの記事 [ggplot2で2軸プロットをする](https://qiita.com/nozma/items/7e430994a2840aad645f) などで紹介されています) 
  
しかしうっかりさんの私の様に、リスケーリングはやらかす可能性があるので嫌だ、という方は 
そこそこいらっしゃるのではないでしょうか。 
 
そこでgridパッケージ等を使い、baseパッケージの`par(new = T)`的な感覚で 
2軸グラフを作る方法を紹介します。 
<br><br><br>

### 基本的な流れ

<img src="https://qiita-image-store.s3.amazonaws.com/0/216102/7a509104-d20f-55d2-1c67-b6d95ab7c5e7.png" width="500px" />

基本的な流れは、 

1. 2軸プロットで1つにまとめたいグラフ2枚を左y軸と同一の右y軸付きで作成し、  
    `ggplotGrob()`でgrob　(gtable)\* 化 
2. 重ねる側のプロットからグラフ (点と線) および右y軸のgrobを抽出 (掘り出す) 
3. 重ねられる側の右y軸を消去 (見えなくする) 
4. 実際に重ねる 

となります。 
(\* grob：グリッド・グラフィックスオブジェクト) 
(gTreeはそれを束ねた物で、gtableはそれらをテーブル状に束ねた物 (略解)) 
 
それでは具体的にやっていきながら、ggplot2 x gridに親しんでいきましょう。 

<br><br><br>

### ⓪ 例示用データの作成
適当にデータを二つ作ります。 

```r
# 以降で使用するパッケージの読み込み (tidyverse は dplyr & ggplot2でも可)
library(grid); library(gtable); library(tidyverse)

set.seed(111)
d1 <- data_frame(x = 2:8, y = sample(seq(110, 170, 10), 7))
d2 <- data_frame(x = 3:8, y = sample(3:8))
```
こんなデータです。

| d1_x| d1_y| d2_x| d2_y|
|----:|----:|----:|----:|
|    2|  150|   NA|   NA|
|    3|  170|    3|    6|
|    4|  120|    4|    5|
|    5|  130|    5|    3|
|    6|  160|    6|    4|
|    7|  110|    7|    7|
|    8|  140|    8|    8|

<br><br>

### ① まとめたいggplot2グラフ2枚の作成
まずはじめに、2軸プロットで1つにまとめたいグラフ2枚をggplot2で描きます。 
  
意識すべき点は、 
  
* `xlim()`等でx軸の範囲を揃える  
* y軸の目盛り桁数の多い方を重ねられる側に用いる  
* ラベルタイトル等の情報は全て重ねられる側に持たせる
* legendが欲しい場合、`geom_blank(data = dummy_data)`で重ねる側のlegend要素を作成  
    (重ねる側プロットの色などは要手動指定)  
* 両グラフとも`scale_y_continuous(sec.axis = sec_axis(~ ., name = "2nd y title"))` で  
    左y軸と同一の右y軸を作成する  
  
y軸の目盛り桁数の多い方が重ねられる側のプロットとなるのは、完全にスペースの都合です。 
右y軸以外の全パーツ (右y軸タイトル含む) は重ねられる側のプロットの物となるため、 
それを意識して作図していきます。 

ダミーデータによるlegendの作成は少々面倒に思えるかもしれませんが、 
`facet_wrap()`での個別ylim等の指定でも使えるテクニックなので、覚えておいて損はありません。 
ggplot2のデフォルト色については、hoxo_b様の[ggplot2のデフォルトの色を知りたい](https://qiita.com/hoxo_b/items/c569da6dbf568032e04a) を参考にしてください。 
`facet_wrap()`で個別軸範囲指定については、baptiste様の[stack overflowの回答](https://stackoverflow.com/questions/18046051/setting-individual-axis-limits-with-facet-wrap-and-scales-free-in-ggplot2)を参考にしてください。
　　
事前にlegend作成の準備をしておきます。 
重ねられる側のデータにlegend用の列を付け加え、 
また重ねる側用のlegendを作るためにdummy_dataを作成します。
x値が揃っていない場合、合計範囲も算出しておきましょう。 

```r
d1 <- d1 %>% mutate(col = "d1 (left y axis)")
dummy_data <- data_frame(x = mean(d1$x), y = mean(d1$y), col = "d2 (rignt y axis)")

x_range <- c(d1$x, d2$x) %>% range()
```
    
それではggplot2で作図します。  

```r
base_plot <- ggplot(d1, aes(x, y, colour = col)) + 
  geom_line() + 
  geom_point() + 
  scale_y_continuous(sec.axis = sec_axis(~ ., name = "y axis (right)")) + # 右y軸
  xlim(x_range) +                # x軸の範囲を揃える
  xlab("x axis") +
  ylab("y axis (left)") + 
  ggtitle("ggplot2 x grid") +
  geom_blank(data = dummy_data)  # geom_blank(ダミーデータ)でlegend要素を加える

additional_plot <- ggplot(d2, aes(x, y)) + 
  geom_line(colour = "#00BFC4") +              # デフォルト色 (n = 2) の2色目を指定
  geom_point(colour = "#00BFC4") +
  scale_y_continuous(sec.axis = sec_axis(~ ., name = "not used")) +     # 右y軸
  xlim(x_range) +                          　# x軸の範囲を揃える
  xlab("not used") +                        # 不要行です
  ylab("not used") +                        # 不要行です
  ggtitle("(additional_plot; not used)")    # 不要行です

## (参考用)
# ちなみにadditionalの方を
# scale_y_continuous(sec.axis = sec_axis(~ ., name = "not used", lim = c(3, 9))
# とすると、重ねた際に右y軸と罫線が揃って見栄えがよくなります。
# with(d1, labeling::extended(min(y), max(y), m = 5)) %>% length() # 7
# with(d2, labeling::extended(min(y), max(y), m = 5)) %>% length() # 6 不揃い
# with(d2, labeling::extended(min(y), 9, m = 5)) %>% length() # 7 揃った

```
  
`ggplotGrob()`でgrob (gtable) 化しておきましょう。  

```r
base_gtable <- ggplotGrob(base_plot)
additional_gtable <- ggplotGrob(additional_plot)
```
  
ggplot2の段階ではこのようなグラフです。  
![fig2](https://qiita-image-store.s3.amazonaws.com/0/216102/be28365e-c915-f7c4-0c23-56f9ad3e0c42.png)
<br><br>

### ② 重ねる側のgtableからグラフ(点と線)のgrobと右y軸のabsoluteGrobを抜き出す

慣れていない人にとっての最難関ポイントです。 
gtableはかなり深いlist構造からなっており、目的のgrobやgTreeを得るには少しコツが入ります。 
迷ったら、`names()`を実行するとヒントが得られます。 
(が、facet_wrap()などで構造が変わらない限り位置は共通なので、実は真面目に掘り出す必要はありません) 
  
gtableの構造を見てみましょう。  


```r
additional_gtable
```


|   |z  |cells         |name       |grob                                          |
|:--|:--|:-------------|:----------|:---------------------------------------------|
|1  |0  |( 1-10, 1- 7) |background |rect[plot.background..rect.9420]              |
|2  |5  |( 5- 5, 3- 3) |spacer     |zeroGrob[NULL]                                |
|3  |7  |( 6- 6, 3- 3) |axis-l     |absoluteGrob[GRID.absoluteGrob.9406]          |
|4  |3  |( 7- 7, 3- 3) |spacer     |zeroGrob[NULL]                                |
|5  |6  |( 5- 5, 4- 4) |axis-t     |zeroGrob[NULL]                                |
|6  |1  |( 6- 6, 4- 4) |panel      |gTree[panel-1.gTree.9383]                     |
|7  |9  |( 7- 7, 4- 4) |axis-b     |absoluteGrob[GRID.absoluteGrob.9399]          |
|8  |4  |( 5- 5, 5- 5) |spacer     |zeroGrob[NULL]                                |
|9  |8  |( 6- 6, 5- 5) |axis-r     |absoluteGrob[GRID.absoluteGrob.9413]          |
|10 |2  |( 7- 7, 5- 5) |spacer     |zeroGrob[NULL]                                |
|11 |10 |( 4- 4, 4- 4) |xlab-t     |zeroGrob[NULL]                                |
|12 |11 |( 8- 8, 4- 4) |xlab-b     |titleGrob[axis.title.x..titleGrob.9386]       |
|13 |12 |( 6- 6, 2- 2) |ylab-l     |titleGrob[axis.title.y..titleGrob.9389]       |
|14 |13 |( 6- 6, 6- 6) |ylab-r     |titleGrob[axis.title.y.right..titleGrob.9392] |
|15 |14 |( 3- 3, 4- 4) |subtitle   |zeroGrob[plot.subtitle..zeroGrob.9417]        |
|16 |15 |( 2- 2, 4- 4) |title      |titleGrob[plot.title..titleGrob.9416]         |
|17 |16 |( 9- 9, 4- 4) |caption    |zeroGrob[plot.caption..zeroGrob.9418]         |         

panelがメインのグラフ部分 (背景なども含む)、axis-rが右側y軸となります。 
cellの番地は重ね書きで必要となるので、メモしておきましょう (パネルは`c(6, 4)`, 右y軸は`c(6, 5)`です) 
 
`gtable名$grobs[[上表左のindex番号]]`でgrob列にあるオブジェクトが抜き出せます。 
右y軸については上表の`absoluteGrob[GRID.absoluteGrob.7024]`を抜き出すだけでいいのですが、 
グラフ (点と線) では、panelのgTree (上表`gTree[panel-1.gTree.6994]`) では背景まで付いてくるため、 
さらに掘って、その中にある点grobと線grobを抜き出す必要があります。 
 
それではまず始めにグラフ (点と線) を抜き出します。 
gTreeの中身はchildrenに収まっています。 
  

```r
additional_gtable$grobs[[6]]$children

## (gTree[grill.gTree.98], zeroGrob[NULL], polyline[GRID.polyline.83], points[geom_point.points.85], zeroGrob[NULL], zeroGrob[panel.border..zeroGrob.86])
```
今回用があるのはchildrenの3番目と4番目の 
`polyline[GRID.polyline.6922]`と`points[geom_point.points.6924]`です。  

```r
additional_line_and_points <- additional_gtable$grobs[[6]]$children[3:4] 

# 以下のようなコードを用いると、添え字の指定なしで抜き出せます
# additional_grobs$grobs[[6]]$children %>% 
#    purrr::discard(str_detect(names(.), "Tree|NULL|zero"))
```
右y軸はもっと簡単に抜き出せます。  

```r
additional_right_y_axis <- additional_gtable$grobs[[9]]
```
<br><br>

### ③ 重ねられる側の右y軸を消去 (見えなくする)
次に、重ねられる側の右y軸を見えなくします。 
右y軸のabsoluteGrobのパラメータに`alpha = 0`を追加することでこれを実現します。 
 
Grob系オブジェは色といった作図パラメータをgpというリスト内に持っており、 
`gpar()`関数に指定したいパラメータを与えて、これに突っ込むことで書き換えができます。 

```r
base_gtable$grobs[[9]]$gp <- gpar(alpha = 0)    # 右y軸のindexは先ほど同様9です。
```
これで、重ねられる側の右y軸が見えなくなりました (完全透過)。 
<br><br><br>

### ④ 抜き出した点・線・右y軸を重ねる  
あとは重ねるだけです。 
`gtable_add_grob()`を用いて重ねるのですが、この際に上のgtableのcell番地が必要になります。
(パネルは`c(6, 4)`, 右y軸は`c(6, 5)`です)  
同セルに複数のgrobを重ね書きする場合、nameを明示する必要がある点 (重複回避のため) に注意が必要です。 
(`additional_line_and_points` は二つのgrobからなるため、これに該当します) 


```r
base_and_additional_grobs <- base_gtable %>% 
  gtable_add_grob(additional_line_and_points, 6, 4, name = c("a", "b")) %>% 
  gtable_add_grob(additional_right_y_axis, 6, 5)
```

完成！！  

```r
grid.newpage()
grid.draw(base_and_additional_grobs)
```
<img src="https://qiita-image-store.s3.amazonaws.com/0/216102/74f23071-6e3c-405b-76d4-6cd70bfcfbe6.png" width="500px" /> 

解説しながら行ったため作業量が多いように感じたと思いますが、 
慣れれば、ぱぱっと作れるようになります (!?)

### Let's enjoy !!