# 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,
replace_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.00220
## 3 2013-03-28 0.0127
## 4 2013-04-30 0.0173
## 5 2013-05-31 -0.0113
## 6 2013-06-28 -0.0233
## 7 2013-07-31 0.0342
## 8 2013-08-30 -0.0231
## 9 2013-09-30 0.0513
## 10 2013-10-31 0.0305
## # ℹ 50 more rows
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 0.337
# Mean of portfolio returns
portfolio_mean_tidyquant_builtin_percent <-
mean(portfolio_returns_tbl$returns)
portfolio_kurt_tidyquant_builtin_percent
## # A tibble: 1 × 1
## Kurtosis
## <dbl>
## 1 0.337
portfolio_returns_tbl %>%
ggplot(aes(x = returns)) +
geom_histogram()
# Transform Data
mean_kurt_tbl <- asset_returns_tbl %>%
#Calculate Mean Return and Kurtosis for Assets
group_by(asset) %>%
summarise(mean = mean(returns),
kurt = kurtosis(returns)) %>%
ungroup() %>%
#Add Portfolio Stats
add_row(portfolio_returns_tbl %>%
summarise(mean = mean(returns),
kurt = kurtosis(returns)) %>%
mutate(asset = "Portfolio"))
#Plot
mean_kurt_tbl %>%
ggplot(aes(x = kurt, y = mean)) +
geom_point() +
ggrepel::geom_text_repel(aes(label = asset, color = asset)) +
#Formatting
theme(legend.position = "none") +
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
#Labeling
labs(x = "Kurtosis",
y = "Expected Returns")
# 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 = "Kurtois",
title = paste0("Rolling", window, "Month Kurtosis")) +
annotate(geom = "text", x = as.Date("2016-07-01"), y = 3, size = 5, color = "red", 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.
Downside risk of the portfolio has increased alot towards the end of 2017, as shown in graph by the rising kurtosis, which suggests a higher likelihood of extreme, potentially negative returns. A negative skew implies a tendency for more frequent or larger negative returns. This translates to an increased downside risk because there is a higher likelihood of significant losses during periods of negative skew.