Tests on the Value at Risk

Author

Affiliation

Beniamino Sartini

University of Bologna

library(dplyr)
library(latex2exp)
library(backports)
library(ggplot2)
library(knitr)

Let’s consider a Gaussian AR(2)-GARCH(1,2) model defined as: \[ \begin{aligned} & {} x_t = \mu + \phi_1 x_{t-1} + \phi_2 x_{t-2} + e_t \text{,}\\ & e_t = \sigma_t u_t \text{,} \\ & \sigma_t^2 = \omega + \alpha_1 e_{t-1}^{2} + \beta_1 \sigma_{t-1}^{2} + \beta_2 \sigma_{t-2}^{2} \text{.} \end{aligned} \] The Value at Risk (VaR) at a confidence level \(\alpha\) is time dependent and implicitly defined as: \[ \mathbb{P}\{X_t \le \text{VaR}_{t|t-1}^{\alpha}|I_{t-1}) = \alpha \text{.} \] The distribution of \(x_t\) is normal with conditional moments given by: \[ \begin{cases} \mathbb{E}\{X_t|I_{t-1}\} = \mu + \phi_1 x_{t-1} + \phi_2 x_{t-1} \\ \mathbb{V}\{X_t|I_{t-1}\} = \omega + \alpha_1 e_{t-1}^{2} + \beta_1 \sigma_{t-1}^{2} + \beta_2 \sigma_{t-2}^{2} \end{cases} \] Hence, given the quantile of a standard normal, namely \(q^{\alpha}\) the Value at Risk can be simply computed as: \[ \text{VaR}_{t|t-1}^{\alpha} = \mathbb{E}\{X_t|I_{t-1}\} + q^{\alpha} \sqrt{\mathbb{V}\{X_t|I_{t-1}\}} \text{.} \]

1 Test on the number of violations

Let’s define a violation of the \(\text{VaR}_{t|t-1}^{\alpha}\) as \[ v_t = \mathbb{1}_{[x_t \le \text{VaR}_{t|t-1}^{\alpha}]} \sim \text{Bernoulli}(\alpha) \text{,} \]

and let’s define the number of violations of the conditional VaR as follows, i.e. \[ N_t = \sum_{i = 1}^{t} v_i \text{.} \]

1.1 Asymptotic variance

Applying the central limit theorem (CLT) it is possible to prove that the statistic test converges in distribution to a standard normal, i.e. \[ NV_1 = \frac{1}{\sqrt{t}} \sum_{i = 1}^{t} \left(\frac{v_i - \alpha}{\sqrt{\alpha(1-\alpha)}} \right) \underset{n\to\infty}{\overset{d}{\longrightarrow}} \mathcal{N}(0, 1) \text{.} \] Hence, given the null hypothesis \(H_0: \mathbb{P}\{X_t \le \text{VaR}_{t|t-1}^{\alpha}|I_{t-1}) = \alpha\), that is equivalent to \(\mathbb{E}\{e_t\} = \alpha\) we define the critical values at a confidence level \(\alpha^{\ast}\) as \[ \begin{align} \alpha & = \mathbb{P}\{|NV_1| > t_{\alpha^{\ast}/2}\} \\ \Updownarrow & \\ t_{\alpha^{\ast}/2} & = \mathbb{P}^{-1}\{\mathbb{P}\{|NV_1| > t_{\alpha^{\ast}/2}\}\} \end{align} \]

where \(\mathbb{P}\) and \(\mathbb{P}^{-1}\) are respectively the distribution and the quantile of a standard normal. Therefore, the null hypothesis is rejected at a confidence level \(\alpha^{\ast}\) if: \[ \begin{cases} [NV_1 < -t_{\alpha^{\ast}/2}] \cup [NV_1 > t_{\alpha^{\ast}/2}] \quad H_0 \text{ rejected} \\ [-t_{\alpha^{\ast}/2} < NV_1 < t_{\alpha^{\ast}/2}] \quad\quad\quad\quad\;\; H_0 \text{ non rejected} \end{cases} \]

1.2 Empirical variance

