相关疑难解决方法(0)

定义一个应该具有S3和S4类实现的通用函数的好方法是什么？我一直在使用这样的东西:

setGeneric("myfun", function(x, ...){  
    standardGeneric("myfun");
});

setMethod("myfun", "ANY", function(x, ...) {
    if(!isS4(x)) {
        return(UseMethod("myfun"));
    }
    stop("No implementation found for class: ", class(x));
});

这成功了:

myfun.bar <- function(x, ...){
    return("Object of class bar successfully dispatched.");
}
object <- structure(123, class=c("foo", "bar"));
myfun(object)

是否有一种"原生"方式来实现这一目标？我知道我们可以使用S3类定义S4方法setOldClass,但是这样我们就失去了S3方法调度,以防对象有多个类.例如(在一个干净的会议中):

setGeneric("myfun", function(x, ...){  
    standardGeneric("myfun");
});

setOldClass("bar")
setMethod("myfun", "bar", function(x, ...){
    return("Object of class bar successfully dispatched.");
});

object <- structure(123, class=c("foo", "bar"));
myfun(object)

这会失败,因为object在这种情况下bar,第二类被忽略.我们可以通过在foo和之间定义正式的S4继承来解决这个问题bar,但是对于我的应用程序,我宁愿myfun.bar在一个类的S3对象上开箱即用bar. …

我正在尝试添加一个merge需要为S4 的空间方法(因为它会调度两个不同对象的类型).

我尝试使用如下的早期解决方案:

#' Merge a SpatialPolygonsDataFrame with a data.frame
#' @param SPDF A SpatialPolygonsDataFrame
#' @param df A data.frame
#' @param \dots Parameters to pass to merge.data.frame
#' 
#' @export
#' @docType methods
#' @rdname merge-methods
setGeneric("merge", function(SPDF, df, ...){
  cat("generic dispatch\n")
  standardGeneric("merge")
})
#' @rdname merge-methods
#' @aliases merge,SpatialPolygonsDataFrame,data.frame-method
setMethod("merge",c("SpatialPolygonsDataFrame","data.frame"), function(SPDF,df,...) {
  cat("method dispatch\n")
})

哪个工作:

x <- 1
class(x) <- "SpatialPolygonsDataFrame"
y <- data.frame()
> merge(x,y)
generic dispatch
method dispatch

你将不得不相信我,如果x实际上是一个SPDF而不是伪造的,它不会返回你实际运行该代码时得到的插槽错误(或者没有,只是使用更宽松的通用以下不会返回错误).SPDF是一种痛苦的创造.

问题是它似乎覆盖了S3调度:

> …

我定义了两个类，它们可以成功添加两个自己的对象或一个数字和一个自己的对象。

a <- structure(list(val = 1), class = 'customClass1')
b <- structure(list(val = 1), class = 'customClass2')
`+.customClass1` <- function(e1, e2, ...){
  val1 <- ifelse(is.numeric(e1), e1, e1$val)
  val2 <- ifelse(is.numeric(e2), e2, e2$val)
  val_res <- val1  + val2
  print('customClass1')
  return(structure(list(val = val_res), class = 'customClass1'))
}
`+.customClass2` <- function(e1, e2, ...){
  val1 <- ifelse(is.numeric(e1), e1, e1$val)
  val2 <- ifelse(is.numeric(e2), e2, e2$val)
  val_res <- val1  + val2
  print('customClass2')
  return(structure(list(val = val_res), class = 'customClass1'))
}
print.customClass1 <- function(x, ...){
  print(x$val)
}
print.customClass2 …