S3メソッドのdouble dispatch
複数のggplotオブジェクトをリストとして保持する独自のクラスを考えます。こんな感じ。
library(ggplot2) set.seed(100) d1 <- data.frame(x = 1:100, y = cumsum(runif(100))) d2 <- data.frame(x = 1:100, y = cumsum(runif(100))) plot_all <- function(...) { l <- lapply(list(...), function(d) ggplot(d, aes(x, y)) + geom_line()) l <- unname(l) class(l) <- "manyplot" l } print.manyplot <- function(x, ...) { do.call(gridExtra::grid.arrange, x) } p <- plot_all(d1, d2) p
これは、plot_all()の中でgridExtra::grid.arrange()してしまえばいいのでは？と思うかもしれませんが、いったんオブジェクトとして返すようにすることで、例えば独自のテーマを足し合わせるなんていう便利なことができます。
...と思うじゃないですか？ やってみるとなにかよく分からないエラーが出ます。
`+.manyplot` <- function(e1, e2) { l <- lapply(e1, function(x) x + e2) class(l) <- "manyplot" l } p + theme_bw() #> Warning: Incompatible methods ("+.manyplot", "+.gg") for "+" #> Error in p + theme_bw(): non-numeric argument to binary operator
これは、二項演算子のための特別なS3メソッドディスパッチの仕組み、「double dispatch」というやつが関わっています。 新版のAdvanced R.ではこの辺についても触れられているので読んでみましょう。
+で2つのものを足し合わせるという操作は順序に関係ないので、以下は同じ結果を返すはずです。
a + b b + a
しかし、ご存知のように、通常のS3のメソッドディスパッチは1つ目の引数に依存してメソッドが決まります。
この理屈でいくと、前者は+.a(a, b)、後者は+.b(a, b)として評価されることになり、結果が異なる可能性があります。
これを防ぐため、aによってディスパッチされる+のメソッドと、bによってディスパッチされる+のメソッドが同一のものをかをチェックする機構があるのです。
具体的には、以下のような挙動になる、と書かれています。
- The methods are the same, so it doesn’t matter which method is used.
- The methods are different, and R calls the first method with a warning.
- One method is internal, in which case R calls the other method.
ただ、どうもこれは間違っている気がします... これでいくと「The methods are different, and R calls the first method with a warning.」になる気がするんですが、実際には前者のメソッドではなくデフォルトのメソッドディスパッチが使われるようです。
つまり、p + theme_bw()はS3のメソッドディスパッチに失敗するので、listとして扱われるようです。で、listは足し合わせられないのでエラーになります。
list() + list() #> Error in list() + list(): non-numeric argument to binary operator
ではどうすればいいかというと、どうもS4クラスとして定義するしかないようです。 S3と違ってS4のメソッドディスパッチは複数のシグネチャを使って行われるので、こういうambiguityの問題は起こらず一意に定まります。
まず、先ほどのS3のクラスと同じ挙動をS4で実現してみましょう。S4を表示するときのメソッドはprint()ではなくshow()であることに注意して、こんな感じになります。
library(ggplot2) set.seed(100) d1 <- data.frame(x = 1:100, y = cumsum(runif(100))) d2 <- data.frame(x = 1:100, y = cumsum(runif(100))) # クラスを定義 setClass("manyplot", slots = c(plots = "list")) # クラスの表示を定義 setMethod("show", signature = "manyplot", function(object) { do.call(gridExtra::grid.arrange, object@plots) }) plot_all <- function(...) { l <- lapply(list(...), function(d) ggplot(d, aes(x, y)) + geom_line()) new("manyplot", plots = unname(l)) } p <- plot_all(d1, d2) p
次に、+のメソッドを定義します*1。
setOldClass("theme") setMethod("+", signature = c("manyplot", "theme"), function(e1, e2) { e1@plots <- lapply(e1@plots, function(x) x + e2) e1 }) p + theme_bw()
予想通り動きました。ちなみに、setOldClass()しないといけない理由はRプログラミング本格入門の補足的なやつに書いたので興味あれば読んでみてください。
しかしなんかもっと簡単な方法ないもんかな...とか言ってたら、そのうちvctrsで解決するかもしれないとのことです。
