Any way to access function installed by makeActiveBinding? - r

The title basically says it all.
If I do this ...
makeActiveBinding("x", function() runif(2), .GlobalEnv)
x
# [1] 0.7332872 0.4707796
x
# [1] 0.5500310 0.5013099
... is there then any way for me to examine x to learn what function it is linked to (and if not, why not)?
(In this case, I'd like to be able to learn that x was defined to be function() runif(2).)

With a bit of noodling around in envir.c, I can get this to work:
#include <Rcpp.h>
using namespace Rcpp ;
#define HASHSIZE(x) LENGTH(x)
#define HASHVALUE(x) TRUELENGTH(x)
// [[Rcpp::export]]
SEXP get_binding_fun( std::string name, Environment env){
SEXP symbol = Rf_install( name.c_str() );
SEXP tab = HASHTAB(env) ;
SEXP c = PRINTNAME(symbol);
// finding the hash code for the symbol
int hashcode = HASHVALUE(c) % HASHSIZE(tab);
// get the value there from the hash table
SEXP res = CAR( VECTOR_ELT(tab, hashcode ) ) ;
return res ;
}
Save this into a .cpp file, sourceCpp it and use it with this R code:
> makeActiveBinding("x", function() runif(2), .GlobalEnv)
> get_binding_fun("x", .GlobalEnv)
# function ()
# runif(2)

Related

An Rcpp function argument being a List filled with default values

It's my first post here! Woohoo!
I would like to have an Rcpp function that would have an argument being a list with some specified default values of its entries. I would like this function to work similarly to the following R function:
> nicetry_R = function(sv = list( a = rep(0, 2)) ) { sv$a }
> nicetry_R()
[1] 0 0
> nicetry_R(list(a=rep(1,2)))
[1] 1 1
In this function argument sv is a list specified by default to contain vector a set to rep(0,2).
What I tried in RcppArmadillo is a solution that is working by refering to R_NilValue in the argument List specification. Here's the content of my nicetry.cpp file:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector nicetry (Nullable<List> sv = R_NilValue) {
NumericVector aux_a(2);
if (sv.isNotNull()){
List SV(sv);
aux_a = SV["a"];
}
return aux_a;
}
/*** R
nicetry()
nicetry(list(a=rep(1,2)))
*/
It does what I want it to do in the sense that it produces the desired outcome:
> nicetry()
[1] 0 0
> nicetry(list(a=rep(1,2)))
[1] 1 1
But I would prefer to have the default values of the list specified in the argument line. The example below is just one of my failed attempts:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector nicetry (
List sv = List::create(Named("a",NumericVector::create(0,0)))
) {
NumericVector aux_a = sv["a"];
return aux_a;
}
/*** R
nicetry()
*/
In this example, the argument declaration contains the list. It does not compile though. When I copy the declaration of the List from the argument declaration section leaving this section empty, and paste the line in the body of the function: List sv = List::create(Named("a",NumericVector::create(0,0))); then the list is created and the outcome provided. But that's not what I want.
Do you think it's possible to declare such a list as an argument at all?
Thanks so much! Greetings, T

How to get R's variable name in C (substitute in C)?

How can I get from C an object name used as a function argument? I
have sample code in C that gives me access to the name of the function
being called:
#include <Rinternals.h>
SEXP xname(SEXP x)
{
const char *fun_name = CHAR(PRINTNAME(CAR(x)));
x = CDR(x);
const char *arg_name = isNull(TAG(x)) ? "" : CHAR(PRINTNAME(TAG(x)));
Rprintf("fn_name: %s, arg_name: %s\n", fun_name, arg_name);
return R_NilValue;
}
and from R:
> xname <- function(...) invisible(.External("xname", ...))
> x1 = 123
> xname(x1)
fn_name: xname, var_name:
However, I am trying to find a way to access the object name. In the
documentation I found a solution for named args only:
> xname(arg = x1)
fn_name: xname, var_name: arg
And I'd like to find the C equivalent for substitute():
> substitute(x1)
x1
I tried substitute() from Rinternals.h, but it always returned a list with what above. Does anyone know how to do it? Maybe findVarInFrame()?
Best regards