Instead of using the theoretical variance of \(e_t\), namely \(\alpha(1-\alpha)\), let’s substitute it with the empirical one, i.e. \[ \alpha(1-\alpha) \longrightarrow \frac{N_t}{t} \left(1 - \frac{N_t}{t} \right) \text{.} \] Hence, the new statistic test \(NV_2\) converges to \(NV_1\) in probability, therefore also in distribution, i.e.  \[ NV_2 = \frac{1}{\sqrt{t}} \sum_{i = 1}^{t} \left(\frac{v_i - \alpha}{\sqrt{\frac{N_t}{t} \left(1 - \frac{N_t}{t} \right)}} \right) \underset{n\to\infty}{\overset{p}{\longrightarrow}} NV_1 \underset{n\to\infty}{\overset{d}{\longrightarrow}} \mathcal{N}(0, 1) \text{.} \]

For small samples, the following relation between the two statistics should be used: \[ NV_2 = \frac{\sqrt{\alpha(1-\alpha)}}{\sqrt{\frac{N_t}{t} \left(1 - \frac{N_t}{t} \right)}} NV_1 \text{.} \]

2 Example: \(H_0\) is not rejected

Instead of simulating exactly \(u_t \sim \mathcal{N}(0, 1)\), let’s simulate residuals that are close to the normal distribution, i.e. \(u_t \sim \mathcal{t}(25)\).

# ===================== Setups ======================
set.seed(1)   # random seed 
ci <- 0.05    # confidence level 
t_bar <- 5000 # number of simulations 
# parameters
parAR <- c(mu=0.5, phi1 = 0.34, phi1 = 0.14)
parGARCH <- c(omega=0.4, alpha1=0.25, 
              beta1=0.25, beta2=0.15) 
# long-term std deviation of residuals 
sigma_eps <- sqrt(parGARCH[1]/(1-sum(parGARCH[-1])))
# ================== Simulation =====================
# Initial points
Xt <- rep(parAR[1]/(1-sum(parAR[-1])), 3)
sigma <- rep(sigma_eps, 3)
# Simulated residuals 
eps <- rt(t_bar, 25)
eps[1:3] = eps[1:3]*sigma_eps
# Value at Risk
q_alpha = qnorm(ci)
VaR = c(0)
for(t in 3:t_bar){
  # AR component 
  Xt[t] <- parAR[1] + parAR[2]*Xt[t-1] + parAR[3]*Xt[t-2]
  # ARCH component 
  sigma[t] <- parGARCH[1] + parGARCH[2]*eps[t-1]^2 
  # GARCH component 
  sigma[t] <- sigma[t] + parGARCH[3]*sigma[t-1]^2 + parGARCH[4]*sigma[t-2]^2
  sigma[t] <- sqrt(sigma[t])
  # Simulated residuals 
  eps[t] <- sigma[t]*eps[t]
  # Simulated value at risk
  VaR[t] <- Xt[t] + sigma[t]*q_alpha
  # Simulated time series 
  Xt[t] <- Xt[t] + eps[t]
}
# ===================== Plot ======================
# GARCH(1,1) simulation
ggplot()+
  geom_line(aes(1:t_bar, Xt), size = 0.2)+
  geom_line(aes(1:t_bar, VaR), size = 0.2, color = "red")+
  theme_bw()+
  labs(x = NULL, y = TeX("$X_t$"),
       subtitle = TeX(paste0("$\\mu:\\;", parAR[1], 
                             "\\;\\; \\phi_{1}:\\;", parAR[2],
                             "\\;\\; \\phi_{2}:\\;", parAR[3],
                             "\\;\\; \\omega:\\;", parGARCH[1], 
                             "\\;\\; \\alpha_{1}:\\;", parGARCH[2],
                             "\\;\\; \\beta_{1}:\\;", parGARCH[3],
                             "\\;\\; \\beta_{2}:\\;", parGARCH[4],
                             "$")))

Figure 1: AR(2)-GARCH(1,2) simulation with theoric (red) VaR at \(\alpha = 0.05\).

