R/reportBacktestResults.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Create PDF Report from a Strategy Backtest Parameter Screen
#'
#' @param benchmark_data OHLC market data of asset used for backtesting
#' @param benchmark_name asset name
#' @param strategy_name name of strategy object
#' @param backtest_results list object as obtained from screenStrategyParameter
#' function containing backtest results
#'
#' @importFrom grDevices pdf
#' @importFrom pheatmap pheatmap
#' @import xts
#' @import quantmod
#' @import PerformanceAnalytics
#' @return Returns plots which are saved to pdf file
#' @export
#'
#' @examples reportBacktestResults(msci_world, "MSCI World",
#' backtest_results, "CCIpullback_SL_TS")
reportBacktestResults <- function (benchmark_data, benchmark_name,
                                   backtest_results, strategy_name) {

  pdf(paste0("./charts/", strategy_name, "_report.pdf"),
      width = 7, height = 10)

  for (i in seq_len(length(backtest_results))) {

    strategy_returns <- lapply(backtest_results[[i]], function (x) {
      lapply (x, function (x) {
        Return.cumulative(x, geometric = TRUE)
      })
    }) %>%
      unlist(.) %>%
      matrix(., ncol = length(backtest_results[[i]]),
             nrow = length(backtest_results[[i]][[1]])) %>%
      'colnames<-'(names(backtest_results[[i]])) %>%
      'rownames<-'(names(backtest_results[[i]][[1]]))

    strategy_drawdown <- lapply(backtest_results[[i]], function (x) {
      lapply (x, function (x) {
        maxDrawdown(x, geometric = TRUE)*-1
      })
    }) %>%
      unlist(.) %>%
      matrix(., ncol = length(backtest_results[[i]]),
             nrow = length(backtest_results[[i]][[1]])) %>%
      'colnames<-'(names(backtest_results[[i]])) %>%
      'rownames<-'(names(backtest_results[[i]][[1]]))

    strategy_kelly <- lapply(backtest_results[[i]], function (x) {
      lapply (x, function (x) {
        KellyRatio(x)
      })
    }) %>%
      unlist(.) %>%
      matrix(., ncol = length(backtest_results[[i]]),
             nrow = length(backtest_results[[i]][[1]])) %>%
      'colnames<-'(names(backtest_results[[i]])) %>%
      'rownames<-'(names(backtest_results[[i]][[1]]))

    charts.PerformanceSummary(dailyReturn(Op(benchmark_data)),
                              geometric = TRUE,
                              main = paste0(benchmark_name))
    pheatmap::pheatmap(strategy_returns,
                       cluster_cols = FALSE, cluster_rows = FALSE,
                       main = paste0(strategy_name,
                                     ": Strategy Return  / SL, TS ",
                                     names(backtest_results)[i]))
    pheatmap::pheatmap(strategy_drawdown,
                       cluster_cols = FALSE, cluster_rows = FALSE,
                       main = paste0(strategy_name,
                                     ": Strategy Drawdown  / SL, TS ",
                                     names(backtest_results)[i]))
    pheatmap::pheatmap(strategy_kelly,
                       cluster_cols = FALSE, cluster_rows = FALSE,
                       main = paste0(strategy_name,
                                     ": Strategy Kelly Ratio  / SL, TS ",
                                     names(backtest_results)[i]))
  }
  dev.off()
}