Portfolio Returns Full Example

## This full example illustrates how PerformanceAnalytics::Return.cumulative could unintentionally lead to non-sensical results.
The function is sensitive to ordering and is not anchored at the start-date explicitly.
The below shows a full example of this - illustrating why the rmsfuns::Safe_Return.portfolio should instead be used.


# Example created with datapasta
library(tidyverse)
library(lubridate)
library(tbl2xts)
df <- 
  bind_cols(
    date  = as.Date(c("2018-01-01", "2018-01-02", "2018-01-03", "2018-01-04", "2018-01-05", "2018-01-06", "2018-01-07", "2018-01-08", "2018-01-09", "2018-01-10", "2018-01-11", "2018-01-12", "2018-01-13", "2018-01-14", "2018-01-15", "2018-01-16", "2018-01-17", "2018-01-18", "2018-01-19", "2018-01-20")),
    tibble::tribble(
      ~A_Shares, ~X_Shares, ~C_Shares, ~A_Price, ~X_Price, ~C_Price,
      15L,       21L,       16L,     200L,     100L,      78L,
      15L,       21L,       16L,     202L,     102L,      77L,
      15L,       21L,       16L,     205L,     103L,      74L,
      15L,       21L,       16L,     201L,     106L,      73L,
      15L,       21L,       16L,     203L,     107L,      71L,
      15L,       21L,       16L,     198L,     108L,      70L,
      15L,       21L,       16L,     199L,     105L,      68L,
      15L,       21L,       16L,     205L,     106L,      69L,
      15L,       21L,       16L,     209L,     110L,      71L,
      15L,       21L,       16L,     208L,     115L,      68L,
      15L,       21L,       16L,     206L,     112L,      65L,
      15L,       21L,       16L,     205L,     116L,      64L,
      15L,       21L,       16L,     202L,     110L,      66L,
      15L,       21L,       16L,     204L,     108L,      61L,
      15L,       21L,       16L,     206L,     105L,      60L,
      15L,       21L,       16L,     209L,     106L,      58L,
      15L,       21L,       16L,     212L,     110L,      57L,
      15L,       21L,       16L,     215L,     112L,      56L,
      15L,       21L,       16L,     214L,     113L,      54L,
      15L,       21L,       16L,     219L,     115L,      52L
    )
    
  )%>% mutate_if(is.integer, as.numeric) 

df_Adj <- 
  left_join(
    df %>% gather(Company, Shares, ends_with("_Shares"))  %>% select(date, Company, Shares) %>% mutate(Company = gsub("_Shares", "", Company)),
    df %>% gather(Company, Price, ends_with("_Price"))  %>% select(date, Company, Price) %>% mutate(Company = gsub("_Price", "", Company)),
    by = c("date", "Company")
  )

By_Hand <- 
  df_Adj %>% 
  group_by(date, Company) %>% 
  mutate(StockHold = Shares*Price) %>% 
  group_by(date) %>% 
  mutate(Port = sum(Shares*Price, na.rm=T)) %>% 
  mutate(weight = StockHold / Port) %>% ungroup()

weights <- 
  By_Hand %>% filter(date == first(date)) %>% 
  select(date, Company, weight) %>% 
  tbl_xts(cols_to_xts = "weight", spread_by = "Company")

weights_reordered <- 
  By_Hand %>% filter(date == first(date)) %>% 
  select(date, Company, weight) %>% 
  tbl_xts(cols_to_xts = "weight", spread_by = "Company") %>% 
  # Let's reorder the names:
  .[,c(1,3,2)]

R <- 
  df_Adj %>% group_by(Company) %>% mutate(Ret = Price / lag(Price) - 1) %>% tbl_xts(cols_to_xts = "Ret", spread_by = "Company")

# Safe return portfolio calc:
df_R_Correct <- 
  rmsfuns::Safe_Return.portfolio(R = R, weights = weights, geometric = TRUE, lag_weights = TRUE, verbose = TRUE)

# The PA version is sensitive to the order of the columns...
df_R_Wrong <- 
  PerformanceAnalytics::Return.portfolio(R = R, weights = weights_reordered, geometric = TRUE, verbose = TRUE)


# Weights comparison:

bind_rows(
tail(By_Hand %>% select(date, Company, weight) %>% spread(Company, weight) %>% mutate_at(vars(-date), funs(round(., 10))), 1) %>% mutate(Which = "By_Hand"),
df_R_Correct$EOP.Weight %>% tail(1) %>% xts_tbl %>% mutate(Which = "Safe_PA"),
tail(df_R_Wrong$EOP.Weight %>% xts_tbl %>% mutate_at(vars(-date), funs(round(., 10))), 1) %>% mutate(Which = "Not_safe_PA")
)


# Cumulative Return Comparison:

c(
  "ByHand" = 
    df_R_Correct$returns %>% xts_tbl %>% 
    # mutate(Cum = cumprod(1+portfolio.returns)) %>% 
    mutate(Cum = cumprod(1+portfolio.returns) - 1) %>% 
    select(Cum) %>% 
    tail(1),
  "Safe_PA" = PerformanceAnalytics::Return.cumulative(df_R_Correct$returns, geometric = T),
  "Not_Safe_PA" = PerformanceAnalytics::Return.cumulative(df_R_Wrong$returns, geometric = T)
)

#' @title Safe_Return.portfolio
#' @description This provides a safe way to do portfolio return calculations.
#' It ensures the returns and weights are explicitly mapped.
#' It is thus a simple wrapper to PerformanceAnalytics::Return.portfolio
#' @importFrom PerformanceAnalytics Return.portfolio
#' @examples
#' Safe_Return.portfolio(R, weights)
#' @export
#'
Safe_Return.portfolio <- function( R, weights, lag_weights = TRUE, ... ) {

  # See: https://gist.github.com/Nicktz/410eefe3995ae131a16a3a2e8899dc0e
  # See Comparison with Hand calc: https://gist.github.com/Nicktz/a24ba1775d41aab85919c505ca1b9a0c
  if(ncol(R) > ncol(weights)) stop("\n\nStocks in return dataframe R has more columns than stocks for weights input...\n\n")
 if(ncol(R) < ncol(weights)) stop("\n\nStocks in weights input has more columns than for returns input R...\n\n")
 if( !"xts" %in% class(R) ) stop("\n\nStock returns must be in xts format...\n\n")
 if( !"xts" %in% class(weights) ) stop("\n\nStock weights must be in xts format...\n\n")

 R <- R[,colnames(weights)] # Squares weight names with return names...
 if(!all.equal(names(R), names(weights))) stop("\n\nStock names not exactly the same for R and weights...\n\n Note that it requires EXACT similarity.\n\n")

 if(lag_weights){
 weights <- weights %>% xts_tbl %>% mutate(date = date - 1) %>% tbl_xts
 }

 Port <- PerformanceAnalytics::Return.portfolio(R = R, weights = weights, ...)
 
Port

 }