Nothing
#' PPP_Model (Collective Panjer & Piecewise Pareto Model) Object
#'
#' @description Constructor function for the PPP_Model object
#'
#' @param FQ Numerical. Expected claim count of the collective model.
#' @param t Numeric vector. Vector containing the thresholds of the Piecewise Pareto distribution.
#' @param alpha Numeric vector. Vector containing the alphas of the Piecewise Pareto distribution.
#' @param truncation Numerical. If \code{truncation} is not \code{NULL} and \code{truncation > max(t)}, then the distribution is truncated at \code{truncation}.
#' @param truncation_type Character. If \code{truncation_type = "wd"} then the whole distribution is truncated. If \code{truncation_type = "lp"} then a truncated Pareto is used for the last piece.
#' @param dispersion Numerical. Dispersion of the Panjer distribution (i.e. variance to mean ratio).
#' @param Status Numerical indicator if a function returns a PPP_Model object: 0 = success, 1 = some information has been ignored, 2 = no solution found
#' @param Comment Charakter. An optional comment.
#' @examples
#' PPPM <- PPP_Model(2, c(1000,2000), c(1,2), dispersion = 2)
#' PPPM
#'
#' @export
PPP_Model <- function(FQ = NULL, t = NULL, alpha = NULL, truncation = NULL, truncation_type = "lp", dispersion = 1, Status = 0, Comment = "OK") {
#
obj <- list(FQ = FQ, t = t, alpha = alpha, truncation = truncation, truncation_type = truncation_type, dispersion = dispersion, Status = Status, Comment = Comment)
class(obj) <- "PPP_Model"
if (!is.valid.PPP_Model(obj)) {
obj <- list(FQ = NULL, t = NULL, alpha = NULL, truncation = NULL, truncation_type = "lp", dispersion = 1, Status = 2, Comment = is.valid.PPP_Model(obj, comment = TRUE))
class(obj) <- "PPP_Model"
}
return(obj)
}
#' Print a PPP_Model Object (Collective Panjer & Piecewise Pareto Model) Object
#'
#' @description Print method for PPP_Model objects
#'
#' @param x PPP_Model object.
#' @param ... Other arguments, all currently ignored.
#'
#' @export
print.PPP_Model <- function(x, ...) {
if (!is.positive.finite.number(x$dispersion)) {
fq_dist <- "Panjer"
} else if (x$dispersion == 1) {
fq_dist <- "Poisson"
} else if (x$dispersion > 1) {
fq_dist <- "Negative Binomial"
} else {
fq_dist <- "Binomial"
}
cat("\nPanjer & Piecewise Pareto model\n\n")
cat("Collective model with a ", fq_dist, " distribution for the claim count and a Piecewise Pareto distributed severity.", sep = "")
cat("\n\n", fq_dist, " Distribution:", sep = "")
cat("\nExpected Frequency: ", x$FQ, sep = "")
if (is.positive.finite.number(x$dispersion) && x$dispersion != 1) {
cat("\nDispersion: ", x$dispersion, sep = "")
if (is.positive.finite.number(x$FQ) && x$dispersion > 1) {
cat(" (i.e. contagion = ", (x$dispersion - 1)/x$FQ, ")", sep = "")
}
}
cat("\n\nPiecewise Pareto Distribution:")
cat("\nThresholds: ", x$t, sep = " ")
cat("\nAlphas: ", x$alpha, sep = " ")
if (!is.null(x$truncation)) {
cat("\nTruncation: ", x$truncation, sep = "")
cat("\nTruncation Type: '", x$truncation_type,"'", sep = "")
} else {
cat("\nThe distribution is not truncated.")
}
cat("\n\nStatus: ", x$Status)
cat("\nComments: ", x$Comment)
if (!is.valid.PPP_Model(x)) {
cat("\n\nThe model is not valid.\n")
cat(is.valid.PPP_Model(x, comment = TRUE))
}
cat("\n\n")
}
#' Check if an object is a PPP_Model
#'
#' @description Checks if the class of an object is 'PPP_Model'
#'
#' @param x Object to be checked.
#' @examples
#' PPPM <- PPP_Model(2, c(1000,2000), c(1,2), dispersion = 2)
#' PPPM
#' is.valid.PPP_Model(PPPM)
#'
#' PPPM$alpha <- 2
#' is.valid.PPP_Model(PPPM)
#' is.PPP_Model(PPPM)
#'
#' @export
is.PPP_Model <- function(x) {
if (inherits(x, "PPP_Model")) {
return(TRUE)
} else {
return(FALSE)
}
}
#' Check if an object is a valid PPP_Model
#'
#' @description Checks if an object is a PPP_Model object and whether it is valid for the use in functions like \code{Layer_Mean}
#'
#' @param x Object to be checked.
#' @param comment If FALSE then the function returns a boolean indicating whether \code{x} is a valid PPP_Model. If TRUE then the function returns a comment instead.
#' @examples
#' PPPM <- PPP_Model(2, c(1000,2000), c(1,2), dispersion = 2)
#' PPPM
#' is.valid.PPP_Model(PPPM)
#' is.valid.PPP_Model(PPPM, comment = TRUE)
#'
#' PPPM$alpha <- 2
#' is.valid.PPP_Model(PPPM)
#' is.valid.PPP_Model(PPPM, comment = TRUE)
#'
#' @export
is.valid.PPP_Model <- function(x, comment = FALSE) {
if (!inherits(x, "PPP_Model") || typeof(x) != "list") {
if (!comment) {
return(FALSE)
} else {
return("Object does not have class PPP_Model.")
}
}
required_elements <- c("FQ", "t", "alpha", "truncation", "truncation_type", "dispersion", "Status", "Comment")
available <- required_elements %in% names(x)
if (sum(!available) > 0) {
if (!comment) {
return(FALSE)
} else {
return(paste("Not all required list elements available. Missing elements:", paste(required_elements[!available], collapse = ", ")))
}
}
if (!is.nonnegative.finite.number(x$FQ)) {
if (!comment) {
return(FALSE)
} else {
return("FQ must be a nonnegative number.")
}
}
if (!valid.parameters.PiecewisePareto(x$t, x$alpha, x$truncation, x$truncation_type)) {
if (!comment) {
return(FALSE)
} else {
return(valid.parameters.PiecewisePareto(x$t, x$alpha, x$truncation, x$truncation_type, comment = TRUE))
}
}
if (!is.positive.finite.number(x$dispersion)) {
if (!comment) {
return(FALSE)
} else {
return("dispersion must be a positive number.")
}
}
if (!comment) {
return(TRUE)
} else {
return("OK")
}
}
PPP_Model_Exp_Layer_Loss_s <- function(Cover, AttachmentPoint, PPP_Model) {
if (!is.valid.PPP_Model(PPP_Model)) {
warning(is.valid.PPP_Model(PPP_Model, comment = TRUE))
return(NaN)
} else {
return(PPP_Model$FQ * PiecewisePareto_Layer_Mean(Cover, AttachmentPoint, PPP_Model$t, PPP_Model$alpha, truncation = PPP_Model$truncation, truncation_type = PPP_Model$truncation_type))
}
}
#' Expected Loss of a Reinsurance Layer
#'
#' @description Calculates the expected loss of a reinsurance layer for a PPP_Model. This function is deprecated. Use \code{Layer_Mean} instead.
#'
#' @param Cover Numeric. Cover of the reinsurance layer. Use \code{Inf} for unlimited layers.
#' @param AttachmentPoint Numeric. Attachment point of the reinsurance layer.
#' @param PPP_Model PPP_Model object.
#'
#' @return The expected loss of the layer \code{Cover} xs \code{AttachmentPoint} for the given \code{PPP_Model}
#'
#' @examples
#' PPPM <- PiecewisePareto_Match_Layer_Losses(Example1_AP, Example1_EL)
#' PPPM
#' Example1_Cov <- c(diff(Example1_AP), Inf)
#' Example1_AP
#' Example1_Cov
#' Example1_EL
#' Layer_Mean(PPPM, Example1_Cov, Example1_AP)
#'
#' @export
PPP_Model_Exp_Layer_Loss <- function(Cover, AttachmentPoint, PPP_Model) {
.Deprecated("Layer_Mean")
PPP_Model_Exp_Layer_Loss_v(Cover, AttachmentPoint, PPP_Model)
}
#PPP_Model_Exp_Layer_Loss_v <- Vectorize(PPP_Model_Exp_Layer_Loss_s, c("Cover", "AttachmentPoint"))
PPP_Model_Exp_Layer_Loss_v <- function(Cover, AttachmentPoint, PPP_Model) {
if (is.null(Cover) || (is.atomic(Cover) && length(Cover) == 0)) {
return(numeric())
}
if (is.null(AttachmentPoint) || (is.atomic(AttachmentPoint) && length(AttachmentPoint) == 0)) {
return(numeric())
}
vecfun <- Vectorize(PPP_Model_Exp_Layer_Loss_s, c("Cover", "AttachmentPoint"))
vecfun(Cover, AttachmentPoint, PPP_Model)
}
PPP_Model_Layer_Var_s <- function(Cover, AttachmentPoint, PPP_Model) {
if (!is.valid.PPP_Model(PPP_Model)) {
warning(is.valid.PPP_Model(PPP_Model, comment = TRUE))
return(NaN)
} else {
E_N <- PPP_Model$FQ
Var_N <- E_N * PPP_Model$dispersion
E_X <- PiecewisePareto_Layer_Mean(Cover, AttachmentPoint, PPP_Model$t, PPP_Model$alpha, truncation = PPP_Model$truncation, truncation_type = PPP_Model$truncation_type)
Var_X <- PiecewisePareto_Layer_Var(Cover, AttachmentPoint, PPP_Model$t, PPP_Model$alpha, truncation = PPP_Model$truncation, truncation_type = PPP_Model$truncation_type)
return(E_N * Var_X + Var_N * E_X^2)
}
}
#' Variance of a Reinsurance Layer
#'
#' @description Calculates the variance of the loss in a reinsurance layer for a PPP_Model. This function is deprecated. Use \code{Layer_Var} instead.
#'
#' @param Cover Numeric. Cover of the reinsurance layer. Use \code{Inf} for unlimited layers.
#' @param AttachmentPoint Numeric. Attachment point of the reinsurance layer.
#' @param PPP_Model PPP_Model object.
#'
#' @return The variance of the loss in the layer \code{Cover} xs \code{AttachmentPoint} for the given \code{PPP_Model}
#'
#' @examples
#' PPPM <- PiecewisePareto_Match_Layer_Losses(Example1_AP, Example1_EL)
#' PPPM
#' Example1_Cov <- c(diff(Example1_AP), Inf)
#' Layer_Var(PPPM, Example1_Cov, Example1_AP)
#'
#' @export
PPP_Model_Layer_Var <- function(Cover, AttachmentPoint, PPP_Model) {
.Deprecated("Layer_Var")
PPP_Model_Layer_Var_v(Cover, AttachmentPoint, PPP_Model)
}
#PPP_Model_Layer_Var_v <- Vectorize(PPP_Model_Layer_Var_s, c("Cover", "AttachmentPoint"))
PPP_Model_Layer_Var_v <- function(Cover, AttachmentPoint, PPP_Model) {
if (is.null(Cover) || (is.atomic(Cover) && length(Cover) == 0)) {
return(numeric())
}
if (is.null(AttachmentPoint) || (is.atomic(AttachmentPoint) && length(AttachmentPoint) == 0)) {
return(numeric())
}
vecfun <- Vectorize(PPP_Model_Layer_Var_s, c("Cover", "AttachmentPoint"))
vecfun(Cover, AttachmentPoint, PPP_Model)
}
PPP_Model_Layer_Sd_s <- function(Cover, AttachmentPoint, PPP_Model) {
if (!is.valid.PPP_Model(PPP_Model)) {
warning(is.valid.PPP_Model(PPP_Model, comment = TRUE))
return(NaN)
} else {
return(sqrt(PPP_Model_Layer_Var_v(Cover, AttachmentPoint, PPP_Model)))
}
}
#' Standard Deviation of a Reinsurance Layer
#'
#' @description Calculates the standard deviation of the loss in a reinsurance layer for a PPP_Model
#'
#' @param Cover Numeric. Cover of the reinsurance layer. Use \code{Inf} for unlimited layers.
#' @param AttachmentPoint Numeric. Attachment point of the reinsurance layer.
#' @param PPP_Model PPP_Model object.
#'
#' @return The standard deviation of the loss in the layer \code{Cover} xs \code{AttachmentPoint} for the given \code{PPP_Model}
#'
#' @examples
#' PPPM <- PiecewisePareto_Match_Layer_Losses(Example1_AP, Example1_EL)
#' PPPM
#' Example1_Cov <- c(diff(Example1_AP), Inf)
#' Layer_Sd(PPPM, Example1_Cov, Example1_AP)
#'
#' @export
PPP_Model_Layer_Sd <- function(Cover, AttachmentPoint, PPP_Model) {
.Deprecated("Layer_Sd")
PPP_Model_Layer_Sd_v(Cover, AttachmentPoint, PPP_Model)
}
#PPP_Model_Layer_Sd_v <- Vectorize(PPP_Model_Layer_Sd_s, c("Cover", "AttachmentPoint"))
PPP_Model_Layer_Sd_v <- function(Cover, AttachmentPoint, PPP_Model) {
if (is.null(Cover) || (is.atomic(Cover) && length(Cover) == 0)) {
return(numeric())
}
if (is.null(AttachmentPoint) || (is.atomic(AttachmentPoint) && length(AttachmentPoint) == 0)) {
return(numeric())
}
vecfun <- Vectorize(PPP_Model_Layer_Sd_s, c("Cover", "AttachmentPoint"))
vecfun(Cover, AttachmentPoint, PPP_Model)
}
PPP_Model_Excess_Frequency_s <- function(x, PPP_Model) {
if (!is.valid.PPP_Model(PPP_Model)) {
warning(is.valid.PPP_Model(PPP_Model, comment = TRUE))
return(NaN)
} else if (!is.atomic(x) || !is.numeric(x) || length(x) != 1 || is.na(x)) {
warning("x must be a number.")
return(NaN)
} else {
return(PPP_Model$FQ * (1 - pPiecewisePareto(x, PPP_Model$t, PPP_Model$alpha, truncation = PPP_Model$truncation, truncation_type = PPP_Model$truncation_type)))
}
}
#' Expected Frequency in Excess of a Threshold
#'
#' @description Calculates the expected frequency in excess of a threshold for a PPP_Model
#'
#' @param x Numeric. Threshold.
#' @param PPP_Model PPP_Model object.
#'
#' @return The expected frequency in excess of \code{x} for the given \code{PPP_Model}
#'
#' @examples
#' PPPM <- PiecewisePareto_Match_Layer_Losses(Example1_AP, Example1_EL)
#' PPPM
#' Excess_Frequency(PPPM, c(-Inf, 0, 1000, 2000, 3000, Inf))
#'
#' @export
PPP_Model_Excess_Frequency <- function(x, PPP_Model) {
.Deprecated("Excess_Frequency")
PPP_Model_Excess_Frequency_v(x, PPP_Model)
}
#PPP_Model_Excess_Frequency_v <- Vectorize(PPP_Model_Excess_Frequency_s, c("x"))
PPP_Model_Excess_Frequency_v <- function(x, PPP_Model) {
if (is.null(x) || (is.atomic(x) && length(x) == 0)) {
return(numeric())
}
vecfun <- Vectorize(PPP_Model_Excess_Frequency_s, "x")
vecfun(x, PPP_Model)
}
#' Simulate Losses with a PPP_Model
#'
#' @description Simulates losses of a PPP_Model
#'
#' @param n Integer. Number of Simulations.
#' @param PPP_Model PPP_Model object.
#'
#' @return A matrix where row k contains the simulated losses of the kth simulation.
#'
#' @examples
#' PPPM <- PiecewisePareto_Match_Layer_Losses(c(1000, 2000, 3000), c(2000, 1000, 500),
#' truncation = 10000, truncation_type = "wd")
#' PPPM
#' Simulate_Losses(PPPM, 100)
#'
#' @export
PPP_Model_Simulate <- function(n, PPP_Model) {
.Deprecated("Simulate_Losses")
if (!is.valid.PPP_Model(PPP_Model)) {
warning(is.valid.PPP_Model(PPP_Model, comment = TRUE))
return(NaN)
}
if (!is.positive.finite.number(n)) {
warning("n must be a positive number.")
return(NaN)
} else {
n <- ceiling(n)
}
claim_count <- rPanjer(n, PPP_Model$FQ, PPP_Model$dispersion)
claims <- rPiecewisePareto(sum(claim_count), PPP_Model$t, PPP_Model$alpha, PPP_Model$truncation, PPP_Model$truncation_type)
result <- matrix(NaN, nrow = n, ncol = max(claim_count))
result[col(result) <= claim_count] <- claims
return(result)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.