Come scrivere i metodi di coercizione

Question

Sto avendo un sacco di classi di riferimento su misura e vorrebbe scrivere i metodi di coercizione per alcuni di loro. Sarebbe bello se una chiamata di funzione sarebbe simile a questa:

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

dove ... è la parte cruciale come a volte voglio passare roba supplementare applicabile a determinati coercizioni (vedi do.deep = TRUE/FALSE qui sotto.

Tuttavia, al fine di farlo, devo realizzare una sorta di "trasformatore" che prende l'argomento to, tenta di un'istanza di un oggetto vuoto della classe specificata da to e poi chiama la "regolare" metodo della spedizione? O c'è un modo migliore?

Di seguito troverete la mia soluzione attuale. Funziona, ma sto "perdere" la possibilità di costringere alla classe character" come questa classe viene utilizzata per le cose di processo al dispatcher regolare e una to = "character si tradurrebbe in una ricorsione infinita. Inoltre, è un sacco di spese generali.

EDIT 2011-12-02

Naturalmente setAs sarebbe il primo indirizzo per controllare. Ma la funzione specificata da def arg in setAs può prendere un solo argomento, e spesso che è troppo rigido per me. Ad esempio, non vedo come potrei includere lo switch do.deep = TRUE/FALSE quando si utilizza setAs.

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

Generico Metodo

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

Intermedio Transformer

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

La coercizione Metodo 'MyVirtual' a 'lista'

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)

    }
)

Esecuzione test

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

Forse utilizzare Setas per creare un metodo di costringere (anche se si dovrebbe piuttosto avere la propria classe di base di scrivere il metodo su, piuttosto che fare questo per envRefClass)

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

e quindi

> 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 versione profonda potrebbe essere come

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

Non ho buone idee per la combinazione di questi, se non per creare una pseudo-class 'deep_list' e un metodo costringere a questo. Mi sento come se non sto capendo il tuo post.