Move anwartschaften to its own file

- add periodTransitionProbabilities (and use it in anwartschaften)
- add pensionTableProbArrange to build the return data.frame or list for transitionProbabilities

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'

NAMESPACE

@@ -44,6 +44,7 @@ exportMethods(getOmega)
 exportMethods(getPeriodTable)
 exportMethods(lifeTable)
 exportMethods(periodDeathProbabilities)
+exportMethods(periodTransitionProbabilities)
 exportMethods(setLoading)
 exportMethods(setModification)
 exportMethods(transitionProbabilities)

R/anwartschaften.R

+#' @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")))
+
+}

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)
 }

man/anwartschaften.Rd

 % 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)}

man/periodTransitionProbabilities.Rd

+% 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)
+
+}

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{