0

我有一堆定制的参考类，想为其中一些编写强制方法。如果函数调用如下所示，那就太好了：

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

关键部分在哪里...，因为有时我想为某些强制传递额外的东西（见do.deep = TRUE/FALSE下文。

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

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

编辑 2011-12-02

当然setAs将是第一个要检查的地址。但是 arg defin指定的函数setAs只能接受一个参数，这对我来说通常太死板了。例如，我看不到如何do.deep = TRUE/FALSE在使用setAs.

类定义

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
4

1 回答 1

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”和一个强制方法之外，我没有组合这些的好主意。感觉看不懂你的帖子。

于 2011-12-01T20:56:08.027 回答