Apply it to your data 9
How has your portfolio preformed over time?
Conor Wiliams
2026-10-30
# 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("CAT", "DE", "LMT", "UNP", "NEE")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = Sys.Date())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] "CAT" "DE" "LMT" "NEE" "UNP"# weights
weights <- c(0.25, 0.25, 0.20, 0.20, 0.10)
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 CAT 0.25
## 2 DE 0.25
## 3 LMT 0.2
## 4 NEE 0.2
## 5 UNP 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: 166 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0450
## 2 2013-02-28 -0.0216
## 3 2013-03-28 0.0189
## 4 2013-04-30 0.0243
## 5 2013-05-31 0.00274
## 6 2013-06-28 -0.00608
## 7 2013-07-31 0.0439
## 8 2013-08-30 -0.00981
## 9 2013-09-30 0.00616
## 10 2013-10-31 0.0204
## # ℹ 156 more rows5 Compute Sharpe Ratio
# 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.2646 Plot: Rolling Sharpe Ratio
# 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.566
## 2 2015-01-30 0.403
## 3 2015-02-27 0.494
## 4 2015-03-31 0.418
## 5 2015-04-30 0.392
## 6 2015-05-29 0.399
## 7 2015-06-30 0.396
## 8 2015-07-31 0.363
## 9 2015-08-31 0.230
## 10 2015-09-30 0.139
## # ℹ 133 more rowsrolling_sr_tbl %>%
ggplot(aes(x = date, y = rolling_sr)) +
geom_line(color = "cornflowerblue") +
# Labeling
labs(x = NULL, y = "Rolling Sharpe Ratio") +
annotate(geom = "text",
x = as.Date("2020-06-01"), y = 1.10,
label = "Strongest risk-adjusted performance\naround 2018",
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?
My portfolio consists of CAT, DE, LMT, UNP, and NEE. Looking at the
24-month rolling Sharpe Ratio, I can see that my portfolio’s
risk-adjusted performance has changed significantly over time. The
overall Sharpe Ratio was 0.264, but the graph shows that performance was
not consistent throughout the period. The strongest performance occurred
around early 2018, when the Sharpe Ratio reached approximately 1.20,
while the weakest periods occurred around early 2016, early 2020, and
2023, when it dropped close to zero.
One of the clearest possible structural breaks occurred around late 2016 into 2017, when the Sharpe Ratio began increasing rapidly from nearly zero to over 1.0. I think this improvement may have been related to the 2016 presidential election and expectations of lower corporate taxes, infrastructure spending, and stronger economic growth. Companies like Caterpillar and Deere could have benefited from these expectations because they are heavily involved in construction, agriculture, and industrial equipment. However, after reaching its peak in early 2018, the Sharpe Ratio began declining. This could have been influenced by rising interest rates and trade tensions between the United States and China, which created uncertainty for industrial companies.
Another noticeable change occurred around early 2020, when the Sharpe Ratio reached nearly zero before recovering throughout 2020 and 2021. The COVID-19 pandemic likely contributed to market volatility and uncertainty during this period. The portfolio then improved as the economy reopened, reaching another high of approximately 0.60 around 2022. However, this recovery did not last, and the Sharpe Ratio declined again throughout 2022 and into 2023. I think high inflation and the Federal Reserve’s aggressive interest-rate increases were possible reasons for this decline, since higher borrowing costs and economic uncertainty can negatively affect businesses and stock prices.
From 2024 through 2026, the portfolio began recovering again, with the Sharpe Ratio generally fluctuating between approximately 0.10 and 0.45. However, it never returned to the strong levels seen in early 2018. Overall, my graph shows that even though my portfolio contains companies from several industries, its risk-adjusted performance is still affected by changing economic conditions. The biggest takeaway for me is that a portfolio can experience periods of positive returns without necessarily delivering strong risk-adjusted performance. The rolling Sharpe Ratio helps show whether the returns are worth the volatility investors are taking on. Since this calculation uses a 24-month rolling window, the changes in the graph may reflect economic events over several months rather than reacting immediately to a single event.