Question

我有一堆定制的参考类，并且想为其中一些编写强制方法。如果函数调用看起来像这样会很好：

objectCoerce(src=obj, to="list", ...)

其中...是关键部分，因为有时我想为某些强制措施传递额外的内容（请参阅下面的do.deep = TRUE/FALSE。

但是，为了做到这一点，我是否需要实现一个带有to参数的“变换器”，尝试实例化to指定的类的空对象然后调用“常规”方法调度？或者有更好的方法吗？

下面你会找到我目前的解决方案。它有效，但我“失去”强制选择类character"的选项，因为这个类用于处理常规调度程序的事情，to = "character会导致无限递归。另外，这是一个很大的开销。

编辑2011-12-02

当然setAs将是第一个要检查的地址。但是def中{arg setAs指定的函数只能接受一个参数，而且这对我来说太过刻板。例如，我在使用do.deep = TRUE/FALSE时看不到如何包含setAs开关。

Class Defs

setRefClass(Class="MyVirtual")

setRefClass(
    Class="A",
    contains="MyVirtual",
    fields=list(
        x="character"
    )
)

setRefClass(
    Class="B",
    contains="MyVirtual",
    fields=list(
        x.a="A",
        x.b="numeric",
        x.c="data.frame"
    )
)

setGeneric(
    name="objectCoerce",
    signature=c("src", "to"),
    def=function(src, to, ...){
        standardGeneric("objectCoerce")       
    }
)

通用方法

setGeneric(
    name="objectCoerce",
    signature=c("src", "to"),
    def=function(src, to, ...){
        standardGeneric("objectCoerce")       
    }
)

中级变压器

setMethod(
    f="objectCoerce",
    signature=signature(src="ANY", to="character"),
    definition=function(src, to, do.deep=FALSE, ...){        

    # Transform 'to' to a dummy object of class 'to'
    to.0 <- to
    # For standard R classes
    try.res <- try(eval(substitute(
        to <- CLASS(), 
        list(CLASS=as.name(to.0))
    )), silent=TRUE)
    # For S4 classes
    if(inherits(try.res, "try-error")){
        try.res <- try(eval(substitute(
            to <- new(CLASS), 
            list(CLASS=to.0)
        )), silent=TRUE)
        # For my classes. In order to get an 'hollow' object, some of them 
        # need to be instantiated by 'do.hollow=TRUE'
        if(inherits(try.res, "try-error")){
            try.res <- try(eval(substitute(
                to <- new(CLASS, do.hollow=TRUE), 
                list(CLASS=to.0)
            )), silent=TRUE)
            if(inherits(try.res, "try-error")){
                stop(try.res)
            }
        }
    }
    # Pass transformed 'to' along so the standard method 
    # dispatcher can kick in.
    out <- objectCoerce(src=src, to=to, do.deep=do.deep, ...)
    return(out)
    }
)

强制方法'MyVirtual'到'list'

setMethod(
    f="objectCoerce",
    signature=signature(src="MyVirtual", to="list"),
    definition=function(src, to, do.deep=FALSE, ...){        

    fields <- names(getRefClass(class(src))$fields())
    out <- lapply(fields, function(x.field){
        src$field(x.field)        
    })
    names(out) <- fields

    if(do.deep){
        out <- lapply(out, function(x){
            out <- x
            if(inherits(x, "MyVirtual")){
                out <- objectCoerce(src=x, to=to, do.deep=do.deep, .ARGS=.ARGS)
            }     
            return(out)
        })
    }

    return(out)

    }
)

测试运行

x <- new("B", x.a=new("A", x="hello world!"), x.b=1:5, 
    x.c=data.frame(a=c(TRUE, TRUE, FALSE)))

> objectCoerce(src=x, to="list")
$x.a
Reference class object of class "A"
Field "x":
[1] "hello world!"

$x.b
[1] 1 2 3 4 5

$x.c
      a
1  TRUE
2  TRUE
3 FALSE

> objectCoerce(src=x, to="list", do.deep=TRUE)
$x.a
$x.a$x
[1] "hello world!"


$x.b
[1] 1 2 3 4 5

$x.c
      a
1  TRUE
2  TRUE
3 FALSE

Answer 1

也许使用setAs来创建一个强制方法（虽然人们宁愿有一个自己的基类来编写方法，而不是为envRefClass做这个）

setAs("envRefClass", "list", function(from) {
    fields <- names(getRefClass(class(from))$fields())
    Map(from$field, fields)
})

然后

> as(new("B"), "list")
$x.a
Reference class object of class "A"
Field "x":
character(0)

$x.b
numeric(0)

$x.c
data frame with 0 columns and 0 rows

？深层版本可能就像

setAs("envRefClass", "list", function(from) {
    fields <- names(getRefClass(class(from))$fields())
    curr <- Map(from$field, fields)
    recurr <- sapply(curr, is, "envRefClass")
    curr[recurr] <- lapply(curr[recurr], as, "list")
    curr
})

我没有很好的想法来组合这些，除了创建一个伪类'deep_list'和一个强制方法。我觉得我不理解你的帖子。

如何写强制方法