element wise matrix multiplication in Rcpp - c++

Question

I am trying to speed up some R code with Rcpp that takes a vector of length L (psi) and a matrix of dimensions (L,L) and does some element-wise operations. Is there a more efficient way to be doing these element-wise operations with Rcpp?
r:
UpdateLambda <- function(psi,phi){
# updated full-day infection probabilites
psi.times.phi <- apply(phi,1,function(x) x*psi)
## return Lambda_{i,j} = 1 - \prod_{j} (1 - \psi_{i,j,t} \phi_{i,j})
apply(psi.times.phi,2,function(x) 1-prod(1-x))
}
cpp:
#include <Rcpp.h>
#include <algorithm>
using namespace Rcpp;
// [[Rcpp::export]]
NumericVector UpdateLambdaC(NumericVector psi,
NumericMatrix phi
){
int n = psi.size();
NumericMatrix psi_times_phi(n,n);
NumericVector tmp(n,1.0);
NumericVector lambda(n);
for(int i=0; i<n;i++){
psi_times_phi(i,_) = psi*phi(i,_);
}
for(int i=0; i<n;i++){
// \pi_{j} (1- \lambda_{i,j,t})
for(int j=0; j<n;j++){
tmp[i] *= 1-psi_times_phi(i,j);
}
lambda[i] = 1-tmp[i];
}
return lambda;
}

Answer 1

You can replace you apply loops with vectorised alternatives.
The first one is equivalent to:
t(phi)*psi
And the second:
1-exp(colSums(log(1-psi.times.phi)))
#test data
phi <- matrix(runif(1e6),1e3)
psi <- runif(1e3)
#new function
UpdateLambda2 <- function(psi,phi) 1-exp(colSums(log(1-t(phi)*psi)))
#sanity check
identical(UpdateLambda(psi,phi),UpdateLambda2(psi,phi))
[1] TRUE
#timings
library(rbenchmark)
benchmark(UpdateLambda(psi,phi),UpdateLambda2(psi,phi))
test replications elapsed relative user.self sys.self
1 UpdateLambda(psi, phi) 100 16.05 1.041 15.06 0.93
2 UpdateLambda2(psi, phi) 100 15.42 1.000 14.19 1.19
Well, it appears that it does not make much of a difference, which is very surprising as colSums is typically much faster than apply. I'm not sure if the test data I've used is relevant as the output is all 1's due number of multiplications of number less than 1 in the second part. You may be better off working in a log scale anyway if you want to note the detail of such small numbers.