diff --git a/DESCRIPTION b/DESCRIPTION
index 643d817b9f2513e8fb328ada82c1f8d3af7ece06..df9560f3ec4e0bf6a2fbf4f9508ed38deb18a4d0 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -32,6 +32,8 @@ Collate:
'mortalityTable.joined.R'
'mortalityTable.mixed.R'
'ages.R'
+ 'pensionTable.R'
+ 'anwartschaften.R'
'baseTable.R'
'baseYear.R'
'mortalityTable.improvementFactors.R'
@@ -47,7 +49,6 @@ Collate:
'mortalityTable.jointLives.R'
'mortalityTables.list.R'
'mortalityTables.load.R'
- 'pensionTable.R'
'plot.mortalityTable.R'
'plotMortalityTableComparisons.R'
'plotMortalityTables.R'
diff --git a/NAMESPACE b/NAMESPACE
index 0918ff00778e944387041208d50763519aeabfcf..17c93db2ea123df13ec4dc4987382fceedb49e41 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -44,6 +44,7 @@ exportMethods(getOmega)
exportMethods(getPeriodTable)
exportMethods(lifeTable)
exportMethods(periodDeathProbabilities)
+exportMethods(periodTransitionProbabilities)
exportMethods(setLoading)
exportMethods(setModification)
exportMethods(transitionProbabilities)
diff --git a/R/anwartschaften.R b/R/anwartschaften.R
new file mode 100644
index 0000000000000000000000000000000000000000..ed46d4deb29e507cd90a7073e7ef7b0549937c8e
--- /dev/null
+++ b/R/anwartschaften.R
@@ -0,0 +1,116 @@
+#' @include pensionTable.R
+NULL
+
+bwRente = function(p, v) {
+ Reduce(function(pp, ax1) { 1 + pp * ax1 * v }, p, 0.0, right = TRUE, accumulate = TRUE)[-(length(p) + 1)];
+}
+
+
+reservesThieleRecursion = function(p, ai, aij, states, i = 0.03) {
+ v = 1 / (1 + i)
+
+ # Recursive relation:
+ # Vi(t,A) = ai(t) + \sum_j v p_ij(t) (aij(t) + Vj(t+1,A))
+ # with: ai(t) .. payment at t for being in state i
+ # aij(t) ... payment at t+1 for switching from state i to j
+ # Vi(t,A) ... reserve for payments A in state i at time t
+ ThieleRecursion = function(t, Vt1) {
+ rr = ai[,t] + v * rowSums(p[,,t] * aij[,,t]) + v * as.vector(p[,,t] %*% Vt1)
+ as.vector(rr)
+ }
+ # Loop backwards over all times (starting value for reserves is 0)
+ times = dimnames(p)[[3]];
+ res = Reduce(f = ThieleRecursion, x = times, init = rep(0, length(states)), right = TRUE, accumulate = TRUE)[-(length(times) + 1)]
+ res = do.call("cbind", res)
+ dimnames(res) = dimnames(ai)
+ res
+}
+if (FALSE) {
+ res = anwartschaften(AVOe2008P.female, YOB = 1977);
+ res
+}
+
+
+#' Calculates all "anwartschaften" for the gien pension table
+#'
+#' @param object A pension table object (instance of a \code{\linkS4class{pensionTable}} class)
+#' @param ... Currently unused
+#' @param i Interest rate (default 0.03)
+#' @param YOB Year of birth (default 1982)
+#'
+#' @examples
+#' pensionTables.load("Austria_*", wildcard=TRUE)
+#' # anwartschaften(EttlPagler.male, i=0.03, YOB=1972)
+#'
+#' @exportMethod transitionProbabilities
+setGeneric("anwartschaften", function(object, ...) standardGeneric("anwartschaften"));
+
+#' @describeIn anwartschaften Calculates all "anwartschaften" for the gien pension table
+setMethod("anwartschaften", "pensionTable",
+ function(object, ..., i = 0.03, YOB = 1982, Period = NULL) {
+ if (!is.null(Period)) {
+ probs = periodTransitionProbabilities(object, Period = Period, ..., as.data.frame = FALSE);
+ } else {
+ probs = transitionProbabilities(object, YOB = YOB, ..., as.data.frame = FALSE);
+ }
+
+ # Time series of transition probabilities
+ pp = probs$transitionProbabilities;
+ x = dimnames(pp)[[3]]
+
+ # Use a data.frame for the annuity PV with the actual ages as dimnames,
+ aw = data.frame(aw = bwRente(1 - probs$widows["qw"], 1 / (1 + i)));
+ dimnames(aw)[[1]] = x
+
+ # Expected death benefit (widows)
+ # Use avg. age of widow to extract the corresponding annuity present value
+ # We used the age as dimname, so we can use simple subsetting
+ expDeathBenefit = probs$widows[["h"]] * aw[as.character(probs$widows[["yx"]]),]
+
+ # Build the matrix of transition payments (only on death there is
+ # the widow PV as benefit, all other transitions do not yield any benefit)
+ states = c("a", "i", "p", "d")
+ transPayments = array(0, dim = c(4,4, length(x)), dimnames = list(states, states, x))
+ transPayments["a","d",] = expDeathBenefit;
+ transPayments["i","d",] = expDeathBenefit;
+ transPayments["p","d",] = expDeathBenefit;
+
+ statePayments = array(0, dim = c(4, length(x)), dimnames = list(states, x));
+
+ aPay = reservesThieleRecursion(p = pp, ai = statePayments + c(1,0,0,0), aij = transPayments*0, states = states, i = i)
+ iPay = reservesThieleRecursion(p = pp, ai = statePayments + c(0,1,0,0), aij = transPayments*0, states = states, i = i)
+ pPay = reservesThieleRecursion(p = pp, ai = statePayments + c(0,0,1,0), aij = transPayments*0, states = states, i = i)
+ wPay = reservesThieleRecursion(p = pp, ai = statePayments, aij = transPayments, states = states)
+
+ list("a" = aPay, "i" = iPay, "p" = pPay, "w" = wPay)
+ });
+
+if (FALSE) {
+ res7 = anwartschaften(AVOe2008P.female, YOB = 1977);
+ res8 = anwartschaften(AVOe2008P.female, YOB = 2017);
+ res
+
+ as.array(res$aPay)
+ str(res$aPay)
+
+
+ dimnames(res$pp)[[3]]
+
+ res["102",]
+ res[,"aw"]
+ a=15:43
+ a
+ a=array(1:8, dim=c(2,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3", "b4"))); a
+ b=array(11:18, dim=c(2,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3", "b4"))); b
+
+ array(a, b)
+ dimnames(a) = c(15:43)
+
+ an = anwartschaften(probs, YOB = 1977); an
+ showMethods("anwartschaften")
+ showMethods("transitionProbabilities")
+
+
+ array(1:12, dim = c(2,3,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3"), c("c1", "c2", "c3", "c4")))
+
+}
diff --git a/R/pensionTable.R b/R/pensionTable.R
index 7b8913aa2467be6566662c748d6f840d404eeaca..353f4c7a66ea4eec91ac4bec1a908c51f0c79408 100644
--- a/R/pensionTable.R
+++ b/R/pensionTable.R
@@ -58,7 +58,33 @@ pensionTable = setClass(
contains = "mortalityTable"
)
-#' Return all transition probabilities of the pension table
+pensionTableProbArrange = function(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = TRUE) {
+ 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")
+ transProb = array(0, dim = c(4,4, length(x)), dimnames = list(states, states, x))
+
+ transProb["a", "a", ] = (1 - i - q) * (1 - ap);
+ transProb["a", "i", ] = i;
+ transProb["a", "p", ] = (1 - q - i ) * ap;
+ transProb["a", "d", ] = q;
+
+ transProb["i", "a", ] = r;
+ transProb["i", "i", ] = (1 - qi - r) * (1 - api);
+ transProb["i", "p", ] = (1 - qi - r) * api;
+ transProb["i", "d", ] = qi;
+
+ transProb["p", "p", ] = 1 - qp;
+ transProb["p", "d", ] = qp;
+
+ transProb["d", "d", ] = 1;
+
+ list(transitionProbabilities = transProb, widows = data.frame(x, h, qw, yx))
+ }
+}
+
+#' Return all transition probabilities of the pension table (generational probabilities)
#'
#' @param object A pension table object (instance of a \code{\linkS4class{pensionTable}} class)
#' @param ... Currently unused
@@ -69,162 +95,65 @@ pensionTable = setClass(
#' # transitionProbabilities(EttlPagler.male)
#'
#' @exportMethod transitionProbabilities
-setGeneric("transitionProbabilities", function(object, ..., YOB = 1982) standardGeneric("transitionProbabilities"));
+setGeneric("transitionProbabilities", function(object, ...) standardGeneric("transitionProbabilities"));
-#' @describeIn transitionProbabilities Return all transition probabilities of the pension table
+#' @describeIn transitionProbabilities Return all transition probabilities of the pension table for the generation YOB
setMethod("transitionProbabilities", "pensionTable",
- function(object, ..., as.data.frame = TRUE, YOB = 1982) {
+ function(object, YOB = 1982, ..., as.data.frame = TRUE) {
na.zero = function(x) { x[is.na(x)] = 0; x }
- x = ages(object@qx);
- q = na.zero(deathProbabilities(object@qx, ..., YOB = YOB));
- i = na.zero(deathProbabilities(object@ix, ..., YOB = YOB));
- qi = deathProbabilities(object@qix, ..., YOB = YOB);
- r = deathProbabilities(object@rx, ..., YOB = YOB);
- ap = deathProbabilities(object@apx, ..., YOB = YOB);
+ x = ages(object@qx);
+ q = na.zero(deathProbabilities(object@qx, ..., YOB = YOB));
+ i = na.zero(deathProbabilities(object@ix, ..., YOB = YOB));
+ qi = deathProbabilities(object@qix, ..., YOB = YOB);
+ r = deathProbabilities(object@rx, ..., YOB = YOB);
+ ap = deathProbabilities(object@apx, ..., YOB = YOB);
api = deathProbabilities(object@apix, ..., YOB = YOB);
- qp = deathProbabilities(object@qpx, ..., YOB = YOB);
- h = deathProbabilities(object@hx, ..., YOB = YOB);
- qw = deathProbabilities(object@qwy, ..., YOB = YOB);
- yx = deathProbabilities(object@yx, ..., YOB = YOB);
- qg = deathProbabilities(object@qgx, ..., YOB = YOB);
- 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")
- transProb = array(0, dim = c(4,4, length(x)), dimnames = list(states, states, x))
-
- transProb["a", "a", ] = (1 - i - q) * (1 - ap);
- transProb["a", "i", ] = i;
- transProb["a", "p", ] = (1 - q - i ) * ap;
- transProb["a", "d", ] = q;
-
- transProb["i", "a", ] = r;
- transProb["i", "i", ] = (1 - qi - r) * (1 - api);
- transProb["i", "p", ] = (1 - qi - r) * api;
- transProb["i", "d", ] = qi;
-
- transProb["p", "p", ] = 1 - qp;
- transProb["p", "d", ] = qp;
-
- transProb["d", "d", ] = 1;
-
- list(transitionProbabilities = transProb, widows = data.frame(x, h, qw, yx))
- }
+ qp = deathProbabilities(object@qpx, ..., YOB = YOB);
+ h = deathProbabilities(object@hx, ..., YOB = YOB);
+ qw = deathProbabilities(object@qwy, ..., YOB = YOB);
+ yx = deathProbabilities(object@yx, ..., 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 (FALSE) {
- transitionProbabilities(AVOe2008P.male, YOB = 1977, as.data.frame = FALSE)
- epP = transitionProbabilities(EttlPagler.male, YOB = 1982)
-# avoe08p =
- transitionProbabilities(AVOe2008P.male, YOB = 1977, as.data.frame = TRUE)
-}
-
-bwRente = function(p, v) {
- Reduce(function(pp, ax1) { 1 + pp * ax1 * v }, p, 0.0, right = TRUE, accumulate = TRUE)[-(length(p) + 1)];
-}
-
-
-reservesThieleRecursion = function(p, ai, aij, states, i = 0.03) {
- v = 1 / (1 + i)
- res = array(0, dim = dim(ai), dimnames = dimnames(ai));
- # Recursive relation:
- # Vi(t,A) = ai(t) + \sum_j v p_ij(t) (aij(t) + Vj(t+1,A))
- # with: ai(t) .. payment at t for being in state i
- # aij(t) ... payment at t+1 for switching from state i to j
- # Vi(t,A) ... reserve for payments A in state i at time t
- ThieleRecursion = function(t, Vt1) {
- rr = ai[,t] + v * rowSums(p[,,t] * aij[,,t]) + v * as.vector(p[,,t] %*% Vt1)
- as.vector(rr)
- }
- # Loop backwards over all times (starting value for reserves is 0)
- times = dimnames(p)[[3]];
- res = Reduce(f = ThieleRecursion, x = times, init = rep(0, length(states)), right = TRUE, accumulate = TRUE)[-(length(times) + 1)]
- res = do.call("cbind", res)
- dimnames(res) = dimnames(ai)
- res
-}
-if (FALSE) {
-res = anwartschaften(AVOe2008P.female, YOB = 1977);
-res
-}
-
-
-#' Calculates all "anwartschaften" for the gien pension table
+#' Return all period transition probabilities of the pension table
#'
#' @param object A pension table object (instance of a \code{\linkS4class{pensionTable}} class)
+#' @param Period Observation year
#' @param ... Currently unused
-#' @param i Interest rate (default 0.03)
-#' @param YOB Year of birth (default 1982)
+#' @param as.data.frame Whether the return value should be a data.frame or an array containing transition matrices
#'
#' @examples
#' pensionTables.load("Austria_*", wildcard=TRUE)
-#' # anwartschaften(EttlPagler.male, i=0.03, YOB=1972)
+#' # periodTransitionProbabilities(EttlPagler.male, Period = 2017)
#'
-#' @exportMethod transitionProbabilities
-setGeneric("anwartschaften", function(object, ...) standardGeneric("anwartschaften"));
-
-#' @describeIn anwartschaften Calculates all "anwartschaften" for the gien pension table
-setMethod("anwartschaften", "pensionTable",
- function(object, ..., i = 0.03, YOB = 1982) {
- probs = transitionProbabilities(object, ..., YOB = YOB, as.data.frame = FALSE);
+#' @exportMethod periodTransitionProbabilities
+setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneric("periodTransitionProbabilities"));
- # Time series of transition probabilities
- pp = probs$transitionProbabilities;
- x = dimnames(pp)[[3]]
- # Use a data.frame for the annuity PV with the actual ages as dimnames,
- aw = data.frame(aw = bwRente(1 - probs$widows["qw"], 1 / (1 + i)));
- dimnames(aw)[[1]] = x
-
- # Expected death benefit (widows)
- # Use avg. age of widow to extract the corresponding annuity present value
- # We used the age as dimname, so we can use simple subsetting
- expDeathBenefit = probs$widows[["h"]] * aw[as.character(probs$widows[["yx"]]),]
-
- # Build the matrix of transition payments (only on death there is
- # the widow PV as benefit, all other transitions do not yield any benefit)
- states = c("a", "i", "p", "d")
- transPayments = array(0, dim = c(4,4, length(x)), dimnames = list(states, states, x))
- transPayments["a","d",] = expDeathBenefit;
- transPayments["i","d",] = expDeathBenefit;
- transPayments["p","d",] = expDeathBenefit;
-
- statePayments = array(0, dim = c(4, length(x)), dimnames = list(states, x));
+#' @describeIn periodTransitionProbabilities Return all transition probabilities of the pension table for the period Period
+setMethod("periodTransitionProbabilities", "pensionTable",
+ function(object, Period = 2017, ..., as.data.frame = TRUE) {
+ na.zero = function(x) { x[is.na(x)] = 0; x }
+ x = ages(object@qx);
+ q = na.zero(periodDeathProbabilities(object@qx, ..., Period = Period));
+ i = na.zero(periodDeathProbabilities(object@ix, ..., Period = Period));
+ qi = periodDeathProbabilities(object@qix, ..., Period = Period);
+ r = periodDeathProbabilities(object@rx, ..., Period = Period);
+ ap = periodDeathProbabilities(object@apx, ..., Period = Period);
+ api = periodDeathProbabilities(object@apix, ..., Period = Period);
+ qp = periodDeathProbabilities(object@qpx, ..., Period = Period);
+ h = periodDeathProbabilities(object@hx, ..., Period = Period);
+ qw = periodDeathProbabilities(object@qwy, ..., Period = Period);
+ yx = periodDeathProbabilities(object@yx, ..., 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)
+ })
- aPay = reservesThieleRecursion(p = pp, ai = statePayments + c(1,0,0,0), aij = transPayments*0, states = states, i = i)
- iPay = reservesThieleRecursion(p = pp, ai = statePayments + c(0,1,0,0), aij = transPayments*0, states = states, i = i)
- pPay = reservesThieleRecursion(p = pp, ai = statePayments + c(0,0,1,0), aij = transPayments*0, states = states, i = i)
- wPay = reservesThieleRecursion(p = pp, ai = statePayments, aij = transPayments, states = states)
- list(pp = pp, transPayments = transPayments, statePayments = statePayments, aPay = aPay, iPay = iPay, pPay = pPay, wPay = wPay)
- list("a" = aPay, "i" = iPay, "p" = pPay, "w" = wPay)
-});
if (FALSE) {
-res = anwartschaften(AVOe2008P.female, YOB = 1977);
-res
-
-as.array(res$aPay)
-str(res$aPay)
-
-
-dimnames(res$pp)[[3]]
-
- res["102",]
-res[,"aw"]
- a=15:43
-a
-a=array(1:8, dim=c(2,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3", "b4"))); a
-b=array(11:18, dim=c(2,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3", "b4"))); b
-
-array(a, b)
-dimnames(a) = c(15:43)
-
-an = anwartschaften(probs, YOB = 1977); an
-showMethods("anwartschaften")
-showMethods("transitionProbabilities")
-
-
-array(1:12, dim = c(2,3,4), dimnames=list(c("a1", "a2"), c("b1", "b2", "b3"), c("c1", "c2", "c3", "c4")))
-
+ transitionProbabilities(AVOe2008P.male, YOB = 1977, as.data.frame = FALSE)
+ epP = transitionProbabilities(EttlPagler.male, YOB = 1982)
+# avoe08p =
+ transitionProbabilities(AVOe2008P.male, YOB = 1977, as.data.frame = TRUE)
}
diff --git a/man/anwartschaften.Rd b/man/anwartschaften.Rd
index 6aad13e7b5a4745b90ded17c59ee5dfe519a3846..6ae5d9d8203a364a51cdf141dc0d7e2f10bd46b4 100644
--- a/man/anwartschaften.Rd
+++ b/man/anwartschaften.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/pensionTable.R
+% Please edit documentation in R/anwartschaften.R
\docType{methods}
\name{anwartschaften}
\alias{anwartschaften}
@@ -8,7 +8,8 @@
\usage{
anwartschaften(object, ...)
-\S4method{anwartschaften}{pensionTable}(object, ..., i = 0.03, YOB = 1982)
+\S4method{anwartschaften}{pensionTable}(object, ..., i = 0.03, YOB = 1982,
+ Period = NULL)
}
\arguments{
\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
diff --git a/man/periodTransitionProbabilities.Rd b/man/periodTransitionProbabilities.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..ee7ecf823d344aa5996c00997444a2a7fc0c1508
--- /dev/null
+++ b/man/periodTransitionProbabilities.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pensionTable.R
+\docType{methods}
+\name{periodTransitionProbabilities}
+\alias{periodTransitionProbabilities}
+\alias{periodTransitionProbabilities,pensionTable-method}
+\title{Return all period transition probabilities of the pension table}
+\usage{
+periodTransitionProbabilities(object, ...)
+
+\S4method{periodTransitionProbabilities}{pensionTable}(object, Period = 2017,
+ ..., as.data.frame = TRUE)
+}
+\arguments{
+\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
+
+\item{...}{Currently unused}
+
+\item{Period}{Observation year}
+
+\item{as.data.frame}{Whether the return value should be a data.frame or an array containing transition matrices}
+}
+\description{
+Return all period transition probabilities of the pension table
+}
+\section{Methods (by class)}{
+\itemize{
+\item \code{pensionTable}: Return all transition probabilities of the pension table for the period Period
+}}
+
+\examples{
+pensionTables.load("Austria_*", wildcard=TRUE)
+# periodTransitionProbabilities(EttlPagler.male, Period = 2017)
+
+}
diff --git a/man/transitionProbabilities.Rd b/man/transitionProbabilities.Rd
index 0b079bccd28e2fce1a36446e0eb968b4b157dd96..6c0bb379310ba820f5f9c0b56e80f611a6b037e9 100644
--- a/man/transitionProbabilities.Rd
+++ b/man/transitionProbabilities.Rd
@@ -4,12 +4,12 @@
\name{transitionProbabilities}
\alias{transitionProbabilities}
\alias{transitionProbabilities,pensionTable-method}
-\title{Return all transition probabilities of the pension table}
+\title{Return all transition probabilities of the pension table (generational probabilities)}
\usage{
-transitionProbabilities(object, ..., YOB = 1982)
+transitionProbabilities(object, ...)
-\S4method{transitionProbabilities}{pensionTable}(object, ...,
- as.data.frame = TRUE, YOB = 1982)
+\S4method{transitionProbabilities}{pensionTable}(object, YOB = 1982, ...,
+ as.data.frame = TRUE)
}
\arguments{
\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
@@ -19,11 +19,11 @@ transitionProbabilities(object, ..., YOB = 1982)
\item{YOB}{Year of birth}
}
\description{
-Return all transition probabilities of the pension table
+Return all transition probabilities of the pension table (generational probabilities)
}
\section{Methods (by class)}{
\itemize{
-\item \code{pensionTable}: Return all transition probabilities of the pension table
+\item \code{pensionTable}: Return all transition probabilities of the pension table for the generation YOB
}}
\examples{