# R/helpers-sstModel-computation.R In sstModel: Swiss Solvency Test (SST) Standard Models

#### Documented in aggregateRisksexpectedShortfallvalueAtRiskvolaToExpectedShortfall

```#' Compute the Expected Shortfall
#'
#' @description function to compute the alpha-Expected Shortfall of a vector.
#'
#' @param x a numeric vector. The vector from which to compute the expected shortfall.
#' @param alpha a numeric value. The alpha-Expected Shortfall, must take values
#'   between 0 and 1. Please note that \code{alpha} represents the mass lying below the \code{alpha}
#'   quantile of \code{x} in the case \code{sup = FALSE} or the mass lying above the \code{1-alpha}
#'   quantile of \code{x} in the other case \code{sup = TRUE}
#' @param sup a logical value. If \code{TRUE} the function returns the upper
#' expected shortfall and otherwise the lower. Default is set to \code{FALSE}.
#'
#' @return a numeric value. The expected shortfall.
#'
#' @note Please consider that we include the boundary value into the empirical mean estimation.
#'
#' @export
expectedShortfall <- function(x, alpha = 0.01, sup = F, ...) {

# PUBLIC FUNCTION.

if (alpha <= 0 | alpha >= 1) {
stop("alpha must take values in ]0, 1[.")
}

if (sup) {
return(mean(x[x >= stats::quantile(x = x, probs = alpha, type = 1)]))
} else {
return(mean(x[x <= stats::quantile(x = x, probs = alpha, type = 1)]))
}
}

#' Compute the Value-at-Risk
#'
#' @description function to compute the alpha-Value-at-Risk of a vector.
#'
#' @param x a numeric vector. The vector from which to compute the value-at-risk.
#' @param alpha numeric value, the alpha-Value-at-Risk, must take values
#'   between 0 and 1. Please note that we consider value-at-risk here to be equivalent
#'   to the alpha-quantiles of \code{x}.
#'
#' @return a numeric value. The value-at-risk.
#'
#' @export
valueAtRisk <- function(x, alpha = 0.005) {

# PUBLIC FUNCTION.

if (alpha <= 0 | alpha >= 1) {
stop("alpha must take values in ]0, 1[.")
}

return(stats::quantile(x = x, probs = alpha, type = 1))
}

#' Transform normal volatility in expected shortfall
#'
#' @description function to compute expected shortfall from volatility for
#'   normal random variables.
#'
#' @param x a numeric vector of positive volatilities.
#' @param alpha a numeric value. The alpha-Expected Shortfall, must take values
#'   between 0 and 1.
#' @param sup a logical value. If \code{TRUE} the function returns the upper
#' expected shortfall and otherwise the lower. Default is set to \code{FALSE}.
#'
#' @return a numeric vector, the expected shortfalls.
#'
#' @export
volaToExpectedShortfall <- function(x, alpha = 0.01, sup = F, ...) {

# PUBLIC FUNCTION.

if (any(x < 0)) {
stop("Invalid volatilities, see ?volaToExpectedShortfall.")
}

if (length(alpha) != 1 || !is.numeric(alpha)) {
stop("alpha must be a numeric value, see ?volaToExpectedShortfall.")
}

if (alpha <= 0 | alpha >= 1) {
stop("alpha must take values in ]0, 1[.")
}

if (sup) {
return(x*stats::dnorm(stats::qnorm(1 - alpha))/(alpha))
} else {
return(-x*stats::dnorm(stats::qnorm(1 - alpha))/(alpha))
}
}

#' Risk Aggregation Helper
#'
#' @description This function aggregates market, life, health
#'   and nonLife insurance risks using a simple or conditional reordering
#'   scheme based on Gaussian copulas.
#'
#' @param risks data.table object.
#' @param model sstModel S3 object.
#'
#' @return None (used for side-effects).
aggregateRisks <- function(risks, model) {

# PRIVATE FUNCTION.

# NOTE: modifying order of market risk here has an influence
# on aggregation, see if (length(risk.names) > 1) /!\
risk.names <- c()
namesDT <- c()

if ("marketRisk" %in% names(risks)) {
risk.names <- c(risk.names, "market")
namesDT <- c(namesDT, "marketRisk")
} else {
stop("Missing marketRisk, see ?sstModel.")
}

if ("lifeRisk" %in% names(risks)) {
risk.names <- c(risk.names, "life")
namesDT <- c(namesDT, "lifeRisk")
}

if ("healthRisk" %in% names(risks)) {
risk.names <- c(risk.names, "health")
namesDT <- c(namesDT, "healthRisk")
}

if ("nonLifeRisk" %in% names(risks)) {
risk.names <- c(risk.names, "nonlife")
namesDT <- c(namesDT, "nonLifeRisk")
}

n.sim <- nrow(risks)

# in case more than one risk is considered
if (length(risk.names) > 1) {
# generate the reordering uniform quantiles
ranks <- conditionalReordering(n                       = n.sim,
list.correlation.matrix = model\$reordering.parameters\$list.correlation.matrix,
name                    = risk.names,
scenario.probability    = model\$reordering.parameters\$scenario.probability,
region.boundaries       = model\$reordering.parameters\$region.boundaries,
region.probability      = model\$reordering.parameters\$region.probability)

# obtain the ranks from the reordering uniform quantiles
risks[,eval(parse(text = paste("c('",
paste(risk.names,
collapse = "', '"),
"') := list(",
paste("data.table::frank(ranks[,'",
names(ranks),
"'], ties.method = 'first')",
sep = "",
collapse = ", "),
")",
sep = "")), envir = .SD)]

rm(ranks)
gc()

# if participation is present, comonotonic aggregation with market
if (!is.null(model\$participation.risk)) {

# aggregate participation with marketRisk (comonotone aggregation rank by rank)
risks[,marketParticipationRisk := sort(marketRisk) + sort(participation)]

# reordering expressions for marketParticipationRisk and insuranceRisks,
# i.e. potentially lifeRisk, healthRisk and nonLifeRisk
reord.expr <- paste("(sort(`",
c("marketParticipationRisk",
namesDT[-1]),
"`, decreasing = F))[`",
risk.names,
"`]", sep = "")

