# Load packages
# Core
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(tidyquant)
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## ✔ PerformanceAnalytics 2.0.8 ✔ TTR 0.24.4
## ✔ quantmod 0.4.28 ✔ xts 0.14.1── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date() masks base::as.Date()
## ✖ zoo::as.Date.numeric() masks base::as.Date.numeric()
## ✖ dplyr::filter() masks stats::filter()
## ✖ xts::first() masks dplyr::first()
## ✖ dplyr::lag() masks stats::lag()
## ✖ xts::last() masks dplyr::last()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary() masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggrepel)
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 2017-12-31
symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
get = "stock.prices",
from = "2012-12-31",
to = "2017-12-31")
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] "AGG" "EEM" "EFA" "IJS" "SPY"
# 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 AGG 0.25
## 2 EEM 0.25
## 3 EFA 0.2
## 4 IJS 0.2
## 5 SPY 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")
## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.
portfolio_returns_tbl
## # A tibble: 60 × 2
## date returns
## <date> <dbl>
## 1 2013-01-31 0.0204
## 2 2013-02-28 -0.00239
## 3 2013-03-28 0.0121
## 4 2013-04-30 0.0174
## 5 2013-05-31 -0.0128
## 6 2013-06-28 -0.0247
## 7 2013-07-31 0.0321
## 8 2013-08-30 -0.0224
## 9 2013-09-30 0.0511
## 10 2013-10-31 0.0301
## # ℹ 50 more rows
portfolio_returns_tbl %>%
tq_performance(Ra = returns,
Rb = NULL,
performance_fun = table.Stats) %>%
select(Kurtosis)
## # A tibble: 1 × 1
## Kurtosis
## <dbl>
## 1 0.488
portfolio_returns_tbl %>%
ggplot(aes(returns)) +
geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# 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)) +
annotate(geom = "text",
x = as.Date("2016-12-01"), y = 3,
color = "red", size = 5,
label = str_glue("The risk level skyrocketed at the end of the period
with the 24-month kurtosis rising above three."))