# 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("TSLA", "NVDA", "GOOGL", "ORCL", "JNJ")
prices <- tq_get(x = symbols,
from = "2012-12-31",
to = "2017-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] "GOOGL" "JNJ" "NVDA" "ORCL" "TSLA"
# weights
weight <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weight
## [1] 0.25 0.25 0.20 0.20 0.10
w_tbl <- tibble(symbols, weight)
w_tbl
## # A tibble: 5 × 2
## symbols weight
## <chr> <dbl>
## 1 GOOGL 0.25
## 2 JNJ 0.25
## 3 NVDA 0.2
## 4 ORCL 0.2
## 5 TSLA 0.1
# ?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: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0527
## 2 2013-02-28 0.0169
## 3 2013-03-28 0.0146
## 4 2013-04-30 0.0728
## 5 2013-05-31 0.0888
## 6 2013-06-28 -0.00817
## 7 2013-07-31 0.0626
## 8 2013-08-30 -0.00442
## 9 2013-09-30 0.0415
## 10 2013-10-31 0.0361
## # ℹ 50 more rows
# ?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: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0527
## 2 2013-02-28 0.0169
## 3 2013-03-28 0.0146
## 4 2013-04-30 0.0728
## 5 2013-05-31 0.0888
## 6 2013-06-28 -0.00817
## 7 2013-07-31 0.0626
## 8 2013-08-30 -0.00442
## 9 2013-09-30 0.0415
## 10 2013-10-31 0.0361
## # ℹ 50 more rows
# Define risk free rate
rfr <- 0.0003
portfolio_SharpeRation_tbl <- portfolio_returns_tbl %>%
tq_performance(Ra = returns, performance_fun = SharpeRatio,
Rf = rfr,
FUN = "StdDev")
portfolio_SharpeRation_tbl
## # A tibble: 1 × 1
## `StdDevSharpe(Rf=0%,p=95%)`
## <dbl>
## 1 0.609
# Create a custom function to calculate rolling SR
Calculate_rolling_SharpeRatio <- function(data) {
rolling_SR <- SharpeRatio(R = data,
Rf = rfr,
FUN = "StdDev")
return(as.numeric(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,
by.column = FALSE,
align = "right",
col_rename = "rolling_sr") %>%
select(-returns) %>%
na.omit()
# Inspect results
rolling_sr_tbl
## # A tibble: 37 × 2
## date rolling_sr
## <date> <dbl>
## 1 2014-12-31 0.668
## 2 2015-01-30 0.535
## 3 2015-02-27 0.569
## 4 2015-03-31 0.501
## 5 2015-04-30 0.472
## 6 2015-05-29 0.423
## 7 2015-06-30 0.374
## 8 2015-07-31 0.368
## 9 2015-08-31 0.353
## 10 2015-09-30 0.317
## # ℹ 27 more rows
# Plot rolling Sharpe ratio
rolling_sr_tbl %>%
ggplot(aes(x = date, y = rolling_sr)) +
geom_line(color = "cornflowerblue") +
labs(x = NULL, y = "Rolling Sharpe Ratio") +
annotate(geom = "text",
x = as.Date("2016-06-01"), y = 0.5,
label = "This portfolio has done quite well since 2016",
color = "red", size = 4)
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?
From 2015-2016, there was a massive structural break and downward
trends, but recovered and reached a high in mid 2017, before dropping a
decent amount in 2018 again, but not to the extreme of the 2016 drop.
The trend seems similar in 2016, as global economics slowed down, and
then after the 2016 presidental ele ction, consumer confidence was
growing with president Trump, making the ratios higher and more
appealing.