Skip to content

Instantly share code, notes, and snippets.

@Nicktz Nicktz/Portfolio Returns Full Example Secret
Last active Mar 28, 2019

Embed
What would you like to do?
# 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)
)
@Nicktz

This comment has been minimized.

Copy link
Owner Author

Nicktz commented Oct 29, 2018

#' @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

}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.