Общие методы 'factor' и 'as.factor'

Question

Я разработал класс S3 в R, который ведет себя очень похоже на фактор-переменную, хотя и не точно. Единственный snafu, который я оставил в моей реализации, заключается в том, что factor и as.factor не являются дженериками.

я обойти это ограничение для моего личного использования перекрывая base::factor в функции .onload в моем пакете следующим образом:

.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 имеет один дополнительный аргумент.

Answer 1

Нет необходимости заменять функции base. Просто переопределите их в своем пакете, чтобы сделать их обобщенными.

Таким образом, внутри упаковки, сделайте следующее:

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

factor.default = base::factor 

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

Так как ваш пакет будет attach ред после base, это factor переопределение будет найден первым.

Answer 2

Ответил на мой вопрос. Код ниже заменил исходную функцию .onLoad в моем пакете. Это не полностью удовлетворить мое желание, чтобы пользователи могли позвонить as.factor(obj,arg='arg') где obj является объектом класса MYCLASS, поэтому я ставлю код из исходного .onLoad выше способом в функцию под названием setGenerics(), которая создает S3 генерик factor и as.factor в запрос пользователя.

Я доволен этим решением. Я просто надеюсь, что это удовлетворит требования 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')