Apply it to your data 9
How has your portfolio preformed over time?
Andrew Byrne
2025-12-1
# Load packages
# Core
library(tidyverse)
library(tidyquant)Goal
Visualize and examine changes in the underlying trend in the performance of your portfolio in terms of Sharpe Ratio.
Choose your stocks.
from 2012-12-31 to present
1 Import stock prices
symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2024-12-31")2 Convert prices to returns (monthly)
asset_returns_tbl <- prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
type = "log") %>%
slice(-1) %>%
ungroup() %>%
set_names(c("asset", "date", "returns"))3 Assign a weight to each asset (change the weigting scheme)
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols## [1] "AGG" "EEM" "EFA" "IJS" "SPY"# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights## [1] 0.25 0.25 0.20 0.20 0.10w_tbl <- tibble(symbols, weights)
w_tbl## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AGG 0.25
## 2 EEM 0.25
## 3 EFA 0.2
## 4 IJS 0.2
## 5 SPY 0.14 Build a portfolio
# ?tq_portfolio
portfolio_returns_tbl <- asset_returns_tbl %>%
tq_portfolio(assets_col = asset,
returns_col = returns,
weights = w_tbl,
rebalance_on = "months",
col_rename = "returns")
portfolio_returns_tbl## # A tibble: 144 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0204
## 2 2013-02-28 -0.00239
## 3 2013-03-28 0.0121
## 4 2013-04-30 0.0174
## 5 2013-05-31 -0.0128
## 6 2013-06-28 -0.0247
## 7 2013-07-31 0.0321
## 8 2013-08-30 -0.0224
## 9 2013-09-30 0.0511
## 10 2013-10-31 0.0301
## # ℹ 134 more rows5 Compute Sharpe Ratio
# Risk free rate
rfr <- 0.0003
portfolio_sharpe_tbl <- portfolio_returns_tbl %>%
tq_performance(Ra = returns,
Rf = rfr,
performance_fun = SharpeRatio,
FUN = "StdDev")
portfolio_sharpe_tbl## # A tibble: 1 × 1
## `StdDevSharpe(Rf=0%,p=95%)`
## <dbl>
## 1 0.1166 Plot: Rolling Sharpe Ratio
Returns Histogram with Risk-Free Rate
# Figure 7.2 Returns Histogram with Risk-Free Rate ggplot ----
portfolio_returns_tbl %>%
ggplot(aes(returns)) +
geom_histogram(binwidth = 0.01, fill = "cornflowerblue", alpha = 0.5) +
geom_vline(xintercept = rfr, color = "green", size = 1) +
annotate(geom= "text",
x = rfr + 0.002, y = 13,
label = "risk free rate", angle = 90, size = 5) +
labs(y = "count")
Scatter Returns around Risk Free Rate
# Figure 7.1 Scatter Returns around Risk Free Rate ----
portfolio_returns_tbl %>%
# Transform data
mutate(returns_excess = if_else(returns > rfr, "above_rfr", "below_rfr")) %>%
ggplot(aes(date, returns, color = returns_excess)) +
geom_point(show.legend = FALSE) +
# risk free rate
geom_hline(yintercept = rfr, linetype = "dotted", size = 1, color = "cornflowerblue") +
# election date
geom_vline(xintercept = as.Date("2016-11-30"), size = 1, color = "cornflowerblue") +
# formatting
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
# labeling
annotate(geom = "text",
x = as.Date("2017-01-01"), y = -0.04,
label = "Election", angle = 90, size = 5) +
annotate(geom = "text",
x = as.Date("2017-06-01"), y = -0.01,
label = str_glue("No returns below the RFR
after the 2016 election"),
color = "red", size = 4) +
labs(y = "percent monthly returns",
x = NULL)
# Custom function
# necessary because we would not be able to specify FUN = "StdDev" otherwise
calculate_rolling_sharpeRatio <- function(df) {
SharpeRatio(df,
Rf = rfr,
FUN = "StdDev")
}
# dump(list = "calculate_rolling_sharpeRatio",
# file = "00_scripts/calculate_rolling_sharpeRatio.R")
# Set the length of periods for rolling calculation
window <- 24
# Calculate rolling sharpe ratios
rolling_sharpe_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
align = "right",
FUN = calculate_rolling_sharpeRatio,
col_rename = "sharpeRatio") %>%
na.omit()
rolling_sharpe_tbl## # A tibble: 121 × 3
## date returns sharpeRatio
## <date> <dbl> <dbl>
## 1 2014-12-31 -0.0131 0.230
## 2 2015-01-30 -0.00933 0.178
## 3 2015-02-27 0.0377 0.240
## 4 2015-03-31 -0.00527 0.210
## 5 2015-04-30 0.0202 0.214
## 6 2015-05-29 -0.00840 0.222
## 7 2015-06-30 -0.0177 0.238
## 8 2015-07-31 -0.0134 0.162
## 9 2015-08-31 -0.0551 0.0950
## 10 2015-09-30 -0.0253 -0.0279
## # ℹ 111 more rows# Figure 7.5 Rolling Sharpe ggplot ----
rolling_sharpe_tbl %>%
ggplot(aes(date, sharpeRatio)) +
geom_line(color = "cornflowerblue") +
labs(title = paste0("Rolling ", window, "-Month Sharpe Ratio"),
y = "rolling Sharpe Ratio",
x = NULL) +
theme(plot.title = element_text(hjust = 0.5)) +
annotate(geom = "text",
x = as.Date("2016-06-01"), y = 0.5,
label = "This portfolio has done quite well since 2016.",
size = 5, color = "red")
How has your portfolio performed over time? Provide dates of the
structural breaks, if any. The Code Along Assignment 9 had one
structural break in November 2016. What do you think the reason
is?
Based off the rolling sharpe ratio, the portfolio’s returns improve over
time.The rolling Sharpe Ratio shows several structural breaks in
performance over time. The first major break occurs around November
2016, when the ratio rises sharply following the U.S. presidential
election, marking a shift to stronger risk-adjusted returns. A second
break appears during the 2018 market downturn, where the Sharpe Ratio
drops noticeably as volatility spiked and equity returns weakened.
Performance strengthens again with a clear upswing beginning in 2020,
driven by the post-pandemic market recovery and strong equity momentum.
This is followed by another structural decline in 2022, coinciding with
high inflation, aggressive rate hikes, and broad market drawdowns that
reduced the portfolio’s risk-adjusted performance. Finally, the
portfolio experiences a renewed improvement in 2023 as markets
stabilized and began recovering.