Get internal R functions to use my S4 method - r

I've created a custom S4 class, and the idea is that it represents a vector that's always sorted, so I don't want sort() to actually do anything to it. So I defined a stub version of sort() for my class:
MyClass <- methods::setClass("MyClass", slots=list(x="numeric"))
setMethod("sort", signature(x="MyClass"), function(x, ...){}) # Do nothing
Then, I want to calculate a quantile of my class. R's quantile() function internally calls sort(). However, the sort() used inside quantile() is not aware of my S4 method, because it dispatches using UseMethod() (the S3 dispatcher) and not standardGeneric(), the S4 dispatcher. This is demonstrated below:
options(error=traceback)
instance = MyClass()
quantile(instance, 0.5)
This returns a call stack like this:
5: order(x, na.last = na.last, decreasing = decreasing)
4: sort.default(x, partial = unique(c(lo, hi)))
3: sort(x, partial = unique(c(lo, hi)))
2: quantile.default(instance, 0.5)
1: quantile(instance, 0.5)
Since sort.default is being called, it is evident that my custom sort implementation isn't being used.
Is there a simple way to get R to use my S4 method here? I realise I can also define sort.MyClass (the S3 way), but if I do this, what is the point of having an S4 method at all? It seems like S4 is incompatible with core R methods which renders it fairly useless.

