Worst case scenario simulation (basic)

Worst case scenario v1

Here is GARP’s lame explainer (source: GARP):

2.11 WORST CASE ANALYSIS:

Occasionally, when there are repeated trials, an analyst will calculate statistics for worst-case results. For example, if a portfolio manager reports results every week, he or she might ask what the worst result will be over a period of 52 weeks. If the distribution of the returns in one week is known, a Monte Carlo simulation can be used to calculate statistics for this worst-case result. For example, one can calculate the expected worst-case result over 52 weeks, the 95th percentile of the worst-case result, and so on.

Below simulations_list will contain five matrices

• The first matrix is 10,000 rows by 1 column (H = 1 day; not realistic just illustrative)
• The second matrix is 10,000 rows by 5 columns (H = 5 days)
• The third matrix is 10,000 rows by 20 columns (H = 20 days)

Note Linda Allen:

In contrast to VaR, WCS focuses on the distribution of the loss during the worst trading period (“period” being, e.g., one day or two weeks), over a given horizon (“horizon” being, e.g., 100 days or one year). The key point is that a worst period will occur with probability one.

So if each row is a trial (i.e., 10,000 rows = 10,000 trials), then we’re retrieving a vector of the worst period within the horizon for each of 10,000 trials. In this simulation, all periods are one day. So, the second matrix will retrieve (a vector of length 10,000 of) the worst one-day period in a five-day horizon. The third matrix will retrieve the worst one-day period in a 20-day horizon. The first matrix has only column, so the worst is the only value in the row: the statistics are the same.

The key function is worst_returns <- map_dbl(1:nrow(simulation), ~ min(simulation[.x, ])). Because it finds the minimum (ie, worst) value in each of the 10,000 rows. That’s the worst_returns vector.

Here is my interpretation, and the numbers are very similar to Linda Allen’s table.

library(tidyverse)
# includes purrr, dplyr, tidyr, ggplot2, tibble
library(gt)

set.seed(73914)

# Vector of different numbers of days
days_vector <- c(1, 5, 20, 100, 250)

# Number of trials
Y <- 10000 # trials; aka, sims

# A full experiment; e.g., 2nd experiment will be 10,000 rows * 5 columns(= 5 days)
# Each experiment has 10,000 rows but they have 5 | 20 | 100 | 250 columns
simulate_trials <- function(X) {
    simulations <- matrix(rnorm(X * Y), nrow=Y)
    return(simulations)
}

# List to of NULLs to store five simulations: 1, 5, 20, 100, 250 days
simulations_list <- setNames(vector("list", length(days_vector)), days_vector)

# Do an experiment for each number of days
simulations_list <- map(days_vector, ~ simulate_trials(.x))
# This first LIST item is a matrix with 10,000 rows and 1 column
# This second LIST item is a matrix with 10,000 rows and 5 (= horizon days) column
str(simulations_list[[1]])

 num [1:10000, 1] 0.21 0.337 -0.248 -0.744 -2.258 ...

str(simulations_list[[2]])

 num [1:10000, 1:5] -0.279 0.752 1.203 1.138 -0.157 ...

# Function: Get the worst return for each row (trial)
get_worst_returns <- function(simulation) {
    
    # .x is the current row index in the iteration
    # simulation[.x, ] selects the entire row because [x., ] is all columns
    # such that ~ min(simulation[.x, ]) is the minimum value in the row
    worst_returns <- map_dbl(1:nrow(simulation), ~ min(simulation[.x, ]))
    return(worst_returns)
}

# Get the worst returns for each set of days
worst_returns_list <- map(simulations_list, ~ get_worst_returns(.x))

# Function: Get percentiles and mean
get_percentiles_and_mean <- function(returns) {
    percentiles <- quantile(returns, probs = c(0.01, 0.05, 0.1, 0.25, 0.5))
    mean_val <- mean(returns)
    c(percentiles, mean = mean_val)
}

# Get them 
percentiles_and_mean_list <- map(worst_returns_list, ~ get_percentiles_and_mean(.x))

# Print percentiles and mean
percentiles_and_mean_list

[[1]]
           1%            5%           10%           25%           50% 
-2.3408352635 -1.6258636416 -1.2747263559 -0.6772910421  0.0009027502 
         mean 
-0.0080410293 

[[2]]
       1%        5%       10%       25%       50%      mean 
-2.901285 -2.337821 -2.049299 -1.598782 -1.133643 -1.169856 

[[3]]
       1%        5%       10%       25%       50%      mean 
-3.273848 -2.768015 -2.545114 -2.187286 -1.818529 -1.866486 

[[4]]
       1%        5%       10%       25%       50%      mean 
-3.735132 -3.284581 -3.072783 -2.760331 -2.462535 -2.506729 

[[5]]
       1%        5%       10%       25%       50%      mean 
-3.931741 -3.526280 -3.330623 -3.045503 -2.773540 -2.816351 

# Name the list elements
names(percentiles_and_mean_list) <- days_vector
# has_rownames(percentiles_and_mean_list) # FALSE

# The rest is awesome gt table stuff
percentiles_df <- as_tibble(percentiles_and_mean_list)
descriptive_stat <- c("1 %ile", "5 %ile", "10 %ile", "25 %ile", "50 %ile", "Exp WCS (mean)")

percentiles_df <- add_column(percentiles_df, descriptive_stat, .before = 1)

percentiles_df_gt <- percentiles_df |> 
    gt(rowname_col = "descriptive_stat") |> 
    fmt_number(
        columns = c(`1`, `5`, `20`, `100`, `250`),
        decimals = 2
    ) |>
    tab_stubhead(label = "Descriptive Stat") |> 
    tab_spanner(
        label = "Horizon in Days",
        columns = c('1', '5', '20', '100', '250')
    ) |> 
    tab_style(
        style = cell_text(weight = "bold"),
        locations = list(cells_column_labels(),
                         cells_stubhead(),
                         cells_column_spanners())
    ) |> 
    tab_options(
        table.font.size = 14
    ) |> 
    data_color(
        rows = 6,
        palette = "lightcyan1"
    ) |> 
    data_color(
        columns = 2,
        palette = "lightgrey"
    )
    
percentiles_df_gt

Descriptive Stat	Horizon in Days
	1	5	20	100	250
1 %ile	−2.34	−2.90	−3.27	−3.74	−3.93
5 %ile	−1.63	−2.34	−2.77	−3.28	−3.53
10 %ile	−1.27	−2.05	−2.55	−3.07	−3.33
25 %ile	−0.68	−1.60	−2.19	−2.76	−3.05
50 %ile	0.00	−1.13	−1.82	−2.46	−2.77
Exp WCS (mean)	−0.01	−1.17	−1.87	−2.51	−2.82