Apply it to your data 8
How has your portfolio’s downside risk changed over time?
Shane McCormick
2026-10-28
# Load packages
# Core
library(tidyverse)
library(tidyquant)Goal
Visualize and examine changes in the underlying trend in the downside risk of your portfolio in terms of kurtosis.
Choose your stocks.
from 2012-12-31 to present
1 Import stock prices
symbols <- c("WMT", "AAPL", "NFLX", "GOOGL")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31")
prices## # A tibble: 13,908 × 8
## symbol date open high low close volume adjusted
## <chr> <date> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 WMT 2012-12-31 22.5 22.8 22.5 22.7 21037500 17.4
## 2 WMT 2013-01-02 23.0 23.1 22.8 23.1 31172400 17.7
## 3 WMT 2013-01-03 23.1 23.1 22.8 22.9 26730300 17.6
## 4 WMT 2013-01-04 22.9 23.1 22.8 23.0 19314000 17.7
## 5 WMT 2013-01-07 22.9 23.0 22.7 22.8 18604200 17.5
## 6 WMT 2013-01-08 22.8 23.0 22.7 22.9 17600700 17.5
## 7 WMT 2013-01-09 22.9 22.9 22.7 22.9 15165600 17.5
## 8 WMT 2013-01-10 22.9 23.0 22.6 22.8 34361400 17.5
## 9 WMT 2013-01-11 22.9 22.9 22.7 22.9 18673500 17.6
## 10 WMT 2013-01-14 22.8 22.9 22.7 22.8 16471200 17.5
## # ℹ 13,898 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"))
asset_returns_tbl## # A tibble: 664 × 3
## asset date returns
## <chr> <date> <dbl>
## 1 AAPL 2013-01-31 -0.156
## 2 AAPL 2013-02-28 -0.0256
## 3 AAPL 2013-03-28 0.00285
## 4 AAPL 2013-04-30 0.000271
## 5 AAPL 2013-05-31 0.0222
## 6 AAPL 2013-06-28 -0.126
## 7 AAPL 2013-07-31 0.132
## 8 AAPL 2013-08-30 0.0804
## 9 AAPL 2013-09-30 -0.0217
## 10 AAPL 2013-10-31 0.0920
## # ℹ 654 more rows3 Assign a weight to each asset (change the weigting scheme)
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols## [1] "AAPL" "GOOGL" "NFLX" "WMT"# weights
weights <- c(0.35, 0.30, 0.20, 0.15)
weights## [1] 0.35 0.30 0.20 0.15w_tbl <- tibble(symbols, weights)
w_tbl## # A tibble: 4 × 2
## symbols weights
## <chr> <dbl>
## 1 AAPL 0.35
## 2 GOOGL 0.3
## 3 NFLX 0.2
## 4 WMT 0.154 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: 166 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0849
## 2 2013-02-28 0.0362
## 3 2013-03-28 0.00894
## 4 2013-04-30 0.0435
## 5 2013-05-31 0.0287
## 6 2013-06-28 -0.0555
## 7 2013-07-31 0.0849
## 8 2013-08-30 0.0350
## 9 2013-09-30 0.0216
## 10 2013-10-31 0.0949
## # ℹ 156 more rows5 Compute kurtosis
portfolio_kurt_tidyquant_builtin_percent <- portfolio_returns_tbl %>%
tq_performance(Ra = returns,
performance_fun =
table.Stats) %>%
select(Kurtosis)
portfolio_kurt_tidyquant_builtin_percent## # A tibble: 1 × 1
## Kurtosis
## <dbl>
## 1 1.076 Plot: Rolling kurtosis
# Assign a value for window
window = 24
# Transform data: Calculate 24 month rolling kurtosis
rolling_kurt_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
FUN = kurtosis,
col_rename = "kurt") %>%
na.omit() %>%
select(-returns)
# Plot
rolling_kurt_tbl %>%
ggplot(aes(x = date, y = kurt)) +
geom_line(color = "cornflowerblue") +
# Formatting
scale_y_continuous(breaks = seq(-1,4,0.5)) +
scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
theme(plot.title = element_text(hjust = 0.5))+
# Labeling
labs(x = NULL,
y = "Kurtosis",
title = paste0("Rolling ", window, " Month Kurtosis"))
Has the downside risk of your portfolio increased or decreased over time? Explain using the plot you created. You may also refer to the skewness of the returns distribution you plotted in the previous assignment.
To start, in the previous apply data assignment I only recorded a skewness for the profile from 12-31-2012 to 12-31-2017, so only for this part of the graph I can speak to skewness and how it connects to the kurtosis results. The kurtosis in this range goes from -0.5 to -1.0 and back to -0.5. The skewness during this range is about -0.5. As per downside risk, it stayed relatively the same during this range. The skewness is moderately negative meaning it has a longer left tail entailing slightly more extreme negative returns. But, the kurtosis rating is slightly negative meaning the thickness of the tail in this direction is very minimal. A thin tail means these moderately extreme negative returns are less likely to happen(almost never happening because of the very low kurtosis rating), meaning an investor in this profile has less drastic risk to worry about.
Examining the rest of the graph, however, shows one major discrepancy in this rolling kurtosis. From the very beginning of 2022 till about halfway through it, downside risk explodes. Kurtosis goes from -0.75 to about 2.5 in a 6 month period. Now, I can’t speak for the skewness during this range as I have not calculated it. But, if it remained a similar skewness during this range, a lot more negative returns appear to have occurred. These more extreme returns happened more frequently in this range then it dropped over the course of the next year and a half. Even with this spike in downside risk, it still falls beneath the typical kurtosis of 3.0. So overall, the “thickness” in the tail isn’t anything outside of what’s considered normal. Over the course of this entire range, kurtosis only increased from -0.5 to -0.25. It got shot up and down a lot between then, but outside of 2022-2024, the kurtosis line steadily increased and downside risk didn’t increase or decrease that much.