benchmark_daily-interest.R

library(Rcpp)
library(purrr)
library(microbenchmark)

# Build a fairly big data frame with empty totals (except the first one)
# and daily interest rates

n <- 10000
t0 <- 100.0
daily <- data.frame(total = c(t0, rep(NA_real_, n-1)),
                    interest = runif(n, 0.0001, 0.002))


# Simple R loop solution, easy to read.
r_daily_compound <- function(df) {
  
  if (nrow(df) < 2) stop("Need at least two rows")
  
  for (i in 1:(nrow(df)-1)) {
    df$total[i+1] <- df$total[i] * (1 + df$interest[i])
  }
  df
  
}

# purrr accumulator. Not as clear but R only
accumulate_daily_compound <- function(df) {
  
  df$total <- purrr::accumulate(df$interest,
                                function(x, y)
                                  (x * (1 + y)),
                                .init = df$total[1])[-nrow(df)]
  df
}


# Rcpp solution. Nearly as readable as the R solution (minus boiler plate) but
# has to be compiled
c_daily_compound <- Rcpp::cppFunction('
  DataFrame modifyDataFrame(DataFrame df) {
  
  // access the columns
  DoubleVector interest = df["interest"];
  DoubleVector total_df = df["total"];
  DoubleVector total(total_df.length());
  
  total[0] = total_df[0];
  int nr = interest.length();
  for(int i=0; i<nr-1; i++) {
    total[i + 1] = total[i] * (1 + interest[i]);
  }
  
  // return a new data frame
  return DataFrame::create(_["total"]=total,
                           _["interest"]= interest);
}
  '
)

res <- microbenchmark(
  rloop = r_daily_compound(daily),
  cpp = c_daily_compound(daily),
  raccumulate = accumulate_daily_compound(daily),
  times = 100
)

res

# Unit: microseconds
# expr      min        lq       mean    median       uq       max neval cld
# rloop 388533.8 405999.70 473492.131 422580.20 496424.5 1007163.4   100   c
# cpp    277.2    397.15    571.434    524.15    581.6    4820.4   100 a  
# raccumulate  25164.7  27227.75  31476.141  27970.60  34915.7   61437.8   100  b