R/calcGapStrategyAllParams.R

In tmk-c/myrlib: My R library for daily work

#' Calculate "Open Gap Strategy" performance parallely.
#'
#' @param param.set Strategy parameters set.
#' @param data      Sliced data by getSlicedData function.
#'
#' @importFrom foreach %dopar%
#'
#' @return data.frame of strategy results.
#' @export
calcGapStrategyParallel <- function(param_set, data) {

  # Prepare foreach
  expt <- c("calcGapStrategy")
  cl   <- parallel::makeCluster(parallel::detectCores())

  doParallel::registerDoParallel(cl)
  on.exit(parallel::stopCluster(cl))

  # Run backtests if we have new param set
  results <- foreach::foreach(i = 1:nrow(param_set), .combine = "rbind",
                     .export = expt) %dopar% {
    calcGapStrategy(param_set[i, ], data, output = "simple")
  }

  return(results)
}

# ------------------------------------------------------------------------------
#' Generate "Open Gap Strategy" data parameters.
#'
#' @param start_date Start date in "yyyy-mm-dd::yyyy-mm-dd" format.
#' @param end_date End date in "yyyy-mm-dd::yyyy-mm-dd" format.
#' @param sma_lens Integer vector of SMA calculation lengths.
#' @param sd_lens Integer vector of SD calculation lengths.
#' @param ato_lens Integer vector of Average turnover calculation lengths.
#' @param ogc_lens Integer vector of Open Gap Coeficient calculation lengths.
#'
#' @return List of data parameters.
#' @export
generateDataParams <- function(
  range    = "2009-01-01::2009-12-31",
  sma_lens = seq(0, 250, 10),
  sd_lens  = seq(10, 250, 10),
  ato_lens = seq(10, 250, 10),
  ogc_lens = seq(0, 250, 10))
{
  result <- list(
    range    = range,
    sma_lens = sma_lens,
    sd_lens  = sd_lens,
    ato_lens = ato_lens,
    ogc_lens = ogc_lens
  )
  return(result)
}

# ------------------------------------------------------------------------------
#' Generate "Open Gap Strategy" parameters
#'
#' @param data_params Data parameters for "Open Gap Strategy".
#' @param side Order side ("Long" or "Short").
#' @param sd_thres Minimum entry threshold of SD.
#' @param ato_l_thres Minimum entry threshold of turnover.
#' @param ato_h_thres Maximum entry threshold of turnover.
#' @param ogc_thres Entry threshold of Open Gap Coeficient.
#' @param stop_thres Stop price coeficent of SD.
#' @param min_thres Minimum entry threshold of open price.
#' @param slippage Slippage percent of entry/exit.
#' @param num_trades Number of trades per day.
#' @param lot Dollar amount of one trade.
#'
#' @return data.table of strategy parameter set for the data set.
#' @export
generateStrategyParamSet <- function(data_params,
  side        = "Long",
  sd_thres    = seq(0, 0.02, 0.005),
  ato_l_thres = c(10000000),
  ato_h_thres = Inf,
  ogc_thres   = seq(0, -0.01, -0.005),
  stop_thres  = seq(0.1, 2, 0.1),
  min_thres   = c(10, 15),
  slippage    = c(0.001),
  num_trades  = c(10),
  lot         = c(10000))
{
  # Data params
  range    <- data_params$range
  sma_lens <- data_params$sma_lens
  sd_lens  <- data_params$sd_lens
  ato_lens <- data_params$ato_lens
  ogc_lens <- data_params$ogc_lens

  # Generate all combinations
  params <- expand.grid(range, sma_lens, sd_lens, ato_lens, ogc_lens,
                        side, sd_thres, ato_l_thres, ato_h_thres,
                        ogc_thres, stop_thres, min_thres, slippage, num_trades,
                        lot, stringsAsFactors = FALSE)

  colnames(params) <- c("range", "sma_len", "sd_len", "ato_len", "ogc_len",
                        "side", "sd_thres", "ato_l_thres",
                        "ato_h_thres", "ogc_thres", "stop_thres", "min_thres",
                        "slippage", "num_trades", "lot")

  params <- data.table::data.table(params)
  return(params)
}

