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

この文章はDATUM STUDIO Advent Calendar 2017の25日目です。

はじめに

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

ただし使いやすい反面、自由度に制限がかかっているのも事実です。
やりたいことができない！、という状況に出くわした際に、　
少しgridパッケージについて知っていれば、ggplot2パッケージの限界を突破することが可能です。

今回は、左右に異なるy軸を用いた2データのプロット (以下2軸プロット) を例に、
ggplot2 + gridパッケージの一端を紹介したいと思います。

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

パッケージ作者のHadley氏は2軸プロットを推奨しておらず、ggplot2にはそのような機能が有りません。
version 2.2.0で右側y軸を作成することが可能となりましたが、
これはあくまで一つのデータに対し、左y軸はcm、右y軸はinch、といった用途を恐らく想定しており、
グラフの描写は左y軸を用いて行われます。

そのためggplot2のみで2軸プロットを行う場合には、右y軸データの左y軸へのリスケーリングが必要です。
(そのような方法は、nozma様のQiitaの記事 ggplot2で2軸プロットをする などで紹介されています)

しかしうっかりさんの私の様に、リスケーリングはやらかす可能性があるので嫌だ、という方は
そこそこいらっしゃるのではないでしょうか。

そこでgridパッケージ等を使い、baseパッケージのpar(new = T)的な感覚で
2軸グラフを作る方法を紹介します。

基本的な流れ

基本的な流れは、

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

となります。
(* grob：グリッド・グラフィックスオブジェクト)
(gTreeはそれを束ねた物で、gtableはそれらをテーブル状に束ねた物 (略解))

それでは具体的にやっていきながら、ggplot2 x gridに親しんでいきましょう。

⓪ 例示用データの作成

適当にデータを二つ作ります。

# 以降で使用するパッケージの読み込み (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

① まとめたい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のデフォルトの色を知りたい を参考にしてください。
facet_wrap()で個別軸範囲指定については、baptiste様のstack overflowの回答を参考にしてください。
　　
事前にlegend作成の準備をしておきます。
重ねられる側のデータにlegend用の列を付け加え、
また重ねる側用のlegendを作るためにdummy_dataを作成します。
x値が揃っていない場合、合計範囲も算出しておきましょう。

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で作図します。

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) 化しておきましょう。

base_gtable <- ggplotGrob(base_plot)
additional_gtable <- ggplotGrob(additional_plot)

ggplot2の段階ではこのようなグラフです。

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

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

gtableの構造を見てみましょう。

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に収まっています。

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]です。

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軸はもっと簡単に抜き出せます。

additional_right_y_axis <- additional_gtable$grobs[[9]]

③ 重ねられる側の右y軸を消去 (見えなくする)

次に、重ねられる側の右y軸を見えなくします。
右y軸のabsoluteGrobのパラメータにalpha = 0を追加することでこれを実現します。

Grob系オブジェは色といった作図パラメータをgpというリスト内に持っており、
gpar()関数に指定したいパラメータを与えて、これに突っ込むことで書き換えができます。

base_gtable$grobs[[9]]$gp <- gpar(alpha = 0)    # 右y軸のindexは先ほど同様9です。

これで、重ねられる側の右y軸が見えなくなりました (完全透過)。

④ 抜き出した点・線・右y軸を重ねる

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

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)

完成！！

grid.newpage()
grid.draw(base_and_additional_grobs)

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

Let's enjoy !!