R/resolveCondition.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Function to Calculate Trading Strategy Condition Status
#'
#' @param data xts object with open, high, low, close market data
#' @param data_tmp xts object with open, high, low, close market data as container
#' for trading strategy data
#' @param strategy strategy object
#' @param ... not in use
#' @return xts object with open, high, low, close market data including trading
#' strategy condition information
#' @import xts
#' @import quantmod
#' @examples resolveCondition(data, data_tmp, strategy)
#'
resolveCondition <- function (data, data_tmp, strategy, ...) {

  data_tmp <- data_tmp
  condition <- strategy$condition

  condition_value <- list(); condition_mode <- list()
  for (i in seq_along(condition)) {

    data_correct <- convertOHLC(data, condition[[i]]$indicator)

    if (condition[[i]]$type == "on-off") {
      #calculate indicator values using selected arguments
      val <- do.call(condition[[i]]$indicator, c(list(data_correct), condition[[i]]$arguments))
      val[seq_len(condition[[i]]$arguments$n-1)] <- condition[[i]]$on
      #calculate indicator mode "on_off"
      if (condition[[i]]$on >= 0) {
        mode <- ifelse(val >= condition[[i]]$on, 1, ifelse(val <= condition[[i]]$off, -1, NA))
        mode <- na.locf(mode)
      }
      if (condition[[i]]$on <= 0) {
        mode <- ifelse(val <= condition[[i]]$on, 1, ifelse(val >= condition[[i]]$off, -1, NA))
        mode <- na.locf(mode)
      }
    }

    if (condition[[i]]$type == "on-signal-off") {
      #calculate indicator values using selected arguments
      val <- do.call(condition[[i]]$indicator, c(list(data_correct), condition[[i]]$arguments))
      val[seq_len(condition[[i]]$arguments$n)] <- condition[[i]]$on
      #calculate indicator mode "on_off"
      if (condition[[i]]$on >= 0) {
        mode <- ifelse(val >= condition[[i]]$on, 1, ifelse(val <= condition[[i]]$off, -1, NA))
        mode <- na.locf(mode) %>%
          lag(., k=1)
      }
      if (condition[[i]]$on <= 0) {
        mode <- ifelse(val <= condition[[i]]$on, 1, ifelse(val >= condition[[i]]$off, -1, NA))
        mode <- na.locf(mode) %>%
          lag(., k=1)
      }
    }

    if (condition[[i]]$type == "weights") {
      #indicator values are weights
      val <- as.xts(asset_weights)
      #indicator mode is weight > 0
      mode <- ifelse(val > 0, 1, 0)
    }

    if (condition[[i]]$type == "cross") {
      print("cross")
    }

    condition_value[[i]] <- na.locf(val)
    names(condition_value[[i]]) <- paste0("cond_value_", i)
    condition_mode[[i]] <- na.locf(mode)
    names(condition_mode[[i]]) <- paste0("cond_mode_", i)
  }

  #bind condition values and mode
  data_tmp <- cbind.xts(data_tmp, do.call(cbind.xts, condition_value)) %>%
    cbind.xts(., do.call(cbind.xts, condition_mode))

  #summarise condition mode
  data_tmp$cond_mode <- (rowSums(
    data_tmp[, grep("cond_mode", colnames(data_tmp))] ) >=
      length(condition))

  data_tmp

}