R/calc_return_portfolio.R

In rengelke/tradr:

#' 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 wealth_index logical, weather to return a wealth index
#' @param ... parameters to pass to PerformanceAnalytics::Return.portfolio
#'
#' @return list containing portfolio returns; direct: direct calculation,
#' rp: Return.Portfolio, rp_spread: Return.Portfolio including transaction costs
#'
#' @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,
                                   wealth_index = FALSE,
                                   ...) {

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

  R %<>% na.fill(fill = 0)
  weights %<>% na.fill(fill = 0)

  # calculate turnover
  txns <- weights - lag(weights)
  turnover <- txns %>% abs %>%
    rowSums() %>% magrittr::divide_by(., 2) %>%
    xts(order.by = index(txns)) %>%
    na.fill(fill = 0)
  turnover_pa <- turnover %>%
    cumsum() %>% last %>% magrittr::divide_by(., 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(tradr:::world_price),
                  weights,
                  join = "right",
                  fill = 0) %>% .[, 1]

  if (!isTRUE(all.equal(rowSums(weights), rep(1, NROW(weights))))) {
    warning("Weights for one or more periods do not sum up to 1")
  }

  # direct return portfolio calculation
  weights_lagged <- weights %>%
      lag(weights, k = 1, na.pad = FALSE)
  return_direct <- as.xts(rowSums(zoo(R)*zoo(weights_lagged)),
                          dateFormat="Date")

  # Return.portfolio
  return_portf <-
    PerformanceAnalytics::Return.portfolio(R,
                                           weights,
                                           verbose = FALSE,
                                           ...) %>%
    `colnames<-`(c("return_portf"))

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


  R_spread <- tradr::add_spread(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,
                                           verbose = FALSE,
                                           ...) %>%
    `colnames<-`(c("return_portf_spread"))

  if (wealth_index == TRUE) {
    price_portf_spread <-
      PerformanceAnalytics::Return.portfolio(R_spread,
                                             weights,
                                             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

}