Apply it to your data 9
How has your portfolio preformed over time?
Cameron Whitty
# Load packages
# Core
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## âś” dplyr 1.1.4 âś” readr 2.1.5
## âś” forcats 1.0.0 âś” stringr 1.5.2
## âś” ggplot2 3.5.2 âś” tibble 3.3.0
## âś” lubridate 1.9.4 âś” tidyr 1.3.1
## âś” purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## âś– dplyr::filter() masks stats::filter()
## âś– dplyr::lag() masks stats::lag()
## â„ą Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(tidyquant)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## âś” PerformanceAnalytics 2.0.8 âś” TTR 0.24.4
## ✔ quantmod 0.4.28 ✔ xts 0.14.1── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## âś– zoo::as.Date() masks base::as.Date()
## âś– zoo::as.Date.numeric() masks base::as.Date.numeric()
## âś– dplyr::filter() masks stats::filter()
## âś– xts::first() masks dplyr::first()
## âś– dplyr::lag() masks stats::lag()
## âś– xts::last() masks dplyr::last()
## âś– PerformanceAnalytics::legend() masks graphics::legend()
## âś– quantmod::summary() masks base::summary()
## â„ą Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggrepel)Goal
Visualize and examine changes in the underlying trend in the performance of your portfolio in terms of Sharpe Ratio.
Choose your stocks.
I chose the stocks JPM, BAC, C, WFC and GS. They are all in the banking industry.
from 2012-12-31 to present
1 Import stock prices
symbols <- c("JPM", "BAC", "C", "WFC", "GS")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2025-11-09")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
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols## [1] "BAC" "C" "GS" "JPM" "WFC"# 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 BAC 0.25
## 2 C 0.25
## 3 GS 0.2
## 4 JPM 0.2
## 5 WFC 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")## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.portfolio_returns_tbl## # A tibble: 155 Ă— 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0567
## 2 2013-02-28 0.00884
## 3 2013-03-28 0.0292
## 4 2013-04-30 0.0248
## 5 2013-05-31 0.103
## 6 2013-06-28 -0.0538
## 7 2013-07-31 0.0863
## 8 2013-08-30 -0.0663
## 9 2013-09-30 0.00833
## 10 2013-10-31 0.0120
## # â„ą 145 more rows5 Calculate 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.1506 Plot: Rolling Sharpe Ratio
# 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")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## â„ą Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
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)
Rolling Sharpe
# 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: 132 Ă— 3
## date returns sharpeRatio
## <date> <dbl> <dbl>
## 1 2014-12-31 0.0277 0.409
## 2 2015-01-30 -0.133 0.178
## 3 2015-02-27 0.0880 0.232
## 4 2015-03-31 -0.0152 0.196
## 5 2015-04-30 0.0373 0.205
## 6 2015-05-29 0.0329 0.161
## 7 2015-06-30 0.0227 0.233
## 8 2015-07-31 0.0295 0.194
## 9 2015-08-31 -0.0817 0.175
## 10 2015-09-30 -0.0601 0.110
## # â„ą 122 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 2018.",
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?
The portfolio has performed very well over time, with the only significant disruption occurring in 2020, which makes sense given the impact of quarantine. I believe the structural break in November 2016 was related to Trump’s presidential victory. It took me a bit to connect the dots, but that explanation fits the timing.