What's the difference between setMethod("$<-") and set setReplaceMethod("$")? - r

Question
When programming in r with the s4 OOP system, when one have to use setReplaceMethod? I don't see what's the difference with the setMethod when adding <- to the name of the function. Does setMethod("$<-") and setReplaceMethod("$") are equal?
Documentation
I didn't find anything in the documentation with ?setReplaceMethod or ??setReplaceMethod. There is nothing except the usage.
In StackOverflow, there is several questions about setReplaceMethod but none helping. I started to search a answer to this question when I saw it seem's is not possible to use roxygen2 to document methods created with setReplaceMethod
I didn't find anything by searching in r-project.org
Reproductible example
library(methods)
# Create a class
setClass("TestClass", slots = list("slot_one" = "character"))
# Test with setMethod -----------------------
setMethod(f = "$<-", signature = "TestClass",
definition = function(x, name, value) {
if (name == "slot_one") x#slot_one <- as.character(value)
else stop("There is no slot called",name)
return(x)
}
)
# [1] "$<-"
test1 <- new("TestClass")
test1$slot_one <- 1
test1
# An object of class "TestClass"
# Slot "slot_one":
# [1] "1"
# Use setReplaceMethod instead -----------------------
setReplaceMethod(f = "$", signature = "TestClass",
definition = function(x, name, value) {
if (name == "slot_one") x#slot_one <- as.character(value)
else stop("There is no slot called",name)
return(x)
}
)
# An object of class "TestClass"
# Slot "slot_one":
# [1] "1"
test2 <- new("TestClass")
test2$slot_one <- 1
test2
# [1] "$<-"
# See if identical
identical(test1, test2)
# [1] TRUE
Actual conclusion
setReplaceMethod seems only to permit to avoid the <- when creating a set method. Because roxygen2 can't document methods produced with, it's better for the moment to use setMethod. Does I have right?

Here's the definition of setReplaceMethod
> setReplaceMethod
function (f, ..., where = topenv(parent.frame()))
setMethod(paste0(f, "<-"), ..., where = where)
<bytecode: 0x435e9d0>
<environment: namespace:methods>
It is pasting a "<-" on to the name, so is functionally equivalent to setMethod("$<-"). setReplaceMethod conveys more semantic meaning.

Related

implementation of dot function `.()` in data.table package [duplicate]

