Cómo escribir métodos de coerción

Question

Tengo un montón de clases de referencia hechas a medida y me gustaría escribir métodos de coerción para algunos de ellos. Sería bueno si una llamada de función se vería así:

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

dónde ... es la parte crucial, ya que a veces quiero pasar cosas adicionales para ciertas coerciones (ver do.deep = TRUE/FALSE abajo.

Sin embargo, para hacer eso, ¿necesito implementar una especie de "transformador" que tome el to argumento, trata de instanciar un objeto vacío de la clase especificado por to ¿Y luego llama al envío del método "regular"? ¿O hay un mejor camino?

A continuación encontrarás mi solución actual. Funciona, pero estoy "perdiendo" la opción de coaccionar a la clase character" ya que esta clase se utiliza para procesar cosas al despachador regular y un to = "character resultaría en una recursión infinita. Además, es una gran cantidad de sobrecarga.

Editar 2011-12-02

por supuesto setAs sería la primera dirección en verificar. Pero la función especificada por Arg def en setAs Solo puede tomar un argumento, y a menudo eso es demasiado rígido para mí. Por ejemplo, no veo cómo podría incluir el do.deep = TRUE/FALSE Cambiar al usar setAs.

Defs de clase

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")       
    }
)

Método genérico

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

Transformador intermedio

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)
    }
)

Método de coerción 'myVirtual' a '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)

    }
)

Prueba de funcionamiento

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

Tal vez use SETAS para crear un método de coercina (aunque preferiría tener una clase base propia para escribir el método, en lugar de hacerlo para EnvrefClass)

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

y entonces

> 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

? La versión profunda podría ser como

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
})

No tengo buenas ideas para combinarlas, aparte de crear una clase Psuedo 'Deep_list' y un método de coercina para eso. Siento que no entiendo tu publicación.