R/loss_functions.R

Defines functions gpl esr_loss

Documented in esr_loss gpl

#' @title Joint Quantile and Expected Shortfall Loss Function
#' @description Computes the joint (VaR, ES) loss
#' @param r Vector of returns
#' @param q Vector of quantiles
#' @param e Vector of expected shortfalls
#' @param alpha Probability level
#' @param g1 1, 2, see \link{G1_fun}
#' @param g2 1, 2, 3, 4, 5, see \link{G2_curly_fun}, \link{G2_fun}
#' @param return_mean If TRUE returns the average tick loss, else the individual values
#' @references Fissler and Ziegel (2016)
#' @export
esr_loss <- function(r, q, e, alpha, g1 = 2L, g2 = 1L, return_mean = TRUE) {
  G1_q <- G_vec(z = q, g = "G1", type = g1)
  G1_r <- G_vec(z = r, g = "G1", type = g1)
  G2_curly_e <- G_vec(z = e, g = "G2_curly", type = g2)
  G2_e <- G_vec(z = e, g = "G2", type = g2)

  loss <- ((r <= q) - alpha) * (G1_q - G1_r) +
    G2_e * (e - q + (q - r) * (r <= q)/alpha) - G2_curly_e

  if (return_mean) {
    mean(loss)
  } else {
    loss
  }
}

#' @title Generalized Piecewise Linear Loss Function
#' @description Equivalent to the tick / check loss when g is the identity function.
#' @param r Vector of returns
#' @param q Vector of quantiles
#' @param alpha Probability level
#' @param g A nondecreasing function
#' @param return_mean If TRUE returns the average tick loss, else the individual values
#' @references Gneiting (2011)
#' @export
gpl <- function(r, q, alpha, g = function(x) x, return_mean = TRUE) {
  loss <- (alpha - (r <= q)) * (g(r) - g(q))

  if (return_mean) {
    mean(loss)
  } else {
    loss
  }
}

Try the esreg package in your browser

Any scripts or data that you put into this service are public.

esreg documentation built on Aug. 22, 2017, 5:05 p.m.