Apply it to your data 9
How has your portfolio preformed over time?
Nate Curtin
2025-11-03
# Load packages
# Core
library(tidyverse)
library(tidyquant)Goal
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
1 Import stock prices
symbols <- c("TSLA", "NVDA", "AAPL", "MSFT", "AMZN")
prices <- tq_get(x = symbols,
from = "2012-12-31",
to = "2017-12-31")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 (change the weigting scheme)
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols## [1] "AAPL" "AMZN" "MSFT" "NVDA" "TSLA"# 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 AAPL 0.25
## 2 AMZN 0.25
## 3 MSFT 0.2
## 4 NVDA 0.2
## 5 TSLA 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")
portfolio_returns_tbl## # A tibble: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 -0.00905
## 2 2013-02-28 -0.00315
## 3 2013-03-28 0.0196
## 4 2013-04-30 0.0666
## 5 2013-05-31 0.103
## 6 2013-06-28 -0.0225
## 7 2013-07-31 0.0651
## 8 2013-08-30 0.0419
## 9 2013-09-30 0.0447
## 10 2013-10-31 0.0497
## # ℹ 50 more rows5 Compute Sharpe Ratio
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.5546 Plot: Rolling Sharpe Ratio
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: 37 × 3
## date returns sharpeRatio
## <date> <dbl> <dbl>
## 1 2014-12-31 -0.0647 0.536
## 2 2015-01-30 0.00277 0.551
## 3 2015-02-27 0.0877 0.617
## 4 2015-03-31 -0.0464 0.527
## 5 2015-04-30 0.0984 0.537
## 6 2015-05-29 0.0200 0.494
## 7 2015-06-30 -0.0310 0.483
## 8 2015-07-31 0.0533 0.476
## 9 2015-08-31 -0.0229 0.412
## 10 2015-09-30 0.0155 0.389
## # ℹ 27 more rowsportfolio_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)
alculate_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: 37 × 3
## date returns sharpeRatio
## <date> <dbl> <dbl>
## 1 2014-12-31 -0.0647 0.536
## 2 2015-01-30 0.00277 0.551
## 3 2015-02-27 0.0877 0.617
## 4 2015-03-31 -0.0464 0.527
## 5 2015-04-30 0.0984 0.537
## 6 2015-05-29 0.0200 0.494
## 7 2015-06-30 -0.0310 0.483
## 8 2015-07-31 0.0533 0.476
## 9 2015-08-31 -0.0229 0.412
## 10 2015-09-30 0.0155 0.389
## # ℹ 27 more rows# 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 the 1st quarter of 2016.",
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?
Overall my portfolio was fairly similar to the code in terms of performance in the rolling 24 month sharpe ratio. With the portfolio dropping to its lowest in the 1st quarter of 2016 and has climbed steadily till 2018.