主页 / coding / 问题 / 77268579
Accepted
Daniel D. Sjoberg
Asked: 2023-10-11 03:44:27 +0800 CST

使用 S7 包装 S3 类

  • 772

我正在尝试使用 R 中引入的新 S7 OOP（https://github.com/RConsortium/S7）。我想使用 S7 来包装一元运算符的 S3 方法|。

我有一个 class 对象"ggsurvfit"，我想定义三个新方法：

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

几周前，我很幸运能够与 Hadley Wickham（他是开发 S7 的 R Consortium 团队的成员）在同一个房间，他好心地向我提供了下面的代码，以使用 S7 包装 S3 方法。（我添加了返回的文本字符串仅供参考）


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"
}

我遇到的问题是我无法启动/触发这些方法。在下面的示例中，我希望/期望操作返回 string "This is ggsurvfit|ggplot"。我在这里缺少什么？谢谢你！

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

创建于 2023 年 10 月 10 日，使用reprex v2.0.2

1 个回答

  1. Best Answer

    我认为问题在于这|不是 S7 方法，也不"ggsurvfit"是 S7 类。文档说的method<-是

    这不是通用方法注册函数：通用和签名至少其中之一需要来自 S7。

    包装现有的 S3 类new_S3_class不会使其成为 S7 类 - 它只是声明您要使用的类是 S3。由于您可能不想创建|S7 通用型，因此最好的选择可能是将 ggsurvfit 包装在 S7 类中。这似乎可以解决问题：

    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"
}

    当然，您需要ggsurvfit在本示例的包装器中创建 。在生产中，您可能会将 ggsurvfit 重写为S7类，但这给了您这样的想法：

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

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

    但观察到正确的行为：

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

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

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

    当然，您需要print为包装器定义一个方法，但这在 S7 中似乎非常简单

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

plot1

    在此输入图像描述

    创建于 2023 年 10 月 10 日，使用reprex v2.0.2

    • 4

相关问题