Object instance is defined with a slot named x that is numeric. When you call quantile(instance, 0.5), R do not know that you want quantile to act on the slot instance#x.
Approach 1:
MyClass <- setClass("MyClass", slots = list(x = "numeric"))
setMethod(
"quantile",
signature(x = "MyClass"),
function(x, ...) {
callNextMethod(x#x, ...)
}
)
# test drive
instance <- MyClass(x = c(0, 5, 2, 1, 3))
quantile(instance, 0.5)
sort(instance) # error
mean(instance) # error
# see that quantile is now using S4 dispatch
quantile
standardGeneric for "quantile" defined from package "stats"
function (x, ...)
standardGeneric("quantile")
<environment: 0x000001fe1375fe08>
Methods may be defined for arguments: x
Use showMethods(quantile) for currently available ones.
# see method table for quantile
showMethods(quantile, includeDefs = TRUE)
Function: quantile (package stats)
x="ANY"
function (x, ...)
UseMethod("quantile")
x="MyClass"
function (x, ...)
{
callNextMethod(x#x, ...)
}
With this approach, you can see that quantile is automatically converted to using S4 dispatch.
The call quantile(instance, 0.5) is dispatch to quantile,MyClass-method
Inside quantile,MyClass-method, the code callNextMethod(x#x, ...) will dispatch to quantile,ANY-method with content of slot x as argument. This argument is numeric.
Inside quantile,ANY-method, the code will S3 dispatch the calling arguments to quantile.default.
However, This approach require you to specify a customized version of every functions to act on MyClass. Therefore sort(instance) and mean(instance) output error.
Approach 2: Make MyClass as a subclass of numeric. Then all functions that work on numeric will work on MyClass. Below, I add a customized initialize method to automatically sort its numeric argument. A sort,MyClass-method to do no sorting and only return MyClass as numeric for consistency.
MyClass <- setClass("MyClass", contains = "numeric")
setMethod("initialize",
signature(.Object = "MyClass"),
function (.Object, ...)
{
callNextMethod(.Object, sort(..1)) # ..1 is first element of ... see ?dots
}
)
setMethod(
"sort",
signature(x = "MyClass"),
function(x, decreasing = FALSE, ...) {
as(x, "numeric")
}
)
# test drive
instance <- MyClass(c(0, 5, 2, 1, 3))
quantile(instance, 0.5)
quantile(instance)
mean(instance)
sd(instance)
plot(instance)
Note:
setMethod("sort", signature(x="MyClass"), function(x, ...){}) # return NULL
setMethod("sort", signature(x="MyClass"), function(x, ...) x) # return x unchange

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

R: S3 Method dispatch depending on arguments

I have a generic function foo that I want to call three different ways depending on the arguments given to it.
foo <- function(...) UseMethod("foo")
#default
foo.default <- function(x, y, ...) {
#does some magic
print("this is the default method")
}
#formula
foo.formula <- function(formula, data = list(), ...) {
print("this is the formula method")
}
#data.frame
foo.data.frame <- function(data, x, y, ...) {
print("this is the data.frame method")
}
In the following I'm going to show how I am expecting the method dispatch to work but the outputs are presented under each call...
mydata <- data.frame(x=c(1,2,3,4),y=c(5,6,7,8))
#ways to call default function
foo(x = mydata$x, y = mydata$y)
#[1] "this is the default method"
#ways to call formula
foo(formula = mydata$x~mydata$y)
#[1] "this is the formula method"
foo(formula = x~y, data = mydata)
#[1] "this is the formula method"
foo(data = mydata, formula = x~y) #ERROR
#[1] "this is the data.frame method"
#ways to call data.frame method
foo(data = mydata, x = x, y = y)
#[1] "this is the data.frame method"
foo(x = x, y = y, data = mydata) #ERROR
#Error in foo(x = x, y = y, data = mydata) : object 'x' not found
from what I can tell, the method used depends on the class of the first argument. Essentially, I would like for the method dispatch to depend on the arguments passed to the generic function foo and not the first argument.
I would like the dispatch to have the following priority:
If the formula argument is present the formula method is used (data argument should be optional here)
Then, if no formula argument is found, if data argument is present use data.frame method (which requires x and y arguments)
else foo expects the x and y arguments or it will fail.
Note
I would like to avoid defining the generic function foo as follows
foo <- function(formula, data,...) UseMethod("foo")
while this would fix all my issues (I believe all except the last case), this will cause a devtools::check() warning because the some of S3 functions will not have the same arguments as the generic function and will no longer be consistent (specifically foo.default and foo.data.frame). And I wouldn't like to include the missing arguments because those methods do not have use for those arguments.
As Thomas has pointed out, this is not the standard behavior for S3 classes. If you really want to stick to S3, however, you could write your functions so as to "mimick" UseMethod, even though it won't be pretty and is probably not what you want to do. Nevertheless, here an idea that is based on capturing all arguments first, and then checking for the presence of your "preferred" argument type:
Get some objects first:
a <- 1; class(a) <- "Americano"
b <- 2; class(b) <- "Espresso"
Let the function in question capture all arguments with dots, and then check for the presence of an argument type in order of your preference:
drink <- function(...){
dots <- list(...)
if(any(sapply(dots, function(cup) class(cup)=="Americano"))){
drink.Americano(...)
} else { # you can add more checks here to get a hierarchy
# try to find appropriate method first if one exists,
# using the first element of the arguments as usual
tryCatch(get(paste0("drink.", class(dots[[1]])))(),
# if no appropriate method is found, try the default method:
error = function(e) drink.default(...))
}
}
drink.Americano <- function(...) print("Hmm, gimme more!")
drink.Espresso <- function(...) print("Tripple, please!")
drink.default <- function(...) print("Any caffeine in there?")
drink(a) # "Americano", dispatch hard-coded.
# [1] "Hmm, gimme more!"
drink(b) # "Espresso", not hard-coded, but correct dispatch anyway
# [1] "Tripple, please!"
drink("sthelse") # Dispatches to default method
# [1] "Any caffeine in there?"
drink(a,b,"c")
# [1] "Hmm, gimme more!"
drink(b,"c", a)
# [1] "Hmm, gimme more!"

R: Set function as generic for some class

I wrote a function that returns an object of class myClass. Specific to this class, I have a function tryMe.myClass() that I'd like to be generic to myClass, such that I only have to call tryMe(object, x) instead of tryMe.myClass(object, x), where tryMe(object, x) will only work of object is of class myClass.
Both functions (the constructor and tryMe.myClass()) have their own .R-File inside a package I created.
What do I need to modify for this to work?
Much thanks!
Stefan
Just define a generic as in line ## below
tryMe <- function(object, ...) UseMethod("tryMe") ##
tryMe.myClass <- function(object, x, ...) "ok"
# test
obj <- structure(NA, class = "myClass")
tryMe(obj, 3)
## [1] ok

R: how to find what S3 method will be called on an object?

I know about methods(), which returns all methods for a given class. Suppose I have x and I want to know what method will be called when I call foo(x). Is there a oneliner or package that will do this?
The shortest I can think of is:
sapply(class(x), function(y) try(getS3method('foo', y), silent = TRUE))
and then to check the class of the results... but is there not a builtin for this?
Update
The full one liner would be:
fm <- function (x, method) {
cls <- c(class(x), 'default')
results <- lapply(cls, function(y) try(getS3method(method, y), silent = TRUE))
Find(function (x) class(x) != 'try-error', results)
}
This will work with most things but be aware that it might fail with some complex objects. For example, according to ?S3Methods, calling foo on matrix(1:4, 2, 2) would try foo.matrix, then foo.numeric, then foo.default; whereas this code will just look for foo.matrix and foo.default.
findMethod defined below is not a one-liner but its body has only 4 lines of code (and if we required that the generic be passed as a character string it could be reduced to 3 lines of code). It will return a character string representing the name of the method that would be dispatched by the input generic given that generic and its arguments. (Replace the last line of the body of findMethod with get(X(...)) if you want to return the method itself instead.) Internally it creates a generic X and an X method corresponding to each method of the input generic such that each X method returns the name of the method of the input generic that would be run. The X generic and its methods are all created within the findMethod function so they disappear when findMethod exits. To get the result we just run X with the input argument(s) as the final line of the findMethod function body.
findMethod <- function(generic, ...) {
ch <- deparse(substitute(generic))
f <- X <- function(x, ...) UseMethod("X")
for(m in methods(ch)) assign(sub(ch, "X", m, fixed = TRUE), "body<-"(f, value = m))
X(...)
}
Now test it. (Note that the one-liner in the question fails with an error in several of these tests but findMethod gives the expected result.)
findMethod(as.ts, iris)
## [1] "as.ts.default"
findMethod(print, iris)
## [1] "print.data.frame"
findMethod(print, Sys.time())
## [1] "print.POSIXct"
findMethod(print, 22)
## [1] "print.default"
# in this example it looks at 2nd component of class vector as no print.ordered exists
class(ordered(3))
## [1] "ordered" "factor"
findMethod(print, ordered(3))
## [1] "print.factor"
findMethod(`[`, BOD, 1:2, "Time")
## [1] "[.data.frame"
I use this:
s3_method <- function(generic, class, env = parent.frame()) {
fn <- get(generic, envir = env)
ns <- asNamespace(topenv(fn))
tbl <- ns$.__S3MethodsTable__.
for (c in class) {
name <- paste0(generic, ".", c)
if (exists(name, envir = tbl, inherits = FALSE)) {
return(get(name, envir = tbl))
}
if (exists(name, envir = globalenv(), inherits = FALSE)) {
return(get(name, envir = globalenv()))
}
}
NULL
}
For simplicity this doesn't return methods defined by assignment in the calling environment. The global environment is checked for convenience during development. These are the same rules used in r-lib packages.

Dispatching an argument's default value from an S4 generic function to its associated methods

Suppose all of your S4 methods associated to a specific S4 generic function/method share a formal argument that is supposed to have a specific default value. Intuitively, I would state such an argument in the definition of the S4 generic (as opposed to stating it in each method definition which would seem somewhat redundant to me).
However, I noticed that this way I'm running into trouble as it seems that the default value of the formal argument is not dispatched to the methods and thus an error is thrown.
Isn't this somewhat against the idea of having a combination of a generic and methods? Why would I have to state the formal argument in each method separately again when the default value is always the same? Can I explicitly dispatch formal arguments' default values somehow?
Below you'll find a short illustration of the behavior
Generic function
setGeneric(
name="testFoo",
signature=c("x", "y"),
def=function(
x,
y,
do.both=FALSE,
...
) {
standardGeneric("testFoo")
}
)
Method
setMethod(
f="testFoo",
signature=signature(x="numeric", y="numeric"),
definition=function(
x,
y
) {
if (do.both) {
out <- list(x=x, y=y)
} else {
out <- x
}
return(out)
}
)
Error
> testFoo(x=1, y=2)
Error in .local(x, y, ...) : object 'do.both' not found
Redundant statement of do.both fixes it
setMethod(
f="testFoo",
signature=signature(x="numeric", y="numeric"),
definition=function(
x,
y,
do.both=FALSE
) {
if (do.both) {
out <- list(x=x, y=y)
} else {
out <- x
}
return(out)
}
)
> testFoo(x=1, y=2)
[1] 1
When you call testFoo(x=1, y=2), it is processed first by the S4 generic, which looks for a method, finds it, and dispatches to it a call that looks like this: testFoo(x=1, y=2, do.both=FALSE, ...).
In the words of ?standardGeneric:
‘standardGeneric’ dispatches the method defined for a generic
function named ‘f’, using the actual arguments in the frame from
which it is called.
If the method to which it dispatches that call does not take a do.both argument, the method --- just like any other R function --- throws an error. No function can process a call containing an argument foo unless it's function definition contains either (a) a formal argument foo or (b) a "dots" argument, ..., which can absorb arbitrary supplied arguments.
Basically what you've tried is no different than the following, which fails in a similarly but perhaps easier-to-see way:
testFooGeneric <- function(x=1, y=2, do.both=FALSE, ...) {
## The line below does essentially what standardGeneric() does
if(is.numeric(x) & is.numeric(y)) {
testFooMethod(x=x, y=y, do.both=do.both)
}
}
testFooMethod <- function(x, y) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
# Error in testFooMethod(x = x, y = y, do.both = do.both) :
# unused argument(s) (do.both = do.both)
To fix the above, you need to redefine testFooMethod() in one of the following two ways, either of which will also remedy your S4 method:
## Option 1
testFooMethod <- function(x, y, do.both) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
# Success!
## Option 2
testFooMethod <- function(x, y, ...) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
## Success!

Resources