# Load packages

# Core
library(tidyverse)
library(tidyquant)
library(plotly)

Goal

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("FNV", "WPM", "NEM", "CCJ", "BWXT", "NVDA", "TSM", "ASML", "CAT", "ITW", "HON", "PLD", "EQIX", "PSA", "TPL", "XOM", "CVX")

prices <- tq_get(x = symbols, 
                 get  = "stock.prices",
                 from = "2012-12-31")

2 Convert Prices to Returns (Monthly)

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"))

asset_returns_tbl
## # A tibble: 2,822 × 3
##    asset date       returns
##    <chr> <date>       <dbl>
##  1 ASML  2013-01-31  0.154 
##  2 ASML  2013-02-28 -0.0563
##  3 ASML  2013-03-28 -0.0430
##  4 ASML  2013-04-30  0.0992
##  5 ASML  2013-05-31  0.0887
##  6 ASML  2013-06-28 -0.0269
##  7 ASML  2013-07-31  0.128 
##  8 ASML  2013-08-30 -0.0327
##  9 ASML  2013-09-30  0.126 
## 10 ASML  2013-10-31 -0.0420
## # ℹ 2,812 more rows

3 Assign a Weight to Each Asset (Change the Weighting Scheme)

symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
##  [1] "ASML" "BWXT" "CAT"  "CCJ"  "CVX"  "EQIX" "FNV"  "HON"  "ITW"  "NEM" 
## [11] "NVDA" "PLD"  "PSA"  "TPL"  "TSM"  "WPM"  "XOM"
weights <- c(0.10, 0.10, 0.10, 0.05, 0.05, 0.04, 0.03, 0.03, 0.04, 0.03, 0.03, 0.07, 0.07, 0.06, 0.07, 0.07, 0.06)
weights
##  [1] 0.10 0.10 0.10 0.05 0.05 0.04 0.03 0.03 0.04 0.03 0.03 0.07 0.07 0.06 0.07
## [16] 0.07 0.06
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 17 × 2
##    symbols weights
##    <chr>     <dbl>
##  1 ASML       0.1 
##  2 BWXT       0.1 
##  3 CAT        0.1 
##  4 CCJ        0.05
##  5 CVX        0.05
##  6 EQIX       0.04
##  7 FNV        0.03
##  8 HON        0.03
##  9 ITW        0.04
## 10 NEM        0.03
## 11 NVDA       0.03
## 12 PLD        0.07
## 13 PSA        0.07
## 14 TPL        0.06
## 15 TSM        0.07
## 16 WPM        0.07
## 17 XOM        0.06

4 Build a 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: 166 × 2
##    date        returns
##    <date>        <dbl>
##  1 2013-01-31  0.0457 
##  2 2013-02-28 -0.0170 
##  3 2013-03-28  0.0106 
##  4 2013-04-30 -0.00468
##  5 2013-05-31  0.0276 
##  6 2013-06-28 -0.0378 
##  7 2013-07-31  0.0389 
##  8 2013-08-30 -0.00842
##  9 2013-09-30  0.0294 
## 10 2013-10-31  0.00176
## # ℹ 156 more rows

5 Compute Kurtosis

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

portfoltio_kurt_tidyquant_builtin_percent
## # A tibble: 1 × 1
##   Kurtosis
##      <dbl>
## 1    0.209

6 Plot: Rolling Kurtosis

# Assign a Value for Window (width)
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 = "skyblue3") +
    
    # 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"))

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.

My portfolio has fluctuated in downside risk over the course of the past thirteen-and-a-half years. Periods shown above around late 2018, mid 2021, and mid-to-late 2025 show higher kurtosis (indicating greater likelihood of extreme returns) while periods like 2017 and 2023-2024 show negative kurtosis. Even though kurtosis measure extremes, not whether they are positive or negative extremes, the above chart paired with last week’s calculation of a portfolio skewness of about 0.17 suggests that my portfolio is skewed toward positive returns and suggests that the extreme returns will not be primarily concentrated towards the downside. Overall, my portfolio experienced periods of increased tail risk, but the fluctuations seen above does not prove there to be any consistent long-term increase/decrease in downside risk.