# ======================================
# Violation of the VaR
vt <- ifelse(Xt < VaR, 1, 0)
vt[1:3] <- 0
# Theoric variance
v_theoric <- ci*(1-ci)
# Empiric variance
v_empiric <- (sum(vt)/t_bar)*(1 - sum(vt)/t_bar)
# Standardized number of violations
Nt <- sum((vt - ci)/sqrt(v_theoric))
# Statistic test (NV_1)
NV1 <- (1/sqrt(t_bar))*Nt
# Statistic test (NV_2)
NV2 <- (sqrt(v_theoric)/sqrt(v_empiric))*NV1
# Rejection level 
t_alpha <- qnorm(ci/2)
# =============== Kable =============== 
kab <- dplyr::tibble(
  n = t_bar,
  alpha = paste0(format(ci*100, digits = 3), "%"),
  alpha_hat = paste0(format(sum(vt)/t_bar*100, digits = 3), "%"),
  t_alpha_dw = t_alpha,
  NV1 = NV1,
  NV2 = NV2,
  t_alpha_up = -t_alpha,
  H01 = ifelse(NV1 > t_alpha_up | NV1 < t_alpha_dw, "Rejected", "Non-Rejected"),
  H02 = ifelse(NV2 > t_alpha_up | NV2 < t_alpha_dw, "Rejected", "Non-Rejected")
)  %>%
  dplyr::mutate_if(is.numeric, format, digits = 4, scientific = FALSE)
colnames(kab) <- c("$$n$$", "$$\\alpha$$", "$$\\frac{N_n}{n}$$", "$$-t_{\\alpha/2}$$", 
                   "$$NV_1$$", "$$NV_2$$", "$$t_{\\alpha/2}$$", "$$H_0(NV_1)$$", "$$H_0(NV_2)$$")
knitr::kable(kab, booktabs = TRUE ,escape = FALSE, align = 'c')%>%
  kableExtra::row_spec(0, color = "white", background = "green") 

Table 1: Test for a Student-\(t\) with 25 degrees of freedom at \(\alpha^{\ast} = 0.05\) on the number of violations of the theoric VaR at \(\alpha = 0.05\).

$$n$$	$$\alpha$$	$$\frac{N_n}{n}$$	$$-t_{\alpha/2}$$	$$NV_1$$	$$NV_2$$	$$t_{\alpha/2}$$	$$H_0(NV_1)$$	$$H_0(NV_2)$$
5000	5%	5.6%	-1.96	1.947	1.845	1.96	Non-Rejected	Non-Rejected

3 Example: \(H_0\) is rejected

Instead of simulating exactly \(u_t \sim \mathcal{N}(0, 1)\), let’s simulate residuals that are not close to the normal distribution, i.e. \(u_t \sim \mathcal{t}(5)\).

# ==================== Setups =====================
set.seed(1)   # random seed 
ci <- 0.05    # confidence level 
t_bar <- 1000 # number of simulations 
# parameters
parAR <- c(mu=0.5, phi1 = 0.34, phi1 = 0.14)
parGARCH <- c(omega=0.4, alpha1=0.25,
              beta1=0.25, beta2=0.15) 
# quasi long-term std deviation of residuals 
sigma_eps <- sqrt(parGARCH[1]/(1-sum(parGARCH[-1])))
# ================== Simulation ===================
set.seed(1)
# Initial points
Xt <- rep(parAR[1]/(1-sum(parAR[-1])), 3)
mu <- rep(parAR[1]/(1-sum(parAR[-1])), 3)
sigma <- rep(sigma_eps, 3)
# Simulated residuals 
eps <- rt(t_bar, 5) 
eps[1:3] <- eps[1:3]*sigma_eps
# Value at Risk
q_alpha = qnorm(ci)
VaR = c(0)
for(t in 3:t_bar){
  # AR component 
  mu[t] <- parAR[1] + parAR[2]*Xt[t-1] + parAR[3]*Xt[t-2]
  # ARCH component 
  sigma[t] <- parGARCH[1] + parGARCH[2]*eps[t-1]^2 
  # GARCH component 
  sigma[t] <- sigma[t] + parGARCH[3]*sigma[t-1]^2 + parGARCH[4]*sigma[t-2]^2
  sigma[t] <- sqrt(sigma[t])
  # Simulated residuals 
  eps[t] <- sigma[t]*eps[t]
  # Simulated value at risk
  VaR[t] <- mu[t] + sigma[t]*q_alpha
  # Simulated time series 
  Xt[t] <- mu[t] + eps[t]
}
# Empirical quantile 
q_alpha_emp <- quantile(eps/sigma, probs = ci)
VaR_emp <- mu + sigma*q_alpha_emp

