I have defined an S4 Class with a slot that is a list. I have written a method (based on Genolini's introduction to S4 - section 10.2) to append a new entry to that list:
setClass("MyClass",
slots = c(entries = "list")
)
a1 <- new("MyClass", entries = list(1))
setGeneric(name="MyAppend",
def=function(.Object, newEntry)
{
standardGeneric("MyAppend")
}
)
setMethod(f = "MyAppend",
signature = "MyClass",
definition = function(.Object, newEntry){
nameObject <- deparse(substitute(.Object))
newlist <- .Object#entries
n <- newlist %>% length
newlist[[n + 1]] <- newEntry
.Object#entries <- newlist
assign(nameObject, .Object, envir = parent.frame())
return(invisible)
}
)
If I then run
MyAppend(a1, 2)
a1
I get
R>a1
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
which is just as it should be.
But in my application I will be generating the names of the objects to be updated dynamically:
ObjectName <- paste0("a", 1)
then I can turn that name into the object itself with
Object <- ObjectName %>% sym %>% eval
and then str(Object) returns
Formal class 'MyClass' [package ".GlobalEnv"] with 1 slot
..# entries:List of 3
.. ..$ : num 1
.. ..$ : num 2
which, again, is just as it should be.
But when I run
MyAppend(Object, 3)
Object
a1
I get the following that shows that while Object has been updated a1 has not been.
R>Object
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
R>
R>a1
An object of class "MyClass"
Slot "entries":
[[1]]
[1] 1
[[2]]
[1] 2
What am I doing wrong, please?
The problem is that this line:
Object <- ObjectName %>% sym %>% eval
Doesn't do what you think it does. The right hand side evaluates to the object a1, so it is no different to doing
Object <- a1
But this creates a copy of a1, it does not create a reference or a pointer or a synonym for a1.
It is possible to create a reference (of sorts) by passing the unevaluated name of the object you wish to append to your generic method. If you leave out the eval part of ObjectName %>% sym %>% eval then Object gets assigned the name a1, which can be passed as a reference to the object a1.
However, this leaves you with a new problem: MyAppend doesn't know what to do with an object of class name. You therefore need to write a suitable method for dealing with names:
setMethod(f = "MyAppend",
signature = "name",
definition = function(.Object, newEntry){
stopifnot(class(eval(.Object)) == "MyClass")
objname <- as.character(.Object)
.Object <- eval(.Object)
.Object#entries <- append(.Object#entries, newEntry)
assign(as.character(objname), .Object, envir = parent.frame())
}
)
Now let's see how this would work:
a1 <- new("MyClass", entries = list(1))
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
MyAppend(a1, 2)
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
Object <- paste0("a", 1) %>% sym()
MyAppend(Object, 3)
a1
#> An object of class "MyClass"
#> Slot "entries":
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
#>
#> [[3]]
#> [1] 3
I think this was what you intended. You may wish to consider having a method that dispatches character strings to make this workflow easier (you would use get inside the method to retrieve the object from the name passed as a character string)
Note that I altered your own function as well; you shouldn't do return(invisible), since this returns the body of the built-in function invisible. Just leave the return statement out altogether. You can also make use of the built-in function append, to make your method for MyClass a bit simpler:
setMethod(f = "MyAppend",
signature = "MyClass",
definition = function(.Object, newEntry){
nameObject <- deparse(substitute(.Object))
.Object#entries <- append(.Object#entries, newEntry)
assign(nameObject, .Object, envir = parent.frame())
}
)
As the accepted answer has mentioned, the line
Object <- ObjectName %>% sym %>% eval
does not function as you intend.
If you want to work with dynamically generated names, the two functions you need to use are get (get an object associated with a name) and assign (assign into an object whose name you compute). Both have comprehensive help pages.
Pretty much nothing else will work (except for eval(parse(text=paste0(...))) but that is not recommended programming practice for a number of reasons.
Related
I am learning how to make custom S3 classes in R and have run into a head scratcher.
After creating an instance of my custom S3 class, it will not append to a list with c(). No warning or error is shown, it simply does not append and I do not know why.
IN:
# initialize a list and observe expected results
my_list <- list()
my_list
OUT:
list()
IN:
# Append to the list with c() as per usual and observe expected results
my_list <- c(my_list, 1)
my_list
OUT:
[[1]]
[1] 1
IN:
my_list <- c(my_list, 2)
my_list
OUT:
[[1]]
[1] 1
[[2]]
[1] 2
IN:
# Define my custom S3 class
my_custom_s3_class <- function(attribute1, attribute2) {
my_custom_s3_class <- structure(list(), class = "my_custom_s3_class")
attributes(my_custom_s3_class)$attribute1 <- attribute1
attributes(my_custom_s3_class)$attribute2 <- attribute2
my_custom_s3_class
}
# Define print method for my S3 class
print.my_custom_s3_class <- function(x, ...) {
cat(attributes(x)$attribute1, attributes(x)$attribute2)
}
# Create an instance of my custom S3 class and observe expected results when calling it
my_custom_object <- my_custom_s3_class("hello", "world")
my_custom_object
OUT:
hello world
IN:
# Attempt to append my custom S3 class to my list from before and observe no warnings or error messages
my_list <- c(my_list, my_custom_object)
# Observe that it was not appended
my_list
OUT:
[[1]]
[1] 1
[[2]]
[1] 2
The object is of length 0
length(my_custom_object)
[1] 0
so we need to wrap it in a list
c(my_list, list(my_custom_object))
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
hello world
I've made a new class, cvb:
setClass("cvb", slots = c(name = "character", dargs = "list"))
cvb <- function(name, ...) {
out <- list(name = name, dargs = list(...))
class(out) <- "cvb"
out
}
And I'd like to be able to call a method to the "combine" function, c(...), with arguments that are of class cvb, numeric, and character. I can make a method like so (not even needing to bother with S4 actually) if the first argument to c(...) is of class cvb:
c.cvb <- function(...) "In cbv c method"
which will return whatever "combination" of arguments my method defines. But I want to be able to deploy this method if any of the arguments are of class cvb, and use the default method otherwise. If the first argument to c(...) is not of class cvb I get the following:
> v <- cvb("i", 1:3)
> c(1, 2, v)
[[1]]
[1] 1
[[2]]
[1] 2
$name
[1] "i"
$dargs
$dargs[[1]]
[1] 1 2 3
Which combines two numeric types and a list type into a list, even though the first argument isn't a list. This suggests to me that there is some kind of dispatch logic that determines that if any argument is a list argument, combine all arguments into a list. I'd like it to use my c.cvb method instead of whatever is being dispatched here. Any thoughts?
I am not that familiar with S4 dispatch but am somewhat familiar with S3 dispatch. So there is likely a better way, but one option would be to supply your own dispatch logic by overriding c():
# cvb generator
cvb <- function(name, ...) {
out <- list(name = name, dargs = list(...))
class(out) <- "cvb"
out
}
# instance of cvb
v <- cvb("i", 1:3)
# new S3 c method for cvb object
c.cvb <- function(...) "In cbv c method"
# dispatch to new S3 method gives desired output
c(v, 1, 2)
#> [1] "In cbv c method"
# but will only work if the first object is of class cvb
c(1, 2, v)
#> [[1]]
#> [1] 1
#>
#> [[2]]
#> [1] 2
#>
#> $name
#> [1] "i"
#>
#> $dargs
#> $dargs[[1]]
#> [1] 1 2 3
# S3 dispatch pre-hook
c <- function(...) {
if("cvb" %in% unlist(lapply(list(...), class)))
c.cvb(...)
else
base::c(...)
}
# now we get c.cvb if any argument has class cvb
c(1, 2, v)
#> [1] "In cbv c method"
Created on 2021-02-22 by the reprex package (v1.0.0)
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.
In the source code for data.frame, the last three lines of code set the attributes and return the result.
...
attr(value, "row.names") <- row.names
attr(value, "class") <- "data.frame"
value
}
In a function I wrote, the result is a named list created by lapply. Before I set any attributes in the function body, result is as follows.
> x <- data.frame(a = 1:5, b = letters[1:5])
> (g <- grep.dataframe("a|c", x))
# ...
# $b
# value row
# 1 a 1
# 2 c 3
> attributes(g) # I want "list" in here...
# $names
# [1] "a" "b"
I'd like "class" to be included in the attributes list, so I add attr(res, "class") <- "list" (res is the final result) just before res. "class" now shows up in the attributes list. However,it also prints out with the result of the function, which I don't want. I tried wrapping it with invisible, but that didn't work.
Why do the manually assigned attributes print with the function result, but are suppressed in a new data frame I create?
> (h <- grep.dataframe("a|c", x))
# ...
# $b
# value row
# 1 a 1
# 2 c 3
# attr(,"class") # ...This prints with the result. I don't want that.
# [1] "list"
> attributes(h) # ...But I want these attributes
# $names
# [1] "a" "b"
# $class
# [1] "list"
The ?class documentation offers some pointers:
Many R objects have a class attribute, a character vector giving the names of the classes from which the object inherits. If the object does not have a class attribute, it has an implicit class, "matrix", "array" or the result of mode(x) (except that integer vectors have implicit class "integer"). (Functions oldClass and oldClass<- get and set the attribute, which can also be done directly.)
When a generic function fun is applied to an object with class attribute c("first", "second"), the system searches for a function called fun.first and, if it finds it, applies it to the object. If no such function is found, a function called fun.second is tried. If no class name produces a suitable function, the function fun.default is used (if it exists). If there is no class attribute, the implicit class is tried, then the default method.
From that and running a few simple tests, I gather that:
a list is one of these implicit classes: see attributes(list(1)), typeof(list(1))
when print is called on a list, it is using print.default
print.default prints the attributes of an object
So you could define a print.list that will handle your special case:
print.list <- function(x, ...) {
if (is.list(x)) attr(x, "class") <- NULL
print.default(x, ...)
}
res <- list(1)
attr(res, "class") <- "list"
res
# [[1]]
# [1] 1
attributes(res)
# $class
# [1] "list"
I am trying to create a simple reference class in R. Here is my code (R beginner):
MyClass <- setRefClass("MyClass",
fields = list(a = "numeric",
b = "numeric"),
methods = list(
initialize <- function(){
print("Initializing")
a <<- 1
b <<- 2
},
printValues <- function(){
print(a)
print(b)
}
)
)
a <- MyClass$new()
a$printValues()
This produces the following error for the last line, a$printValues:
Error in envRefInferField(x, what, getClass(class(x)), selfEnv) :
"printValues" is not a valid field or method name for reference class “MyClass”
Also, the initializer method is not being called ?
Can someone point me to where the issue lies here ? Many thanks in advance.
The methods argument to setRefClass needs to be a named list. The problem is you are using the assign operator <- instead of = when defining your list. See the difference between
list(a = 1, b = 2)
# $a
# [1] 1
#
# $b
# [1] 2
which returns a named list and
list(a <- 1, b <- 2)
# [[1]]
# [1] 1
#
# [[2]]
# [1] 2
which creates a and b in your environment and returns an unnamed list.
So when passing your methods, you need to use =:
methods = list(initialize = function [...],
printValues = function [...]