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.
Related
I have an issue verifying the validity of my class 'class2'; it is made of a list of 'class1' objects. I want to verify that it is indeed the case:
class2 <- setClass(
Class = "class2",
slots = c(slotListName = "list"),
validity = function(object){
lapply(object#slotListName, function(x){
if(!identical(is(x), "class1"))
stop(" not a class1 object");
});
});
The problem is that lapply returns values which are not accepted:
Error in validObject(.Object) :
invalid class “class2” object: 1: NULL
invalid class “class2” object: 2: NULL
I checked that the problem was coming from the lapply by testing only the first element of the list, which is working fine:
if(!identical(is(object#slotListName[[1]]), "class1"))
stop("not a class1 object");
I tried vectorizing but this does not change the problem.
Is there a way to verify that slotListName is indeed a list of 'class1' objects?
Thanks a lot!
The problem with your function is that it gives an error for an invalid object. It's supposed to return a diagnostic message, with the S4 object construction machinery taking care of the error.
Here's how you can do it using the recommended approach, which is to define methods for initialize and setValidity. See ?setClass for more details.
class2 <- setClass("class2", slots=c(slotListName="list"))
setMethod("initialize", "class2", function(.Object, lst)
{
.Object#slotListName <- lst
validObject(.Object)
.Object
})
# returns TRUE if the object is valid, otherwise a diagnostic message
setValidity("class2", function(object)
{
if(length(object#slotListName) < 1)
"must contain at least one class1 object"
else if(!all(sapply(object#slotListName, function(x) inherits(x, "class1"))))
"all objects in list must be class1"
else TRUE
})
## testing
x <- 42
class(x) <- "class1"
y <- 43
class(y) <- "bad"
l1 <- list(x, x, x)
l2 <- list(x, x, y)
## works
obj1 <- class2(l1)
## error: bad object in list
obj2 <- class2(l2)
## error: empty list
obj3 <- class2(list())
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.
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"
I defined a class (tdtfile), which inherits data.frame. I am now trying to define a [.data.frame-equivalent replacement method to return an appropriate object of class tdtfile rather than data.frame, but am having trouble.
Here is What I'm doing:
# Define Class
setClass("tdtfile",
representation(Comment = "character"),
prototype(Comment = NULL),
contains = c("data.frame"))
# Construct instance and populate
test <- new("tdtfile",Comment="Blabla")
df <- data.frame(A=seq(26),B=LETTERS)
for(sName in names(getSlots("data.frame"))){
slot(test,sName) <- slot(df,sName)
}
# "Normal" data.frame behavior (loss of slot "Comment")
str(test[1])
# Works as well - will be trying to use that below
`[.data.frame`(test,1)
# Try to change replacement method in order to preserve slot structure
# while accessing data.frame functionality
setMethod(
`[`,
signature=signature(x="tdtfile"),
function(x, ...){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
tmpDF <- `[.data.frame`(x, ...)
# Reintegrate the results
if(inherits(x=tmpDF,what="data.frame")){
for(sName in names(getSlots("data.frame"))){
slot(storedtdt,sName) <- slot(tmpDF,sName)
}
return(storedtdt)
} else {
return(tmpDF)
}
})
# Method does not work - data.frame remains complete. WHY?
str(test[1])
# Cleanup
#removeMethod(
# `[`,
# signature=signature(x="tdtfile"))
When calling something like
tdtfile[1]
this returns a a tdtfile object with all contained data.frame columns rather than just the first ... can anyone spot what I'm missing?
Thank you for your help.
Sincerely, Joh
The reason your method is misbehaving is that i, j, and drop are automatically made available inside your [ method, I believe simply as a consequence of how the [ generic works. This means you need to pass these arguments by name to [.data.frame rather than relying on .... Unfortunately, this in turn puts the onus on you to handle the various forms of indexing correctly.
Here is a modified method definition that does a decent job, though it may not behave exactly analogously to the pure data frame indexing under certain uses of the drop argument:
setMethod(
`[`,
signature=signature(x="tdtfile"),
function(x, ...){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
Nargs <- nargs()
hasdrop <- "drop" %in% names(sys.call())
if(Nargs==2) {
tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop=FALSE)
} else if((Nargs==3 && hasdrop)) {
tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop)
} else if(hasdrop) {
tmpDF <- `[.data.frame`(x, i, j, ..., drop)
} else {
tmpDF <- `[.data.frame`(x, i, j, ...)
}
# Reintegrate the results
if (inherits(x=tmpDF, what="data.frame")){
for(sName in names(getSlots("data.frame"))){
slot(storedtdt, sName) <- slot(tmpDF, sName)
}
return(storedtdt)
} else {
return(tmpDF)
}
})
A few examples with your test object:
> head(test[1])
Object of class "tdtfile"
A
1 1
2 2
3 3
4 4
5 5
6 6
Slot "Comment":
[1] "Blabla"
> test[1:2,]
Object of class "tdtfile"
A B
1 1 A
2 2 B
Slot "Comment":
[1] "Blabla"
I'm not sure if there is a more canonical way of doing this. Perhaps trying looking at the source code of some S4 packages?
Edit: Here is a replacement method in spirit similar to the extraction method above. This one explicitly coerces the object to a data frame before calling [<- directly on it, mostly to avoid a warning you get if [<-.data.frame does it. Again, behavior is not exactly identical to the pure data frame replacement method, though with more work it could be made so.
setMethod(
`[<-`,
signature=signature(x="tdtfile"),
function(x, ..., value){
# Save the original
storedtdt <- x
# Use the fact that x is a subclass to "data.frame"
Nargs <- nargs()
if (any(!names(sys.call()) %in% c("", "i", "j", "value"))) {
stop("extra arguments are not allowed")
}
tmpDF <- data.frame(x)
if(Nargs==3) {
if (missing(i)) i <- j
tmpDF[i] <- value
} else if(Nargs==4) {
tmpDF[i, j] <- value
}
# Reintegrate the results
for(sName in names(getSlots("data.frame"))){
slot(storedtdt, sName) <- slot(tmpDF, sName)
}
return(storedtdt)
})
Examples:
> test[2] <- letters
> test[1,"B"] <- "z"
> test$A[1:3] <- 99
> head(test)
Object of class "tdtfile"
A B
1 99 z
2 99 b
3 99 c
4 4 d
5 5 e
6 6 f
Slot "Comment":
[1] "Blabla"
As an aside, if it's critical that extract/replace work exactly as they do on data frames, I'd consider rewriting the class to have a slot containing the data frame, rather than having data.frame as a superclass. Composition over inheritance!
While experimenting with the new reference classes in R I noticed some odd behaviour if you use the "[[ ]]" notation for methods (X[["doSomething"]] instead of X$doSomething). This notation works for fields, but I initially thought it wouldn't work for methods until I found that if you execute "class(X$doSomething)" you can then use "[[ ]]" afterwards. The simple example below illustrates the point.
setRefClass("Number",
fields = list(
value = "numeric"
),
methods = list(
addOne = function() {
value <<- value + 1
}
)
)
X <- new("Number", value = 1)
X[['value']] # 1
X[["addOne"]]() # Error: attempt to apply non-function
class(X[["addOne"]]) # NULL
class(X$addOne) # "refMethodDef"
# Now the following works!
X[["addOne"]]() # sets X$value = 2
class(X[["addOne"]]) # "refMethodDef"
The reason I encountered this is because I want to group my objects together in a list and create an "applyMethod" function which applies a specified method on each of the objects within. Therefore, I need to specify the method as a string. Does anyone have any ideas how I can achieve this?
Here's a class
.A <-
setRefClass("A",
fields=list(x="numeric"),
methods=list(foo=function() x))
If I had an instance a and wanted to construct a call to the 'foo' method using '$' I could
eval(substitute(a$FUN(), list(FUN="foo")))
So I'll create a class Alist that is meant to have a list of elements of class A (this could be enforced programmatically), and that has a .delegate method that'll apply an arbitrary method to all elements of the list. I'll then add a method that delegates foo.
.delegate <- function(FUN, ...)
{
lapply(elts, function(elt, ...) {
eval(substitute(elt$FUN(...), list(FUN=FUN, ...)))
})
}
.Alist <-
setRefClass("Alist",
fields=list(elts="list"),
methods=list(
initialize = function(...) callSuper(elts=list(...)),
.delegate = .delegate,
foo=function() .delegate("foo")))
And then use it
> aList <- .Alist$new(.A$new(x=1), .A$new(x=2))
> aList$foo()
[[1]]
[1] 1
[[2]]
[1] 2
basically R5 ref class does not cache the method until it is necessary. This is probably a kind of delayed evaluation.
And the caching takes place when you access the method via $.
So, AFAIK, there is no way to access the method via [[string]]
But you can find a workaround using .dollarForEnvRefClass like this:
> X <- new("Number", value = 1)
> ls(X#.xData)
[1] "value" # no methods named "addOne" before caching
> X[["addOne"]]
NULL
> methods:::.dollarForEnvRefClass(X, "addOne") # cache it
Class method definition for method addOne()
function ()
{
value <<- value + 1
}
<environment: 0x116a4aa00>
> ls(X#.xData)
[1] "addOne" "value" # you can find it
> X$value # value is 1
[1] 1
> X[["addOne"]]() # call the method
> X$value # the method works
[1] 2
if you are interested in more detail, see the implementation:
http://svn.r-project.org/R/trunk/src/library/methods/R/refClass.R
Maybe there is more straightforward way.
Report as bug on r-devel so John Chambers can fix it.