# 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("NKE", "AAPL", "NFLX", "MSFT", "WMT")
prices <- tq_get(x = symbols,
from = "2012-12-31",
to = "2024-10-30")
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] "AAPL" "MSFT" "NFLX" "NKE" "WMT"
# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights
## [1] 0.25 0.25 0.20 0.20 0.10
w_tbl <- tibble(symbols,weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AAPL 0.25
## 2 MSFT 0.25
## 3 NFLX 0.2
## 4 NKE 0.2
## 5 WMT 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: 142 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0955
## 2 2013-02-28 0.0282
## 3 2013-03-28 0.0314
## 4 2013-04-30 0.0818
## 5 2013-05-31 0.0210
## 6 2013-06-28 -0.0420
## 7 2013-07-31 0.0442
## 8 2013-08-30 0.0581
## 9 2013-09-30 0.0411
## 10 2013-10-31 0.0590
## # ℹ 132 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
## `StdDevSharpe(Rf=0%,p=95%)`
## <dbl>
## 1 0.326
# 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: 119 × 2
## date rolling_sr
## <date> <dbl>
## 1 2014-12-31 0.704
## 2 2015-01-30 0.673
## 3 2015-02-27 0.699
## 4 2015-03-31 0.568
## 5 2015-04-30 0.569
## 6 2015-05-29 0.576
## 7 2015-06-30 0.639
## 8 2015-07-31 0.649
## 9 2015-08-31 0.512
## 10 2015-09-30 0.468
## # ℹ 109 more rows
rolling_sr_tbl %>%
ggplot(aes(x = date, y = rolling_sr)) +
geom_line(color = "cornflowerblue") +
# 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?
The portfolio over time has fluctuated in its performance. At the start of the graph you can see the portfolio is on a steady decline from 2012-2016, when finally in 2017 the portfolio started to see some rapid growth up until about 2019 when there was an extreme drop off in performance for the portfolio until about 2020 when slowly the portfolio began to rise again but then 2022 came around and the portfolio had its most rapid decline and lowest value for the rolling sharpe ratio. The portfolio stayed around this depth up until this year, 2024 when the portfolio experienced a rapid increase in its rolling sharpe ratio and got it almost back to where it started around 0.50 rolling sharpe ratio. The portfolio in the code along assignment 9 had one structural break in November 2016, which I’m not positive if it is the reason but would guess that it might have something to do with the election of Donald Trump as president which would have potentially impacted the stock market, as the market usually fluctuates during the time of an election.