S3 Methods: Extending ggplot2 `+.gg` function

Question

I am trying to extend ggplot2 with a new class that we will call foo for this example. The goal is to write a +.foo method that will be used in place of +.gg. However I am running into an issue of "incompatible methods"

The Setup

Currently I am able to write ggplot_add.foo_layer which will make plot into my foo class and then add the corresponding layer as normal.

The idea is that once the plot object inherits foo it will dispatch to +.foo when the next layer added.

The reason I would like to do this is because I want to check if the structure of foo object is still valid/compatible with the incoming layer. This will prevent me from having to write a method for ggplot_build.

Code Definitions

library(ggplot2)

`+.foo` <- function(e1, e2){
  cat("Using foo ggplot +") # for Debugging
  NextMethod() #ideally just dispatches to `+.gg`
}

ggplot_add.foo_layer <- function(object, plot, object_name) {
  plot <- as_foo(plot)
  ggplot2:::add_ggplot(plot, object$layer, object_name) 
}

as_foo <- function(x){
  if(!is_foo(x)){
    class(x) <- c("foo", class(x))
  }
  x
}

is_foo <- function(x) inherits(x, "foo")

foo_layer <- function(x) structure(list(layer = x), class = "foo_layer")

The Error

p1 <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
  geom_point()
class(p1)
#[1] "gg"     "ggplot"
p1 + geom_density(aes(y = after_stat(density)))


p2 <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
  foo_layer(geom_point()) 

class(p2)
#[1] "foo"    "gg"     "ggplot"
p2 + geom_density(aes(y = after_stat(density)))
#Error in p2 + geom_density(aes(y = after_stat(density))) : 
#  non-numeric argument to binary operator
#In addition: Warning message:
#Incompatible methods ("+.foo", "+.gg") for "+" 

From the code above p1 + geom_* executes fine. However p2 + geom_* can not be made due to the above error about Incompatible methods. From what I know about S3 method dispatch I don't understand why this would not work. Could someone explain why this is or how I could remedy this.

Ideally I would not have to write a method ggplot_build.foo because I want other package's ggplot_build to be used if they exist (for example gganimate).

Answer 1

One thing you can do is to overwrite ggplot2:::+gg method to support double dispatch in S3. This isn't really good behaviour if you're writing a package, but it gets the job done. Note that this being naughty behaviour hasn't stopped other packages from overwriting ggplot's functions (looking at you, ggtern).

library(ggplot2)

`+.gg` <- function(e1, e2) {
  UseMethod("+.gg")
}

`+.gg.default` <- ggplot2:::`+.gg`

`+.gg.foo` <- function(e1, e2) {
  cat("Using foo ggplot +")
  NextMethod()
}

ggplot_add.foo_layer <- function(object, plot, object_name) {
  plot <- as_foo(plot)
  ggplot2:::add_ggplot(plot, object$layer, object_name) 
}

as_foo <- function(x){
  if(!is_foo(x)){
    class(x) <- c("foo", class(x))
  }
  x
}

is_foo <- function(x) inherits(x, "foo")

foo_layer <- function(x) structure(list(layer = x), class = "foo_layer")

p1 <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
  geom_point()

p2 <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
  foo_layer(geom_point()) 


p2 + geom_density(aes(y = after_stat(density)))
#> Using foo ggplot +

^{Created on 2021-01-20 by the reprex package (v0.3.0)}

Answer 2

Thanks the resource provided by @teunbrand, we can use S4 to safely dispatch with +

EDIT ----

It seems that between sessions this code is not actually dispatching on my defined S4 method +. For some reason its still dispatching to +.gg. I will do some research on dispatching on why this is, but for the time being, the below code does not work.

S4 class Definitions

setOldClass(c("gg", "ggplot")) #required to make it inherit from gg
setClass("Foo", contains = c("gg","ggplot", "list"))
setMethod("initialize", "Foo",
          function(.Object, plot){
            .Object[names(plot)] <- plot
            .Object 
          } )


setMethod("+", signature(e1 = "Foo",e2 = "gg"),
          function(e1, e2){
            cat("Using S4 Method")
            gg <- ggplot2:::`+.gg`(e1, e2)
            as_foo(gg) #ensure that new layers (from other packages) dont return S3
          })
setMethod("show", signature("Foo"),
          function(object){
          ggplot2:::print.ggplot(object)})

ggplot_add.foo_layer <- function(object, plot, object_name) {
  plot <- as_foo(plot)
  ggplot2:::add_ggplot(plot, object$layer, object_name)
}

as_foo <- function(x){
  if(!is_foo(x)){
    x <- new("Foo", x)
  }
  x
}

is_foo <- function(x) inherits(x, "Foo")

foo_layer <- function(x) structure(list(layer = x), class = "foo_layer")

For all intents and purposes, the new foo object 'behaves' like a standard ggplot object.

p2 <- ggplot(iris, aes(Sepal.Width, Sepal.Length, color = Species)) +
  foo_layer(geom_point())
p2 + geom_density(aes(y = after_stat(density)))

Additionally, Other packages like gganimate will still return a Foo object but call their own ggplot_build S3 method

library(gganimate)
anim <- p2 + transition_states(Species)
is_foo(anim)
inherits(anim, "gganim")
anim