Is there any way in which to make an Infix function using sourceCpp()

I was wondering whether it is possible to make an infix function, e.g. A %o% B with Rcpp.
I know that this is possible using the inline package, but have yet been able to find a method for doing this when using sourceCpp().
I have made the following infix implementation of %o% / outer() when arguments are sure to be vectors using RcppEigen and inline:
`%op%` <- cxxfunction(signature(v1="NumericVector",
v2="NumericVector"),
plugin = "RcppEigen",
body = c("
NumericVector xx(v1);
NumericVector yy(v2);
const Eigen::Map<Eigen::VectorXd> x(as<Eigen::Map<Eigen::VectorXd> >(xx));
const Eigen::Map<Eigen::VectorXd> y(as<Eigen::Map<Eigen::VectorXd> >(yy));
Eigen::MatrixXd op = x * y.transpose();
return Rcpp::wrap(op);
"))
This can easily be implemented in to be imported using sourceCpp(), however not as an infix function.
My current attempt is as follows:
#include <Rcpp.h>
using namespace Rcpp;
#include <RcppEigen.h>
// [[Rcpp::depends(RcppEigen)]]
// [[Rcpp::export]]
NumericMatrix outerProd(NumericVector v1, NumericVector v2) {
NumericVector xx(v1);
NumericVector yy(v2);
const Eigen::Map<Eigen::VectorXd> x(as<Eigen::Map<Eigen::VectorXd> >(xx));
const Eigen::Map<Eigen::VectorXd> y(as<Eigen::Map<Eigen::VectorXd> >(yy));
Eigen::MatrixXd op = x * y.transpose();
return Rcpp::wrap(op);
}
So to summarize my question.. Is it possible to make an infix function available through sourceCpp?
Is it possible to make an infix function available through sourceCpp?
Yes.
As always, one should read the Rcpp vignettes!
In particular here, if you look in Section 1.6 of the Rcpp attributes vignette, you'd see you can modify the name of a function using the name parameter for Rcpp::export.
For example, we could do:
#include <Rcpp.h>
// [[Rcpp::export(name = `%+%`)]]
Rcpp::NumericVector add(Rcpp::NumericVector x, Rcpp::NumericVector y) {
return x + y;
}
/*** R
1:3 %+% 4:6
*/
Then we'd get:
Rcpp::sourceCpp("~/infix-test.cpp")
> 1:3 %+% 4:6
[1] 5 7 9
So, you still have to name C++ functions valid C++ names in the code, but you can export it to R through the name parameter of Rcpp::export without having to do anything further on the R side.
John Chambers states three principles on page four of the (highly recommended) "Extending R" book:
Everything that exists in R is an object.
Everything that happens in R is a function call.
Interfaces to other software are part of R.
So per point two, you can of course use sourceCpp() to create your a compiled function and hang that at any odd infix operator you like.
Code Example
library(Rcpp)
cppFunction("std::string cc(std::string a, std::string b) { return a+b; }")
`%+%` <- function(a,b) cc(a,b)
cc("Hello", "World")
"hello" %+% "world"
Output
R> library(Rcpp)
R> cppFunction("std::string cc(std::string a, std::string b) { return a+b; }")
R> `%+%` <- function(a,b) cc(a,b)
R>
R> cc("Hello", "World")
[1] "HelloWorld"
R>
R> "hello" %+% "world"
[1] "helloworld"
R>
Summary
Rcpp is really just one cog in the machinery.
Edit
It also works with your initial function, with some minor simplification. For
`%op%` <- cppFunction("Eigen::MatrixXd op(Eigen::VectorXd x, Eigen::VectorXd y) { Eigen::MatrixXd op = x * y.transpose(); return op; }", depends="RcppEigen")
as.numeric(1:3) %op% as.numeric(3:1)
we get
R> `%op%` <- cppFunction("Eigen::MatrixXd op(Eigen::VectorXd x, Eigen::VectorXd y) { Eigen::MatrixXd op = x * y.transpose(); return op; }", depends="RcppEigen")
R> as.numeric(1:3) %op% as.numeric(3:1)
[,1] [,2] [,3]
[1,] 3 2 1
[2,] 6 4 2
[3,] 9 6 3
R>
(modulo some line noise from the compiler).

rcpp: how to apply gamma function to a scalar?

I guess the function gamma only works for a vector as the input. Is there a way to apply it to a scalar, say,gamma(3)`?
Actually, I would get the correct output if I include gamma(3) as part of my code, but there's a warning message....
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
List fool(NumericVector vec){
double res = 0;
res = sum(gamma(vec)) + gamma(3);
List result;result["num"] = res;
return result;
}
Here is the warning messgae:
exp.cpp:7:27: warning: 'gamma' is deprecated: first deprecated in OS X 10.9 [-Wdeprecated-declarations]
res = sum(gamma(vec)) + gamma(3);
^
/usr/include/math.h:720:15: note: 'gamma' has been explicitly marked deprecated here
extern double gamma(double) __OSX_AVAILABLE_BUT_DEPRECATED(__MAC_10_0, __MAC_10_9, __IPHONE_NA, __IPHONE_NA);
^
1 warning generated.
Thanks for posting code. You fell victim of being careless with namespaces. There is a (vectorized) gamma() in the Rcpp namespace -- the first argument and there is (was) a scalar gamma() (preferred: tgamma()) in the C math library. And it is better to be explicit.
Corrected code below:
#include <Rcpp.h>
// [[Rcpp::export]]
double fool(Rcpp::NumericVector vec){
double res =
Rcpp::sum(Rcpp::gamma(vec)) + // Rcpp sugar sum() and gamma() on vector
::tgamma(3.0); // math library tgamma of double
return res;
}
/*** R
v <- 1:5
fool(v)
sum(gamma(v)) + gamma(3)
*/
Output
R> sourceCpp("/tmp/shuang.cpp")
R> v <- 1:5
R> fool(v)
[1] 36
R> sum(gamma(v)) + gamma(3)
[1] 36
R>

Can Rcpp::Function be NULL?

I have a cpp function which has an R function as one of its arguments like below:
void mycppfunction(SEXP x, Rcpp::Function func)
func can be a function, or it can be NULL. How can I implement this? If I do this:
void mycppfunction(SEXP x, Rcpp::Nullable<Rcpp::Function> func)
then, the line:
func(x)
gives me the error:
error: no match for call to ‘(Rcpp::Nullable<Rcpp::Function_Impl<Rcpp::PreserveStorage> >) (SEXP)’
On the other hand, if I just define mycppfunction as:
void mycppfunction(SEXP x, Rcpp::Function func)
then running the code with a NULL value for func results in a segfault: "memory not mapped".
Yes you can do this but I would advise that you are careful about verifying the compatibility of the function passed in and the argument. Here's a small example, with minimal defensive code to ensure that f is a valid function:
#include <Rcpp.h>
typedef Rcpp::Nullable<Rcpp::Function> nullable_t;
// [[Rcpp::export]]
SEXP null_fun(Rcpp::NumericVector x, nullable_t f = R_NilValue) {
if (f.isNotNull()) {
return Rcpp::as<Rcpp::Function>(f)(x);
}
return Rcpp::wrap((double)Rcpp::sum(x));
}
/*** R
null_fun(1:5)
#[1] 15
null_fun(1:5, mean)
#[1] 3
null_fun(1:5, min)
#[1] 1
null_fun(1:5, max)
#[1] 5
*/
Note that the use of SEXP as a return type and the Rcpp::wrap((double)...) was just to quiet the compiler in this specific example, and won't necessarily apply to your use case(s).

Resources