# ===================== Plot ======================
# GARCH(1,1) simulation
ggplot()+
  geom_line(aes(1:t_bar, Xt), size = 0.2)+
  geom_line(aes(1:t_bar, VaR), size = 0.2, color = "red")+
  geom_line(aes(1:t_bar, VaR_emp), size = 0.2, color = "blue")+
  theme_bw()+
  labs(x = NULL, y = TeX("$X_t$"),
       subtitle = TeX(paste0("$\\mu:\\;", parAR[1], 
                             "\\;\\; \\phi_{1}:\\;", parAR[2],
                             "\\;\\; \\phi_{2}:\\;", parAR[3],
                             "\\;\\; \\omega:\\;", parGARCH[1], 
                             "\\;\\; \\alpha_{1}:\\;", parGARCH[2],
                             "\\;\\; \\beta_{1}:\\;", parGARCH[3],
                             "\\;\\; \\beta_{2}:\\;", parGARCH[4],
                             "$")))

Figure 2: AR(2)-GARCH(1,2) simulation with theoric (red) and empirical (blue) VaR at \(\alpha = 0.05\).

Computing the test on the normal quantile gives a rejection of the null hypothesis \(H_0\), i.e. the deviation from the VaR is not stochastic and it is not an adequate measure of risk.

# ======================================
# Violation of the VaR
vt <- ifelse(Xt < VaR, 1, 0)
vt[1:3] <- 0
# Theoric variance
v_theoric <- ci*(1-ci)
# Empiric variance
v_empiric <- (sum(vt)/t_bar)*(1 - sum(vt)/t_bar)
# Standardized number of violations
Nt <- sum((vt - ci)/sqrt(v_theoric))
# Statistic test (NV_1)
NV1 <- (1/sqrt(t_bar))*Nt
# Statistic test (NV_2)
NV2 <- (sqrt(v_theoric)/sqrt(v_empiric))*NV1
# Rejection level 
t_alpha <- qnorm(ci/2)
# =============== Kable =============== 
kab <- dplyr::tibble(
  n = t_bar,
  alpha = paste0(format(ci*100, digits = 3), "%"),
  alpha_hat = paste0(format(sum(vt)/t_bar*100, digits = 3), "%"),
  t_alpha_dw = t_alpha,
  NV1 = NV1,
  NV2 = NV2,
  t_alpha_up = -t_alpha,
  H01 = ifelse(NV1 > t_alpha_up | NV1 < t_alpha_dw, "Rejected", "Non-Rejected"),
  H02 = ifelse(NV2 > t_alpha_up | NV2 < t_alpha_dw, "Rejected", "Non-Rejected")
)  %>%
  dplyr::mutate_if(is.numeric, format, digits = 4, scientific = FALSE)
colnames(kab) <- c("$$n$$", "$$\\alpha$$", "$$\\frac{N_n}{n}$$", "$$-t_{\\alpha/2}$$", 
                   "$$NV_1$$", "$$NV_2$$", "$$t_{\\alpha/2}$$", "$$H_0(NV_1)$$", "$$H_0(NV_2)$$")
knitr::kable(kab, booktabs = TRUE ,escape = FALSE, align = 'c')%>%
  kableExtra::row_spec(0, color = "white", background = "green") 

Table 2: Test for a Student-\(t\) with 5 degrees of freedom at \(\alpha^{\ast} = 0.05\) on the number of violations of the theoric VaR at \(\alpha = 0.05\).

$$n$$	$$\alpha$$	$$\frac{N_n}{n}$$	$$-t_{\alpha/2}$$	$$NV_1$$	$$NV_2$$	$$t_{\alpha/2}$$	$$H_0(NV_1)$$	$$H_0(NV_2)$$
1000	5%	8.5%	-1.96	5.078	3.969	1.96	Rejected	Rejected

Setting \(\alpha = 0.05\) we obtain an empiric \(\hat{q}_{\alpha}\) equal to -2.07 different from the theoric one of -1.6449.

4 VaR for \({\color{orange}{\text{BTC}}}\)

