Steps 1-4: Rebuild the Portfolio (from Code Along 5)

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")

prices <- tq_get(
  x    = symbols,
  get  = "stock.prices",
  from = "2012-01-01",
  to   = "2017-01-01"
)

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_vec <- asset_returns_tbl %>%
  distinct(asset) %>%
  pull()

weights <- c(0.25, 0.25, 0.20, 0.20, 0.10)

w_tbl <- tibble(symbols_vec, weights) %>%
  set_names(c("asset", "weights"))

portfolio_returns_tbl <- asset_returns_tbl %>%
  tq_portfolio(
    assets_col   = asset,
    returns_col  = returns,
    weights      = w_tbl,
    col_rename   = "returns",
    rebalance_on = "months"
  )
## Warning in check_weights(weights, assets_col, map, x): Sum of weights does not
## equal 1.

Step 5: Calculate Kurtosis

portfolio_kurt_tbl <- portfolio_returns_tbl %>%
  tq_performance(
    Ra              = returns,
    Rb              = NULL,
    performance_fun = table.Stats
  ) %>%
  select(Kurtosis)

portfolio_kurt_tbl
## # A tibble: 1 × 1
##   Kurtosis
##      <dbl>
## 1    0.430

Note: Kurtosis here is excess kurtosis (a normal distribution = 0), so values above 0 mean fatter tails than normal and values below 0 mean thinner tails.

Plots

Distribution of Portfolio Returns

portfolio_returns_tbl %>%
  ggplot(aes(x = returns)) +
  geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

Expected Returns vs. Downside Risk (Kurtosis)

# Step 1: transform the data
asset_mean_kurt_tbl <- asset_returns_tbl %>%
  group_by(asset) %>%
  summarize(mean = mean(returns),
            kurt = kurtosis(returns)) %>%
  ungroup()

portfolio_mean_kurt_tbl <- portfolio_returns_tbl %>%
  summarize(mean = mean(returns),
            kurt = kurtosis(returns)) %>%
  mutate(asset = "Portfolio") %>%
  select(asset, mean, kurt)

mean_kurt_table <- bind_rows(asset_mean_kurt_tbl, portfolio_mean_kurt_tbl)
mean_kurt_table
## # A tibble: 6 × 3
##   asset         mean    kurt
##   <chr>        <dbl>   <dbl>
## 1 AGG        0.00164  0.887 
## 2 EEM       -0.00136  0.189 
## 3 EFA        0.00431  0.576 
## 4 IJS        0.0118  -0.0323
## 5 SPY        0.0108   0.109 
## 6 Portfolio  0.00437  0.430
# Step 2: make the plot
mean_kurt_table %>%
  ggplot(aes(x = kurt, y = mean)) +
  geom_point() +
  geom_text_repel(aes(label = asset, color = asset)) +
  theme(legend.position = "none") +
  scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
  labs(x = "Kurtosis", y = "Expected returns")

Rolling Kurtosis

# Step 1: transform the data
window <- 24

rolling_kurt_table <- portfolio_returns_tbl %>%
  tq_mutate(
    select     = returns,
    mutate_fun = rollapply,
    width      = window,
    FUN        = kurtosis,
    col_rename = "kurt"
  ) %>%
  na.omit() %>%
  select(-returns)

rolling_kurt_table
## # A tibble: 36 × 2
##    date          kurt
##    <date>       <dbl>
##  1 2014-01-31  0.895 
##  2 2014-02-28  0.839 
##  3 2014-03-31  0.914 
##  4 2014-04-30  1.14  
##  5 2014-05-30 -0.0395
##  6 2014-06-30  0.168 
##  7 2014-07-31 -0.143 
##  8 2014-08-29 -0.175 
##  9 2014-09-30 -0.316 
## 10 2014-10-31 -0.228 
## # ℹ 26 more rows
# Step 2: make the plot
rolling_kurt_table %>%
  ggplot(aes(x = date, y = kurt)) +
  geom_line(color = "cornflowerblue") +
  scale_y_continuous(breaks = seq(-1, 4, 0.5)) +
  scale_x_date(breaks = scales::pretty_breaks(n = 7)) +
  labs(x = "", y = "Kurtosis",
       title = paste0("Rolling ", window, " Month Kurtosis")) +
  theme(plot.title = element_text(hjust = 0.5))

  # Optional annotation (adjust x/y/label to match YOUR plot):
  # + annotate(geom = "text", x = as.Date("2016-07-01"), y = 3.3,
  #            label = str_glue("Downside risk rose\nat the end of the period"),
  #            color = "red", size = 4)