Merge 8a84f32 into 5b21eaa

DESCRIPTION

@@ -16,7 +16,7 @@ Authors@R: c(
     role = c("fnd")),
     person("Optimum Credit Ltd's analysts", 
     comment = "https://www.optimumcredit.co.uk/", role = c("fnd")),
-    person("Maëlle", "Salmon", role = "ctb"))
+    person("Ma<U+00EB>lle", "Salmon", role = "ctb"))
 Depends:
     R (>= 3.0.2)
 Imports:
@@ -28,7 +28,8 @@ Imports:
     plyr,
     scales,
     stringr,
-    XML
+    XML,
+    Rcpp
 Suggests:
     testthat,
     covr,
@@ -39,3 +40,4 @@ URL: https://github.com/lockedata/optiRum, https://itsalocke.com/optirum/
 BugReports: https://github.com/lockedata/optiRum/issues
 VignetteBuilder: knitr
 RoxygenNote: 6.0.1.9000
+LinkingTo: Rcpp

R/RcppExports.R

@@ -0,0 +1,39 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#' @param rate The nominal interest rate per period (should be positive)
+#' @param nper Number of periods
+#' @param pv Present value i.e. loan advance (should be positive)
+#' @export 
+pmt_cpp <- function(rate, nper, pv) {
+    .Call('_optiRum_pmt_cpp', PACKAGE = 'optiRum', rate, nper, pv)
+}
+
+#'
+#' @param rate The nominal interest rate per period (should be positive)
+#' @param nper Number of periods
+#' @param pmt Instalment per period (should be negative)
+#' @param fv      Future value i.e. redemption amount
+#' @export
+pv_cpp <- function(rate, nper, pmt) {
+    .Call('_optiRum_pv_cpp', PACKAGE = 'optiRum', rate, nper, pmt)
+}
+
+#'  Calculates compounded interest rate
+#' 
+#' @param nper Number of periods
+#' @param pmt Instalment per period (should be negative)
+#' @param pv Present value i.e. loan advance (should be positive)
+#' @export
+ratecpp <- function(nper, pmt, pv) {
+    .Call('_optiRum_ratecpp', PACKAGE = 'optiRum', nper, pmt, pv)
+}
+
+#' Multiply numbers
+#' 
+#' @param x integer
+#' @export
+times_two <- function(x) {
+    .Call('_optiRum_times_two', PACKAGE = 'optiRum', x)
+}
+

microbenchmark.Rmd

