R/loss_Es_VaR.R

In 3schwartz/SpecialeScrAndFun: Script and functions used for master thesis.

#' loss_Es_VaR
#'
#' @description Calculate VaR and ES for losses and return plots
#'
#' @param riskFactorChange Risk factor change
#' @param name Name used for saving and plot
#' @param height Height of saved file
#' @param outputFig output dir
#' @param width Width of saved file
#'
#' @return Only saves files
#' @export
#'
loss_Es_VaR <- function(riskFactorChange = NULL,
                        # Price,
                        name = NULL,
                        width = 8, height = 6,
                        outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/")) {
B <- 1000

if(!is.null(riskFactorChange)) {
  L <- matrix(as.numeric(- riskFactorChange[-1]),
              dimnames = list(as.character(zoo::index(riskFactorChange[-1])),
                              "loss"))
} else {
  th <- 2
  set.seed(271)
  L <- rPar(n, shape = th)
}

alpha <- 0.99
VaR. <- VaR_np(L, level = alpha)
ES.  <-  ES_np(L, level = alpha, verbose = TRUE)

pdf(file = paste0(outputFig, "VaRESalpha_",name,".pdf"),
    width = width, height = height)
plot(L, xaxt = "n", ylab = c("Loss"), xlab = "",
     main = bquote(atop(~widehat(VaR)[alpha]~"and"~widehat(ES)[alpha]~ " for "~ alpha~"="~.(alpha),
                        .(name))))
abline(h = c(VaR., ES.), lty = 2, col = c("royalblue3", "maroon3"))
legend("bottomleft", bty = "n", lwd = c(2,2),
       lty = c("dashed", "dashed"),
       col = c("royalblue3", "maroon3"),
       legend = c(
         expression(widehat(VaR)[alpha]),
         expression(widehat(ES)[alpha])),
       cex = 1)
if(!is.null(riskFactorChange)) {
  axis(1, at=1:nrow(L), labels=rownames(L))
  title(xlab = c("Time"))
} else {title(xlab = c("Index"))}
dev.off()

## Compute the nonparametric VaR_alpha and ES_alpha estimators as functions of alpha
alpha <- 1-10^-seq(0.5, 5, by = 0.05)
stopifnot(0 < alpha, alpha < 1)
VaR. <- VaR_np(L, level = alpha)
ES.  <-  ES_np(L, level = alpha, verbose = TRUE)

## Bootstrap the VaR estimator
set.seed(271)
VaR.boot <- bootstrap(L[,"loss"], B = B, level = alpha)
stopifnot(all(!is.na(VaR.boot)))

## Compute statistics
VaR.boot.    <- rowMeans(VaR.boot)
VaR.boot.var <- apply(VaR.boot, 1, var)
VaR.boot.CI  <- apply(VaR.boot, 1, CI)

## Bootstrap the ES estimator
set.seed(271)
system.time(ES.boot <- bootstrap(L[,"loss"], B = B, level = alpha, method = "ES"))

## Investigate appearing NaNs (due to too few losses exceeding hat(VaR)_alpha)
isNaN <- is.nan(ES.boot)

## Plot % of NaN
pdf(file = paste0(outputFig, "numberOfNaN_ES_",name,".pdf"),
    width = width, height = height)
percNaN <- 100 * apply(isNaN, 1, mean) # % of NaNs for all alpha
plot(1-alpha, percNaN, type = "l", log = "x",
     xlab = expression(1-alpha), ylab = expression("% of NaN when estimating "~ES[alpha]),
     main = name)
dev.off()

## Compute statistics with NaNs removed
na.rm <- TRUE
ES.boot.    <- rowMeans(ES.boot, na.rm = na.rm)
ES.boot.var <- apply(ES.boot, 1, var, na.rm = na.rm)
ES.boot.CI  <- apply(ES.boot, 1, CI, na.rm = na.rm)

pdf(file = paste0(outputFig, "VaRESBootAlpha_",name,".pdf"),
    width = width, height = height)
ran <- range(VaR.,
             VaR.boot.,
             VaR.boot.var,
             VaR.boot.CI,
             ES., ES.boot., ES.boot.var, ES.boot.CI, na.rm = TRUE)
## VaR_alpha
plot(1-alpha, VaR., type = "l", log = "xy", xaxt = "n", yaxt = "n",
     ylim = ran, xlab = expression(1-alpha), ylab = "", lty = "solid",
     lwd = 2, col = "royalblue3", main = name)
lines(1-alpha, VaR.boot., lty = "dashed", col = "royalblue3")
lines(1-alpha, VaR.boot.var, lty = "dotdash", lwd = 1.4, col = "royalblue3")
lines(1-alpha, VaR.boot.CI[1,], lty = "dotted", col = "royalblue3")
lines(1-alpha, VaR.boot.CI[2,], lty = "dotted", col = "royalblue3")
## ES_alpha
lines(1-alpha, ES., lwd = 2, col = "maroon3", lty = "solid")
lines(1-alpha, ES.boot., lty = "dashed", col = "maroon3")
lines(1-alpha, ES.boot.var, lty = "dotdash", lwd = 1.4, col = "maroon3")
lines(1-alpha, ES.boot.CI[1,], lty = "dotted", col = "maroon3")
lines(1-alpha, ES.boot.CI[2,], lty = "dotted", col = "maroon3")
sfsmisc::eaxis(1)
sfsmisc::eaxis(2)
legend("bottomleft", bty = "n", lwd = rep(c(2, 1, 1.4, 1), 2),
       lty = rep(c("solid", "dashed", "dotdash", "dotted"), times = 2),
       col = rep(c("royalblue3", "maroon3"), each = 4),
       legend = c(
         expression(widehat(VaR)[alpha]),
         expression("Bootstrapped"~~widehat(VaR)[alpha]),
         expression("Bootstrapped"~~Var(widehat(VaR)[alpha])),
         "Bootstrapped 95% CIs",
         expression(widehat(ES)[alpha]),
         expression("Bootstrapped"~~widehat(ES)[alpha]),
         expression("Bootstrapped"~~Var(widehat(ES)[alpha])),
         "Bootstrapped 95% CIs"),
       cex = 0.7)
dev.off()
}