Moving Cpp functions into package.

.vscode/settings.json

@@ -0,0 +1,7 @@
+{
+    "files.associations": {
+        "*.Rmd": "rmd",
+        "*.lock": "json",
+        "init.C": "cpp"
+    }
+}

DESCRIPTION

@@ -11,9 +11,11 @@ Authors@R:
 Maintainer: Dereck Mezquita <dereck@mezquita.io>
 Description: A plotting toolkit for financial and time series data. The package provides algorithms, functions, layers and outlines a framework for working with working with and analysing financial and time series data.
 Depends: R (>= 4.1.0)
+LinkingTo: Rcpp
 Imports:
     ggplot2 (>= 3.4.0),
-    data.table
+    data.table,
+    Rcpp
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

R/cpp.R

@@ -0,0 +1,62 @@
+# Wrapper functions for C++ code in dmplot package
+
+#' @useDynLib dmplot, .registration = TRUE
+#' @importFrom Rcpp evalCpp
+NULL
+
+#' Bollinger Bands
+#'
+#' @param price A numeric vector of prices
+#' @param n The period for the moving average
+#' @param sd The number of standard deviations for the bands
+#' @return A list containing the lower band, moving average, upper band, and percentage B
+#' @export
+bb <- function(price, n, sd = 2) {
+    .Call('_dmplot_bb', PACKAGE = 'dmplot', price, n, sd)
+}
+
+#' Exponential Moving Average
+#'
+#' @param price A numeric vector of prices
+#' @param n The period for the EMA
+#' @param wilder Whether to use Wilder's smoothing
+#' @return A numeric vector containing the EMA values
+#' @export
+ema <- function(price, n, wilder = FALSE) {
+    .Call('_dmplot_ema', PACKAGE = 'dmplot', price, n, wilder)
+}
+
+#' Moving Average Convergence Divergence (MACD)
+#'
+#' @param price A numeric vector of prices
+#' @param s The short-term period
+#' @param l The long-term period
+#' @param k The signal line period
+#' @param percent Whether to return the MACD as a percentage
+#' @return A list containing the MACD and signal line values
+#' @export
+macd <- function(price, s, l, k, percent = TRUE) {
+    .Call('_dmplot_macd', PACKAGE = 'dmplot', price, s, l, k, percent)
+}
+
+#' Momentum
+#'
+#' @param price A numeric vector of prices
+#' @param n The period for momentum calculation
+#' @return A numeric vector containing the momentum values
+#' @export
+mom <- function(price, n) {
+    .Call('_dmplot_mom', PACKAGE = 'dmplot', price, n)
+}
+
+#' Monte Carlo Simulation
+#'
+#' @param seed_price The starting price
+#' @param daily_vol The daily volatility
+#' @param num_sims The number of simulations to run
+#' @param num_days The number of days to simulate
+#' @return A list containing the simulation results and end prices
+#' @export
+monte_carlo <- function(seed_price, daily_vol, num_sims, num_days) {
+    .Call('_dmplot_monte_carlo', PACKAGE = 'dmplot', seed_price, daily_vol, num_sims, num_days)
+}

renv.lock

@@ -61,6 +61,17 @@
       ],
       "Hash": "45f0398006e83a5b10b72a90663d8d8c"
     },