This question already has an answer here:
How is dot (.) alias for list constructor implemented in data.table package?
(1 answer)
Closed 4 years ago.
from ?data.table::data.table :
The expression '.()' is a shorthand alias to list(); they both mean
the same
However this function is nowhere to be found :
data.table:::.
Error in get(name, envir = asNamespace(pkg), inherits = FALSE) :
object '.' not found
So I suppose the input is parsed somehow, how is it done ? I'd like to use the same feature in my own package.
The following works not too bad :
test <- function(x) {
eval(substitute(
eval.parent(substitute(x, list(.=list)))
))
}
foo <- "bar"
test(.(foo))
# [[1]]
# [1] "bar"
identical(test(.(foo)), list(foo))
# [1] TRUE
However there will be some dot variables used inside this dot function, and this fails :
. <- "baz"
test(.(foo,.))
# [[1]]
# [1] "bar"
#
# [[2]]
# function (...) .Primitive("list")
Expected :
# [[1]]
# [1] "bar"
#
# [[2]]
# [1] "baz"
The data.table package accomplishes it with this bit of code
replace_dot_alias <- function(e) {
# we don't just simply alias .=list because i) list is a primitive (faster to iterate) and ii) we test for use
# of "list" in several places so it saves having to remember to write "." || "list" in those places
if (is.call(e)) {
# . alias also used within bquote, #1912
if (e[[1L]] == 'bquote') return(e)
if (e[[1L]] == ".") e[[1L]] = quote(list)
for (i in seq_along(e)[-1L]) if (!is.null(e[[i]])) e[[i]] = replace_dot_alias(e[[i]])
}
e
}
found in R/data.table.R (currently at line 173). That's why you don't find data.table:::. anywhere, and how they accomplish the parsing you mention in your post.
Then in [.data.table" <- function (x, i, j,... they can do this sort of thing
if (!missing(j)) {
jsub = replace_dot_alias(substitute(j))
root = if (is.call(jsub)) as.character(jsub[[1L]])[1L] else ""
....

Error in using match.arg for multiple arguments

I am new to using match.arg for default value specification in R functions. And I have a query regarding the below behavior.
trial_func <- function(a=c("1","9","20"),b=c("12","3"),d=c("55","01")){
a <- match.arg(a)
b <- match.arg(b)
d <- match.arg(d)
list(a,b,d)
}
trial_func()
# [[1]]
# [1] "1"
#
# [[2]]
# [1] "12"
#
# [[3]]
# [1] "55"
When I try using match.arg for each individual argument, it works as expected. But when I try to use an lapply to reduce the code written, it causes the below issue.
trial_func_apply <- function(a=c("1","9","20"),b=c("12","3"),d=c("55","01")){
lapply(list(a,b,d), match.arg)
}
trial_func_apply()
Error in FUN(X[[i]], ...) : 'arg' must be of length 1
Am I missing something here?
It's an old question, but I feel it's a great one, so I will try to provide extensive explanation for it by explaining the following:
Read the relevant documentation for ?match.arg
Make match.arg fail to guess the choices
Learn three features of the R language that match.arg uses underneath.
Simplified match.arg implementation
Make the lapply example of the question work
match.arg documentation
The usage tells you that match.arg needs the selected option you want to match (arg) and all the possible choices:
match.arg(arg, choices, several.ok = FALSE)
If we read choices, we see that it can often be missing, and we should read more in the details... How could match.arg work without having the possible choices, we wonder?
choices: a character vector of candidate values, often missing, see
‘Details’.
Maybe the Details section gives some hints (bold is mine):
Details:
In the one-argument form ‘match.arg(arg)’, the choices are
obtained from a default setting for the formal argument ‘arg’ of
the function from which ‘match.arg’ was called. (Since default
argument matching will set ‘arg’ to ‘choices’, this is allowed as
an exception to the ‘length one unless ‘several.ok’ is ‘TRUE’’
rule, and returns the first element.)
So, if you don't specify the choices argument, R will make a bit of effort to guess it right automagically. For the R magic to work, several conditions must be fulfilled:
The match.arg function must be called directly from the function with the argument
The name of the variable to be matched must be the name of the argument.
match.arg() can be tricked:
Let's make match.arg() fail to guess the choices:
dummy_fun1 <- function(x = c("a", "b"), y = "c") {
# If you name your argument like another argument
y <- x
# The guessed choices will correspond to y (how could it know they were x?)
wrong_choices <- match.arg(y)
}
dummy_fun1(x = "a")
# Error in match.arg(y) : 'arg' should be “c”
dummy_fun2 <- function(x = c("a", "b"), y = "c") {
# If you name your argument differently
z <- x
# You don't get any guess:
wrong_choices <- match.arg(z)
}
dummy_fun2(x="a")
#Error in match.arg(z) : 'arg' should be one of
Three R language features that match.arg needs and uses
(1) It uses non-standard evaluation to get the name of the variable:
whats_the_var_name_called <- function(arg) {
as.character(substitute(arg))
}
x <- 3
whats_the_var_name_called(x)
# "x"
y <- x
whats_the_var_name_called(y)
# "y"
(2) It uses sys.function() to get the caller function:
this_function_returns_its_caller <- function() {
sys.function(1)
}
this_function_returns_itself <- function() {
me <- this_function_returns_its_caller()
message("This is the body of this_function_returns_itself")
me
}
> this_function_returns_itself()
This is the body of this_function_returns_itself
function() {
me <- this_function_returns_its_caller()
message("This is the body of this_function_returns_itself")
me
}
(3) It uses formals() to get the possible values:
a_function_with_default_values <- function(x=c("a", "b"), y = 3) {
}
formals(a_function_with_default_values)[["x"]]
#c("a", "b")
How does match.arg work?
Combining these things, match.arg uses substitute() to get the name of the args variable, it uses sys.function() to get the caller function, and it uses formals() on the caller function with the argument name to get the default values of the function (the choices):
get_choices <- function(arg, choices) {
if (missing(choices)) {
arg_name <- as.character(substitute(arg))
caller_fun <- sys.function(1)
choices_as_call <- formals(caller_fun)[[arg_name]]
choices <- eval(choices_as_call)
}
choices
}
dummy_fun3 <- function(x = c("a", "b"), y = "c") {
get_choices(x)
}
dummy_fun3()
#[1] "a" "b"
Since we now know the magic used to get the choices, so we can create our match.arg implementation:
my_match_arg <- function(arg, choices) {
if (missing(choices)) {
arg_name <- as.character(substitute(arg))
caller_fun <- sys.function(1)
choices_as_call <- formals(caller_fun)[[arg_name]]
choices <- eval(choices_as_call)
}
# Really simple and cutting corners... but you get the idea:
arg <- arg[1]
if (! arg %in% choices) {
stop("Wrong choice")
}
arg
}
dummy_fun4 <- function(x = c("a", "b"), y = "c") {
my_match_arg(x)
}
dummy_fun4(x="d")
# Error in my_match_arg(x) : Wrong choice
dummy_fun4(x="a")
# [1] "a"
And that's how match.arg works.
Why it does not work under lapply? How to fix it?
To guess the choices argument, we look at the caller argument. When we use match.arg() inside an lapply call, the caller is not our function, so match.arg fails to guess the choices. We can get the choices manually and provide the choices manually:
trial_func_apply <- function(a=c("1","9","20"),b=c("12","3"),d=c("55","01")){
this_func <- sys.function()
the_args <- formals(this_func)
default_choices <- list(
eval(the_args[["a"]]),
eval(the_args[["b"]]),
eval(the_args[["d"]])
)
# mapply instead of lapply because we have two lists we
# want to apply match.arg to
mapply(match.arg, list(a,b,d), default_choices)
}
trial_func_apply()
# [1] "1" "12" "55"
Please note that I am cutting corners by not defining the environments where all the evals should happen, because in the examples above they work as-is. There may be some corner cases that make this examples to fail, so don't use them in production.
After investigating a bit, you need to pass the argument that your character vector is NULL, i.e.
trial_func_apply <- function(a=c("1","9","20"),b=c("12","3"),d=c("55","01")){
lapply(list(a,b,d), function(i)match.arg(NULL, i))
}
trial_func_apply()
#[[1]]
#[1] "1"
#[[2]]
#[1] "12"
#[[3]]
#[1] "55"

Why, for an integer vector x, does as(x, "numeric") trigger loading of an additional S4 method for coerce?

While my question is related to this recent one, I suspect its answer(s) will have to do with the detailed workings of R's S4 object system.
What I would expect:
(TLDR; -- All indications are that as(4L, "numeric") should dispatch to a function whose body uses as.numeric(4L) to convert it to a "numeric" vector.)
Whenever one uses as(object, Class) to convert an object to the desired Class, one is really triggering a behind-the-scenes call to coerce(). coerce(), in turn, has a bunch of methods that are dispatched to based on the signature of the function call -- here the class of its first and second arguments. To see a list of all available S4 coerce() methods, one can run showMethods("coerce").
Doing so shows that there is only one method for converting to class "numeric". It's the one with signature from="ANY", to="numeric":
showMethods("coerce")
# Function: coerce (package methods)
# from="ANY", to="array"
# ... snip ...
# from="ANY", to="numeric"
# ... snip ...
That method uses as.numeric() to perform its conversion:
getMethod("coerce", c("ANY", "numeric"))
# Method Definition:
#
# function (from, to, strict = TRUE)
# {
# value <- as.numeric(from)
# if (strict)
# attributes(value) <- NULL
# value
# }
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "ANY" "numeric"
# defined "ANY" "numeric"
Given its signature, and the fact that it's the only coerce() method for conversion to class "numeric",
I would've expected that the function shown above is what would be dispatched to by a call to as(4L, "numeric").
That expectation is only reinforced by running the following two checks.
## (1) There isn't (apparently!) any specific method for "integer"-->"numeric"
## conversion
getMethod("coerce", c("integer", "numeric"))
# Error in getMethod("coerce", c("integer", "numeric")) :
# no method found for function 'coerce' and signature integer, numeric
## (2) This says that the "ANY"-->"numeric" method will be used for "integer"-->"numeric"
## conversion
selectMethod("coerce", signature=c("integer", "numeric"))
# Method Definition:
#
# function (from, to, strict = TRUE)
# {
# value <- as.numeric(from)
# if (strict)
# attributes(value) <- NULL
# value
# }
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "integer" "numeric"
# defined "ANY" "numeric"
What actually happens:
(TLDR; In fact, calling as(4L, "numeric") loads and dispatches to a method that does nothing at all.)
Despite what all indications mentioned above, as(4L, "numeric") does not dispatch to the coerce() method for calls with signature c("ANY", "numeric").
Here are a couple of ways to show that:
## (1) as.numeric() would do the job, but as(..., "numeric") does not
class(as(4L, "numeric"))
#[1] "integer"
class(as.numeric(4L))
# [1] "numeric"
## (2) Tracing shows that the "generic" method isn't called
trace("coerce", signature=c("ANY", "numeric"))
as(c(FALSE, TRUE), "numeric") ## <-- It's called for "logical" vectors
# Tracing asMethod(object) on entry
# [1] 0 1
as(c("1", "2"), "numeric") ## <-- and for "character" vectors
# Tracing asMethod(object) on entry
# [1] 1 2
as(c(1L, 2L), "numeric") ## <-- but not for "integer" vectors
# [1] 1 2
untrace("coerce")
What method, then, is used? Well, apparently the act of calling as(4L, "numeric")
adds a new S4 method to the list of methods for coerce(), and it's what is used.
(Compare the results of the following calls to what they produced before we had attempted our
first "integer" to "character" conversion.)
## At least one conversion needs to be attempted before the
## "integer"-->"numeric" method appears.
as(4L, "numeric")
## (1) Now the methods table shows a new "integer"-->"numeric" specific method
showMethods("coerce")
# Function: coerce (package methods)
# from="ANY", to="array"
# ... snip ...
# from="ANY", to="numeric"
# ... snip ...
# from="integer", to="numeric" ## <-- Here's the new method
# ... snip ...
## (2) selectMethod now tells a different story
selectMethod("coerce", signature=c("integer", "numeric"))
# Method Definition:
#
# function (from, to = "numeric", strict = TRUE)
# if (strict) {
# class(from) <- "numeric"
# from
# } else from
# <environment: namespace:methods>
#
# Signatures:
# from to
# target "integer" "numeric"
# defined "integer" "numeric"
My questions:
Why does as(4L, "numeric") not dispatch to the available coerce() method for signature=c("ANY", "numeric")?
How/why does it instead add a new method to the S4 methods table?
From where (in R's source code or elsewhere) does the definition of the coerce() method for signature=c("integer", "numeric") come?
I'm not sure whether I can answer your question exhaustively, but I'll try.
The help of the as() function states:
The function ‘as’ turns ‘object’ into an object of class ‘Class’. In doing so, it applies a “coerce method”, using S4 classes and methods, but in a somewhat special way.
[...]
Assuming the ‘object’ is not already of the desired class, ‘as’ first looks for a method in the table of methods for the function 'coerce’ for the signature ‘c(from = class(object), to = Class)’, in the same way method selection would do its initial lookup.
[...]
If no method is found, ‘as’ looks for one. First, if either ‘Class’ or ‘class(object)’ is a superclass of the other, the class definition will contain the information needed to construct a coerce method. In the usual case that the subclass contains the superclass (i.e., has all its slots), the method is constructed either by extracting or replacing the inherited slots.
This is exactly what you can see if you look at the code of the as() function (to see it, type as (without the parentheses!) to the R console) - see below. First it looks for an asMethod, if it can't find any it tries to construct one, and finally at the end it executes it:
if (strict)
asMethod(object)
else asMethod(object, strict = FALSE)
When you copy-paste the code of the as() function and define your own function - let's call it myas() - your can insert a print(asMethod) above the if (strict) just mentioned to get the function used for coercing. In this case the output is:
> myas(4L, 'numeric')
function (from, to = "numeric", strict = TRUE)
if (strict) {
class(from) <- "numeric"
from
} else from
<environment: namespace:methods>
attr(,"target")
An object of class “signature”
from to
"integer" "numeric"
attr(,"defined")
An object of class “signature”
from to
"integer" "numeric"
attr(,"generic")
[1] "coerce"
attr(,"generic")attr(,"package")
[1] "methods"
attr(,"class")
[1] "MethodDefinition"
attr(,"class")attr(,"package")
[1] "methods"
attr(,"source")
[1] "function (from, to = \"numeric\", strict = TRUE) "
[2] "if (strict) {"
[3] " class(from) <- \"numeric\""
[4] " from"
[5] "} else from"
[1] 4
So, as you can see (look at attr(,"source")), the as(4L, 'numeric') simply assigns class numeric to the input object and returns it. Thus, the following two snippets are equivalent (for this case!):
> # Snippet 1
> x = 4L
> x = as(x, 'numeric')
> # Snippet 2
> x = 4L
> class(x) <- 'numeric'
Interestingly, both to 'nothing'. More interestingly, the other way round it works:
> x = 4
> class(x)
[1] "numeric"
> class(x) <- 'integer'
> class(x)
[1] "integer"
I'm not exactly sure about this (as the class method seems to be implemented in C) - but my guess would be that when assigning class numeric, it first checks whether it is already numeric. Which could be the case as integer is numeric (although not double) - see also the "historical anomaly" quote below:
> x = 4L
> class(x)
[1] "integer"
> is.numeric(x)
[1] TRUE
Regarding as.numeric:
This is a generic method and calls as.double(), which is why it 'works' (from the R help on as.numeric):
It is a historical anomaly that R has two names for its floating-point vectors, ‘double’ and ‘numeric’ (and formerly had ‘real’).
‘double’ is the name of the type. ‘numeric’ is the name of the mode and also of the implicit class.
Regarding questions (1) - (3): The magic happens in those four lines at the top of the as function:
where <- .classEnv(thisClass, mustFind = FALSE)
coerceFun <- getGeneric("coerce", where = where)
coerceMethods <- .getMethodsTable(coerceFun, environment(coerceFun), inherited = TRUE)
asMethod <- .quickCoerceSelect(thisClass, Class, coerceFun, coerceMethods, where)
Im lacking the time to dig into there, sorry.
Hope that helps.
Looking at the source code for as(), it has two parts. (The source code has been shortened for clarity). First, it looks for existing methods for coerce(), as you described above.
function (object, Class, strict = TRUE, ext = possibleExtends(thisClass,
Class))
{
thisClass <- .class1(object)
where <- .classEnv(thisClass, mustFind = FALSE)
coerceFun <- getGeneric("coerce", where = where)
coerceMethods <- .getMethodsTable(coerceFun, environment(coerceFun),
inherited = TRUE)
asMethod <- .quickCoerceSelect(thisClass, Class, coerceFun,
coerceMethods, where)
# No matching signatures from the coerce table!!!
if (is.null(asMethod)) {
sig <- c(from = thisClass, to = Class)
asMethod <- selectMethod("coerce", sig, optional = TRUE,
useInherited = FALSE, fdef = coerceFun, mlist = getMethodsForDispatch(coerceFun))
If it doesn't find any methods, as in this case, then it attempts to create a new method as follows:
if (is.null(asMethod)) {
canCache <- TRUE
inherited <- FALSE
# The integer vector is numeric!!!
if (is(object, Class)) {
ClassDef <- getClassDef(Class, where)
if (identical(ext, FALSE)) {}
else if (identical(ext, TRUE)) {}
else {
test <- ext#test
# Create S4 coercion method here
asMethod <- .makeAsMethod(ext#coerce, ext#simple,
Class, ClassDef, where)
canCache <- (!is(test, "function")) || identical(body(test),
TRUE)
}
}
if (is.null(asMethod)) {}
else if (canCache)
asMethod <- .asCoerceMethod(asMethod, thisClass,
ClassDef, FALSE, where)
if (is.null(asMethod)) {}
else if (canCache) {
cacheMethod("coerce", sig, asMethod, fdef = coerceFun,
inherited = inherited)
}
}
}
# Use newly created method on object here
if (strict)
asMethod(object)
else asMethod(object, strict = FALSE)
By the way, if you're only dealing with the basic atomic types, I would stick to base functions and avoid the methods package; the only reason to use methods is dealing with S4 objects.

Call more then one slot or fields in S4 or Reference Classes

Is it possible to call or set values for more then one slot?
A<-setClass(Class="A",slot=c(name="character",type="character"))
a<-A()
slot(object,c("name","type"),check=T)
Do I have to write own getSlot and setSlot methods? And how to that in R5?
AB <- setRefClass("AB", fields=c(name="character"),
methods=list(getName=AB.getName)
)
AB.getName<-function(object){
object$name
}
a<-AB(name="abc")
AB.getName(a)
This answer applies to reference classes.
Let's start with the simplest definition of AB, without any methods.
AB <- setRefClass(
"AB",
fields = list(
name = "character"
)
)
You can retrieve the value of the name field in the same way you would a list.
ab <- AB$new(name = "ABC")
ab$name
## [1] "ABC"
(ab$name <- "ABCD")
## [1] "ABCD"
It is possible to autogenerate accessor methods to get and set the name field.
AB$accessors("name")
ab$getName()
ab$setName("ABCDE")
This is really pointless though since it has the exactly same behaviour as before, but with more typing. What can be useful is to do input checking (or other custom behaviour) when you set a field. To do this, you can add a setName method that you write yourself.
AB$methods(
setName = function(x)
{
if(length(x) > 1)
{
warning("Only using the first string.")
x <- x[1]
}
name <<- x
}
)
ab$setName(letters)
## Warning message:
## In ab$setName(letters) : Only using the first string.
It is also possible (and usually more useful) to define this method when you assign the reference class template.
AB <- setRefClass(
"AB",
fields = list(
name = "character"
),
methods = list(
setName = function(x)
{
if(length(x) > 1)
{
warning("Only using the first string.")
x <- x[1]
}
name <<- x
}
)
)
Response to comment:
Yes that works, but:
getFieldNames is more maintainable if implemented as names(AB$fields()).
When defining fields in setRefClass, use a list. For example, list(name="character", var2="character").
When assigning an instance of a reference class, use new. For example, AB$new(name="abc",var2="abc")
In S4, the default initialize method allows one to write
A <- setClass(Class="A", slot=c(name="character",type="character"))
a <- A(name="abc", type="def")
initialize(a, name="cde", type="fgh")
Your own initialize methods (if any -- I think it's usually best to avoid them) have to be written to allow for this use. There is no default way to convert an S4 representation to a list.
You could incorporate these ideas into your own generics / methods with something like
setGeneric("values", function(x, ...) standardGeneric("values"))
setMethod("values", "A", function(x, ...) {
slts = slotNames(x)
lapply(setNames(slts, slts), slot, object=x)
})
setGeneric("values<-", function(x, ..., value) standardGeneric("values<-"))
setReplaceMethod("values", c(x="A", value="list"), function(x, ..., value) {
do.call("initialize", c(x, value))
})
with
> a <- A(name="abc", type="def")
> values(a) = list(name="cde", type="fgh")
> values(a)
$name
[1] "cde"
$type
[1] "fgh"

How to write coercion methods

I'm having a bunch of custom-made Reference Classes and would like to write coercion methods for some of them. It'd be nice if a function call would look like this:
objectCoerce(src=obj, to="list", ...)
where ... is the crucial part as sometimes I want to pass additional stuff for certain coercions (see do.deep = TRUE/FALSE below.
However, in order to do that, do I need to implement sort of a "transformer" that takes the to argument, tries to instantiate an empty object of the class specified by to and then calls the "regular" method dispatch? Or is there a better way?
Below you'll find my current solution. It works, but I'm "loosing" the option to coerce to class character" as this class is used to process things to the regular dispatcher and a to = "character would result in infinite recursion. Plus, it's a lot of overhead.
EDIT 2011-12-02
Of course setAs would be the first address to check. But the function specified by arg def in setAs can only take one argument, and often that's too rigid for me. For example, I don't see how I could include the do.deep = TRUE/FALSE switch when using 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")
}
)
Generic Method
setGeneric(
name="objectCoerce",
signature=c("src", "to"),
def=function(src, to, ...){
standardGeneric("objectCoerce")
}
)
Intermediate 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)
}
)
Coercion Method 'MyVirtual' to '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)
}
)
Test Run
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
Maybe use setAs to create a coerce method (though one would rather have one's own base class to write the method on, rather than doing this for envRefClass)
setAs("envRefClass", "list", function(from) {
fields <- names(getRefClass(class(from))$fields())
Map(from$field, fields)
})
and then
> 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
? The deep version might be like
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
})
I don't have good ideas for combining these, other than to create a psuedo-class 'deep_list' and a coerce method to that. I feel like I'm not understanding your post.

Resources