# 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 ## 1 Import stock prices
symbols <- c("AAPL", "WMT", "TGT", "GOOG", "NFLX")
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] "AAPL" "GOOG" "NFLX" "TGT" "WMT"
# 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 AAPL 0.25
## 2 GOOG 0.25
## 3 NFLX 0.2
## 4 TGT 0.2
## 5 WMT 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.100
## 2 2013-02-28 0.0447
## 3 2013-03-28 0.0227
## 4 2013-04-30 0.0458
## 5 2013-05-31 0.0233
## 6 2013-06-28 -0.0451
## 7 2013-07-31 0.0758
## 8 2013-08-30 0.00990
## 9 2013-09-30 0.0235
## 10 2013-10-31 0.0783
## # ℹ 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.241
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)) +
annotate(geom = "text",
x = as.Date("2016-12-01"), y = 3,
color = "red", size = 5,
label = str_glue("Downside risk skyrocketed toward the end of 2017"))
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 downside risk of the portfolio
changed over time, with a sharp increase near the end of 2017. This
means that during that time, the portfolio had a higher chance of
experiencing extreme losses. Earlier in the period, the risk was lower
and more stable. A high kurtosis value means the returns are more likely
to have big jumps, especially on the downside. This matches what we see
in the return distribution plot, which shows that the portfolio returns
had more extreme ups and downs, especially later on. Overall, downside
risk increased toward the end of the time period.