更新 S3 方法调用

Updating S3 methods calls

我正在尝试更新对我使用新 class 开发的新功能的调用。开发过程与 Leish 文章 "Creating R packages".

中的 linmod 非常相似

在函数内部,调用存储为match.call()

当我尝试更新调用时,如下:

library(MASS)
fit <- linmod(Hwt~Bwt*Sex, data=cats)
update(fit, subset = -1)

我收到以下错误消息:

Error in eval(expr, envir, enclos) : could not find function "linmod.formula"

问题似乎是 match.call() 保存了完整的 S3 方法名称 (linmod.formula),而不是仅保存通用函数名称 (linmod),这将完美运行。

谁能帮我解决这个问题?

我知道解决这个问题的最简单方法是导出方法。为此,您需要添加 @export linmod.formula。当然一般不建议导出方法

另一种选择是为 update 创建一个方法。以下是 update.default 的副本,增加了一行:

#' @export
update.linmod <- function (object, formula., ..., evaluate = TRUE) 
{
  if (is.null(call <- getCall(object))) 
    stop("need an object with call component")
  extras <- match.call(expand.dots = FALSE)$...
  #call generic instead of method:
  call[[1]] <- quote(linmod)
  if (!missing(formula.)) 
    call$formula <- update.formula(formula(object), formula.)
  if (length(extras)) {
    existing <- !is.na(match(names(extras), names(call)))
    for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
    if (any(!existing)) {
      call <- c(as.list(call), extras[!existing])
      call <- as.call(call)
    }
  }
  if (evaluate) 
    eval(call, parent.frame())
  else call
}

我不喜欢这两个选项,并且会避免使用 linmod 函数的方法。你的默认方法对我来说似乎没用。请注意,例如,lm 不是 S3 泛型。

PS: update 没有 subset 参数。

由于此处尚未提及,这是?update中明确推荐的方法:为getCall编写一个方法。来自 ?update:

“Extracting the call” in update() and similar functions uses getCall() which itself is a (S3) generic function with a default method that simply gets x$call. Because of this, update() will often work (via its default method) on new model classes, either automatically, or by providing a simple getCall() method for that class.

那么,在您的包裹中,如果您有:

#' @export
f <- function(x) {
  UseMethod("f")
}

#' @export
f.bar <- function(x) {
  structure(list(x = x, call = match.call()), class = "fbar")
}

#' @export
#' @importFrom stats getCall
getCall.fbar <- function(x) {
  x$call[[1L]] <- quote(f) # replacing `f.bar`
  x$call
}

然后,在您的脚本中,您可以:

x1 <- structure(1, class = "bar")
x2 <- structure(2, class = "bar")

fx1 <- f(x = x1)
fx2 <- update(fx1, x = x2)

fx1
# $x
# [1] 1
# attr(,"class")
# [1] "bar"
#
# $call
# f.bar(x = x1)
#
# attr(,"class")
# [1] "fbar"

fx2
# $x
# [1] 2
# attr(,"class")
# [1] "bar"
# 
# $call
# f.bar(x = x2)
# 
# attr(,"class")
# [1] "fbar"