panic_copula.Rmd

---
title: "Panic Copula"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{panic_copula}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

```{r setup}
library(cma)
library(dplyr, warn.conflicts = FALSE)

# stationarity - "invariance"
x <- matrix(diff(log(EuStockMarkets)), ncol = 4)
colnames(x) <- colnames(EuStockMarkets)
head(x)
```

Assume there is a equally-weighted portfolio of stocks from the indexes that appears in object `x`.

```{r}
# weights
w <- rep(0.25, 4)

pnl <- tibble::tibble(
  base_pnl = as.double(x %*% w)
)
```

The main statistics of the P&L can be seen with `empirical_stats()`:

```{r}
empirical_stats(pnl)
```

The big question here is: **how would the P&L statistics change in response to a massive *sudden* sell-off?**

To address this question we follow [*A New Breed for Copulas for Risk and Portfolio Management*](https://papers.ssrn.com/sol3/papers.cfm?abstract_id=1752702) and model the market as a mixture of "calm" vs. "panic" distributions. For details on the full specification of this market, please, see the reference above.

```{r}
# For the details on how the market is modeled, please, see the paper: 
# "A New Breed for Copulas for Risk and Portfolio Management"
panic <- panic_copula(x, n = 50000, panic_cor = 0.97, panic_prob = 0.02, dist = "normal")
calm  <- panic_copula(x, n = 50000, panic_cor = 0.00, panic_prob = 0.00, dist = "normal")
```

We simulate `50.000` scenarios that matches the normal distribution *exactly*, with the sample counterparts of $\hat{\mu}$ and $\hat{\sigma}$.

In the first scenario we assume there is a `2%` probability of panic, in which *all* the cross-correlations are set equal to `0.97`:

```{r, echo=FALSE}
co <- matrix(0.97, 4, 4)
rownames(co) <- colnames(EuStockMarkets)
colnames(co) <- colnames(EuStockMarkets)
diag(co) <- 1
co
```

We also model a "calm" scenario without changing the historical correlation structure.

For consistency, we continue with an equal-weight strategy for both simulations:

```{r}
# Equal-Weight Portfolio Under the Panic Market
pnl_panic <- tibble::tibble(
  pnl_panic = as.matrix(panic$simulation) %*% w
)

# Equal-Weight Portfolio Under the Calm Market
pnl_calm <- tibble::tibble(
  pnl_calm = as.matrix(calm$simulation) %*% w
)
```

The "panic" P&L can be seen with `plot_panic_distribution()`:

```{r, fig.align='center', fig.height=4, fig.width=7}
# PnL under the Panic Regime
plot_panic_distribution(pnl_panic, panic$p, breaks = 200)
```

The new marginal distribution shows a hump shape format around `-2%`, which is a direct consequence of the panic being instated. Nevertheless, the location and dispersion parameters still matches the sample counterparts. *The panic is hidden*!

The full picture - with the similarities and differences - among these markets regimes can be seen with help of `ggplot2`:

```{r, fig.align='center', fig.height=4, fig.width=7}
stats_panic <- empirical_stats(pnl_panic)
stats_calm  <- empirical_stats(pnl_calm)

bind_rows(stats_panic, stats_calm) |> 
  ggplot2::ggplot(ggplot2::aes(x = stat, y = value, fill = name)) + 
  ggplot2::geom_col(position = "dodge") +
  ggplot2::facet_wrap(~ stat, scales = "free") + 
  ggplot2::labs(x = NULL, y = NULL, fill = "regime") + 
  ggplot2::scale_fill_viridis_d()
```

While the location and dispersion doesn't change, all the other metrics are twisted for markets that operate under dual market rules. The objects `stats_panic` and `stats_calm` imply that a 2% probability of panic increases the kurtosis by 6% and VaR and CVaR by 10%.