Apply it to your data 9
How has your portfolio preformed over time?
Vincent Fosser
2025-06-12
# 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.
1 Import stock prices
symbols <- c("Asker.st", "Atco-B.st", "Axfo.st", "Bahn-b.st", "BRK-B", "Cers", "LLY", "Embrac-b.st", "Indu-c.st", "Inve-b.st", "Inwi.st", "Novo-b.co", "NVDA", "Yubico.st")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2020-04-01",
to = "2025-06-01")
prices## # A tibble: 16,672 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Asker.st 2025-03-27 83 87.2 80.2 83.7 16441271 83.7
## 2 Asker.st 2025-03-28 83 84.0 81.7 82 1262083 82
## 3 Asker.st 2025-03-31 81.3 81.9 80.1 80.5 626988 80.5
## 4 Asker.st 2025-04-01 80.8 82.2 80.6 81.9 356628 81.9
## 5 Asker.st 2025-04-02 81.9 82.1 80.9 82.1 576561 82.1
## 6 Asker.st 2025-04-03 81 81.8 80.1 80.7 235131 80.7
## 7 Asker.st 2025-04-04 80.5 81.2 77.3 78.6 780928 78.6
## 8 Asker.st 2025-04-07 74.8 80.1 71.4 77.8 377461 77.8
## 9 Asker.st 2025-04-08 79.2 79.9 75 77 371563 77
## 10 Asker.st 2025-04-09 76.1 78.7 72.8 74.2 1171607 74.2
## # ℹ 16,662 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] "Asker.st" "Atco-B.st" "Axfo.st" "BRK-B" "Bahn-b.st"
## [6] "Cers" "Embrac-b.st" "Indu-c.st" "Inve-b.st" "Inwi.st"
## [11] "LLY" "NVDA" "Novo-b.co" "Yubico.st"weights <- c(0.0314, 0.0133, 0.0136, 0.0589, 0.0112, 0.0068, 0.0201, 0.1858, 0.2298, 0.0584, 0.0892, 0.2504, 0.0168, 0.0143)
weights## [1] 0.0314 0.0133 0.0136 0.0589 0.0112 0.0068 0.0201 0.1858 0.2298 0.0584
## [11] 0.0892 0.2504 0.0168 0.0143w_tbl <- tibble(symbols, weights)
w_tbl## # A tibble: 14 × 2
## symbols weights
## <chr> <dbl>
## 1 Asker.st 0.0314
## 2 Atco-B.st 0.0133
## 3 Axfo.st 0.0136
## 4 BRK-B 0.0589
## 5 Bahn-b.st 0.0112
## 6 Cers 0.0068
## 7 Embrac-b.st 0.0201
## 8 Indu-c.st 0.186
## 9 Inve-b.st 0.230
## 10 Inwi.st 0.0584
## 11 LLY 0.0892
## 12 NVDA 0.250
## 13 Novo-b.co 0.0168
## 14 Yubico.st 0.01434 Build a 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: 68 × 2
## date returns
## <date> <dbl>
## 1 2020-05-29 0.0285
## 2 2020-06-30 0.0121
## 3 2020-07-31 0.0243
## 4 2020-08-31 0.0373
## 5 2020-09-30 0.0430
## 6 2020-10-30 -0.0622
## 7 2020-11-30 0.0746
## 8 2020-12-30 0.0297
## 9 2020-12-31 0.0128
## 10 2021-01-29 0.0187
## # ℹ 58 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.2976 Plot: Rolling Sharpe Ratio
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: 45 × 2
## date rolling_sr
## <date> <dbl>
## 1 2021-12-31 0.674
## 2 2022-01-31 0.448
## 3 2022-02-28 0.392
## 4 2022-03-31 0.421
## 5 2022-04-29 0.359
## 6 2022-05-31 0.318
## 7 2022-06-30 0.335
## 8 2022-07-29 0.342
## 9 2022-08-31 0.207
## 10 2022-09-30 0.155
## # ℹ 35 more rows#Plot
rolling_sr_tbl %>%
ggplot(aes(x = date, y = rolling_sr)) +
geom_line(color = "skyblue1") +
#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?
Since 2023 the portfolio has performed well. However, as mentioned in previous assignments we can see how the sharpe ratio relates to the macro trends. There is a clear structural break towards the end of 2024. The reason could be quite simple, the portfolio saw high returns when recovering from covid and probably with big help of Nvidia that saw high returns and is one of the biggest holds. Towards the end of 2024, we have seen an increased market volatility, a change in leadership and the return of stocks have cooled, specifically for Nvidia. The risk might not be a lot higher even if the Sharpe ratio has fallen a lot however, combined with the cooling of returns the sharpe ratio will fall. It would be interesting putting a comparison with indexes to see how the portfolio stand compared to different index. A quick search tells me that S&P 500 Sharpe ratio has also fallen to around 0.5