From the series of close prices \(P_t\), let’s compute the log-returns as: \[ R_t = \log\left(\frac{P_t}{P_{t-1}} \right) = \log(P_t) - \log(P_{t-1}) \] Then, we fit a GARCH(2,3) on the log-returns, i.e. \[ \begin{aligned} & {} x_t = \mu + e_t \\ & e_t = \sigma_t u_t \\ & \sigma_t^{2} = \omega + \sum_{i=1}^{2} \alpha_i e_{t-i}^2 + \sum_{j=1}^{3} \beta_j \sigma_{t-j}^2 \end{aligned} \] under the assumption of \(u_t \sim \mathcal{N}(0,1)\).

library(rugarch)
ci <- 0.05    # confidence level 
# library(binancer) download prices 
load("../../../databases/data/temporary/crypto_prices.RData")
#btcusdt <- binancer::binance_klines("BTCUSDT", api = "spot", interval = "1d", 
#                                    from = "2018-01-01", to = Sys.Date()) 
# log close prices
btcusdt$log_Pt <- log(btcusdt$close)
# log returns 
btcusdt$Rt <- c(0, diff(btcusdt$log_Pt))
# In sample estimate 
data <- dplyr::filter(btcusdt, date <= as.POSIXct("2024-01-01"))
# Test 
data_test <- dplyr::filter(btcusdt, date >= as.POSIXct("2023-12-01"))

# GARCH Model
# Variance specification
GARCH_spec <- rugarch::ugarchspec(
    variance.model = list(model = "sGARCH", garchOrder = c(2,3), external.regressors = NULL),
    mean.model = list(armaOrder = c(0,0), include.mean = FALSE), distribution.model = "norm")
# Fitted model
GARCH_model <- rugarch::ugarchfit(data = data$Rt, spec = GARCH_spec, out.sample = 0)
# Fitted variance
data$sigma2 <- GARCH_model@fit$var
# Fitted standard deviation
data$sigma <- sqrt(data$sigma2)
# Standardized residuals
data$ut <- data$Rt/data$sigma

kab <- as_tibble(t(as_tibble(GARCH_model@fit$coef)))%>%
  dplyr::mutate_if(is.numeric, format, digits = 4, scientific = FALSE)
colnames(kab) <- c("$$\\omega$$", "$$\\alpha_1$$", "$$\\alpha_2$$", 
                   "$$\\beta_1$$", "$$\\beta_2$$", "$$\\beta_3$$")
knitr::kable(kab, booktabs = TRUE ,escape = FALSE, align = 'c')%>%
  kableExtra::row_spec(0, color = "white", background = "green") 

Table 3: Estimated GARCH(2,3) parameters on \({\color{orange}{\text{BTC}}}\) log-returns.

$$\omega$$	$$\alpha_1$$	$$\alpha_2$$	$$\beta_1$$	$$\beta_2$$	$$\beta_3$$
0.0001155	0.1929	0.00000009728	0.1843	0.00000004144	0.5573

ggplot(data)+
  geom_line(aes(date, sigma))+
  theme_bw()

Figure 3: GARCH(2,3) std. deviation of \({\color{orange}{\text{BTC}}}\) log-returns.

VaR <- qnorm(0.05)*data$sigma
VaR_emp <- quantile(data$ut, probs = 0.05)*data$sigma
ggplot(data)+
  geom_line(aes(date, Rt), size = 0.2)+
  geom_line(aes(date, VaR), color = "red")+
  geom_line(aes(date, VaR_emp), color = "blue", size = 0.2)+
  theme_bw()+
  labs(x = NULL, y = TeX("$R_t$"))

Figure 4: Empirical VaR (red) and theoric VaR (blue) at \(\alpha^{\ast} = 0.05\) for \({\color{orange}{\text{BTC}}}\) log-returns.

# ======================================
Xt <- data$Rt
t_bar <- nrow(data)
# Violation of the VaR
vt <- ifelse(Xt < VaR, 1, 0)
vt[1:3] <- 0
# Theoric variance
v_theoric <- ci*(1-ci)
# Empiric variance
v_empiric <- (sum(vt)/t_bar)*(1 - sum(vt)/t_bar)
# Standardized number of violations
Nt <- sum((vt - ci)/sqrt(v_theoric))
# Statistic test (NV_1)
NV1 <- (1/sqrt(t_bar))*Nt
# Statistic test (NV_2)
NV2 <- (sqrt(v_theoric)/sqrt(v_empiric))*NV1
# Rejection level 
t_alpha <- qnorm(ci/2)
# =============== Kable =============== 
kab <- dplyr::tibble(
  n = t_bar,
  alpha_hat = paste0(format(sum(vt)/t_bar*100, digits = 3), "%"),
  t_alpha_dw = t_alpha,
  NV1 = NV1,
  NV2 = NV2,
  t_alpha_up = -t_alpha,
  H01 = ifelse(NV1 > t_alpha_up | NV1 < t_alpha_dw, "Rejected", "Non-Rejected"),
  H02 = ifelse(NV2 > t_alpha_up | NV2 < t_alpha_dw, "Rejected", "Non-Rejected")
)  %>%
  dplyr::mutate_if(is.numeric, round, digits = 4)