# ------------------------------------------------------------------------------
#' Get parameter setdiff from past results in DB.
#'
#' @param dbcon_str Connection string to "strategy DB".
#' @param param_set Parameter set.
#'
#' @return parameter set diff
#' @export
getParamSetDiff <- function(dbcon_str, param_set) {

  results <- getGapStrategyResults(dbcon_str, add_perf = FALSE)

  if (nrow(results) > 0) {
    # Get setdiff
    names     <- names(param_set)
    results   <- results[, .SD, .SDcols = names]
    param_set <- param_set[!results, on = names]
  }

  return(param_set)
}

# ------------------------------------------------------------------------------
#' Insert backtest result into DB.
#'
#' @param results Backtest results.
#' @inheritParams getParamSetDiff
#'
#' @export
insertResults <- function(strategy.db, table, results) {

  # Insert result df
  con <- DBI::dbConnect(RSQLite::SQLite(), strategy.db)
  src <- dbplyr::src_dbi(con)

  dplyr::db_insert_into(con, table = table, values = results)
  DBI::dbDisconnect(con)
}

# ------------------------------------------------------------------------------
#' Calculate "Open Gap Strategy" performance of all parameter set.
#'
#' @param data_dbcon_str Data DB connection string.
#' @param strat_dbcon_str Strategy DB connection string.
#' @param ranges Character vector of ranges in "yyyy-mm-dd::yyyy-mm-dd" format.
#' @inheritParams generateDataParams
#' @inheritParams generateStrategyParamSet
#'
#' @export
calcGapStrategyAllParams <- function(data_dbcon_str, strat_dbcon_str,
  ranges      = getAnnualRanges(2009, 2018),
  sma_lens    = seq(0, 250, 10),
  sd_lens     = seq(10, 250, 10),
  ato_lens    = seq(10, 250, 10),
  ogc_lens    = seq(0, 250, 10),
  side        = "Long",
  sd_thres    = seq(0, 0.02, 0.005),
  ato_l_thres = c(10000000),
  ato_h_thres = Inf,
  ogc_thres   = seq(0, -0.01, -0.005),
  stop_thres  = seq(0.1, 2, 0.1),
  min_thres   = c(10, 15),
  slippage    = c(0.001),
  num_trades  = c(10),
  lot         = c(10000))
{
  # Increase memory max size
  options(future.globals.maxSize = (2000 * 1024 ^ 2)) # 2GB

  # Generate all data parameters by ranges
  data_param_set <- lapply(ranges, generateDataParams, sma_lens, sd_lens,
                           ato_lens, ogc_lens)

  for(data_params in data_param_set) {

    # Start watch
    s <- proc.time()

    # Create paramter set diff
    param_set <- generateStrategyParamSet(
      data_params, side, sd_thres, ato_l_thres, ato_h_thres,
      ogc_thres, stop_thres, min_thres, slippage, num_trades, lot)

    param_set <- getParamSetDiff(strat_dbcon_str, param_set)

    if (nrow(param_set) > 0) {

      # Build parameters for data request
      columns    <-  c("open", "high", "low", "close", "adj.open", "roc.pc2to",
                       "sma", "sd", "avg.tover", "open.gap.coef")
      start_date <- str_split(data_params$range, "::", simplify = TRUE)[1]
      end_date   <- str_split(data_params$range, "::", simplify = TRUE)[2]

      symbols    <- getActiveSymbols(data_dbcon_str, start_date, end_date)

      # Request data
      data <- getSliceData(data_dbcon_str, columns, start_date, end_date,
                           symbols, TRUE, data_params$sma_lens,
                           data_params$sd_lens, data_params$ato_lens,
                           data_params$ogc_lens)

      # Calc parallel
      results <- calcGapStrategyParallel(param_set, data)
      insertResults(strat_dbcon_str, "open_gap", results)
    }

    # End time
    e <- proc.time() - s
    cat(paste0("Range=", data_params$range, ", params=", nrow(param_set),
               ", Completed in ", e[3], " sec.\n\n"))
  }
}