Overloading + operator and avoiding incompatibility - r

I was trying to overload + operator and ran into incompatibility issues. Even though + is an S3 generic function, it seems to look at both arguments (similar to a multiple dispatch) instead of just the left argument like other S3 generic functions (see Groups "Ops" at http://www.inside-r.org/r-doc/base/summary). So, if two different + functions are defined for the arguments, R issues a warning and falls back to + for two numeric values.
Here is an example:
myType1 <- function(obj) {
structure(obj, class = "myType1")
} # function myType1
`+.myType1` <- function(obj1, obj2) {
return(obj1)
} # function +.myType1
myType2 <- function(obj) {
structure(obj, class = "myType2")
} # function myType2
`+.myType2` <- function(obj1, obj2) {
return(obj2)
} # function +.myType2
myType1("A") + 1 # this works, use defined types seem to have precedence
myType1("A") + myType2(1) # this doesn't
Is there a way to get around this problem? I know that S4 methods support multiple dispatch. Will using S4 help me avoid this problem, even if an S3 + method is defined for one of the arguments?
Thank you so much in advance.
Sincerely,
Junghoon Lee

Related

Rcpp function to construct a function

In R the possibility exists to have a function that creates another function, e.g.
create_ax2 <- function(a) {
ax2 <- function(x) {
y <- a * x^2
return(y)
}
return(ax2)
}
The result of which is
> fun <- create_ax2(3)
> fun(1)
[1] 3
> fun(2)
[1] 12
> fun(2.5)
[1] 18.75
I have such a complicated create function in R which take a couple of arguments, sets some of the constants used in the returned function, does some intermediary computations etc... But the result is a function that is way too slow. Hence I tried to translate the code to C++ to use it with Rcpp. However, I can't figure out a way to construct a function inside a C++ function and return it to be used in R.
This is what I have so far:
Rcpp::Function createax2Rcpp(int a) {
double ax2(double x) {
return(a * pow(x, 2));
};
return (ax2);
}
This gives me the error 'function definition is not allowed here', I am stuck about how to create the function.
EDIT: The question RcppArmadillo pass user-defined function comes close, but as far as I can tell, it only provides a way to pass a C++ function to R. It does not provide a way to initialise some values in the C++ function before it is passed to R.
Ok, as far as I understand, you want a function returning function with a closure, a.k.a. " the function defined in the closure 'remembers' the environment in which it was created."
In C++11 and up it is quite possible to define such function, along the lines
std::function<double(double)> createax2Rcpp(int a) {
auto ax2 = [a](double x) { return(double(a) * pow(x, 2)); };
return ax2;
}
What happens, the anonymous class and object with overloaded operator() will be created, it will capture the closure and moved out of the creator function. Return will be captured into instance of std::function with type erasure etc.
But! C/C++ function in R requires to be of a certain type, which is narrower (as an opposite to wider, you could capture narrow objects into wide one, but not vice versa).
Thus, I don't know how to make from std::function a proper R function, looks like it is impossible.
Perhaps, emulation of the closure like below might help
static int __a;
double ax2(double x) {
return(__a * pow(x, 2));
}
Rcpp::Function createax2Rcpp(int a) {
__a = a;
return (ax2);
}

Using a method/function within a reference class method of the same name

When defining a new reference class in R there is a bunch of boiler-plate methods that are expected (by R conventions), such as length, show etc. When these are defined they aggressively masks similar named methods/functions when called from within the class' methods. As you can not necessarily know the namespace of the foreign function it is not possible to use the package:: specifier.
Is there a way to tell a method to ignore its own methods unless called specifically using .self$?
Example:
tC <- setRefClass(
'testClass',
fields = list(data='list'),
methods = list(
length=function() {
length(data)
}
)
)
example <- tC(data=list(a=1, b=2, c=3))
example$length() # Will cause error as length is defined without arguments
Alternatively one could resort to defining S4 methods for the class instead (as reference classes are S4 classes under the hood), but this seems to be working against the reference class idea...
Edit:
To avoid focusing on instances where you know the class of the data in advance consider this example:
tC <- setRefClass(
'testClass',
fields = list(data='list'),
methods = list(
length=function() {
length(data)
},
combineLengths = function(otherObject) {
.self.length() + length(otherObject)
}
)
)
example <- tC(data=list(a=1, b=2, c=3))
example$combineLength(rep(1, 3)) # Will cause error as length is defined without arguments
I am aware that it is possible to write your own dispatching to the correct method/function, but this seems as such a common situation that I thought it might have already been solved within the methods package (sort of the reverse of usingMethods())
My question is thus, and I apologise if this wasn't clear before: Are there ways of ignoring there reference class methods and fields within the method definitions and solely rely on .self for accessing these, so that methods/functions defined outside the class are not masked?
The example is not very clear. I don't know for what reason you can't know the namespace of your method. Whatever, here a couple of methods to work around this problem:
You can use a different name for the reference class method Length with Capital "L" for example
You can find dynamically the namespace of the generic function.
For example:
methods = list(
.show =function(data) {
ns = sub(".*:","",getAnywhere("show")$where[1])
func = get("show",envir = getNamespace(ns))
func(data)
},
show=function() {
.show(data)
}
)
You can use the new reference class System R6.
For example:
tC6 <- R6Class('testClass',
public = list(
data=NA,
initialize = function(data) {
if (!missing(data)) self$data <- data
},
show=function() show(self$data)
)
)

R unary operator overload: risks?

In my continuing quest to avoid using parentheses for some simple commands, I wrote up the following operator to create a new graphics window. My question is: am I at risk of "breaking" anything in R, other than the obvious inability to execute the "not" function on my variable "newdev"?
# function to overload "!" for one purpose only
#this is adapted from the sos package code for "???", credited to Duncan Murdoch.
# Example of how to create a specialized unary operator that doesn't require
# parentheses for its argument. So far as I can tell,
#the only way to do this is to overload an existing function or
# operator which doesn't require parentheses. "?" and "!" meet this requirement.
`!` <- function (e1, e2) {
call <- match.call()
# match.call breaks out each callable function in argument list (which was "??foo" for the sos package "???",
# which allows topicExpr1 to become a list variable w/ callable function "!" (or "?" in sos)
original <- function() {
call[[1]]<-quote(base::`!`)
return(eval(call, parent.frame(2)))
}
# this does preclude my ever having an actual
# variable called "newdev" (or at least trying to create the actual NOT of it)
if(call[[2]] =='newdev') {
windows(4.5,4.5,restoreConsole=T)
}else{
return(original()) # do what "!" is supposed to do
}
}
I executed "!" = function(a){stop("'NOT' is used")} and executed the replications function, which uses the ! operator, and this worked fine. So it looks like it is safe to override "!".
Still you probably want to use classes, which you can do as follows:
# Create your object and set the class
A = 42
class(A) = c("my_class")
# override ! for my_class
"!.my_class" = function(v){
cat("Do wathever you want here. Argument =",v,"\n")
}
# Test ! on A
!A
with
makeActiveBinding
you can replace ls() by e.g LS w/o need of unary operators

R - Function overloading

Does R support function overloading ??
I want to do something in the lines of :
g <- function(X,Y) { # do something and return something }
g <- function(X) { # do something and return something}
EDIT, following clarification of the question in comments above:
From a quick glance at this page, it looks like Erlang allows you to define functions that will dispatch completely different methods depending on the arity of their argument list (up to a ..., following which the arguments are optional/don't affect the dispatched method).
To do something like that in R, you'll probably want to use S4 classes and methods. In the S3 system, the method that is dispatched depends solely on the class of the first argument. In the S4 system, the method that's called can depend on the classes of an arbitrary number of arguments.
For one example of what's possible, try running the following. It requires you to have installed both the raster package and the sp package. Between them, they provide a large number of functions for plotting both raster and vector spatial data, and both of them use the S4 system to perform method dispatch. Each of the lines returned by the call to showMethods() corresponds to a separate function, which will be dispatched when plot() is passed x and y arguments that having the indicated classes (which can include being entirely "missing").
> library(raster)
> showMethods("plot")
Function: plot (package graphics)
x="ANY", y="ANY"
x="Extent", y="ANY"
x="Raster", y="Raster"
x="RasterLayer", y="missing"
x="RasterStackBrick", y="ANY"
x="Spatial", y="missing"
x="SpatialGrid", y="missing"
x="SpatialLines", y="missing"
x="SpatialPoints", y="missing"
x="SpatialPolygons", y="missing"
R sure does. Try, for an example:
plot(x = 1:10)
plot(x = 1:10, y = 10:1)
And then go have a look at how the function accomplishes that, by typing plot.default.
In general, the best way to learn how implement this kind of thing yourself will be to spend some time poking around in the code used to define functions whose behavior is already familiar to you.
Then, if you want to explore more sophisticated forms of method dispatch, you'll want to look into both the S3 and S4 class systems provided by R.
This is usually best done through optional arguments. For example:
g <- function(X, Y=FALSE) {
if (Y == FALSE) {
# do something
}
else {
# do something else
}
}
Check out the missing() function in R. For the function to still run, you need to reassign the missing variables before running the rest of the function. For example, this code:
overload = function(x,y) {
if (missing(y)) {
y = FALSE
}
if (y == FALSE) {
print("One variable provided")
} else {
print("Two variables provided")
}
}
overload(1)
overload(1, 2)
Will return:
> overload(1)
[1] "One variable provided"
> overload(1, 2)
[1] "Two variables provided"
Lastly, the missing() function is only reliable if you haven't altered the variable in question in the function.

Forcing specific data types as arguments to a function

I was just wondering if there was a way to force a function to only accept certain data types, without having to check for it within the function; or, is this not possible because R's type-checking is done at runtime (as opposed to those programming languages, such as Java, where type-checking is done during compilation)?
For example, in Java, you have to specify a data type:
class t2 {
public int addone (int n) {
return n+1;
}
}
In R, a similar function might be
addone <- function(n)
{
return(n+1)
}
but if a vector is supplied, a vector will (obviously) be returned. If you only want a single integer to be accepted, then is the only way to do to have a condition within the function, along the lines of
addone <- function(n)
{
if(is.vector(n) && length(n)==1)
{
return(n+1)
} else
{
return ("You must enter a single integer")
}
}
Thanks,
Chris
This is entirely possible using S3 classes. Your example is somewhat contrived in the context or R, since I can't think of a practical reason why one would want to create a class of a single value. Nonetheless, this is possible. As an added bonus, I demonstrate how the function addone can be used to add the value of one to numeric vectors (trivial) and character vectors (so A turns to B, etc.):
Start by creating a generic S3 method for addone, utlising the S3 despatch mechanism UseMethod:
addone <- function(x){
UseMethod("addone", x)
}
Next, create the contrived class single, defined as the first element of whatever is passed to it:
as.single <- function(x){
ret <- unlist(x)[1]
class(ret) <- "single"
ret
}
Now create methods to handle the various classes. The default method will be called unless a specific class is defined:
addone.default <- function(x) x + 1
addone.character <- function(x)rawToChar(as.raw(as.numeric(charToRaw(x))+1))
addone.single <- function(x)x + 1
Finally, test it with some sample data:
addone(1:5)
[1] 2 3 4 5 6
addone(as.single(1:5))
[1] 2
attr(,"class")
[1] "single"
addone("abc")
[1] "bcd"
Some additional information:
Hadley's devtools wiki is a valuable source of information on all things, including the S3 object system.
The S3 method doesn't provide strict typing. It can quite easily be abused. For stricter object orientation, have a look at S4 classes, reference based classesor the proto package for Prototype object-based programming.
You could write a wrapper like the following:
check.types = function(classes, func) {
n = as.name
params = formals(func)
param.names = lapply(names(params), n)
handler = function() { }
formals(handler) = params
checks = lapply(seq_along(param.names), function(I) {
as.call(list(n('assert.class'), param.names[[I]], classes[[I]]))
})
body(handler) = as.call(c(
list(n('{')),
checks,
list(as.call(list(n('<-'), n('.func'), func))),
list(as.call(c(list(n('.func')), lapply(param.names, as.name))))
))
handler
}
assert.class = function(x, cls) {
stopifnot(cls %in% class(x))
}
And use it like
f = check.types(c('numeric', 'numeric'), function(x, y) {
x + y
})
> f(1, 2)
[1] 3
> f("1", "2")
Error: cls %in% class(x) is not TRUE
Made somewhat inconvenient by R not having decorators. This is kind of hacky
and it suffers from some serious problems:
You lose lazy evaluation, because you must evaluate an argument to determine
its type.
You still can't check the types until call time; real static type checking
lets you check the types even of a call that never actually happens.
Since R uses lazy evaluation, (2) might make type checking not very useful,
because the call might not actually occur until very late, or never.
The answer to (2) would be to add static type information. You could probably
do this by transforming expressions, but I don't think you want to go there.
I've found stopifnot() to be highly useful for these situations as well.
x <- function(n) {
stopifnot(is.vector(n) && length(n)==1)
print(n)
}
The reason it is so useful is because it provides a pretty clear error message to the user if the condition is false.

Resources