rcpp: how to apply gamma function to a scalar? - r

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>

Related

setting element name Rcpp error stack usage

In rcpp I want to create characterVector, with the vector variable set as character element
I tried with
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
CharacterVector assignName(){
CharacterVector rn={"a","b","c"};
rn.names()=rn;
return rn;
}
/***R
assignName()
m <- assignName()
m
*/
For example i have a CharacterVector rn as a,b,c.
rn should be set : a="a", b="b", c="c"
then in R after the call of this function as :
m<-assignName()
An error occurr :
Error: C stack usage 7969212 is too close to the limit
But if i do not assign the function to a variable all works, for example if i do :
>assignName()
a b c
"a""b""c"
I am not sure why this is the case, but it seems it is not a good idea to use the vector itself as name. You can fix this by using Rcpp::clone:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
CharacterVector assignName(){
CharacterVector rn={"a","b","c"};
// original rn.names()=rn;
rn.names()=clone(rn);
return rn;
}
/***R
assignName()
m <- assignName()
m
*/

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).

Sequence of Integers in Rcpp

I want to create a sequence of integer numbers for indexing within a matrix. The R pendant would be:
indexRow <- max(0,1):min(2,12)
matrix1[indexRow, ]
This is what i have tried in Rcpp to create the sequence of integers:
#include <Rcpp.h>
#include <algorithm>
#include <vector>
#include <numeric>
using namespace Rcpp;
using namespace std;
// [[Rcpp::export]]
NumericVector test(NumericVector x) {
IntegerVector indexRow = Rcpp::seq_along(max(0, 1), min(1, 12));
}
However I get the Error message:
no matching function for call to 'seq_along(const int&, const int&)'
How can I create a sequence of integers in Rcpp?
Here is a possible Rcpp implementation :
library(Rcpp)
cppFunction(plugins='cpp11','NumericVector myseq(int &first, int &last) {
NumericVector y(abs(last - first) + 1);
if (first < last)
std::iota(y.begin(), y.end(), first);
else {
std::iota(y.begin(), y.end(), last);
std::reverse(y.begin(), y.end());
}
return y;
}')
#> myseq(max(0,1), min(13,17))
#[1] 1 2 3 4 5 6 7 8 9 10 11 12 13
This code generates a function myseq which takes two arguments: The first and the last number in an integer series. It is similar to R's seq function called with two integer arguments seq(first, last).
A documentation on the C++11 function std::iota is given here.
seq_along takes in a vector, what you want to use is seq combined with min and max, both take vectors. seq returns an IntegerVector. Here is an example.
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
IntegerVector test(IntegerVector a, IntegerVector b) {
IntegerVector vec = seq(max(a), min(b));
return vec;
}
In R you use
> test(c(0,1), c(2,12))
[1] 1 2

Rcpp sum over multiple indexes

I want to compute a function of the form:
$m_{jl}(x) = x + \gamma[j]*zeta[j,l] + sum_{k \neq j} zeta[j,k]$
using Rcpp. My problem is about the sum_{k \neq j} zeta[j,k]$.. I would like to be able to do something zeta[j,-j]. Is it possible? I tried zeta(j,-)-zeta(j,j), but the Rcpp does not like zeta(j,-).
You can use sugar functions:
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
double myFun(NumericMatrix x) {
return sum(x)-sum(diag(x));
}
R:
A <- matrix(1:9,3)
sum(A)-sum(diag(A))
#[1] 26
myFun(A)
#[1] 26
I suspect this could be made faster with RcppEigen.

Any way to access function installed by makeActiveBinding?

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)

Resources