# Load packages

# Core
library(tidyverse)
library(tidyquant)

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("TGT", "WMT", "LOW", "GOOG", "AMZN")

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

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

3 Assign a weight to each asset (change the weigting scheme)

# symbols
symbols <- asset_returns_tbl %>% distinct(asset) %>% pull()
symbols
## [1] "AMZN" "GOOG" "LOW"  "TGT"  "WMT"
# weights
weights <- c(0.2, 0.2, 0.2, 0.2, 0.2)
weights
## [1] 0.2 0.2 0.2 0.2 0.2
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 AMZN        0.2
## 2 GOOG        0.2
## 3 LOW         0.2
## 4 TGT         0.2
## 5 WMT         0.2

4 Build a portfolio

# ?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: 166 × 2
##    date         returns
##    <date>         <dbl>
##  1 2013-01-31  0.0490  
##  2 2013-02-28  0.0223  
##  3 2013-03-28  0.0278  
##  4 2013-04-30  0.0149  
##  5 2013-05-31  0.0328  
##  6 2013-06-28 -0.000319
##  7 2013-07-31  0.0519  
##  8 2013-08-30 -0.0522  
##  9 2013-09-30  0.0405  
## 10 2013-10-31  0.0826  
## # ℹ 156 more rows

5 Compute kurtosis

portfolio_skew_tidyquant_builtin_percent <- portfolio_returns_tbl %>%

    tq_performance(Ra = returns, 
                  performance_fun = table.Stats) %>%
    
        select(Kurtosis)

portfolio_skew_tidyquant_builtin_percent 
## # A tibble: 1 × 1
##   Kurtosis
##      <dbl>
## 1    0.392

5 Compute Skewness

# Asset Skewness
asset_skewness_tbl <- asset_returns_tbl %>%

    group_by(asset) %>%
       tq_performance(Ra = returns,
                   performance_fun = table.Stats) %>%
    
        ungroup() %>%
    select(asset, Skewness)
       
        asset_skewness_tbl 
## # A tibble: 5 × 2
##   asset Skewness
##   <chr>    <dbl>
## 1 AMZN    0.001 
## 2 GOOG    0.0888
## 3 LOW    -0.152 
## 4 TGT    -0.306 
## 5 WMT    -0.358
# Portfolio Skewness
    portfolio_skewness_tbl <- portfolio_returns_tbl %>%
 tq_performance(Ra = returns, 
                  performance_fun = table.Stats) %>%
    
        select(Skewness) %>%
        rename(skew= Skewness) %>%
    mutate(asset = "Portfolio")
        
   portfolio_skewness_tbl      
## # A tibble: 1 × 2
##      skew asset    
##     <dbl> <chr>    
## 1 -0.0722 Portfolio

Expected Return vs Downside Risk

# 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"))
## # A tibble: 2 × 3
##      mean   kurt asset    
##     <dbl>  <dbl> <chr>    
## 1  0.0134  0.392 portfolio
## 2 NA      NA     <NA>
 # 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 (Downsize risk)",
         y = "Expected Returns vs kurtosis")

## 6 Plot: Rolling kurtosis

# 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.2, 
             size = 4, color = "red",
             label = ("Kurtosis rose extremely in 2025,\nin showing potential large return"))

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 kurtosis of the portfolio is 0.392, showing potential high or low returns and risk. The portfolio’s potential risk has increased continuously over the time window, and especially towards the end of 2025. The chart indicates that kurtosis over 24 months fluctuated. It stayed primarily below zero until 2024, when it rose in 2025. After a high peak above a kurtosis of 3, it declined in 2026. Kurtosis decreased, showing potential returns returning to that of typical ones. The skewness of the portfolio is -0.0722 indicating that downside risk may be higher than upside.