# Load packages
# Core
library(tidyverse)
library(tidyquant)
library(plotly)
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("FNV", "WPM", "NEM", "CCJ", "BWXT", "NVDA", "TSM", "ASML", "CAT", "ITW", "HON", "PLD", "EQIX", "PSA", "TPL", "XOM", "CVX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-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"))
asset_returns_tbl
## # A tibble: 2,822 × 3
## asset date returns
## <chr> <date> <dbl>
## 1 ASML 2013-01-31 0.154
## 2 ASML 2013-02-28 -0.0563
## 3 ASML 2013-03-28 -0.0430
## 4 ASML 2013-04-30 0.0992
## 5 ASML 2013-05-31 0.0887
## 6 ASML 2013-06-28 -0.0269
## 7 ASML 2013-07-31 0.128
## 8 ASML 2013-08-30 -0.0327
## 9 ASML 2013-09-30 0.126
## 10 ASML 2013-10-31 -0.0420
## # ℹ 2,812 more rows
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "ASML" "BWXT" "CAT" "CCJ" "CVX" "EQIX" "FNV" "HON" "ITW" "NEM"
## [11] "NVDA" "PLD" "PSA" "TPL" "TSM" "WPM" "XOM"
weights <- c(0.10, 0.10, 0.10, 0.05, 0.05, 0.04, 0.03, 0.03, 0.04, 0.03, 0.03, 0.07, 0.07, 0.06, 0.07, 0.07, 0.06)
weights
## [1] 0.10 0.10 0.10 0.05 0.05 0.04 0.03 0.03 0.04 0.03 0.03 0.07 0.07 0.06 0.07
## [16] 0.07 0.06
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 17 × 2
## symbols weights
## <chr> <dbl>
## 1 ASML 0.1
## 2 BWXT 0.1
## 3 CAT 0.1
## 4 CCJ 0.05
## 5 CVX 0.05
## 6 EQIX 0.04
## 7 FNV 0.03
## 8 HON 0.03
## 9 ITW 0.04
## 10 NEM 0.03
## 11 NVDA 0.03
## 12 PLD 0.07
## 13 PSA 0.07
## 14 TPL 0.06
## 15 TSM 0.07
## 16 WPM 0.07
## 17 XOM 0.06
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: 166 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0457
## 2 2013-02-28 -0.0170
## 3 2013-03-28 0.0106
## 4 2013-04-30 -0.00468
## 5 2013-05-31 0.0276
## 6 2013-06-28 -0.0378
## 7 2013-07-31 0.0389
## 8 2013-08-30 -0.00842
## 9 2013-09-30 0.0294
## 10 2013-10-31 0.00176
## # ℹ 156 more rows
# Define Risk Free Rate
rfr <- 0.0003
portfolio_SharpeRatio_tbl <- portfolio_returns_tbl %>%
tq_performance(Ra = returns,
performance_fun = SharpeRatio,
Rf = rfr,
FUN = "StdDev")
portfolio_SharpeRatio_tbl
## # A tibble: 1 × 1
## `SharpeRatio(Rf=0%,p=95%)`
## <dbl>
## 1 0.278
# 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: 143 × 2
## date rolling_sr
## <date> <dbl>
## 1 2014-12-31 0.241
## 2 2015-01-30 0.158
## 3 2015-02-27 0.241
## 4 2015-03-31 0.179
## 5 2015-04-30 0.237
## 6 2015-05-29 0.196
## 7 2015-06-30 0.183
## 8 2015-07-31 0.0728
## 9 2015-08-31 0.0415
## 10 2015-09-30 -0.00930
## # ℹ 133 more rows
# Plot
rolling_sr_tbl %>%
ggplot(aes(x = date, y = rolling_sr)) +
geom_line(color = "blue") +
scale_x_date(date_breaks = "1 year",
date_labels = "%Y") +
# Labeling
labs(x = NULL, y = "Rolling Sharpe Ratio")
While there has been a few dips over the years, overall, my portfolio has performed well and is moving in an upward trend as time continues. There looks to be four structural breaks that affected my portfolio, and for each of them, I looked online into what might have been the major (root) cause of the breaks. The first was in September/October of 2015, and I think this was due to China’s economic slowdown and the decline in commodity prices at that time. The second break began June/July 0f 2017 when the ratio skyrocketed before peaking at the start of 2018, and my belief for this was the strong signals of economic growth and corporate earnings paired with major rises in both technology and construction companies. However, the ratio falls sharply throughout the year until the start of 2019 which I believe was due to dropping economic sentiment and the rising of federal interest rates at the time, as well as trade tensions throughout the global market. The third structural break looks to have occurred around March of 2020, which was when COVID was trekking across the world and made it’s way to the U.S. COVID disrupted the flow of the world (including the stock market) when it arrived, and so I see it as the root cause for that break. Finally, the fourth break looks to hit in 2023. This is when the investment and growth for the A.I. boom really began, and at the start, there was mixed sentiment among investors on the rapid increase in technology. Among other factors such as interest rates and economic uncertainty, I believe these factors explain the break in the Sharpe Ratio at that time. Speaking mathematically, the three breaks that dropped where due to rise in market volatility according to my research (more in-depth research into the companies would be required to gauge growth in returns) while the drastic increase in 2017-2018 was (due to the market boom) a large increase in returns with little market volatility stunting the growth until later 2018. That is how my portfolio performed over time under the Sharpe Ratio.