# Load packages
# Core
library(tidyverse)
library(tidyquant)
Collect individual returns into a portfolio by assigning a weight to each stock
four stocks: “XOM”, “SHEL”, “BP”, “CVX”
from 2012-12-31 to 2017-12-31
symbols <- c("XOM", "SHEL", "BP", "CVX")
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] "BP" "CVX" "SHEL" "XOM"
#weights
weights <- c(0.25,0.25,0.25,0.25)
weights
## [1] 0.25 0.25 0.25 0.25
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 4 × 2
## symbols weights
## <chr> <dbl>
## 1 BP 0.25
## 2 CVX 0.25
## 3 SHEL 0.25
## 4 XOM 0.25
# ?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.0477
## 2 2013-02-28 -0.0292
## 3 2013-03-28 0.0150
## 4 2013-04-30 0.0213
## 5 2013-05-31 0.00575
## 6 2013-06-28 -0.0263
## 7 2013-07-31 0.0401
## 8 2013-08-30 -0.0338
## 9 2013-09-30 0.00754
## 10 2013-10-31 0.0360
## # ℹ 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.435
portfolio_returns_tbl %>%
ggplot(aes(x = returns)) +
geom_histogram()
# Transform Data
mean_kurt_tbl <- asset_returns_tbl %>%
# Calculate mean returns 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 = "Kurtosis",
title = paste0("Rolling ", window, " Month Kurtosis")) +
annotate(geom = "text",
x = as.Date("2016-07-01"), y = 3,
size = 5, color = "red",
label = str_glue("Kurtosis seems to increase in 2 year intervals, but never exceeds 0.5"))
The portfolio kurtosis is -0.435 indicating that the distribution has very thin tails. We know from previous applications that this portfolio has a skewness of 0.272 which is well withing the “normal” range. That in mind, this portfolio has little downside risk as the distribution is very narrow “low kurtosis” and slightly positive “slight positive skewness”.