Apply it to your data 9
How has your portfolio preformed over time?
Takeru Ito
2025-10-29
# 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("AAPL", "WMT", "TGT", "GOOG", "NFLX")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")2 Convert prices to returns
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
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols## [1] "AAPL" "GOOG" "NFLX" "TGT" "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.10w_tbl <- tibble(symbols, weights)
w_tbl## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AAPL 0.25
## 2 GOOG 0.25
## 3 NFLX 0.2
## 4 TGT 0.2
## 5 WMT 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.100
## 2 2013-02-28 0.0447
## 3 2013-03-28 0.0227
## 4 2013-04-30 0.0458
## 5 2013-05-31 0.0233
## 6 2013-06-28 -0.0451
## 7 2013-07-31 0.0758
## 8 2013-08-30 0.00990
## 9 2013-09-30 0.0235
## 10 2013-10-31 0.0783
## # ℹ 50 more rows5 Calculate Sharpe Ratio
# Risk free rate
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.4466 Plot
Returns Histogram with Risk-Free Rate
# Figure 7.2 Returns Histogram with Risk-Free Rate ggplot ----
portfolio_returns_tbl %>%
ggplot(aes(returns)) +
geom_histogram(binwidth = 0.01, fill = "cornflowerblue", alpha = 0.5) +
geom_vline(xintercept = rfr, color = "green", size = 1) +
annotate(geom= "text",
x = rfr + 0.002, y = 13,
label = "risk free rate", angle = 90, size = 5) +
labs(y = "count")
Scatter Returns around Risk Free Rate
# Figure 7.1 Scatter Returns around Risk Free Rate ----
portfolio_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)
Rolling Sharpe
# Custom function
# necessary because we would not be able to specify FUN = "StdDev" otherwise
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.0250 0.552
## 2 2015-01-30 0.0630 0.546
## 3 2015-02-27 0.0581 0.554
## 4 2015-03-31 -0.0271 0.486
## 5 2015-04-30 0.0418 0.483
## 6 2015-05-29 0.0298 0.489
## 7 2015-06-30 -0.00359 0.560
## 8 2015-07-31 0.0791 0.560
## 9 2015-08-31 -0.0377 0.486
## 10 2015-09-30 -0.0285 0.421
## # ℹ 27 more rows# Figure 7.5 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 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?
The portfolio showed steady but up and down performance from 2013 to
mid-2016, with returns often moving up and down around the risk-free
rate. Around November 2016, there was a clear change in trend, as both
the portfolio’s returns and Sharpe ratio increased and stayed higher
afterward. This shift likely resulted from the U.S. presidential
election in November 2016, which boosted investor confidence due to
expectations of lower corporate taxes, less regulation, and stronger
business growth. These changes especially benefited large technology and
retail companies like Apple, Google, and Netflix, leading to better
overall performance for the portfolio.