How to compute rowSums in rcpp - r

I'm converting an R function into Rcpp, where I have used the R function rowSums, which appears to not be a valid sugar expression in Rcpp. I found code for an Rcpp version of rowSums here. But I'm getting
error: use of undeclared identifier
when I use rowSumsC() in my main Rcpp function.
Is there a easy fix?
Edit: The code
cppFunction(
"NumericMatrix Expcpp(NumericVector x, NumericMatrix w,
NumericVector mu, NumericVector var, NumericVector prob, int k) {
for (int i=1; i<k; ++i){
w(_,i) = prob[i] * dnorm(x,mu[i], sqrt(var[i]));
}
w = w / rowSums(w)
return w;
}")

Rcpp officially added rowSum support in 0.12.8. Therefore, there is no need to use rowSumsC function devised by Hadley in Advanced R.
Having said this, there are a few issues with the code.
Rcpp presently does not support Matrix to Vector or Matrix to Matrix computations. (Support for the later may be added per #583, though if needed one should consider using RcppArmadillo or RcppEigen). Therefore, the following line is problematic:
w = w / rowSums(w)
To address this, first compute the rowSums and then standardize the matrix using a traditional for loop. Note: Looping in C++ is very fast unlike R.
NumericVector summed_by_row = rowSums(w);
for (int i = 0; i < k; ++i) {
w(_,i) = w(_,i) / summed_by_row[i];
}
Next, C++ indices begin at 0 not 1. Therefore, the following for loop is problematic:
for (int i=1; i<k; ++i)
The fix:
for (int i=0; i<k; ++i)
Lastly, the parameters of the function can be reduced as some of the values are not relevant or are overridden.
The function declaration goes from:
NumericMatrix Expcpp(NumericVector x, NumericMatrix w,
NumericVector mu, NumericVector var, NumericVector prob, int k)
To:
NumericMatrix Expcpp(NumericVector x, NumericVector mu, NumericVector var, NumericVector prob) {
int n = x.size();
int k = mu.size();
NumericMatrix w = no_init(n,k);
.....
Putting all of the above feedback together, we get the desired function.
Rcpp::cppFunction(
'NumericMatrix Expcpp(NumericVector x, NumericVector mu, NumericVector var, NumericVector prob) {
int n = x.size();
int k = mu.size();
NumericMatrix w = no_init(n,k);
for (int i = 0; i < k; ++i) { // C++ indices start at 0
w(_,i) = prob[i] * dnorm(x, mu[i], sqrt(var[i]));
}
Rcpp::Rcout << "Before: " << std::endl << w << std::endl;
NumericVector summed_by_row = rowSums(w);
Rcpp::Rcout << "rowSum: " << summed_by_row << std::endl;
// normalize by column to mimic R
for (int i = 0; i < k; ++i) {
w(_,i) = w(_,i) / summed_by_row[i];
}
Rcpp::Rcout << "After: " << std::endl << w << std::endl;
return w;
}')
set.seed(51231)
# Test values
n <- 2
x <- seq_len(n)
mu <- x
var <- x
prob <- runif(n)
mat <- Expcpp(x, mu, var, prob)
Output
Before:
0.0470993 0.125384
0.0285671 0.160996
rowSum: 0.172483 0.189563
After:
0.273066 0.661436
0.165623 0.849300

Related

How to make Rcpp code efficient with multiple for loops?

I am trying to implement following Rcpp code by calling from R. The computing time is extremely slow. There are lots of for loops involved.
#include <RcppArmadillo.h>
using namespace Rcpp;
// [[Rcpp::depends(RcppArmadillo)]]
// [[Rcpp::export]]
arma::mat qpart(
const int& n,
const int& p,
const int& m,
arma::vec& G,
arma::vec& ftime,
arma::vec& cause,
arma::mat& covs,
arma::mat& S1byS0hat,
arma::vec& S0hat,
arma::vec& expz){
arma::mat q(n,p);
q.zeros();
for(int u=0;u<n;++u){
arma::mat q1(1,p);
q1.zeros();
for(int iprime=0;iprime<n;++iprime){
for(int i=0;i<n;++i){
if(cause(iprime)==1 & cause(i)>1 & (ftime(i) < ftime(u)) & (ftime(u) <= ftime(iprime))){
q1 += (covs.row(i) - S1byS0hat.row(iprime))*G(iprime)/G(i)*expz(i)/S0hat(iprime);
}
}
}
q.row(u) = q1/(m*m);
}
return q;
}
Following is an example in R.
#### In R ########
n = 2000
m = 500
p=3
G = runif(n)
ftime = runif(n,0.01,5)
cause = c(rep(0,600),rep(1,1000),rep(2,400))
covs = matrix(rnorm(n*p),n,p)
S1byS0hat = matrix(rnorm(n*p),p,n)
S0hat = rnorm(n)
expz = rnorm(n)
system.time( qpart(n,p,m,G,ftime,cause,covs,t(S1byS0hat),S0hat,expz))
user system elapsed
21.5 0.0 21.5
As we can see, the computing time is very high.
Same code implemented in R and the computing time is very high.
q = matrix(0,n,p)
for(u in 1 : n){
q1 <- matrix(0,p,1)
for(iprime in 1 : n){
for(i in 1 : n){
if(cause[iprime]==1 & cause[i]>1 & (time[i]<time[u]) & (time[u] <= time[iprime])){
q1 = q1 + (covs[i,] - S1byS0hat[,iprime])*G[iprime]/G[i]*expz[i]/S0hat[iprime]
}
}
}
q[u,] = q1/(m*m)
}
Following is the formula that I am trying to implement.
Some conditions depends only on u and iprime so you can check them much before.
You can also precompute some stuff. This gives:
arma::mat qpart2(
double m,
arma::vec& ftime,
arma::vec& cause,
arma::mat& covs,
arma::mat& S1byS0hat,
arma::vec& G_div_S0hat,
arma::vec& expz_div_G){
double m2 = m * m;
int n = covs.n_rows;
int p = covs.n_cols;
arma::mat q(n, p, arma::fill::zeros);
for (int u = 0; u < n; u++) {
double ftime_u = ftime(u);
for (int iprime = 0; iprime < n; iprime++) {
if (cause(iprime) == 1 && ftime_u <= ftime(iprime)) {
for (int i = 0; i < n; i++) {
if (cause(i) > 1 && ftime(i) < ftime_u) {
double coef = G_div_S0hat(iprime) * expz_div_G(i);
for (int j = 0; j < p; j++) {
q(u, j) += (covs(i, j) - S1byS0hat(iprime, j)) * coef;
}
}
}
}
}
for (int j = 0; j < p; j++) q(u, j) /= m2;
}
return q;
}
Using qpart2(m, ftime, cause, covs, t(S1byS0hat), G / S0hat, expz / G) takes 3.7 sec (vs 32 sec for your code).
**
Small remarks:
Is there a reason why you are using arma structures instead of Rcpp ones?
You should access matrices by columns, not by rows, it should be a bit faster because they are stored column-wise.

Optimizing strucchange with Rcpp

I'm trying to speed up the breakpoints.formula function in the strucchange package (source). It has a bottleneck in the extend.RSS.table.
Here's my attempt at rewiring the for(i in my.index) loop inside it using Rcpp:
// [[Rcpp::export]]
NumericMatrix fillMyRSStable(NumericMatrix myRSStable, List & RSStriang, IntegerVector & myIndex, int m, float h) {
NumericMatrix myRSStableCPY = clone(myRSStable);
CharacterVector indexI(1), indexj(1);
int n = myIndex.size();
CharacterVector nms = rownames(myRSStableCPY);
for(int myIndexI = 0; myIndexI < n; ++myIndexI) {
int i = myIndex[myIndexI];
IntegerVector potIndex = seq((m - 1)*h, i - h);
//sapply
int np = potIndex.size();
NumericVector breakRSS(np);
for(int pin = 0; pin < np; ++pin) {
int j = potIndex[pin];
NumericVector RSStriangI = as<NumericVector>(RSStriang[j]);
indexj[0] = j;
IntegerVector matchedIdxJ = match(indexj, nms);
breakRSS[pin] = myRSStableCPY(matchedIdxJ[0] - 1, 1) + RSStriangI[i - j - 1];
}
// end sapply
int opt = which_min(breakRSS);
indexI[0] = i;
IntegerVector matchedIdxI = match(indexI, nms);
myRSStableCPY(matchedIdxI[0] - 1, 2) = potIndex[opt];
myRSStableCPY(matchedIdxI[0] - 1, 3) = breakRSS[opt];
}
return myRSStableCPY;
}
This code is a bit faster than R but not nearly as fast as I would have thought. Any glaring inefficiencies in the code below that someone can spot? Any general (or specific) advice would be helpful.
Edit Code for profiling:
library(strucchange)
library(profvis)
library(microbenchmark)
data("Grossarl")
pr <- profvis(microbenchmark(Grossarl.bp <- breakpoints(fraction ~ 1, data = Grossarl, h = 0.1)))
htmlwidgets::saveWidget(pr, "profile.html")
Link to my Rcpp version: https://github.com/s-Nick-s/strucchange

Unexpected behaviour in Rcpp

Please note that this error was taken from a bigger context, which I cannot obviously report here entirely.
I have the following functions in the file fun.cpp
#include <RcppArmadilloExtensions/sample.h>
using namespace Rcpp;
// [[Rcpp::depends(RcppArmadillo)]]
arma::vec colMeans(arma::mat data){
int n_0 = data.n_rows;
arma::vec xbar(data.n_cols);
for(int i = 0; i < data.n_rows; i++){
for(int j = 0; j < data.n_cols; j++){
xbar[j] += data(i,j) /n_0;
}
}
return xbar;
}
// [[Rcpp::export]]
List PosteriorNIW(arma::mat data, arma::vec mu0, double lambda0,
double df0, arma::mat V){
// Compute posterior
int n = data.n_rows;
arma::vec xbar = colMeans(data);
double lambdan = lambda0 + n;
arma::vec mun = (lambda0 * mu0 + n * xbar) / lambdan;
arma::mat S;
S.zeros(data.n_cols, data.n_cols);
for(int i = 0; i < n; i++){
S += (arma::conv_to<arma::vec>::from(data.row(i)) - xbar) * arma::trans(arma::conv_to<arma::vec>::from(data.row(i)) - xbar);
}
arma::mat Vn = V + S + ((lambda0*n)/(lambda0 + n)) * (xbar - mu0) * arma::trans(xbar - mu0);
return List::create(_["mun"] = mun,
_["Vn"] = Vn,
_["lambdan"] = lambdan);
}
Calling now:
library(Rcpp); library(RcppArmadillo)
mu0 <- c(3,3)
V0 <- matrix(c(2.5,0.0,0.0,2.5), nrow = 2)
sourceCpp("fun.cpp")
data <- cbind(rep(5,15),rep(0,15))
PosteriorNIW(data, mu0, 1, 1, V0)
gives the expected result.
$mun
[,1]
[1,] 4.8750
[2,] 0.1875
$Vn
[,1] [,2]
[1,] 6.250 -5.6250
[2,] -5.625 10.9375
$lambdan
[1] 16
Now if I add to the file fun.cpp the following functions (again, these are taken from a bigger context so don't bother trying to understand but just paste them) strange things happens:
// [[Rcpp::export]]
NumericMatrix myFun(arma::mat t_dish, arma::cube data){
int l = 0;
for(int j = 0; j < data.n_rows; j++){
l++;
}
NumericMatrix Dk(l, 2);
return Dk;
}
// [[Rcpp::export]]
int myFun2(arma::cube n_cust){
arma::mat temp = n_cust.subcube(arma::span(0), arma::span(), arma::span());
int i;
for(i = 0; i < n_cust.n_cols; i++){
arma::rowvec temp2 = temp.row(i);
}
return i + 1;
}
// [[Rcpp::export]]
arma::vec myFun3(arma::mat k_tables){
arma::vec temp(k_tables.n_cols * k_tables.n_rows);
int l = 0;
if(!R_IsNA(k_tables(0,0))){
l++;
}
arma::vec temp2(l);
arma::vec tmp3 = sort(temp2);
return tmp3;
}
double myFun4(arma::vec x, double nu, arma::vec mu, arma::mat Sigma){
arma::vec product = (arma::trans(x - mu) * arma::inv(Sigma) * (x - mu));
double num = pow(1 + (1 / nu) * product[0], - ( nu + 2 ) / 2);
double den = pow(sqrt(M_PI * nu),2) * sqrt(arma::det(Sigma));
return num / den;
}
bool myFun5(NumericVector X, double z) {
return std::find(X.begin(), X.end(), z)!=X.end();
}
calling PosteriorNIW(data, mu0, 1, 1, V0) repeatedly starts giving different results every time. Note that there is no randomness in the functions and that obviously those functions have got no impact as they are not called in the original function.
I have tried on a different machine to make sure it was not a problem of my compiler but the error keeps happening.
I know that removing those function (even just one of them) fixes the problem but clearly this is not a feasible solution when I am working with more functions.
I would like to know if other users are able to replicate this behavior and if yes if there is a fix for it.
Thank you in advance
EDIT:
The version of R is 3.3.2 and Rtools is 3.4. Both Rcpp and RcppArmadillo are up-to-date
You're not zeroing xbar in your colMeans function. If I do do that:
arma::vec colMeans(arma::mat data){
int n_0 = data.n_rows;
arma::vec xbar;
xbar.zeros(data.n_cols);
for(int i = 0; i < data.n_rows; i++){
for(int j = 0; j < data.n_cols; j++){
xbar[j] += data(i,j) /n_0;
}
}
return xbar;
}
I get this everytime:
> PosteriorNIW(data, mu0, 1, 1.1, V0)
$mun
[,1]
[1,] 4.8750
[2,] 0.1875
$Vn
[,1] [,2]
[1,] 6.250 -5.6250
[2,] -5.625 10.9375
$lambdan
[1] 16
Even when I do add your extra block of code.
I don't know if these vectors are documented to be initialised to zero by their constructor (in which case this might be a bug there) or not, in which case its your bug!

RcppArmadillo on several cpu cores

I have the following RccpArmadillo function that runs fine if I execute it on one cpu core. But if I use several cores, then R will crash. All the other Rcpp functions I created so far run fine on several cores (with foreach), only RccpArmadillo seems to be problematic. Any ideas how to fix that?
cppFunction('double augmentedDickeyFullerCpp(NumericVector a, NumericVector b, double gamma, double mu, int lags) {
if (gamma < 0) {
return 0;
}
int n = a.size()-1;
int lags2 = lags + 1;
// first rows, then columns
NumericMatrix x(n-lags2,lags2);
NumericMatrix zdifflag(n-lags2+1,lags2);
NumericVector diff(n);
NumericVector zdiff(n-lags2+1);
NumericVector residuals(n+1);
residuals[0] = a[0] - gamma * b[0] - mu;
// residuals a is y and b is x
for(int i = 1; i < n+1; i++) {
residuals[i] = a[i] - gamma * b[i] - mu;
diff[i-1] = residuals[i] - residuals[i-1];
}
for(int i = 0; i < n-lags2+1; i++) {
zdifflag[0,i] = residuals[i+lags2-1];
}
for(int j = 0; j < n-lags2+1; j++) {
for(int i = 0; i < lags2; i++) {
x(j,i) = diff[j+lags2-1-i];
if (i > 0) {
zdifflag(j,i) = x(j,i);
}
}
zdiff[j] = x(j,0);
}
int length = zdifflag.nrow(), k = zdifflag.ncol();
arma::mat X(zdifflag.begin(), length, k, false); // reuses memory and avoids extra copy
arma::colvec y(zdiff.begin(), zdiff.size(), false);
arma::colvec coef = arma::solve(X, y); // fit model y ~ X
arma::colvec res = y - X*coef; // residuals
// std.errors of coefficients
//arma::colvec res = y - X*coef[0];
// sqrt(sum(residuals^2)/(length - k))
double s2 = std::inner_product(res.begin(), res.end(), res.begin(), 0.0)/(length - k);
arma::colvec std_err = arma::sqrt(s2 * arma::diagvec(arma::pinv(arma::trans(X)*X)));
return coef[0]/std_err[0];
}',depends = "RcppArmadillo", includes="#include <RcppArmadillo.h>")
I generally recommend putting the code into a small package, and having each parallel worker load the package. That is known to work, both in serial and parallel, whereas relying on cppFunction() for an ad-hoc function may be too fragile for parallel execution.

Parallel computation of a quadratic term in Rcpp

Let Y and K be an n-dimensional (column) vector and n by n matrix, respectively. Think of Y and K as a sample vector and its covariance matrix.
Corresponding to each entry of Y (say Yi) there is a row vector (of size 2) Si encoding the location of the sample in a two dimensional space. Construct the n by 2 matrix S by concatenating all the Si vectors. The ij-th entry of K is of the form
Kij= f( |si-sj|, b )
in which |.| denotes the usual Euclidean norm, f is the covariance function and b represents the covariance parameters. For instance for powered exponential covariance we have f(x) = exp( (-|x|/r)q ) and b = (r,q).
The goal is to compute the following quantity in Rcpp, using a parallel fashion. (YT stands for Y transpose and ||.||2 denotes the sum of square entries of K).
YTKY ⁄ ||K||2
Here is the piece of code I've written to do the job. While running, Rstudio runs out of memory after a few seconds and the following massage displays: "R encountered a fatal error. The session was terminated". I've very recently started using open MP in Rcpp and I have no idea why this happens! Can anybody tell me what have I done wrong here?
#include <Rcpp.h>
#include<math.h>
#include<omp.h>
// [[Rcpp::plugins(openmp)]]
using namespace Rcpp;
// [[Rcpp::export]]
double InnerProd(NumericVector x, NumericVector y) {
int n = x.size();
double total = 0;
for(int i = 0; i < n; ++i) {
total += x[i]*y[i];
}
return total;
}
// [[Rcpp::export]]
double CorFunc(double r, double range_param, double beta) {
double q,x;
x = r/range_param;
q = exp( -pow(x,beta) );
return(q);
}
// [[Rcpp::export]]
double VarianceComp( double range, NumericVector Y, NumericMatrix s, double
beta, int t ){
int n,i,j;
double Numer = 0, Denom = 0, dist, CorVal, ObjVal;
NumericVector DistVec;
n = Y.size();
omp_set_num_threads(t);
# pragma omp parallel for private(DistVec,CorVal,dist,j) \
reduction(+:Numer,Denom)
for( i = 0; i < n; ++i) {
for( j = 0; j < n; ++j){
DistVec = ( s(i,_)-s(j,_) );
dist = sqrt( InnerProd(DistVec,DistVec) );
CorVal = CorFunc(dist,range,beta);
Numer += Y[i]*Y[j]*CorVal/n;
Denom += pow( CorVal, 2 )/n;
}
}
ObjVal = Numer/Denom;
return( ObjVal );
}

Resources