# Load packages
# Core
library(tidyverse)
library(tidyquant)
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
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")
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
# 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."))
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 rolling kurtosis plot shows that the portfolio’s downside risk has increased over time. Kurtosis rises toward the end of the period, indicating fatter tails and a greater likelihood of extreme negative returns.