# Load packages
# Core
library(tidyverse)
library(tidyquant)
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
symbols <- c("MCD", "WEN", "YUM", "DPZ", "SBUX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2021-12-31")
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"))
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "DPZ" "MCD" "SBUX" "WEN" "YUM"
# weights
weights <- c(0.2, 0.2, 0.2, 0.2, 0.2)
weights
## [1] 0.2 0.2 0.2 0.2 0.2
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 DPZ 0.2
## 2 MCD 0.2
## 3 SBUX 0.2
## 4 WEN 0.2
## 5 YUM 0.2
# ?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: 108 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0524
## 2 2013-02-28 0.0273
## 3 2013-03-28 0.0496
## 4 2013-04-30 0.0226
## 5 2013-05-31 0.0218
## 6 2013-06-28 0.00976
## 7 2013-07-31 0.0804
## 8 2013-08-30 -0.00594
## 9 2013-09-30 0.0690
## 10 2013-10-31 0.00341
## # … with 98 more rows
# Define risk free rate
rfr <- 0.0003
portfolio_Sharpe_tbl <- portfolio_returns_tbl %>%
tq_performance(Ra = returns, performance_fun = SharpeRatio,
Rf = rfr,
FUN = "StdDev")
portfolio_Sharpe_tbl
## # A tibble: 1 × 1
## `StdDevSharpe(Rf=0%,p=95%)`
## <dbl>
## 1 0.367
# Create a custom function to calculate rolling SR
Calculate_rolling_SharpeRatio <- function(data)
{rolling_SR <-SharpeRatio(R = data,
Rf = rfr,
FUN = "StdDev")
return(rolling_SR)}
# Define Window
window <- 24
# Transform data: calculate rolling sharpe ratio
rolling_sr_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
FUN = Calculate_rolling_SharpeRatio,
col_rename = "rolling_sr") %>%
select(-returns) %>%
na.omit()
rolling_sr_tbl
## # A tibble: 85 × 2
## date rolling_sr
## <date> <dbl>
## 1 2014-12-31 0.537
## 2 2015-01-30 0.536
## 3 2015-02-27 0.562
## 4 2015-03-31 0.490
## 5 2015-04-30 0.493
## 6 2015-05-29 0.513
## 7 2015-06-30 0.519
## 8 2015-07-31 0.459
## 9 2015-08-31 0.326
## 10 2015-09-30 0.275
## # … with 75 more rows
rolling_sr_tbl %>%
ggplot(aes(x = date,
y = rolling_sr)) +
geom_line(color = "violet") +
# Labeling
labs(x = NULL, y = "Rolling Sharpe Ratio")
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?
My portfolio performed relatively stable over time. Sharpe ratio stayed within a range of low of ~0.3, to a high of ~0.55 between 2016 to the beginning of 2020. This is not a lot of fluctuation. In 2020, the ratio plummeted to under 0.05, likely as a result of the economic impacts of Covid-19. It seems to be slowly recovering since this period, hovering at ~0.2.
As for the Code along assignment, I am not exactly sure what would have caused a sharp decline in the Sharpe ratio in November 2016. The only thing that comes to mind is that Donald Trump was elected. I am not sure what effects that had on the economy at that time.