Come scrivere i metodi di coercizione
-
27-10-2019 - |
Domanda
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
Soluzione
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.