# standalone risks reordering
risks[,eval(parse(text = paste("c('",
paste(c("marketParticipationRisk",
namesDT[-1]),
collapse = "', '"),
"') := list(",
paste(reord.expr,
collapse = ", "),
")",
sep = "")), envir = .SD)]

# insurance risks aggregation
risks[,eval(parse(text = paste("insuranceRisk := ",
paste(namesDT[-1],
collapse = " + "),
sep = "")), envir = .SD)]

# creating drbc
risks[, drbc := marketParticipationRisk + insuranceRisk]

} else {

# reordering expressions for marketRisk
# and potentially lifeRisk, healthRisk and nonLifeRisk
reord.expr <- paste("(sort(`",
namesDT,
"`, decreasing = F))[`",
risk.names,
"`]", sep = "")

# standalone insurance risks reordering
risks[,eval(parse(text = paste("c('",
paste(namesDT[-1],
collapse = "', '"),
"') := list(",
paste(reord.expr[-1],
collapse = ", "),
")",
sep = "")), envir = .SD)]

# insurance risks aggregation
risks[,eval(parse(text = paste("insuranceRisk := ",
paste(namesDT[-1],
collapse = " + "),
sep = "")), envir = .SD)]

# adding reordered marketRisk to insuranceRisk
risks[,eval(parse(text = paste("drbc :=",
reord.expr[1],
" + insuranceRisk", sep = "")), envir = .SD)]

}

} else {

if (!is.null(model\$portfolio\$participation.item)) {

# aggregate participation with marketRisk (comonotone aggregation rank by rank)
risks[, marketParticipationRisk := sort(marketRisk) + sort(participation)]

# creating drbc
risks[, drbc := marketParticipationRisk]

} else {

# no need to reorder because only market risk
risks[, drbc := marketRisk]

}

}

risks[, drbc := drbc +
model\$portfolio\$portfolio.parameters\$rtkr -
model\$portfolio\$portfolio.parameters\$rtkg]

# remove for efficiency unwanted columns
for (risk in risk.names) {
risks[,eval(parse(text = paste0("risks[, ",
risk, " := NULL]")),
envir = .SD)]
}

gc()
}
```

## Try the sstModel package in your browser

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

sstModel documentation built on May 4, 2018, 1:04 a.m.