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.
Related
I need to build a lot of functions with lots of different arguments, though they otherwise share a lot of code and structure.
To avoid duplication, I thought I'd be clever and build myself a function factory (aka closure).
I can't figure out how to pass the function arguments inside the function factory.
My use case is a bunch of S3 constructor functions, all of which share the same validation mechanism.
So I'll use that as an example to explain my problem.
Say, I have a ClassA and ClassB, each of which require their own arguments in the respective constructor functions:
ClassA <- function(A_arg1, A_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- list(A_arg1, A_arg2)
# some GENERAL construction magic happens
class(out) <- "ClassA"
return(out)
}
ClassB <- function(B_arg1, B_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- B_arg1 + B_arg2
# some GENERAL construction magic happens
class(out) <- "ClassB"
return(out)
}
Obviously, I'd love to avoid the duplication in the general part of the constructor functions, so a function factory that could be used like so would be nice:
ClassA <- produce_class_constructor(classname = "ClassA", fun = function(A_arg1, A_arg2) {return(list(A_arg1, A_arg2))})
This should, ideally, yield the exact same function as the above manually constructed ClassA function, with the general part factored out.
Here's my attempt at building that function factory:
produce_class_constructor <- function(classname, fun) {
class_specific_arguments <- formals(fun = fun) # this works just fine on the console
construct_class <- function(class_specific_arguments) {
# here runs the class-specific stuff
out <- fun(class_specific_arguments)
# here runs the general stuff
class(out) <- classname
}
}
This however, does not work, because the resulting constructor function only has a class_specific_arguments-argument, not the, well, actual A_arg1, and A_arg2.
Is there way to do this?
Am I doing this wrong?
(It's really important to me that the resulting class constructor functions have properly named arguments, so a ... approach won't work).
Here's my attempt:
produce_class_constructor <- function(classname, fun) {
out_fun <- function() {
out_obj <- do.call(fun, as.list(environment()))
class(out_obj) <- classname
out_obj
}
formals(out_fun) <- formals(fun)
out_fun
}
ClassA <- produce_class_constructor(classname = "ClassA",
fun = function(A_arg1, A_arg2) {list(A_arg1, A_arg2)})
ClassA(1, 2)
#[[1]]
#[1] 1
#
#[[2]]
#[1] 2
#
#attr(,"class")
#[1] "ClassA"
ClassB <- produce_class_constructor(classname = "ClassB",
fun = function(B_arg1, B_arg2) {B_arg1 + B_arg2})
ClassB(B_arg2 = 2, 1)
#[1] 3
#attr(,"class")
#[1] "ClassB"
Idea with as.list(environment()) taken from this question. Note that you should be extra careful along that path, as ?formals says, "this is
advanced, dangerous coding".
I am trying to write an rbind method for a particular class. Here's a simple example where it doesn't work (at least for me):
rbind.character <- function(...) {
do.call("paste", list(...))
}
After entering this function, I seemingly can confirm that it is a valid method that R knows about:
> methods("rbind")
[1] rbind.character rbind.data.frame rbind.rootogram* rbind.zoo*
see '?methods' for accessing help and source code
However, it is not recognized if I try to use it:
> rbind("abc", "xyz")
[,1]
[1,] "abc"
[2,] "xyz"
> #### compared with ####
> rbind.character("abc", "xyz")
[1] "abc xyz"
The help page says that dispatch is performed internally as follows:
For each argument we get the list of possible class memberships from
the class attribute.
We inspect each class in turn to see if there is an applicable
method.
If we find an applicable method we make sure that it is identical to
any method determined for prior arguments. If it is identical, we
proceed, otherwise we immediately drop through to the default code.
With rbind("abc", "xyz"), I believe all these criteria are satisfied. What gives, and how can I fix it?
attributes("abc")
#NULL
A character vector doesn't have a class attribute. I don't think a method can be dispatched by rbind for the implicit classes.
A workaround would be to define your own class:
b <- "abc"
class(b) <- "mycharacter"
rbind.mycharacter <- function(...) {
do.call("paste", list(...))
}
rbind(b, b)
# [1] "abc abc"
The reason why it does not work with character was nicely explained by Roland in his comment.
rbind is not a standard S3 function, so you cannot "intercept" it for character.
Luckily, you can override the default implementation. Try:
rbind.character <- function(...) {
print("hello from rbind.character")
}
rbind <- function(...) {
args <- list(...)
if (all(vapply(args, is.character, logical(1)))) {
rbind.character(...)
} else {
base::rbind(...)
}
}
Basically, we check if the arguments are all characters. If so, we call our character function. If not, we call the default implementation.
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.
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.
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.