+    "Rcpp": {
+      "Package": "Rcpp",
+      "Version": "1.0.12",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "methods",
+        "utils"
+      ],
+      "Hash": "5ea2700d21e038ace58269ecdbeb9ec0"
+    },
     "TTR": {
       "Package": "TTR",
       "Version": "0.24.4",

src/bb-bollinger-bands.cpp

@@ -0,0 +1,49 @@
+#include <Rcpp.h>
+#include <math.h>
+
+#include "bb-bollinger-bands.h"
+#include "sma-simple-moving-average.h"
+
+using namespace Rcpp;
+
+// https://gallery.rcpp.org/articles/creating-a-datatable-in-rcpp/
+
+// [[Rcpp::export]]
+Rcpp::List bb(std::vector<double> price, int n, int sd = 2) {
+    // calculate the simple moving average
+    std::vector<double> mavg = sma(price, n);
+
+    // pre-allocate std::vector with 0 values for the standard deviation
+    std::vector<double> std_dev(price.size(), 0);
+
+    // calculate the standard deviation
+    for (int i = n - 1; i < price.size(); i++) {
+        // population standard deviation is used
+        // delta = sqrt(sum((x_i - mean) * (x_i - mean)) / n)
+        double sum = 0;
+        for (int j = i - n + 1; j <= i; j++) {
+            sum += std::pow(price[j] - mavg[i], 2);
+        }
+        std_dev[i] = std::sqrt(sum / (double) n);
+    }
+
+    // calculate the upper and lower bands
+    std::vector<double> upper_bound(price.size(), 0);
+    std::vector<double> lower_bound(price.size(), 0);
+    std::vector<double> pct(price.size(), 0);
+
+    for (int i = 0; i < mavg.size(); i++) {
+        upper_bound[i] = mavg[i] + sd * std_dev[i];
+        lower_bound[i] = mavg[i] - sd * std_dev[i];
+        pct[i] = (price[i] - lower_bound[i]) / (upper_bound[i] - lower_bound[i]);
+    }
+
+    List result = List::create(
+        _["bb_lower"] = lower_bound,
+        _["bb_mavg"] = mavg,
+        _["bb_upper"] = upper_bound,
+        _["bb_pct"] = pct
+    );
+
+    return result;
+}

src/bb-bollinger-bands.h

@@ -0,0 +1,6 @@
+#ifndef KUCOIN_BB_BOLLINGER_BANDS_H
+#define KUCOIN_BB_BOLLINGER_BANDS_H
+
+Rcpp::List bb(std::vector<double> price, int n, int sd);
+
+#endif

src/ema-exponential-moving-average.cpp

@@ -0,0 +1,51 @@
+#include <Rcpp.h>
+#include <vector>
+
+using namespace Rcpp;
+
+// conclusion ema_rcpp is faster
+
+// algorithm inspired from:
+// https://bookdown.org/kochiuyu/technical-analysis-with-r-second-edition2/exponential-moving-average-ema.html
+// https://github.com/joshuaulrich/TTR/blob/master/src/moving_averages.c
+
+
+// [[Rcpp::export]]
+std::vector<double> ema(std::vector<double> price, int n, bool wilder = false) {
+    // define beta
+    // for EMA, wilder=FALSE (the default) uses an exponential smoothing ratio of 2/(n+1), while wilder=TRUE uses Welles Wilder's exponential smoothing ratio of 1/n
+    double beta = wilder ? 1.0 / n : 2.0 / ((double) n + 1.0);
+
+    // pre-allocate the vector with NA values
+    std::vector<double> result(price.size(), NA_REAL);
+
+    // check for non-leading NAs and get first non-NA location
+    int first_non_na = 0;
+    for (int i = 0; i < price.size(); i++) {
+        if (!std::isnan(price[i])) {
+            first_non_na = i;
+            break;
+        }
+    }
+
+    // if first value larger than n then throw error
+    if (n + first_non_na > price.size()) {
+        stop("Not enough non-NA values");
+    }
+
+    // calculate the first value as the average of the first n values
+    double seed = 0.0;
+    for (int i = first_non_na; i < first_non_na + n; i++) {
+        // std::cout << price[i] << std::endl;
+        seed += price[i] / (double) n;
+    }
+
+    result[first_non_na + n - 1] = seed;
+
+    // calculate the ema
+    for (int i = first_non_na + n; i < price.size(); i++) {
+        result[i] = beta * price[i] + (1.0 - beta) * result[i - 1];
+    }
+
+    return result;
+}

src/ema-exponential-moving-average.h

@@ -0,0 +1,6 @@
+#ifndef KUCOIN_EMA_EXPONENTIAL_MOVING_AVEREAGE_H
+#define KUCOIN_EMA_EXPONENTIAL_MOVING_AVEREAGE_H
+
+std::vector<double> ema(std::vector<double> price, int n, bool wilder = false);
+
+#endif

src/init.c

@@ -0,0 +1,25 @@
+#include <R.h>
+#include <Rinternals.h>
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* .Call calls */
+extern SEXP _dmplot_bb(SEXP, SEXP, SEXP);
+extern SEXP _dmplot_ema(SEXP, SEXP, SEXP);
+extern SEXP _dmplot_macd(SEXP, SEXP, SEXP, SEXP, SEXP);
+extern SEXP _dmplot_mom(SEXP, SEXP);
+extern SEXP _dmplot_monte_carlo(SEXP, SEXP, SEXP, SEXP);
+
+static const R_CallMethodDef CallEntries[] = {
+    {"_dmplot_bb", (DL_FUNC) &_dmplot_bb, 3},
+    {"_dmplot_ema", (DL_FUNC) &_dmplot_ema, 3},
+    {"_dmplot_macd", (DL_FUNC) &_dmplot_macd, 5},
+    {"_dmplot_mom", (DL_FUNC) &_dmplot_mom, 2},
+    {"_dmplot_monte_carlo", (DL_FUNC) &_dmplot_monte_carlo, 4},
+    {NULL, NULL, 0}
+};
+
+void R_init_dmplot(DllInfo *dll) {
+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}

src/macd-moving-average-convergence-divergence.cpp

@@ -0,0 +1,31 @@
+#include <Rcpp.h>
+#include <vector>
+
+#include "macd-moving-average-convergence-divergence.h"
+#include "ema-exponential-moving-average.h"
+
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+List macd(std::vector<double> price, int s, int l, int k, bool percent = true) {
+    std::vector<double> mavg_fast = ema(price, s);
+    std::vector<double> mavg_slow = ema(price, l);
+
+    // calculate the macd as the difference between mavg_fast and mavg_slow
+    std::vector<double> macd_res;
+
+    // we use a for loop here
+    for (int i = 0; i < mavg_fast.size(); i++) {
+        if (percent) {
+            macd_res.push_back(100 * (mavg_fast[i] / mavg_slow[i] - 1));
+        } else {
+            macd_res.push_back(mavg_fast[i] - mavg_slow[i]);
+        }
+    }
+
+    std::vector<double> signal = ema(macd_res, k);
+
+    List result = List::create(_["macd"] = macd_res, _["signal"] = signal);
+
+    return result;
+}

src/macd-moving-average-convergence-divergence.h

@@ -0,0 +1,6 @@
+#ifndef KUCOIN_MACD_MOVING_AVERAGE_CONVERGENCE_DIVERGENCE_H
+#define KUCOIN_MACD_MOVING_AVERAGE_CONVERGENCE_DIVERGENCE_H
+
+Rcpp::List macd(std::vector<double> price, int s, int l, int k, bool percent);
+
+#endif

src/mom-momentum.cpp

@@ -0,0 +1,19 @@
+#include <Rcpp.h>
+
+#include "mom-momentum.h"
+
+using namespace Rcpp;
+
+// https://bookdown.org/kochiuyu/technical-analysis-with-r-second-edition2/momentum.html
+// M_t(n) = P_t - P_(t-n)
+
+// [[Rcpp::export]]
+std::vector<double> mom(std::vector<double> price, int n) {
+    std::vector<double> result(price.size(), NA_REAL);
+
+    for (int i = n; i < price.size(); i++) {
+        result[i] = price[i] - price[i - n];
+    }
+
+    return result;
+}

src/mom-momentum.h

@@ -0,0 +1,6 @@
+#ifndef KUCOIN_MOM_MOMENTUM_H
+#define KUCOIN_MOM_MOMENTUM_H
+
+std::vector<double> mom(std::vector<double> price, int n);
+
+#endif

src/monte_carlo.cpp

@@ -0,0 +1,39 @@
+#include <Rcpp.h>
+
+// [[Rcpp::export]]
+Rcpp::List monte_carlo(double seed_price, double daily_vol, int num_sims, int num_days) {
+    int total_rows = num_sims * num_days;
+    Rcpp::NumericVector close(total_rows);
+    Rcpp::IntegerVector sim_idx(total_rows);
+    Rcpp::NumericVector end_price(num_sims);
+    Rcpp::IntegerVector end_idx(num_sims);
+
+    int row_index = 0;
+    for (int i = 0; i < num_sims; ++i) {
+        double current_price = seed_price;
+        for (int j = 0; j < num_days; ++j) {
+            current_price *= (1 + R::rnorm(0, daily_vol));
+            close[row_index] = current_price;
+            sim_idx[row_index] = i + 1;
+            ++row_index;
+        }
+
+        end_price[i] = current_price;
+        end_idx[i] = i + 1;
+    }
+
+    Rcpp::DataFrame sim_df = Rcpp::DataFrame::create(
+        Rcpp::_["close"] = close,
+        Rcpp::_["simulation"] = sim_idx
+    );
+
+    Rcpp::DataFrame end_df = Rcpp::DataFrame::create(
+        Rcpp::_["close"] = end_price,
+        Rcpp::_["simulation"] = end_idx
+    );
+
+    return Rcpp::List::create(
+        Rcpp::_["simulations"] = sim_df,
+        Rcpp::_["end_prices"] = end_df
+    );
+}

src/roc-rate-of-change.cpp

@@ -0,0 +1,27 @@
+#include <Rcpp.h>
+#include <math.h>
+
+#include "roc-rate-of-change.h"
+
+using namespace Rcpp;
+
+// https://bookdown.org/kochiuyu/technical-analysis-with-r-second-edition2/rate-of-change-roc.html
+// discrete type
+// ROC_t(K) = (price_t - price_(t-K)) / price_(t-K)
+// continuous type - TTR uses continuous by default
+// ROC_t(K) = log(P_t) - log(P_(t-K))
+
+// [[Rcpp::export]]
+std::vector<double> roc(std::vector<double> price, int n, char type = 'c') {
+    std::vector<double> result(price.size(), NA_REAL);
+
+    for (int i = n; i < price.size(); i++) {
+        if (type == 'c') {
+            result[i] = std::log(price[i]) - std::log(price[i - n]);
+        } else {
+            result[i] = (price[i] - price[i - n]) / price[i - n];
+        }
+    }
+
+    return result;
+}

src/roc-rate-of-change.h

@@ -0,0 +1,6 @@
+#ifndef KUCOIN_ROC_RATE_OF_CHANGE_H
+#define KUCOIN_ROC_RATE_OF_CHANGE_H
+
+std::vector<double> roc(std::vector<double> price, int n, char type);
+
+#endif