R/resolveBuySignal.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Function to Calculate Buy Signals and Prices
#'
#' @param data xts object with open, high, low, close market data
#' @param data_cond xts object with open, high, low, close market data and
#' trading strategy condition data
#' @param strategy strategy object
#' @param ... not in use
#' @return xts object with open, high, low, close market data including trading
#' strategy condition and buying information
#' @import xts
#' @import quantmod
#' @examples resolveBuySignal(data, data_cond, strategy)
#'
resolveBuySignal <- function (data, data_cond, strategy, ...) {

  data_tmp <- data_cond
  buy_signal <- strategy$buy_signal
  buy_condition <- strategy$buy_condition[[1]]

  buysignal_value <- list(); buysignal_mode <- list()
  for (i in 1:length(buy_signal)) {

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

    val <- do.call(buy_signal[[i]]$indicator, c(list(data_correct), buy_signal[[i]]$arguments))
    val <- na.fill(na.approx(val, na.rm=FALSE), buy_signal[[i]]$on)

    if (buy_signal[[i]]$type == "cross-up") {
      #all buy signal crosses from down to up
      mode <- diff.xts(val >= buy_signal[[i]]$on, na.pad=FALSE)
      mode <- na.fill(mode, 0)
    }
    if (buy_signal[[i]]$type == "cross-down") {
      #all buy signal crosses from up to down
      mode <- diff(val <= buy_signal[[i]]$on, na.pad=FALSE)
      mode %<>% na.fill(., 0)
    }
    if (buy_signal[[i]]$type == "price-up") {
      print("price-up")
    }
    if (buy_signal[[i]]$type == "price-down") {
      print("price-down")
    }
    if (buy_signal[[i]]$type == "indicator-cross-up") {
      print("indicator-cross")
    }
    if (buy_signal[[i]]$type == "indicator-cross-down") {
      print("indicator-cross")
    }
    if (buy_signal[[i]]$type == "candle") {
      print("candle")
    }

    buysignal_value[[i]] <- val
    names(buysignal_value[[i]]) <- paste0("buy_value_", i)
    buysignal_mode[[i]] <- mode == 1
    names(buysignal_mode[[i]]) <- paste0("buy_mode_", i)

  }

  data_tmp <- cbind.xts(data_tmp, do.call(cbind.xts, buysignal_value)) %>%
    cbind.xts(., do.call(cbind.xts, buysignal_mode))

  #summarise buy mode
  data_tmp$buy_mode <- (rowSums(
    data_tmp[, grep("buy_mode", colnames(data_tmp))] ) >=
      length(buy_signal))



  #include only true buy signals
  data_tmp$buy_signal <- ifelse(data_tmp$cond_mode == 1 & data_tmp$buy_mode == 1, 1, 0)

  #n-lag for true buying day
  data_tmp$buy_day <- lag.xts(data_tmp$buy_signal, k = buy_signal[[1]]$lag)


  # #validity of buy signal
  # buy_valid <- list()
  # if (buy_condition$valid == 1) {
  #   buy_valid[[1]] <- data_tmp$buy_day
  # } else {
  #   for (i in 2:buy_condition$valid) {
  #     buy_valid[[i]] <- lag.xts(data_tmp$buy_day, k = i-1)
  #   }
  # }
  #
  # buy_valid_tmp <- cbind.xts( data_tmp$buy_day, do.call(cbind.xts, buy_valid) )
  # data_tmp$buy_valid <- xts(
  #   rowSums(buy_valid_tmp, na.rm=TRUE),
  #   index(buy_valid_tmp) )
  # data_tmp$buy_valid <- ifelse(data_tmp$buy_valid >= 1, 1, 0)
  #
  # rm(data_correct, mode, val, buysignal_value, buysignal_mode, buy_valid, buy_valid_tmp)
  #
  # #previous close
  # data_tmp$'Cl_1' <- lag.xts( ifelse(data_tmp$buy_signal == 1, Cl(data_tmp), 0),
  #                             k = buy_condition$lag)
  # #verify if buy still valid after lagging
  # data_tmp$'Cl_1' <- ifelse(data_tmp$'Cl_1' != 0 & data_tmp$buy_valid == 1, data_tmp$'Cl_1', 0)
  #
  # Cl_valid <- list()
  # for (i in 1:buy_condition$valid) {
  #   Cl_valid[[i]] <- lag.xts(ifelse(data_tmp$buy_signal == 1, Cl(data_tmp), 0), k = i)
  # }
  # Cl_valid_tmp <- cbind.xts( do.call(cbind.xts, Cl_valid) ) %>%
  #   apply(., 1, function(x) max(x)) %>% as.data.frame(.)
  # data_tmp$Cl_valid <- xts(Cl_valid_tmp, order.by = as.Date(rownames(Cl_valid_tmp)))
  # #verify if buy still valid after lagging
  # data_tmp$Cl_valid <- ifelse(data_tmp$Cl_valid != 0 & data_tmp$buy_valid == 1, data_tmp$Cl_valid, 0)
  #
  # #buying price if buy condition '>Cl'
  # if (buy_condition$condition == '>Cl') {
  #   data_tmp$buy_price <- ifelse(data_tmp$Cl_valid != 0 & data_tmp$Cl_valid >= Op(data_tmp) &
  #                                  data_tmp$Cl_valid <= Hi(data_tmp), data_tmp$Cl_valid,
  #                                ifelse(data_tmp$Cl_valid != 0 & data_tmp$Cl_valid <= Op(data_tmp),
  #                                       Op(data_tmp), 0)
  #   )
  # }

  #buying price if buy condition NULL
  if (is.null(buy_condition$condition)) {
    data_tmp$buy_price <- ifelse(data_tmp$buy_day == 1, Op(data_tmp), 0)
                          #ifelse(data_tmp$Cl_valid != 0, data_tmp$Cl_valid, 0)
  }

  # buy_price_tmp <- data_tmp[, colnames(data_tmp) %in% c("Cl_valid", "buy_price")]
  # buy_price_tmp <- buy_price_tmp[buy_price_tmp$buy_price > 0, ]
  # buy_price_tmp <- buy_price_tmp[!duplicated(buy_price_tmp[,c("Cl_valid")]), ]
  # data_tmp$buy_price_corr <- buy_price_tmp$buy_price
  #
  # rm(Cl_valid, Cl_valid_tmp, buy_price_tmp)


  # #buying price corrected for spread
  # data_tmp$buy_spread <- data_tmp$buy_price_corr + data_tmp$buy_price_corr * buy_condition$spread
  # data_tmp$buy_spread[is.na(data_tmp$buy_spread)] <- 0

  data_tmp
}