colnames(kab) <- c("$$n$$", "$$\\frac{N_n}{n}$$", "$$-t_{\\alpha/2}$$", 
                   "$$NV_1$$", "$$NV_2$$", "$$t_{\\alpha/2}$$", "$$H_0(NV_1)$$", "$$H_0(NV_2)$$")
knitr::kable(kab, booktabs = TRUE ,escape = FALSE, align = 'c')%>%
  kableExtra::row_spec(0, color = "white", background = "green") 

Table 4: Test at \(\alpha^{\ast} = 0.05\) on the number of violations of the theoric VaR at \(\alpha = 0.05\) for log-returns of \({\color{orange}{\text{BTC}}}\).

$$n$$	$$\frac{N_n}{n}$$	$$-t_{\alpha/2}$$	$$NV_1$$	$$NV_2$$	$$t_{\alpha/2}$$	$$H_0(NV_1)$$	$$H_0(NV_2)$$
2193	4.38%	-1.96	-1.3374	-1.4247	1.96	Non-Rejected	Non-Rejected

# ==================== Setups =====================
set.seed(3959) # random seed 
parAR <- c(mu=0, phi1=0, phi2=0) # AR parameters
parGARCH <- GARCH_model@fit$coef # GARCH parameters
# long-term std deviation of residuals 
sigma_eps <- sqrt(parGARCH[1]/(1-sum(parGARCH[-1])))
# ================== Simulation ===================
# Initial points
Xt <- data_test$Rt
# number of simulations 
t_bar <- length(Xt)
mu <- rep(parAR[1]/(1-sum(parAR[-1])), 4)
sigma <- rep(sigma_eps, 4)
# Simulated residuals 
eps <- rnorm(t_bar) 
eps[1:4] = eps[1:4]*sigma[1]
# Value at Risk
q_alpha = qnorm(ci)
VaR = c(0)
for(t in 4:t_bar){
  # AR component 
  mu[t] <- parAR[1] + parAR[2]*Xt[t-1] + parAR[3]*Xt[t-2]
  # ARCH component 
  sigma[t] <- parGARCH[1] + parGARCH[2]*eps[t-1]^2 + parGARCH[3]*eps[t-2]^2 
  # GARCH component 
  sigma[t] <- sigma[t] + parGARCH[4]*sigma[t-1]^2 + parGARCH[5]*sigma[t-2]^2 + parGARCH[6]*sigma[t-3]^2
  sigma[t] <- sqrt(sigma[t])
  # Simulated residuals 
  eps[t] <- sigma[t]*eps[t]
  # Simulated value at risk
  VaR[t] <- mu[t] + sigma[t]*q_alpha
  # Simulated time series 
  Xt[t] <- mu[t] + eps[t]
}
# Empirical quantile 
q_alpha_emp <- quantile(eps/sigma, probs = ci)
VaR_emp <- mu + sigma*q_alpha_emp

# ===================== Plot ======================
# GARCH(2,3) simulation
ggplot()+
  geom_line(aes(data_test$date, data_test$close[4]*cumprod(exp(Xt)), color = "sim"), size = 0.2)+
  geom_line(aes(data_test$date, data_test$close[4]*cumprod(exp(data_test$Rt)), color = "emp"), size = 0.2)+
  scale_color_manual(values = c(sim = "red", emp = "black"),
                     labels = c(sim = "Simulated", emp = "Empiric"))+
  theme_bw()+
  theme(legend.position = "top")+
  labs(x = NULL, y = "BTC-USDT", color = NULL)

Figure 5: \({\color{orange}{\text{BTC}}}\) under GARCH(2,3) model (red) and realized prices (black).