# Load packages
# Core
library(tidyverse)
library(tidyquant)
Measure portfolio risk using kurtosis. It describes the fatness of the tails in probability distributions. In other words, it measures whether a distribution has more or less returns in its tails than the normal distribution. It matters to investors because a distribution with excess kurtosis (kurtosis > 3) means our portfolio might be at risk of a rare but huge downside event. Kurtosis less than 3 means the portfolio is less risky because it has fewer returns in the tails.
five stocks: “SPY”, “EFA”, “IJS”, “EEM”, “AGG”
from 2012-12-31 to 2021-01-01
symbols <- c("CRWD", "AMZN", "SHOP", "TTD", "NVDA")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2021-01-01")
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"))
# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "AMZN" "CRWD" "NVDA" "SHOP" "TTD"
# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights
## [1] 0.25 0.25 0.20 0.20 0.10
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
## symbols weights
## <chr> <dbl>
## 1 AMZN 0.25
## 2 CRWD 0.25
## 3 NVDA 0.2
## 4 SHOP 0.2
## 5 TTD 0.1
# ?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: 96 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0142
## 2 2013-02-28 0.00648
## 3 2013-03-28 0.00476
## 4 2013-04-30 0.00195
## 5 2013-05-31 0.0256
## 6 2013-06-28 0.00173
## 7 2013-07-31 0.0260
## 8 2013-08-30 -0.0121
## 9 2013-09-30 0.0374
## 10 2013-10-31 0.0332
## # ℹ 86 more rows
portfolio_returns_tbl %>%
tq_performance(Ra = returns,
Rb = NULL,
performance_fun = table.Stats) %>%
select(Kurtosis)
## # A tibble: 1 × 1
## Kurtosis
## <dbl>
## 1 1.76
portfolio_returns_tbl %>%
ggplot(aes(returns)) +
geom_histogram()
# Figure 6.3 Asset and Portfolio Kurtosis Comparison ----
asset_returns_kurtosis_tbl <- asset_returns_tbl %>%
# kurtosis for each asset
group_by(asset) %>%
summarise(kt = kurtosis(returns),
mean = mean(returns)) %>%
ungroup() %>%
# kurtosis of portfolio
add_row(tibble(asset = "Portfolio",
kt = kurtosis(portfolio_returns_tbl$returns),
mean = mean(portfolio_returns_tbl$returns)))
asset_returns_kurtosis_tbl %>%
ggplot(aes(kt, mean)) +
geom_point() +
# Formatting
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
theme(legend.position = "none") +
# Add label
ggrepel::geom_text_repel(aes(label = asset, color = asset), size = 5) +
labs(y = "Expected Return",
x = "Kurtosis")
# 3 Rolling kurtosis ----
# Assign a value to winder
window <- 24
port_rolling_kurtosis_tbl <- portfolio_returns_tbl %>%
tq_mutate(select = returns,
mutate_fun = rollapply,
width = window,
FUN = kurtosis,
col_rename = "rolling_kurtosis") %>%
select(date, rolling_kurtosis) %>%
na.omit()
# Figure 6.5 Rolling kurtosis ggplot ----
port_rolling_kurtosis_tbl %>%
ggplot(aes(date, rolling_kurtosis)) +
geom_line(color = "cornflowerblue") +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
scale_x_date(breaks = scales::breaks_pretty(n = 7)) +
labs(title = paste0("Rolling ", window, "-Month Kurtosis"),
x = NULL,
y = "kurtosis") +
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.
The downside risk has increased towards the end of the period, which is shown by the spike in the rolling kurtosis, a higher kurtosis indicates more extreme returns which are the fat tails