How to make function perform faster?

Question

I have following function: http://i.stack.imgur.com/yXA67.png, where mu is matrix (n_X rows and n_Y columns). d_X and d_Y are distance matrices.

One way to

Answer 1

Seems like @Marat Talipov's suggestion is way to go. If you are not comfortable with coding in C++, you can use typedFunction to auto-generate Rcpp code for simple R functions. It takes R function and it's arguments along with their types, assuming that there is explicit return call, and returns text code.

 H_mu <- function(mu, d_X, d_Y){      
  value <- 0
  for(i in 1:nrow(d_X)){
    for(ii in 1:nrow(d_X)){
      for(j in 1:nrow(d_Y)){
        for(jj in 1:nrow(d_Y)){
          value <- value + mu[i,j]*mu[ii,jj]*abs(d_X[i,ii]-d_Y[j,jj])
        }}}} 
  return (value)
}

Here I've added return(value) to your H_mu function

text <- typedFunction(H_mu, H_mu='double', value='double',
              mu='NumericVector',
              d_X='NumericVector',
              d_Y='NumericVector',
              i='int',
              ii='int',
              jj='int',
              j='int')
cat(text)

Copy-paste the outcome to your Rcpp editor, and after little tweaking you have executable H_mu_typed function.

Rcpp::cppFunction('double H_mu_typed(NumericMatrix mu, NumericMatrix d_X, NumericMatrix d_Y) {
  double value=0;
                  value = 0;
                  for (int i = 0; i <d_X.nrow(); i++) {
                  for (int ii = 0; ii < d_X.nrow(); ii++) {
                  for (int j = 0; j < d_Y.nrow(); j++) {
                  for (int jj = 0; jj < d_Y.nrow(); jj++) {
                  value = value + mu(i, j) * mu(ii, jj) * abs(d_X(i, ii) - d_Y(j, jj));
                  };
                  };
                  };
                  };
                  return(value);
                  }
                  ')

Enjoy the C++ speed.

H_mu_typed(mu, d_X, d_Y)
[1] 41650

system.time(H_mu_typed(mu, d_X, d_Y))[3]
elapsed 
   0.01 

Answer 2

This will save you 2 name look ups and a function call (i.e. [) per loop, which is a wopping 8% faster (so really @Marat Talipov's suggestion is the way to go) :

H_mu_2 <- function(mu, d_X, d_Y){
    value <- 0
    for(i in 1:nrow(d_X))
    for(j in 1:nrow(d_Y)){
        tmp <- mu[i,j]
        for(ii in 1:nrow(d_X))
        for(jj in 1:nrow(d_Y)){
            value <- value + tmp*mu[ii,jj]*abs(d_X[i,ii]-d_Y[j,jj])
        }} 
}