# Load packages

# Core
library(tidyverse)
library(tidyquant)

Goal

Visualize and examine changes in the underlying trend in the downside risk of my portfolio in terms of kurtosis.

1 Import stock prices

symbols <- c("Asker.st", "Atco-B.st", "Axfo.st", "Bahn-b.st", "BRK-B", "Cers", "LLY", "Embrac-b.st", "Indu-c.st", "Inve-b.st", "Inwi.st", "Novo-b.co", "NVDA", "Yubico.st")

prices <- tq_get(x    = symbols, 
                 get  = "stock.prices", 
                 from = "2020-04-01",
                 to   = "2025-06-01")
prices
## # A tibble: 16,672 × 8
##    symbol   date        open  high   low close   volume adjusted
##    <chr>    <date>     <dbl> <dbl> <dbl> <dbl>    <dbl>    <dbl>
##  1 Asker.st 2025-03-27  83    87.2  80.2  83.7 16441271     83.7
##  2 Asker.st 2025-03-28  83    84.0  81.7  82    1262083     82  
##  3 Asker.st 2025-03-31  81.3  81.9  80.1  80.5   626988     80.5
##  4 Asker.st 2025-04-01  80.8  82.2  80.6  81.9   356628     81.9
##  5 Asker.st 2025-04-02  81.9  82.1  80.9  82.1   576561     82.1
##  6 Asker.st 2025-04-03  81    81.8  80.1  80.7   235131     80.7
##  7 Asker.st 2025-04-04  80.5  81.2  77.3  78.6   780928     78.6
##  8 Asker.st 2025-04-07  74.8  80.1  71.4  77.8   377461     77.8
##  9 Asker.st 2025-04-08  79.2  79.9  75    77     371563     77  
## 10 Asker.st 2025-04-09  76.1  78.7  72.8  74.2  1171607     74.2
## # ℹ 16,662 more rows

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 <- asset_returns_tbl %>% distinct(asset) %>% pull() 
symbols
##  [1] "Asker.st"    "Atco-B.st"   "Axfo.st"     "BRK-B"       "Bahn-b.st"  
##  [6] "Cers"        "Embrac-b.st" "Indu-c.st"   "Inve-b.st"   "Inwi.st"    
## [11] "LLY"         "NVDA"        "Novo-b.co"   "Yubico.st"
weights <- c(0.0314, 0.0133, 0.0136, 0.0589, 0.0112, 0.0068, 0.0201, 0.1858, 0.2298, 0.0584, 0.0892, 0.2504, 0.0168, 0.0143)
weights
##  [1] 0.0314 0.0133 0.0136 0.0589 0.0112 0.0068 0.0201 0.1858 0.2298 0.0584
## [11] 0.0892 0.2504 0.0168 0.0143
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 14 × 2
##    symbols     weights
##    <chr>         <dbl>
##  1 Asker.st     0.0314
##  2 Atco-B.st    0.0133
##  3 Axfo.st      0.0136
##  4 BRK-B        0.0589
##  5 Bahn-b.st    0.0112
##  6 Cers         0.0068
##  7 Embrac-b.st  0.0201
##  8 Indu-c.st    0.186 
##  9 Inve-b.st    0.230 
## 10 Inwi.st      0.0584
## 11 LLY          0.0892
## 12 NVDA         0.250 
## 13 Novo-b.co    0.0168
## 14 Yubico.st    0.0143

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: 68 × 2
##    date       returns
##    <date>       <dbl>
##  1 2020-05-29  0.0285
##  2 2020-06-30  0.0121
##  3 2020-07-31  0.0243
##  4 2020-08-31  0.0373
##  5 2020-09-30  0.0430
##  6 2020-10-30 -0.0622
##  7 2020-11-30  0.0746
##  8 2020-12-30  0.0297
##  9 2020-12-31  0.0128
## 10 2021-01-29  0.0187
## # ℹ 58 more rows

5 Compute kurtosis

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     1.24

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

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.

Looking at the 24-month rolling kurtosis the downside risk sarted high, became stable, then increased during 2024 to regain balance and then increase again. This graph makes sense and relates to the macroeconomic trends. The start of the graph is during the recovery of Covid, a period that was getting increasingly better but with uncertainty of the future. 2023 was a stable year however, 2024 became uncertain because of the inflation, uncertain future for labor market and interest rates and the inverted yield curved showed a worrying outlook. However, thanks to clever monetary policy the US avoided a recession. The most recent uncertainty is connected to tariff war and the uncertainty that has come with it.

The portfolio shows the highest downside risk since 2022. Correlating the downside risk to skewness of the portfolio that is around -1. This tells us that the portfolio often experiences small gains with the occasional large loss, the kurtosis is slightly below 3 which indicates platykurtic kurtosis. Platykurtic distributions have more stability than other curves because the extreme price movements have been rare in the past. With that said the portfolio is moderately stable, but the negative skewness together with an increased kurtosis show concernes of an increased risk of a negative outlier.