Commit c3cace7c authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

pensionTable: Commutation numbers need to take retirement probabilities for...

pensionTable: Commutation numbers need to take retirement probabilities for actives into account; remove "g" state for total portfolio and replace by OverallMortality argument
parent 4a0365b6
......@@ -52,9 +52,12 @@ setMethod("commutationNumbers", "pensionTable",
function(object, ..., i = 0.03) {
probs = transitionProbabilities(object, ...)
ages = probs$x
# Exit probabilities of actives are: - not dead or invalid & no transition to pension
act.exit = (1 - probs$q - probs$i) * (1 - probs$ap)
inv.exit = (1 - probs$qi) * (1 - probs$api)
list(
q = commutationNumbers(probs$q + probs$i, ages = ages, i = i),
qi = commutationNumbers(probs$qi, ages = ages, i = i),
q = commutationNumbers(1 - act.exit, ages = ages, i = i),
qi = commutationNumbers(1 - inv.exit, ages = ages, i = i),
qp = commutationNumbers(probs$qp, ages = ages, i = i),
qw = commutationNumbers(probs$qw, ages = ages, i = i),
qg = commutationNumbers(probs$qg, ages = ages, i = i)
......
......@@ -71,8 +71,8 @@ pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, a
if (as.data.frame) {
data.frame(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg)
} else {
states = c("a", "i", "p", "d", "g")
transProb = array(0, dim = c(5,5, length(x)), dimnames = list(states, states, x))
states = c("a", "i", "p", "d")
transProb = array(0, dim = c(length(states), length(states), length(x)), dimnames = list(states, states, x))
transProb["a", "a", ] = (1 - i - q) * (1 - ap);
transProb["a", "i", ] = i;
......@@ -89,9 +89,6 @@ pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, a
transProb["d", "d", ] = 1;
transProb["g", "d", ] = qg;
transProb["g", "g", ] = 1 - qg;
list(transitionProbabilities = transProb, widows = data.frame(x, h, qw, yx))
}
}
......@@ -130,7 +127,7 @@ setGeneric("transitionProbabilities", function(object, ...) standardGeneric("tra
#' @describeIn transitionProbabilities Return all transition probabilities of the pension table for the generation YOB
setMethod("transitionProbabilities", "pensionTable",
function(object, YOB = 1982, ..., Period = NULL, retirement = NULL,
function(object, YOB = 1982, ..., OverallMortality = FALSE, Period = NULL, retirement = NULL,
invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
if (!missing(Period) && !is.null(Period)) {
return(periodTransitionProbabilities(
......@@ -183,7 +180,12 @@ setMethod("transitionProbabilities", "pensionTable",
qw = deathProbabilities(object@qwy, ..., YOB = YOB);
yx = deathProbabilities(object@yx, ..., YOB = YOB);
qg = deathProbabilities(object@qgx, ..., YOB = YOB);
if (!OverallMortality) {
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame)
} else {
# Gesamttafel, i.e. actives, invalids and pensioners have the same mortality qg
pensionTableProbArrange(x, qg, i, qg, r, ap, api, qg, h, qg, yx, qg, as.data.frame = as.data.frame)
}
})
#' Return all period transition probabilities of the pension table
......@@ -216,9 +218,8 @@ setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneri
#' @describeIn periodTransitionProbabilities Return all transition probabilities of the pension table for the period Period
setMethod("periodTransitionProbabilities", "pensionTable",
function(object, Period = 2017, ..., retirement = NULL, invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
function(object, Period = 2017, ..., OverallMortality = FALSE, retirement = NULL, invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
x = ages(object@qx);
browser()
q = periodDeathProbabilities(object@qx, ..., Period = Period);
i = periodDeathProbabilities(object@ix, ..., Period = Period);
qi = periodDeathProbabilities(object@qix, ..., Period = Period);
......@@ -251,7 +252,11 @@ browser()
qw = periodDeathProbabilities(object@qwy, ..., Period = Period);
yx = periodDeathProbabilities(object@yx, ..., Period = Period);
qg = periodDeathProbabilities(object@qgx, ..., Period = Period);
if (!OverallMortality) {
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame)
} else {
pensionTableProbArrange(x, qg, i, qg, r, ap, api, qg, h, qg, yx, qg, as.data.frame = as.data.frame)
}
})
......
......@@ -9,8 +9,8 @@
periodTransitionProbabilities(object, ...)
\S4method{periodTransitionProbabilities}{pensionTable}(object, Period = 2017,
..., retirement = NULL, invalids.retire = object@invalids.retire,
as.data.frame = TRUE)
..., OverallMortality = FALSE, retirement = NULL,
invalids.retire = object@invalids.retire, as.data.frame = TRUE)
}
\arguments{
\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
......
......@@ -9,7 +9,7 @@
transitionProbabilities(object, ...)
\S4method{transitionProbabilities}{pensionTable}(object, YOB = 1982, ...,
Period = NULL, retirement = NULL,
OverallMortality = FALSE, Period = NULL, retirement = NULL,
invalids.retire = object@invalids.retire, as.data.frame = TRUE)
}
\arguments{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment