Wrapping S3 classes using S7

Question

I am trying to use the new S7 OOP being introduced to R (https://github.com/RConsortium/S7). I would like to use S7 to wrap an S3 method for the unary operator |.

I have an object of class "ggsurvfit", and I would like to define three new methods:

`|`(ggsurvfit, ggsurvfit)
`|`(ggsurvfit, ggplot)
`|`(ggplot, ggsurvfit)

A couple of weeks ago I was lucky enough to be in the same room with Hadley Wickham (who is part of the R Consortium team developing S7) and he kindly provided me the code below to wrap the S3 method using S7. (I added the returned text string FYI)

method(`|`, list(new_S3_class("ggsurvfit"), new_S3_class("ggsurvfit"))) <- function(e1, e2) { 
  "This is ggsurvfit|ggsurvfit"
}
method(`|`, list(new_S3_class("ggsurvfit"), new_S3_class("ggplot"))) <- function(e1, e2) { 
  "This is ggsurvfit|ggplot"
}
method(`|`, list(new_S3_class("ggplot"), new_S3_class("ggsurvfit"))) <- function(e1, e2) { 
  "This is ggplot|ggsurvfit"
}

The issue I am having is that I can't get these methods to be initiated/triggered. In the example below, I was hoping/expecting the operation to return the string "This is ggsurvfit|ggplot". What am I missing here? THANK YOU!

library(ggsurvfit)
#> Loading required package: ggplot2

S7::method(`|`, list(S7::new_S3_class("ggsurvfit"), S7::new_S3_class("ggplot"))) <- function(e1, e2) { 
  "This is ggsurvfit|ggplot"
}

plot1 <- 
  survfit2(Surv(time, status) ~ sex, data = df_lung) |> 
  ggsurvfit() +
  add_risktable()
class(plot1)
#> [1] "ggsurvfit" "gg"        "ggplot"

plot2 <- 
  ggplot(mtcars, aes(mpg, cyl)) +
  geom_point()
class(plot2)
#> [1] "gg"     "ggplot"

ret <- plot1 | plot2
#> Error in plot1 | plot2: operations are possible only for numeric, logical or complex types

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

Answer 1

I think the problem is that | is not an S7 method, and "ggsurvfit" is not an S7 class. The docs say about method<- that

this is not a general method registration function: at least one of generic and signature needs to be from S7.

Wrapping an existing S3 class in new_S3_class does not make it an S7 class - it just declares that a class you want to use is S3. Since you probably don't want to make | an S7 generic, your best option may be to wrap your ggsurvfit in an S7 class. This seems to do the trick:

library(S7)
library(ggsurvfit)
#> Loading required package: ggplot2

ggsurvfit_S7 <- new_class("ggsurvfit_S7",
                   properties = list(
                     obj = new_S3_class("ggsurvfit")
                   )
)

method(`|`, list(ggsurvfit_S7, new_S3_class("ggplot"))) <- function(e1, e2) { 
  "This is ggsurvfit|ggplot"
}

method(`|`, list(new_S3_class("ggplot"), ggsurvfit_S7)) <- function(e1, e2) { 
  "This is ggplot|ggsurvfit"
}

method(`|`, list(ggsurvfit_S7, ggsurvfit_S7)) <- function(e1, e2) { 
  "This is ggsurvfit|ggsurvfit"
}

Of course, you will need to create the ggsurvfit in the wrapper for this example. In production you would likely rewrite ggsurvfit to be an S7 class, but this gives you the idea:

plot1 <- ggsurvfit_S7(
  obj = survfit2(Surv(time, status) ~ sex, data = df_lung) |> 
        ggsurvfit() +
        add_risktable()
  )

plot2 <- ggplot(mtcars, aes(mpg, cyl)) + geom_point()

But the correct behaviour is observed:

plot1 | plot2
#> [1] "This is ggsurvfit|ggplot"

plot2 | plot1
#> [1] "This is ggplot|ggsurvfit"

plot1 | plot1
#> [1] "This is ggsurvfit|ggsurvfit"

Of course, you will need to define a print method for your wrapper, but this seems very straightforward in S7

method(print, ggsurvfit_S7) <- function(x, ...) print(x@obj, ...)

plot1

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