Apply it to your data 9
How has your portfolio preformed over time?
Marlene S. Krohn
2026-11-01
# 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("TSM", "MU", "NOW", "MRVL", "PLTR")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2020-12-31",
to = "2026-11-01")
prices## # A tibble: 7,325 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 TSM 2020-12-31 110. 110. 108. 109. 4909500 99.5
## 2 TSM 2021-01-04 111. 114. 110. 112. 11262100 102.
## 3 TSM 2021-01-05 112. 115. 112. 113. 10583600 103.
## 4 TSM 2021-01-06 114. 116. 113. 116. 10609300 105.
## 5 TSM 2021-01-07 119. 123. 118. 121. 13556100 111.
## 6 TSM 2021-01-08 126. 126. 117. 119. 18976800 108.
## 7 TSM 2021-01-11 120. 124. 119. 123. 12006800 112.
## 8 TSM 2021-01-12 125. 125. 122. 123 14163200 112.
## 9 TSM 2021-01-13 124. 125. 118 119. 20650500 109.
## 10 TSM 2021-01-14 123. 135. 122. 126. 37125400 115.
## # ℹ 7,315 more rows2 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 <- asset_returns_tbl %>% distinct(asset) %>% pull
symbols## [1] "MRVL" "MU" "NOW" "PLTR" "TSM"weight <- c(0.15, 0.20, 0.30, 0.25, 0.10)
weight## [1] 0.15 0.20 0.30 0.25 0.10weight_tbl <- tibble(symbols, weight)
weight_tbl## # A tibble: 5 × 2
## symbols weight
## <chr> <dbl>
## 1 MRVL 0.15
## 2 MU 0.2
## 3 NOW 0.3
## 4 PLTR 0.25
## 5 TSM 0.14 Build a portfolio
library(PerformanceAnalytics)
portfolio_returns_tbl <- asset_returns_tbl %>%
tq_portfolio(assets_col = asset,
returns_col = returns,
weights = weight_tbl,
rebalance_on = "months",
col_rename = "returns")
portfolio_returns_tbl## # A tibble: 70 × 2
## date returns
## <date> <dbl>
## 1 2021-01-29 0.127
## 2 2021-02-26 -0.0768
## 3 2021-03-31 -0.0370
## 4 2021-04-30 -0.0170
## 5 2021-05-28 -0.0150
## 6 2021-06-30 0.112
## 7 2021-07-30 -0.0438
## 8 2021-08-31 0.0689
## 9 2021-09-30 -0.0484
## 10 2021-10-29 0.0685
## # ℹ 60 more rows5 Compute Sharpe Ratio
#Using the current Risk Free Rate
rfr <- 0.00049
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.1846 Plot: Rolling Sharpe Ratio
#Create a custom function to calcualte rolling SR
Calculate_rolling_SharpeRatio <- function(data) {
rolling_SR <- SharpeRatio(R = data,
Rf = rfr,
FUN = "StdDev")
return(rolling_SR)
}
#Define width
window <- 24
# Transforming 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: 47 × 2
## date rolling_sr
## <date> <dbl>
## 1 2022-12-30 -0.295
## 2 2023-01-31 -0.256
## 3 2023-02-28 -0.231
## 4 2023-03-31 -0.188
## 5 2023-04-28 -0.196
## 6 2023-05-31 -0.0397
## 7 2023-06-30 -0.0806
## 8 2023-07-31 -0.0193
## 9 2023-08-31 -0.0812
## 10 2023-09-29 -0.0716
## # ℹ 37 more rowsrolling_sr_tbl %>%
ggplot(aes(x = date,
y = rolling_sr)) +
geom_line(color = "violet") +
labs(x = NULL,
y = "Rolling Sharpe Ratio") +
annotate(geom = "text",
x = as.Date("2023-10-01"),
y = 0.5,
label = stringr::str_wrap(
"The portfolio had a fast increase from 2023, until the beginning of 2026, where it started to decline",
width = 35
),
color = "cornflowerblue",
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?
The portfolio has overall performed well over time, where it went on a strong run from 2023 into 2025, with a fast growing Sharpe ratio. The portfolio started in 2023, with a negative ratio, meaning that either the risk free return were greater than the portfolio return, or the portfolio had a negative yield. The increase of sharpe ratio, means one that the returns of the portfolio has been strongly increasing.
There is one negative structural break being gradual more developed / prominent, fall 2025. Since the break the Sharpe ratio of the portfolio gradually has been declining. One could also argue that the beginning of 2023, marks the beginning of a structural break, going from negative returns to moderately strong SR of 0,5.
A structural break in the Sharpe ratio, can be primarily driven by two factors: one, markable changes in portfolio return. Two, strong change in portfolio volatility, measured in standard deviation. The graphic bellow, shows the monthly return of the portfolio, where a big change in the pattern would help indicate what is causing the change. In this case, I belive the SR decline in 2025 is driven by a moderately pull down of the portfolio (more negative returns), which lowers the overall portfolio return, in addition to the increase in draw down will increase the standard deviation, acting as a denominator in the calculation of SR. We are seeing how small adjustment in (decrease) in the numerator, (increase) the the denominator can quickly impact the overall trend of a portfolio when it comes to Sharpe ratio.
Scatterplot of Returns around Risk Free Rate
portfolio_returns_tbl %>%
# Add a new variable
mutate(excess_returns = if_else(returns > rfr,
"rfr_above",
"rfr_below")) %>%
#Plot
ggplot(aes(x = date, y = returns)) +
geom_point(aes(color= excess_returns)) +
geom_hline(yintercept = rfr, color = "cornflowerblue",
linetype = 3, size = 1) +
theme(legend.position = "none") +
labs(y = "monthly retunrs", x = NULL)