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", ...@@ -52,9 +52,12 @@ setMethod("commutationNumbers", "pensionTable",
function(object, ..., i = 0.03) { function(object, ..., i = 0.03) {
probs = transitionProbabilities(object, ...) probs = transitionProbabilities(object, ...)
ages = probs$x 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( list(
q = commutationNumbers(probs$q + probs$i, ages = ages, i = i), q = commutationNumbers(1 - act.exit, ages = ages, i = i),
qi = commutationNumbers(probs$qi, ages = ages, i = i), qi = commutationNumbers(1 - inv.exit, ages = ages, i = i),
qp = commutationNumbers(probs$qp, ages = ages, i = i), qp = commutationNumbers(probs$qp, ages = ages, i = i),
qw = commutationNumbers(probs$qw, ages = ages, i = i), qw = commutationNumbers(probs$qw, ages = ages, i = i),
qg = commutationNumbers(probs$qg, 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 ...@@ -71,8 +71,8 @@ pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, a
if (as.data.frame) { if (as.data.frame) {
data.frame(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg) data.frame(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg)
} else { } else {
states = c("a", "i", "p", "d", "g") states = c("a", "i", "p", "d")
transProb = array(0, dim = c(5,5, length(x)), dimnames = list(states, states, x)) 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", "a", ] = (1 - i - q) * (1 - ap);
transProb["a", "i", ] = i; transProb["a", "i", ] = i;
...@@ -89,9 +89,6 @@ pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, a ...@@ -89,9 +89,6 @@ pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, a
transProb["d", "d", ] = 1; transProb["d", "d", ] = 1;
transProb["g", "d", ] = qg;
transProb["g", "g", ] = 1 - qg;
list(transitionProbabilities = transProb, widows = data.frame(x, h, qw, yx)) list(transitionProbabilities = transProb, widows = data.frame(x, h, qw, yx))
} }
} }
...@@ -130,7 +127,7 @@ setGeneric("transitionProbabilities", function(object, ...) standardGeneric("tra ...@@ -130,7 +127,7 @@ setGeneric("transitionProbabilities", function(object, ...) standardGeneric("tra
#' @describeIn transitionProbabilities Return all transition probabilities of the pension table for the generation YOB #' @describeIn transitionProbabilities Return all transition probabilities of the pension table for the generation YOB
setMethod("transitionProbabilities", "pensionTable", 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) { invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
if (!missing(Period) && !is.null(Period)) { if (!missing(Period) && !is.null(Period)) {
return(periodTransitionProbabilities( return(periodTransitionProbabilities(
...@@ -183,7 +180,12 @@ setMethod("transitionProbabilities", "pensionTable", ...@@ -183,7 +180,12 @@ setMethod("transitionProbabilities", "pensionTable",
qw = deathProbabilities(object@qwy, ..., YOB = YOB); qw = deathProbabilities(object@qwy, ..., YOB = YOB);
yx = deathProbabilities(object@yx, ..., YOB = YOB); yx = deathProbabilities(object@yx, ..., YOB = YOB);
qg = deathProbabilities(object@qgx, ..., YOB = YOB); qg = deathProbabilities(object@qgx, ..., YOB = YOB);
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame) 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 #' Return all period transition probabilities of the pension table
...@@ -216,9 +218,8 @@ setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneri ...@@ -216,9 +218,8 @@ setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneri
#' @describeIn periodTransitionProbabilities Return all transition probabilities of the pension table for the period Period #' @describeIn periodTransitionProbabilities Return all transition probabilities of the pension table for the period Period
setMethod("periodTransitionProbabilities", "pensionTable", 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); x = ages(object@qx);
browser()
q = periodDeathProbabilities(object@qx, ..., Period = Period); q = periodDeathProbabilities(object@qx, ..., Period = Period);
i = periodDeathProbabilities(object@ix, ..., Period = Period); i = periodDeathProbabilities(object@ix, ..., Period = Period);
qi = periodDeathProbabilities(object@qix, ..., Period = Period); qi = periodDeathProbabilities(object@qix, ..., Period = Period);
...@@ -251,7 +252,11 @@ browser() ...@@ -251,7 +252,11 @@ browser()
qw = periodDeathProbabilities(object@qwy, ..., Period = Period); qw = periodDeathProbabilities(object@qwy, ..., Period = Period);
yx = periodDeathProbabilities(object@yx, ..., Period = Period); yx = periodDeathProbabilities(object@yx, ..., Period = Period);
qg = periodDeathProbabilities(object@qgx, ..., Period = Period); qg = periodDeathProbabilities(object@qgx, ..., Period = Period);
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame) 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 @@ ...@@ -9,8 +9,8 @@
periodTransitionProbabilities(object, ...) periodTransitionProbabilities(object, ...)
\S4method{periodTransitionProbabilities}{pensionTable}(object, Period = 2017, \S4method{periodTransitionProbabilities}{pensionTable}(object, Period = 2017,
..., retirement = NULL, invalids.retire = object@invalids.retire, ..., OverallMortality = FALSE, retirement = NULL,
as.data.frame = TRUE) invalids.retire = object@invalids.retire, as.data.frame = TRUE)
} }
\arguments{ \arguments{
\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)} \item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
transitionProbabilities(object, ...) transitionProbabilities(object, ...)
\S4method{transitionProbabilities}{pensionTable}(object, YOB = 1982, ..., \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) invalids.retire = object@invalids.retire, as.data.frame = TRUE)
} }
\arguments{ \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