'factor' 和 'as.factor' 的通用方法

Generic methods of 'factor' and 'as.factor'

我在 R 中开发了一个 S3 class,其行为与因子变量非常相似,但不完全相同。我在我的实现中留下的唯一混乱是 factoras.factor 不是泛型。

我通过在我的包中的 .onload 函数中覆盖 base::factor 来绕过这个限制供我个人使用,如下所示:

.onAttach <- function(libname,pkgname){

    # note that as.factor is not a generic -- need to override it
    methods:::bind_activation(on = TRUE)

    # TODO: make a better attmept to deterime if base::factor is a generic or not.
    if(!length(ls(pattern='^as\.factor\.default$', envir=as.environment('package:base'),all.names=TRUE))){

        # bind  the current implementation of 'as.factor' to 'as.factor.default'
        assign('as.factor.default',
               base:::as.factor,
               envir=as.environment('package:base'))

        # unock the binding for 'as.factor' 
        unlockBinding('as.factor', as.environment('package:base'))

        # bind the generic to 'as.factor' in the 'package:base'
        assign('as.factor',
               function (x,...) UseMethod('as.factor') ,
               envir=as.environment('package:base'))

        # re-lock the binding for 'as.factor' 
        lockBinding('as.factor', as.environment('package:base'))
    }
    [similar code for making 'factor' and 'table' behave as generics excluded]
}

但是我知道修改 base 永远不会在 CRAN 上运行,所以我很好奇是否有解决方法。正如@BondedDust 指出的那样,我当然可以将负责强制转换为普通因子(当前名为 as.factor.MYCLASS)的函数重命名为 As.factor 之类的东西,但我不想走那条路,因为这意味着用户必须编写如下代码:

#coerce x to a factor
if(inherits(x,'MYCLASS'))
    x <- As.factor(x)
else
    x <- as.factor(x)

if(inherits(x,'MYCLASS'))
    x <- Factor(x)
else
    x <- factor(x)

对因子的强制转换没有作为通用实现,这让人感觉很奇怪。

我也尝试了 .onAttach

的这个实现
.onAttach <- function(libname,pkgname){

    setOldClass(c("MYCLASS"),
                where=as.environment('package:MyPackage'))

    setMethod('factor',
            signature(x='MYCLASS'),
            factor.MYCLASS,
            where=as.environment('package:MyPackage'))

}

但我收到此错误消息:

Error in rematchDefinition(definition, fdef, mnames, fnames, signature) : 
   methods can add arguments to the generic ‘factor’ only if '...' is an 

因为 factor 没有使用 dots 参数,而我的 factor.MYCLASS 还有一个参数。

回答了我自己的问题。下面的代码已经替换了我包中原来的.onLoad函数。这并没有完全满足我希望用户能够调用 as.factor(obj,arg='arg') 的愿望,其中 obj 是一个带有 class MYCLASS 的对象,所以我把代码从原来的 .onLoad 方法转换为名为 setGenerics() 的函数,该函数根据用户的请求为 factoras.factor 创建 S3 泛型。

我对这个解决方案非常满意。我只是希望这能满足 CRAN 的要求。

# create a virtual S4 class from my S3 class
setOldClass(c("MYCLASS"))

# set methods for the virtual S4 classes of 'ordered','factor'
setMethod('as.ordered',
        signature(x='MYCLASS'),
        function(x)as.factor.MYCLASS(x,ordered=T))

setMethod('as.factor',
        signature(x='MYCLASS'),
        function(x)as.factor.MYCLASS(x))

setMethod('factor',
        signature(x='MYCLASS'),
        # re-capitulate the signature for base::factor()
        function (x , levels, labels = levels, exclude = NA, 
            ordered = is.ordered(x), nmax = NA) {
            ARGS <- list(x=x)
            if(!missing(levels))
                args['levels'] <- levels
            if(!missing(labels))
                args['labels'] <- labels
            if(!missing(exclude))
                args['exclude'] <- exclude
            if(!missing(ordered))
                args['ordered'] <- ordered
            if(!missing(nmax))
                warning('unused argument `nmax` in factor.MYCLASS')
            do.call(as.factor.MYCLASS,ARGS)
        })


setGenerics <- function(){

    [contents from the original .onLoad method]

}

.onAttach <- function(libname,pkgname)
    cat('Call setGenerics() for increased compatibility with `factor`, `as.factor`, and `table`.\n')

完全没有必要替换base功能。只需在您的包中覆盖它们,使它们通用。

所以,在你的包裹里,做:

factor = function (...)
    UseMethod('factor')

factor.default = base::factor

factor.MyClass = function (...) your logic

由于您的包将在 base 之后 attach 编辑,因此将首先找到此 factor 重新定义。