R: Using toString on a list of objects - r

Question
How do I make toString output each element of a list the same way as toString outputs a single object?
Explanation
I have created a class an implemented the to.character method for it. It works fine when I use as.character or toString on one object. But if I use those functions on a list of objects I get an uninformative string, which seems to be the output from deparse.
Example code:
setClass("my.class",
slots = c(value = "character"))
my.class <- function(value) {
new("my.class", value = value)
}
setMethod("as.character", "my.class", function (x) {
return(paste0('MyClass(',x#value,')'))
})
obj1 = my.class("val1")
obj2 = my.class("val2")
# desired: MyClass(val1)
# actual: MyClass(val1)
message(toString(obj1))
# desired: MyClass(val1)
# actual: <S4 object of class "my.class">
message(toString(list(obj1)))
# desired: MyClass(val1), MyClass(val2)
# actual: <S4 object of class "my.class">, <S4 object of class "my.class">
message(toString(list(obj1, obj2)))
# FYI:
# outputs: <S4 object of class structure("my.class", package = ".GlobalEnv")>
message(deparse(obj1))

Well, toString is basically a wrapper to paste(). So the problem is how paste(list(obj1, obj2)) runs compared to paste(obj1, obj2). It seems when you pass a list like that, the internal paste() code runs a function called coerceVector which ultimately calls a deparse like function on each of the elements. A seimilar thing happens with S3 classes
paste(list(lm(1:10~rnorm(10)), lm(1:10~rnorm(10))))
What if you defined your own collection class? For example
setClass("my.classes",
slots = c(values = "list"))
setMethod("as.character", "my.classes", function (x) {
sapply(x#values, function(z) as(z, "character"))
})
my.classes <- function(...) {
new("my.classes", values = list(...))
}
list1 <- my.classes(obj1, obj2)
toString(list1)
# [1] "MyClass(val1), MyClass(val2)"
Or maybe you could create a special toString method for lists? This would look like
toString.list <- function(x, ...) {
paste(sapply(x, toString), collapse=", ")
}
then you would call
toString(list(obj1, obj2))
# [1] "MyClass(val1), MyClass(val2)"
The problem would be if any functions depended on the default behavior of toString.default for list objects so it seems a bit less safe, but certainly easier.
And let me clarify that i'm not S4 class expert, but I really can't see a way around the paste() problem after looking at the C code.

Related

What is the difference between object and .Object in OOP in R?

I'm studying S4 classes and methods and I got confused to know when to use .Object and object (using as an argument to functions on classes). I don't understand if is there any difference between them.
For example, Would be correct:
setGeneric("getTimes",function(object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(object){
return(object#times)
}
)
or:
setGeneric("getTimes",function(.Object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(.Object){
return(.Object#times)
}
)
First, you should avoid the curly braces around {standardGeneric("getTimes")}.
The short answer for your question: there is no difference between the 2 code in your example. You were defining getTimes as a brand new generic function of your own. You can specify its arguments name whatever you like (object, x, xobject, .Object). Then, when you write the methods for the generic function, your methods' arguments name must match with the generic function's arguments name. For example:
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(object) object#times)
If not follow, there will be error (technically, a warning because R automatically/"silently" correct it. However, in my opinion, R should stop and throw an error in this case):
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(x) x#times)
# mismatch between `x` argument name in method and `object` argument name in generic
In the case you want to define methods for existing generic, you should use function method.skeleton.
Example 1:
setGeneric("getTimes", function(xobject) standardGeneric("getTimes")) # generic function is defined
getTimes # type function name without parentheses to get a summary of the generic
method.skeleton("getTimes", "Trajectories", stdout())
# copy this method skeleton to your script/source file and modify to your need
Example 2, show is a predefined generic with object as argument (see ?show) or you can type show without parentheses to check. Therefore, setMethod("show", "Trajectories", function(.Object) .Object) will be error. You can proceed using this approach, however, I think method.skeleton is a pretty useful alternative:
> method.skeleton("show", "Trajectories", stdout())
setMethod("show",
signature(object = "Trajectories"),
function (object)
{
stop("need a definition for the method here")
}
)
Example 3, initialize is a generic function and its argument .Object may be defined (type initialize without parentheses to check). From my understanding, the reason .Object is chosen as argument name in this case to invoke the feeling of a prototype object (you can read more at ?initialize). Similarly to Example 2, use the method.skeleton helper function:
> method.skeleton("initialize", "Trajectories", stdout())
setMethod("initialize",
signature(.Object = "Trajectories"),
function (.Object, ...)
{
stop("need a definition for the method here")
}
)
Note: there is a special case for replacement/assignment function (<-), that is its last argument must be named value. Read more. For example:
setClass("Trajectories", slots = c(times = "numeric"))
setGeneric("getTimes", function(x) standardGeneric("getTimes"))
setMethod("getTimes","Trajectories", function(x) x#times)
setGeneric("getTimes<-", function(xobject, value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, value) {
xobject#times <- value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42
getTimes(m)
R will not output any error or warning if you use other name (new_value in below) when defining the generic and accompanying methods. However, when you use it, R will error:
setGeneric("getTimes<-", function(xobject, new_value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, new_value) {
xobject#times <- new_value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42 # error because the right side of <- is always considered as `value` argument

How to see if an object has a particular method?

I would like to know if a given object has a particular method.
For example, suppose I want to know whether my mystery object has a specific print method. From reading ?methods, I try something like this:
has.print <- function (mysteryObject) {
'print' %in% attr(methods(class=class(mysteryObject)), 'info')$generic
}
m <- lm(Sepal.Length ~ Species, iris)
class(m) # 'lm'
has.print(m)
This is fine if mysteryObject has just one class. If it has multiple, there are problems in methods. I can get around this by using class(mysteryObject)[1], so that (for example)
library(data.table)
class(test) # data.table, data.frame
test <- data.table(iris)
has.print(test) # TRUE since there's a print.data.table
However, if I have something with multiple classes but the first does not have a print method, this returns false. Example:
mlm <- lm(cbind(Petal.Length, Petal.Width) ~ Species, iris)
class(mlm) # 'mlm', 'lm'. Note there is no print.mlm but there's a print.lm
has.print(mlm) # FALSE
This returns FALSE as there is no print.mlm. However, there is a print.lm, that is used instead, so I would like this to return TRUE.
Speaking as someone who knows very little about S3, S4, etc, is there a "proper" way to see if an object has a 'print' method on any of its classes? Ideally this works for both S3 and S4 objects, though I do not know what this means.
I can vectorise my methods(class=...) over class(mysteryObject), but I bet there's a more appropriate way to do it...
Apply methods on every class, unlist and search for "print":
has.print <- function(object) {
"print" %in%
unlist(
lapply(
class(object),
function(x) attr(methods(class = x), "info")$generic)
)
}
It is possible to start from the other side (searching for a class in all
generic print functions):
has.print <- function(object) {
any( sprintf("print.%s", class(object)) %in%
rownames(attr(methods(generic.function = "print"), "info")))
}
To find the method:
which.print <- function(object) {
print_methods <- rownames(attr(methods(generic.function = "print"), "info"))
print_methods[print_methods %in% sprintf("print.%s", class(object))]
}
# > which.print(mlm)
# [1] "print.lm"
S4
S4 classes are "printed" with show method. If no specialized method exists the showDefault is called. Function showMethods will show if there is any specialized show:
For example:
library(Matrix)
showMethods(f = "show", class = "denseMatrix")
#> Function: show (package methods)
#> object="denseMatrix"
showDefault is also calling print for non S4 members.

Make S4 object act as an S3 class?

I would like to write an S4 object such that it can be passed to methods that only take an S3 object. (It seems like setOldClass() might be related to this but it's not clear to me from the documentation?)
e.g. for a minimal example imagine I have the S3 class and function:
myS3 <- list(a = 1, b = 2)
class(myS3) <- "myS3class"
myS3function.myS3class <- function(x) x$a + x$b
and I have the S4 object
setClass("myS4class", representation(a = "numeric", b = "numeric"))
obj <- new("myS4class", a = 1, b = 2)
Is there anything I can do such that
myS3function.myS3class(obj)
gives me same thing as
myS3function.myS3class(myS3)
by modifying only the S4 class?
Edit My rationale for this approach is to take advantage of all existing methods for the S3 class (that may generally come from other packages, etc) without having to rewrite them. I realize one approach is simply to write a coercion method (setAs()) that would turn my S4 object into and S3 object, but then a user would always have to perform this step manually. (While it works, I'm also a bit unclear whether it is bad practice to use setAs() to take an S4 class to an S3 class, rather than mapping between S4 classes).
From the way I read the documentation of setOldClass, it sounds like this can make S3 objects act like S4 objects? Is that correct? If so, my question then is if it possible to do the reverse (maybe by setting the prototype in the S4 class?).
If this is not possible, how about an explanation of the rationale why this would be a bad idea?
Add a method to your S4 class to convert it to being an S3 class.
setGeneric(
"as.myS3class",
function(object)
{
standardGeneric("as.myS3class")
}
)
setMethod(
"as.myS3class",
signature(object = "myS4class"),
function(object)
{
structure(list(a = object#a, b = object#b), class = "myS3class")
}
)
Then you can call the S3 method like this:
myS3function(as.myS3class(obj))
A successful solution is indeed buried in the documentation of setOldClass:
## Examples of S3 classes with guaranteed attributes
## an S3 class "stamped" with a vector and a "date" attribute
## Here is a generator function and an S3 print method.
## NOTE: it's essential that the generator checks the attribute classes
stamped <- function(x, date = Sys.time()) {
if(!inherits(date, "POSIXt"))
stop("bad date argument")
if(!is.vector(x))
stop("x must be a vector")
attr(x, "date") <- date
class(x) <- "stamped"
x
}
print.stamped <- function(x, ...) {
print(as.vector(x))
cat("Date: ", format(attr(x,"date")), "\n")
}
## Now, an S4 class with the same structure:
setClass("stamped4", contains = "vector", representation(date = "POSIXt"))
## We can use the S4 class to register "stamped", with its attributes:
setOldClass("stamped", S4Class = "stamped4")
selectMethod("show", "stamped")
## and then remove "stamped4" to clean up
removeClass("stamped4")
someLetters <- stamped(sample(letters, 10),
ISOdatetime(2008, 10, 15, 12, 0, 0))
st <- new("stamped", someLetters)
st
# show() method prints the object's class, then calls the S3 print method.
stopifnot(identical(S3Part(st, TRUE), someLetters))
# creating the S4 object directly from its data part and slots
new("stamped", 1:10, date = ISOdatetime(1976, 5, 5, 15, 10, 0))
Note that the S4 object can use the S3 print method. What surprised me is that this works for other methods that are defined for the S3 class but not the S4 class even without additional calls to selectMethod. I illustrate this with a more detailed example about my use case with ape::phylo object here: http://carlboettiger.info/2013/10/07/nexml-phylo-class-extension.html
If you want to reuse the one function for both S3 and S4 classes, and not change it, you can write your own definition for $:
f <- function(x, name)
slot(x, name)
setMethod("$", signature=c(x="myS4class"), definition=f)
myS3function.myS4class(obj)
# [1] 3
This seems rather dubious to me, though. For starters, you'll probably also need a similar method for [[, since a function could reference a list element either way:
setMethod("[[", signature=c(x="myS4class", i="character"),
definition=function(x, i) slot(x, i))
And you'll need methods for assignment as well:
setMethod("$<-", signature=c(x="myS4class", value="numeric"),
definition=function(x, name, value) `slot<-`(x, name, check=TRUE, value))
setMethod("[[<-", signature=c(x="myS4class", i="character", value="numeric"),
definition=function(x, i, value) `slot<-`(x, i, check=TRUE, value))
But then you have the problem of referencing by number:
obj[[1]]
# Error in obj[[1]] : this S4 class is not subsettable
So you need yet another method:
g <- function(x, i)
{
slots <- names(getClass("myS4class")#slots)
slot(x, slots[i])
}
setMethod("[[", signature=c(x="myS4class", i="numeric"), g)
All up, it seems like a lot of work for not much gain.

Is it possible to modify an object on a list in a parent frame in R?

I'm working on an R package that has a number of functions that follow a non-R-standard practice of modifying in place the object passed in as an argument. This normally works OK, but fails when the object to be modified is on a list.
An function to give an example of the form of the assignments:
myFun<-function(x){
xn <- deparse(substitute(x))
ev <- parent.frame()
# would do real stuff here ..
# instead set simple value to modify local copy
x[[1]]<-"b"
# assign in parent frame
if (exists(xn, envir = ev))
on.exit(assign(xn, x, pos = ev))
# return invisibly
invisible(x)
}
This works:
> myObj <-list("a")
> myFun(myObj)
> myObj
[[1]]
[1] "b"
But it does not work if the object is a member of a list:
> myObj <-list("a")
> myList<-list(myObj,myObj)
> myFun(myList[[1]])
> myList
[[1]]
[[1]][[1]]
[1] "a"
[[2]]
[[2]][[1]]
[1] "a"
After reading answers to other questions here, I see the docs for assign clearly state:
assign does not dispatch assignment methods, so it cannot be used to set elements of vectors, names, attributes, etc.
Since there is an existing codebase using these functions, we cannot abandon the modify-in-place syntax. Does anyone have suggestions for workarounds or alternative approaches for modifying objects which are members of a list in a parent frame?
UPDATE:
I've considered trying to roll my own assignment function, something like:
assignToListInEnv<-function(name,env,value){
# assume name is something like "myList[[1]]"
#check for brackets
index<-regexpr('[[',name,fixed=TRUE)[1]
if(index>0){
lname<-substr(name,0,index-1)
#check that it exists
if (exists(lname,where=env)){
target<-get(lname,pos=env)
# make sure it is a list
if (is.list(target)){
eval(parse(text=paste('target',substr(name,index,999),'<-value',sep='')))
assign(lname, target, pos = env)
} else {
stop('object ',lname,' is not a list in environment ',env)
}
} else {
stop('unable to locate object ',lname,' in frame ',env)
}
}
}
But it seems horrible brittle, would need to handle many more cases ($ and [ as well as [[) and would probably still fail for [[x]] because x would be evaluated in the wrong frame...
Since it was in the first search results to my query, here's my solution :
You can use paste() with "<<-" to create an expression which will assign the value to your list element when evaluated.
assignToListInEnv<-function(name, value, env = parent.frame()){
cl <- as.list(match.call())
lang <- str2lang(paste(cl["name"], "<<-", cl["value"]))
eval(lang, envir = env)
}
EDIT : revisiting this answer because it got a vote up
I'm not sure why I used <<- instead of <-. If using the 'env' argument, <<-with assign to the parent.frame of that env.
So if you always want it to be the first parent.frame it can just be :
assignToListInParentFrame<-function(name, value){
cl <- as.list(match.call())
paste(cl["name"], "<<-", cl["value"]) |>
str2lang() |>
eval()
}
and if you want to precise in which env to modify the list :
assignToListInEnv<-function(name, value, env){
cl <- as.list(match.call())
paste(cl["name"], "<-", cl["value"]) |>
str2lang() |>
eval(envir = env)
}

Using "[[ ]]" notation for reference class methods

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.

Resources