Force execution of a specified S3 method

Question

I am using the {patchwork} package internally in my package. I would like to utilize the patchwork arithmetic operators (ie |, \, etc).

I export methods for my class of objects. For example:

"|.ggsurvfit" <- function(e1, e2) {
  build_and_wrap(e1) | build_and_wrap(e2)
}

In the example above, when a figure of class 'ggsurvfit' is passed, it is processed and converted to class 'ggplot', then executed with the patchwork method "|.ggplot".

The issue I am encountering is that users need to combine a typical ggplot with a ggsurvfit plot. For example p1 | p2 where p1 has class 'ggplot' and p2 has class 'ggsurvfit'. The patchwork package exports a |.ggplot method which is being used. But we get an error because the |.ggplot doesn't know how to do the processing needed for the second argument that is class 'ggsurvfit'.

I am trying to write an S3 method |.ggplot that would handle the second argument appropriately. But I can't get anything to work...ugh!

Is there a way to force execution of some code via a specified S3 method, i.e. how can I force execution with patchwork's |.ggplot method?

"|.ggplot" <- function(e1, e2) {
  e2 <- build_and_wrap(e2) # process the second argument

  # patch together the figures using the patwork `|.ggplot` method
  withr::with_namespace(
    package = "patchwork",
    code = e1 | e2
  )
}

Answer 1

S3 is not designed for multiple dispatch. S4 is. A principled approach would be to define ggsurvfit as an S4 subclass of ggplot, and then define suitable S4 methods for | (or any other internally generic binary operator).

setOldClass("ggplot")
setClass("ggsurvfit", contains = "ggplot", slots = c(p = "ggplot"))

setMethod("|", c("ggplot", "ggsurvfit"), 
          function(e1, e2) <do stuff with e1   and e2@p here>)
setMethod("|", c("ggsurvfit", "ggplot"), 
          function(e1, e2) <do stuff with e1@p and e2   here>)
setMethod("|", c("ggsurvfit", "ggsurvfit"), 
          function(e1, e2) <do stuff with e1@p and e2@p here>)

Your package's DESCRIPTION and NAMESPACE files would need to change accordingly.

We can test that this works with a simple example. Here, classes a and b take the place of classes ggplot and ggsurvfit, and the S3 method |.a takes the place of |.ggplot from patchwork:

setOldClass("a")
setClass("b", contains = "a", slots = c(p = "a"))

.S3method("|",   "a",       function(e1, e2) "aa")
setMethod("|", c("a", "b"), function(e1, e2) "ab")
setMethod("|", c("b", "a"), function(e1, e2) "ba")
setMethod("|", c("b", "b"), function(e1, e2) "bb")

a <- structure(1, class = "a")
b <- new("b", p = structure(2, class = "a"))

a | a
## [1] "aa"
a | b
## [1] "ab"
b | a
## [1] "ba"
b | b
## [1] "bb"

For more details about hybrid use of S3 and S4, you can take a look at ?Methods_for_S3, ?setOldClass, and ?S3Part.

Answer 2

The following seems to work.
Instead of overloading the operator |.ggplot, define a new generic using the standard R syntax for infix operators, then define a method for objects of class "ggplot".

library(ggplot2)
library(ggsurvfit)
library(patchwork)

"%|%" <- function(e1, ...) UseMethod("%|%", e1)
"%|%.ggplot" <- function(e1, e2) {
  #e2 <- build_and_wrap(e2) # process the second argument
  
  # patch together the figures using the patwork `|.ggplot` method
  withr::with_namespace(
    package = "patchwork",
    code = e1 | e2
  )
}

g1 <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point()
g2 <- survfit2(Surv(time, status) ~ sex, data = df_lung) |>
  ggsurvfit()

g1 %|% g2

^{Created on 2022-10-14 with reprex v2.0.2}

---

Edit

Here is another idea. In the new method body there is no need to use the infix notation to call patchwork:::|.ggplot, so, don't.

library(ggplot2)
library(ggsurvfit)
library(patchwork)

"|.ggplot" <- function(e1, e2) {
  #e2 <- build_and_wrap(e2) # process the second argument
  
  # patch together the figures using the patwork `|.ggplot` method
  withr::with_namespace(
    package = "patchwork",
    code = patchwork:::`|.ggplot`(e1, e2)
  )
}

g1 <- ggplot(mtcars, aes(disp, mpg)) +
  geom_point()
g2 <- survfit2(Surv(time, status) ~ sex, data = df_lung) |>
  ggsurvfit()

g1 | g2

^{Created on 2022-10-14 with reprex v2.0.2}