How could I speed up this Rcpp code? - r

Question

I had implemented a function in R which was long to run. I have succeeded in improving it in R but now I would like to speed it up more by using Rcpp package.
I have created the following Rcpp code. Unfortunately, it takes approximately the same time to run as the R code. I would like thus to improve it. Has anyone an idea on how to improve this piece of code?
Thanks a lot!
#include <math.h>
#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]
double kernelcpp(NumericVector a, NumericVector b, int N){
int i;
double sum=0.0;
for (i=0;i<N;i++){
if (a[i] > b[i])
sum+= a[i] - b[i];
else
sum+= b[i] - a[i];
}
return(exp( - sum));
}
// [[Rcpp::export]]
NumericVector testFromontcpp(NumericMatrix z1, NumericMatrix z2, int Nbootstrap){
// first element of TKeps = TK
int i,j,k,t;
int dim1 = z1.nrow();
int dim2 = z2.nrow();
double n1 = (double) dim1;
double n2 = (double) dim2;
int dimension = z1.ncol();
int N = dim1 + dim2;
NumericVector TKeps(Nbootstrap+1);
Rcpp::NumericMatrix bb(N,N);
double cc = 1 / (n1*n2*(n1+n2-2));
double a = sqrt(1/(n1*n1-n1)-cc);
double b = - sqrt(1/(n2*n2-n2)-cc);
for (i=0 ; i<N ; i++){
for (j=0 ; j<N ; j++){
if (i != j){
if (i < dim1) {
if (j < dim1){
bb(i,j) = kernelcpp(z1(i,_),z1(j,_),dimension);
} else {
bb(i,j) = kernelcpp(z1(i,_),z2(j-dim1,_),dimension);
}
}
else{
if (j < dim1){
bb(i,j) = kernelcpp(z2(i-dim1,_),z1(j,_),dimension);
} else {
bb(i,j) = kernelcpp(z2(i-dim1,_),z2(j-dim1,_),dimension);
}
}
}
}
}
TKeps(0)=0.0;
for (i=0 ; i<N ; i++){
for (j=0 ; j<N ; j++){
if (i != j){
if (i < dim1) {
if (j < dim1){
TKeps(0) += bb(i,j)* (a*a + cc);
} else {
TKeps(0) += bb(i,j) * (a*b + cc);
}
}
else{
if (j < dim1){
TKeps(0) += bb(i,j) * (a*b + cc);
} else {
TKeps(0) += bb(i,j) * (b*b + cc);
}
}
}
}
}
for (k=1 ; k<=Nbootstrap ; k++){
TKeps(k)=0;
int R[N];
for (i = 0 ; i < N ; i++)
R[i] = i;
for (i = 0; i < N - 1 ; i++) {
int j = i + rand() / (RAND_MAX / (N - i) + 1);
t = R[j];
R[j] = R[i];
R[i] = t;
}
for (i=0 ; i<N ; i++){
for (j=0 ; j<N ; j++){
if (i != j){
if (R[i] < n1) {
if (R[j] < n1){
TKeps(k) += bb(i,j) * (a*a + cc);
} else {
TKeps(k) += bb(i,j) * (a*b + cc);
}
} else{
if (R[j] < n1){
TKeps(k) += bb(i,j) * (b*a + cc);
} else {
TKeps(k) += bb(i,j) * (b*b + cc);
}
}
}
}
}
}
return(TKeps);
}

Answer 1

Since I do not exactly know what your code does, I can see two things from the scratch:
The function you call from your R environment is testFromontcpp(...). I suggest that this function should have SEXP values as parameters. Those S-Expressions are pointer to the memory of R. If you don't use SEXP, then both matrices will be copied:
Consider a 1000x1000 matrix, this means you have 1 million entries saved in R, which are copied to C++. To do so write:
testFromontcpp(SEXP x, SEXP y, SEXP z) {
NumericMatrix z1(x), z2(y);
int *Nbootstrap = INTEGER(z);
...
}
Be careful: In the for-loop you cannot use i<Nbootstrap. You have to write i<*Nbootstrap!!!
Secondly...and more important: Since R's matrices are saved as pointer to column and from the column pointer to the row, C's matrices are saved the other way round. What I want to say is that it costs a lot to jump into memory and jump back the whole time instead of following the memory path. My suggestion for this is: Switch the for-loops, so first iterate over the row of a specific column and not the other way round.
To the last point: In a task at university I had the problem with iterating over matrices, too. In my case it was way cheaper to transpose the matrix and then do calculations.
I hope I could help you.
Best,
Michael
PS: Referring to point 1...I just benchmarked your code with your implementation and with using SEXP. With SEXP it is slightly quicker for a 100x100 matrix with random numbers between 1 to 10.