Rcpp override summary method for custom class - r

Suppose I have the following function:
List foo(List x)
{
x.attr("class") = "myOwnClass";
return(x);
}
I whant to override R summary method for foo function output. However the following R-style approach does not work:
List summary.myOwnClass(List x)
{
return(x)
}
During compilation I have a error which says that "expected initializer before '.' token".
Please help me to understand how to implement summary function override within Rcpp framework for my customly defined class.
Will be very greatfull for help!

I feel like this is likely a duplicate, but my initial search didn't pull one up. I add a quick answer for now, but if I later find one I'll delete this answer and propose a duplicate.
The way to solve this issue is to use the export tag to specify the function's R side name as summary.myOwnClass while using something else for the C++ side name; you can't have dots in the middle of a C++ function name (think about, e.g., how member functions are called -- it would be unworkable). So, we do the following
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
List foo(List x)
{
x.attr("class") = "myOwnClass";
return(x);
}
// [[Rcpp::export(summary.myOwnClass)]]
List summary(List x)
{
return(x);
}
/*** R
l <- foo(1:3)
summary(l)
*/
Then we get the output we expect
> l <- foo(1:3)
> summary(l)
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
attr(,"class")
[1] "myOwnClass"

Related

Rcpp parallelize functions that return XPtr? [duplicate]

This question already has answers here:
Using Rcpp within parallel code via snow to make a cluster
(3 answers)
Closed 6 years ago.
Taking an example XPtr function:
test.cpp
#include <Rcpp.h>
// [[Rcpp::export]]
SEXP funx()
{
/* creating a pointer to a vector<int> */
std::vector<int>* v = new std::vector<int> ;
v->push_back( 1 ) ;
v->push_back( 2 ) ;
/* wrap the pointer as an external pointer */
/* this automatically protected the external pointer from R garbage
collection until p goes out of scope. */
Rcpp::XPtr< std::vector<int> > p(v, true) ;
/* return it back to R, since p goes out of scope after the return
the external pointer is no more protected by p, but it gets
protected by being on the R side */
return( p ) ;
}
R
library(Rcpp)
sourceCpp("test.cpp")
xp <- funx()
xp
<pointer: 0x9618cc0>
But if I try to parallelize this I get null pointers
library(parallel)
out <- mclapply(1:2, function(x) funx())
out
[[1]]
<pointer: (nil)>
[[2]]
<pointer: (nil)>
Is it possible to achieve this kind of functionality?
Edit
It is worth noting that despite a duplicate question there appears to be no true solution to this problem. From what I understand now, an XPtr is not able to be multi-threaded. So essentially this cannot be done in R.
For example, when I put the function inside package test and try to use snow it still fails to return the pointers.
library(test)
library(snow)
fun <- function(){
library(test)
test:::funx()
}
cl <- makeCluster(2, type = "SOCK")
clusterExport(cl, 'fun')
clusterCall(cl, fun)
[[1]]
<pointer: (nil)>
[[2]]
<pointer: (nil)>
Regarding
Is it possible to achieve this kind of functionality?
I would say the answer is a pretty firm 'nope' as the First Rule of Fight Club applies here: you simply cannot parallelise the underlying R instance merely by hoping it would work. Packages like RcppParallel are very careful about using non-R data structures for multithreaded work.
I may be too pessimistic but I would place the 'collection level' one level deeper, and only return its aggregated result to R.

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);
}

How to subclass a function in R?

I was wondering if it is possible to use Reference Classes to subclass a function in R. For instance, the following
> CustomFunction <- setRefClass("CustomFunction", contains = "function")
> foo <- CustomFunction()
> foo()
NULL
works OK (does not throw an error), but how can I customise the behaviour (i.e. other than returning NULL)? How can I define function arguments?
I also tried
> setMethod("(",
> signature(x = "CustomFunction"),
> function(...) {
> "Hello!" # A function that always returns "Hello!"
> }
> )
Error in genericForPrimitive(f) :
methods may not be defined for primitive function ‘(’ in this version of R
but that doesn't seem to work.
I was hoping that being able to subclass functions means that I could implement custom behaviour before and after function calls. E.g. to have functions that automatically logs the call expression each time it is called (for audit purposes), or to create functions that automatically throws an error if NULL is returned etc etc.
You don't need Reference Classes for this, you can just enclose the function of interest
logger <- function(f) {
force(f)
function(...) {
print("running function...")
f(...)
}
}
printhello <- function(name="Al") print(paste("hello", name))
printhello_logged <- logger(printhello)
printhello()
# [1] "hello Al"
printhello_logged("Zed")
# [1] "running function..."
# [1] "hello Zed"
If this is for auditing/testing type purposes, you might be interested in trace() which allows you to attach code to various parts of functions.

Function param default value std:vector initialization with Rcpp and C++11?

I am trying to write a C++/Rcpp function that has an optional argument whos default needs to be a vector of length 1 with a value of 0. The following does not compile properly:
cppFunction("std::vector<int> test(std::vector<int> out = {0}) {
return out;
}")
I get the following error:
Error in cppFunction("std::vector test(std::vector out =
{1}) {\n return out;\n}") : No function definition found In
addition: Warning messages: 1: No function found for Rcpp::export
attribute at fileee5f629605d7.cpp:5 2: In sourceCpp(code = code, env
= env, rebuild = rebuild, showOutput = showOutput, : No Rcpp::export attributes or RCPP_MODULE declarations found in source
What is the right way to do this?
This answer was posted on the Rcpp issue tracker. This is the desired result that I wanted just not with std::vector.
cppFunction("IntegerVector test(IntegerVector out = IntegerVector::create(0)) {
return out;
}")
You could wrap the underlying C++ function in an R function that uses a default value:
#include <Rcpp.h>
#include <vector>
// [[Rcpp::plugins(cpp11)]]
// [[Rcpp::export]]
std::vector<int> cpp_test(const std::vector<int>& x)
{
return x;
}
/*** R
test <- function(X = c(0L))
{
cpp_test(X)
}
test()
test(c(1:5))
*/
which gives you
> Rcpp::sourceCpp('~/RcppFiles/cpp_test.cpp')
> test()
[1] 0
> test(c(1:5))
[1] 1 2 3 4 5
Currently the Rcpp package didn't support the exporting the default values. There are several packages to improve this (including Rcpp11), thought, I have a solution on Rcpp with RCPP_MODULES:
library("Rcpp")
cppFunction(plugins=c("cpp11"),'NumericVector test(std::vector<int> out) {
return wrap(out);
}
RCPP_MODULE(mod) {
function("test",&test,List::create( _["out"] = std::vector<int>({0})), "Simple description");
}', verbose=TRUE,rebuild=TRUE)
I change the return type, thought, it work even if you return std::vector<int>.
So, how this works: it just creates a documentation entry with the default value, third argument for RCPP_MODULES.
With just {0} my R crashes, so, it's necessary for me to put std::vector explicitly.

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