R/add_spread.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Add Spread Costs to a Return Portfolio
#'
#' @param R xts object containing asset returns
#' @param weights xts object containing asset weights
#' @param spread_buy number or numeric vector containing spread for buy orders
#' @param spread_sell number or numeric vector containing spread for sell orders
#'
#' @return xts object containing returns including spread
#' @export
#' @import xts
#' @importFrom magrittr %>%
#'
#' @examples add_spread(returns, weights, spread_buy = -0.005, spread_sell = -0.003)
#'
add_spread <- function (R, weights, spread_buy = -0.003, spread_sell = NULL) {

  assertive.types::assert_is_any_of(R, classes = c("xts"))
  assertive.types::assert_is_any_of(weights, classes = c("xts"))
  assertive.types::assert_is_numeric(spread_buy)
  assertive.types::assert_is_any_of(spread_sell, classes = c("NULL", "numeric"))

  transactions <- weights - lag(weights, k = 1) #diff(weights)

  transactions_buy <- transactions
  transactions_buy[transactions_buy < 0] <- 0
  transactions_buy <- merge.xts(weights, transactions_buy, join = "left") %>%
    .[, (ncol(weights)+1):ncol(.)] %>%
    `colnames<-`(colnames(transactions_buy)) %>%
    na.fill(fill=0)
  transactions_buy_perc <- (transactions_buy/weights) %>%
    replace(!is.finite(.), values = 0)

  transactions_sell <- transactions
  transactions_sell[transactions_sell > 0] <- 0
  transactions_sell <- lag(abs(transactions_sell), k = -1, na.pad = TRUE)
  transactions_sell <- merge.xts(weights, transactions_sell, join = "left") %>%
    .[, (ncol(weights)+1):ncol(.)] %>%
    `colnames<-`(colnames(transactions_sell)) %>%
    na.fill(fill=0)
  transactions_sell_perc <- (transactions_sell/weights) %>%
    replace(!is.finite(.), values = 0)

  if (length(spread_buy) == 1) {
    transaction_buy_costs <- transactions_buy_perc * spread_buy
  } else if (length(spread_buy) > 1) {
    transaction_buy_costs <- transactions_buy_perc %>%
      apply(1, function (x) {
        x * sample(spread_buy, length(x), replace = TRUE)
      }) %>% t() %>% as.xts(dateFormat="Date")
  }
  if (!all(index(R) == index(transaction_buy_costs))){
    stop("R, transaction_buy_costs: xts index do not align")
  }

  if (is.null(spread_sell)) {
    transaction_sell_costs <- 0
  } else {
    if (length(spread_sell) == 1) {
      transaction_sell_costs <- transactions_sell_perc * spread_sell
    } else if (length(spread_sell) > 1) {
      transaction_sell_costs <- transactions_sell_perc %>%
        apply(1, function (x) {
          x * sample(spread_sell, length(x), replace = TRUE)
        }) %>% t() %>% as.xts(dateFormat="Date")
    }
    if (!all(index(R) == index(transaction_sell_costs))) {
      stop("R, transaction_sell_costs: xts index do not align")
    }
  }

  if (all(is.na(transaction_buy_costs))) {
    warning("transaction_buy_costs: NA values detected")
  }
  if (all(is.na(transaction_sell_costs))) {
    warning("transaction_buy_costs: NA values detected")
  }

  R + transaction_buy_costs + transaction_sell_costs
}