@@ -0,0 +1,36 @@
+---
+title: "Speed C++ functions"
+author: "Rita Giordano"
+date: "15 July 2018"
+output: html_document
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+library(microbenchmark)
+library(optiRum)
+```
+
+# Testing speed of c++ functions: RATE, PV and PMT.
+
+## RATE
+
+```{r rate}
+df<-data.frame(nper=c(12,12),pmt=c(-500,-400),pv=c(3000,3000))
+microbenchmark(RATE(df$nper,df$pmt,df$pv), ratecpp(df$nper,df$pmt,df$pv))
+```
+
+## PV
+
+```{r pv}
+df<-data.frame(rate=c(.1,.1),nper=c(12,24),pmt=c(-10,-15))
+microbenchmark(PV(df$rate,df$nper,df$pmt), pv_cpp(df$rate,df$nper,df$pmt))
+```
+
+## PMT
+
+```{r pmt}
+df<-data.frame(rate=c(.1,.2),nper=c(12,24),pv=c(3000,1000))
+microbenchmark(PMT(df$rate,df$nper,df$pv), pmt_cpp(df$rate,df$nper,df$pv))
+```
+

src/.gitignore

@@ -0,0 +1,3 @@
+*.o
+*.so
+*.dll

src/RcppExports.cpp

@@ -0,0 +1,70 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// pmt_cpp
+NumericVector pmt_cpp(NumericVector rate, NumericVector nper, NumericVector pv);
+RcppExport SEXP _optiRum_pmt_cpp(SEXP rateSEXP, SEXP nperSEXP, SEXP pvSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type rate(rateSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type nper(nperSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type pv(pvSEXP);
+    rcpp_result_gen = Rcpp::wrap(pmt_cpp(rate, nper, pv));
+    return rcpp_result_gen;
+END_RCPP
+}
+// pv_cpp
+NumericVector pv_cpp(NumericVector rate, NumericVector nper, NumericVector pmt);
+RcppExport SEXP _optiRum_pv_cpp(SEXP rateSEXP, SEXP nperSEXP, SEXP pmtSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type rate(rateSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type nper(nperSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type pmt(pmtSEXP);
+    rcpp_result_gen = Rcpp::wrap(pv_cpp(rate, nper, pmt));
+    return rcpp_result_gen;
+END_RCPP
+}
+// ratecpp
+NumericVector ratecpp(const NumericVector nper, const NumericVector pmt, const NumericVector pv);
+RcppExport SEXP _optiRum_ratecpp(SEXP nperSEXP, SEXP pmtSEXP, SEXP pvSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const NumericVector >::type nper(nperSEXP);
+    Rcpp::traits::input_parameter< const NumericVector >::type pmt(pmtSEXP);
+    Rcpp::traits::input_parameter< const NumericVector >::type pv(pvSEXP);
+    rcpp_result_gen = Rcpp::wrap(ratecpp(nper, pmt, pv));
+    return rcpp_result_gen;
+END_RCPP
+}
+// times_two
+NumericVector times_two(NumericVector x);
+RcppExport SEXP _optiRum_times_two(SEXP xSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP);
+    rcpp_result_gen = Rcpp::wrap(times_two(x));
+    return rcpp_result_gen;
+END_RCPP
+}
+
+static const R_CallMethodDef CallEntries[] = {
+    {"_optiRum_pmt_cpp", (DL_FUNC) &_optiRum_pmt_cpp, 3},
+    {"_optiRum_pv_cpp", (DL_FUNC) &_optiRum_pv_cpp, 3},
+    {"_optiRum_ratecpp", (DL_FUNC) &_optiRum_ratecpp, 3},
+    {"_optiRum_times_two", (DL_FUNC) &_optiRum_times_two, 1},
+    {NULL, NULL, 0}
+};
+
+RcppExport void R_init_optiRum(DllInfo *dll) {
+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}

src/pmt_cpp.cpp

@@ -0,0 +1,34 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// This is a simple example of exporting a C++ function to R. You can
+//' @param rate The nominal interest rate per period (should be positive)
+//' @param nper Number of periods
+//' @param pv Present value i.e. loan advance (should be positive)
+//' @export 
+// [[Rcpp::export]]
+NumericVector pmt_cpp(NumericVector rate, NumericVector nper, NumericVector pv) {
+  int size_d = nper.size();
+  NumericVector pmt = size_d;
+
+  for (int i = 0; i < size_d; i++) {
+    double rate_i = rate[i];
+    double nper_i = nper[i];
+    const double pmt_r = -pv[i] * rate_i/(1 - 1/std::pow(1 + rate_i, nper_i));
+    // round to the second decimal
+    double pvmt_round = floor(pmt_r * 100.0 + .5)/100.0;
+    pmt[i] = pvmt_round;
+  }
+  return pmt;
+}
+
+
+// You can include R code blocks in C++ files processed with sourceCpp
+// (useful for testing and development). The R code will be automatically 
+// run after the compilation.
+//
+
+/*** R
+df<-data.frame(rate=c(.1,.2),nper=c(12,24),pv=c(3000,1000))
+pmt_cpp(df$rate,df$nper,df$pv)
+*/

src/pv_cpp.cpp

@@ -0,0 +1,45 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+//'
+//' @param rate The nominal interest rate per period (should be positive)
+//' @param nper Number of periods
+//' @param pmt Instalment per period (should be negative)
+//' @param fv      Future value i.e. redemption amount
+//' @export
+// [[Rcpp::export]]
+NumericVector pv_cpp(NumericVector rate, NumericVector nper, NumericVector pmt, NumericVector fv = 0) {
+
+  int size_d = pmt.size();
+  NumericVector regcashfactor(size_d);
+  NumericVector pv = size_d;
+  //double pvof;
+  for (int i = 0; i < size_d; i++) {
+
+    double rate_i = rate[i];
+    double nper_i = nper[i];
+
+    //return ifelse(rate == 0, 1 / nper, rate / (1 - 1 / std::pow(1 + rate_i, nper_i)));
+    if (rate[i] == 0) {
+      regcashfactor[i] = 1/ (1 / nper[i]);
+    } else {
+      regcashfactor[i] = 1/ (rate[i] / (1 - 1 / std::pow(1 + rate_i, nper_i)));
+    }
+    const double pvof = -pmt[i] * regcashfactor[i]; 
+    double pv_round = floor(pvof * 100 + .5)/100.0;
+    pv[i] = pv_round;
+  }
+
+  return pv;
+}
+
+
+// You can include R code blocks in C++ files processed with sourceCpp
+// (useful for testing and development). The R code will be automatically 
+// run after the compilation.
+//
+
+/*** R
+df<-data.frame(rate=c(.1,.1),nper=c(12,24),pmt=c(-10,-15))
+pv_cpp(df$rate,df$nper,df$pmt)
+  */

src/rate_cpp.cpp

@@ -0,0 +1,48 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+//'  Calculates compounded interest rate
+//' 
+//' @param nper Number of periods
+//' @param pmt Instalment per period (should be negative)
+//' @param pv Present value i.e. loan advance (should be positive)
+//' @export
+// [[Rcpp::export]]
+NumericVector ratecpp(const NumericVector nper, const NumericVector pmt, const NumericVector pv) 
+{
+    // max lenght of pmt and initial vector
+    int size_d = pmt.size();
+    NumericVector rate = size_d;
+    int n = 10;
+    for(int j = 0; j < size_d ; j++) {
+      double rate1 = 0.01;
+      double rate2 = 0.005;
+      for(int i = 0; i < n; i++) {
+
+        double nper_i = nper[j];
+
+        const double pv1 = -pmt[j]/rate1 * (1 - 1/(std::pow(1 + rate1, nper_i))) - pv[j];
+        const double pv2 = -pmt[j]/rate2 * (1 - 1/(std::pow(1 + rate2, nper_i))) - pv[j];
+
+        if (std::abs(pv1) > std::abs(pv2)) {
+          rate1 = (pv1 * rate2 - pv2 * rate1)/(pv1 - pv2);
+        } else {
+          rate2 = (pv1 * rate2 - pv2 * rate1)/(pv1 - pv2);
+          }
+      }
+      rate[j] = rate1;
+    }
+    return rate;
+}
+
+
+
+// You can include R code blocks in C++ files processed with sourceCpp
+// (useful for testing and development). The R code will be automatically 
+// run after the compilation.
+//
+
+/*** R
+df<-data.frame(nper=c(12,12),pmt=c(-500,-400),pv=c(3000,3000))
+ratecpp(df$nper,df$pmt,df$pv)
+*/