R/calc_return_portfolio.R

In rengelke/quantTraiding_trato: Trading Strategies Development Tool Kit

#' Calculate Return Portfolios
#'
#' @param R xts matrix object of 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
#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic (FALSE) to aggregate returns. Default TRUE.
#' @param wealth_index logical, weather to return a wealth index
#' @param ... parameters to pass to PerformanceAnalytics::Return.portfolio
#'
#' @return list containig portfolio returns; direct: direct calculation,
#' rp: Return.Portfolio, rp_geom: Return.Portfolio geometric,
#' rp_spread: Return.Portfolio including trasaction costs,
#' rp_spread_geom: Return.Portfolio including trasaction costs geometric
#'
#' @importFrom magrittr %>%
#' @import xts
#' @export
#'
#' @examples calc_return_portfolio(R, weights, spread_buy = -0.0035)
calc_return_portfolio <- function (R,
                                   weights,
                                   spread_buy = -0.003,
                                   spread_sell = NULL,
                                   geometric = TRUE,
                                   wealth_index = FALSE,
                                   ...) {

  # align index of returns and weights
  Rw <- trato::alignXts(R, weights,
                        join = "right",
                        fill = 0)
  R       <- Rw[[1]]
  weights <- Rw[[2]]

  # calculate turnover
  txns <- weights - lag(weights)
  turnover <- txns %>% abs %>%
    rowSums() %>% `/`(2) %>%
    xts(order.by = index(txns)) %>%
    na.fill(fill = 0)
  turnover_pa <- turnover %>%
    cumsum() %>% last %>% `/`(length(turnover)/255) %>% round(2) %>%
    as.data.frame() %>%
    `rownames<-`("Annualized Turnover") %>%
    `colnames<-`("portfolio_stats")

  # align world index of returns and weights
  Rb <- merge.xts(quantmod::dailyReturn(trato:::world_price),
                  weights,
                  join = "right",
                  fill = 0) %>% .[, 1]

  if (!all(
    zoo(weights) %>% rowSums() %>%
    sapply(function (x) all.equal(x, 1))
  )) {
    warning("Warning: Weights do not sum up to 1!")
  }

  # direct return portfolio calculation
  return_direct <- as.xts(rowSums(zoo(R)*zoo(weights)),
                          dateFormat="Date")

  # Return.portfolio
  weights_lagged <- lag(weights, k=-1, na.pad = TRUE) %>%
    na.locf()
  return_portf <- PerformanceAnalytics::Return.portfolio(R,
                                                         weights_lagged,
                                                         geometric = geometric,
                                                         verbose = FALSE,
                                                         ...) %>%
    `colnames<-`(c("return_portf"))

  if (wealth_index == TRUE) {
    price_portf <- PerformanceAnalytics::Return.portfolio(R,
                                                          weights_lagged,
                                                          geometric = geometric,
                                                          verbose = FALSE,
                                                          wealth.index = TRUE,
                                                          ...) %>%
      `colnames<-`(c("price_portf"))
  }


  R_spread <- trato::applySpread(R, weights,
                                 spread_buy = spread_buy,
                                 spread_sell = spread_sell)
  if ("CORR" %in% colnames(R_spread)) {
    R_spread$CORR <- 1e-09
  }

  return_portf_spread <- PerformanceAnalytics::Return.portfolio(R_spread,
                                                                weights_lagged,
                                                                geometric = geometric,
                                                                verbose = FALSE,
                                                                ...) %>%
    `colnames<-`(c("return_portf_spread"))

  if (wealth_index == TRUE) {
    price_portf_spread <- PerformanceAnalytics::Return.portfolio(R_spread,
                                                                 weights_lagged,
                                                                 geometric = geometric,
                                                                 verbose = FALSE,
                                                                 wealth.index = TRUE,
                                                                 ...) %>%
      `colnames<-`(c("price_portf_spread"))
  }

  rp_stats <- calc_return_stats(return_portf, Rb) %>%
    rbind(., turnover_pa) %>%
    `colnames<-`("return_portf")
  rp_spread_stats <- calc_return_stats(return_portf_spread, Rb) %>%
    rbind(., turnover_pa) %>%
    `colnames<-`("return_portf_spread")

  if (wealth_index == TRUE) {
    portf <- list(returns         = R,
                  weights         = weights,
                  direct          = return_direct,
                  rp              = return_portf,
                  rp_spread       = return_portf_spread,
                  price           = price_portf,
                  price_spread    = price_portf_spread,
                  rp_stats        = rp_stats,
                  rp_spread_stats = rp_spread_stats) %>%
      `names<-`(c("returns", "weights", "direct",
                  "rp", "rp_spread", "price", "price_spread",
                  "rp_stats", "rp_spread_stats"))

  } else {
    portf <- list(returns         = R,
                  weights         = weights,
                  direct          = return_direct,
                  rp              = return_portf,
                  rp_spread       = return_portf_spread,
                  rp_stats        = rp_stats,
                  rp_spread_stats = rp_spread_stats) %>%
      `names<-`(c("returns", "weights", "direct",
                  "rp", "rp_spread",
                  "rp_stats", "rp_spread_stats"))
  }

  portf

}