From b42e10fec0da0d50e3c6251df6e262b8f0e36e8b Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Mon, 5 Dec 2016 15:46:59 +0000
Subject: [PATCH] Joint life tables (on first death) for now have a maximum age
taken from the first insured person (i.e. the first table).
The reason is a purely technical one: The ages of the insured are not part of the table, so the getOmega function does not know any ages. Only the deathProbabilities function gets the actual ages.
This makes it impossible to create tables, where e.g. the last value is repeated as needed. Instead, we will always cut off the table at the maximum age of the table for the first insured person.
---
R/mortalityTable.jointLives.R | 49 ++++++++++++++++++++++++-----------
man/getOmega.Rd | 5 ++--
2 files changed, 37 insertions(+), 17 deletions(-)
diff --git a/R/mortalityTable.jointLives.R b/R/mortalityTable.jointLives.R
index 4808b1e..d79ae95 100644
--- a/R/mortalityTable.jointLives.R
+++ b/R/mortalityTable.jointLives.R
@@ -45,11 +45,19 @@ deathProbabilitiesIndividual = function(tables, YOB, ageDifferences) {
# Find the required length to have all (shifted) death probabilities fit
# last value will be repeated for shorter tables
- qxlen = max(mapply(
- function(table, yob, difference) {
- getOmega(table) - difference
- },
- tables, YOB, ageDifferences)) + 1;
+ # FIXME: For now, wee cannot make the table longer than the first table, because
+ # ages(...) will always just return a list of ages allowed for the first table.
+ # The reason is that the deathProbabilities function gets a list of ageDifferences
+ # influencing the possible length of the death probabilities, while the ages
+ # function has only the mortalityTable.2Lives object without any further information,
+ # i.e. the age differences are not part of the mortality table definition,
+ # but ages(...) has only access to that definition and nothing else.
+ # qxlen = max(mapply(
+ # function(table, yob, difference) {
+ # getOmega(table) - difference
+ # },
+ # tables, YOB, ageDifferences)) + 1;
+ qxlen = getOmega(tables[[1]]) + 1;
qxMatrix = mapply(
function(table, yob, difference) {
qx = deathProbabilities(table, yob);
@@ -77,11 +85,19 @@ periodDeathProbabilitiesIndividual = function(tables, period, ageDifferences) {
# Find the required length to have all (shifted) death probabilities fit
# last value will be repeated for shorter tables
- qxlen = max(mapply(
- function(table, difference) {
- getOmega(table) - difference
- },
- tables, ageDifferences)) + 1;
+ # FIXME: For now, wee cannot make the table longer than the first table, because
+ # ages(...) will always just return a list of ages allowed for the first table.
+ # The reason is that the deathProbabilities function gets a list of ageDifferences
+ # influencing the possible length of the death probabilities, while the ages
+ # function has only the mortalityTable.2Lives object without any further information,
+ # i.e. the age differences are not part of the mortality table definition,
+ # but ages(...) has only access to that definition and nothing else.
+ # qxlen = max(mapply(
+ # function(table, yob, difference) {
+ # getOmega(table) - difference
+ # },
+ # tables, YOB, ageDifferences)) + 1;
+ qxlen = getOmega(tables[[1]]) + 1;
qxMatrix = mapply(
function(table, difference) {
qx = periodDeathProbabilities(table, Period = period);
@@ -104,19 +120,19 @@ periodDeathProbabilitiesIndividual = function(tables, period, ageDifferences) {
#' @describeIn ages Return the defined ages of the joint lives mortality table (returns the ages of the first table used for joint lives)
setMethod("ages", "mortalityTable.jointLives",
function(object, ...) {
- ages(c(object@table)[1], ...);
+ ages(c(object@table)[[1]], ...);
})
#' @describeIn baseTable Return the base table of the joint lives mortality table (returns the base table of the first table used for joint lives)
setMethod("baseTable", "mortalityTable.jointLives",
function(object, ...) {
- baseTable(c(object@table)[1], ...)
+ baseTable(c(object@table)[[1]], ...)
})
#' @describeIn baseYear Return the base year of the life table
setMethod("baseYear", "mortalityTable.jointLives",
function(object, ...) {
- baseYear(c(object@table)[1], ...)
+ baseYear(c(object@table)[[1]], ...)
})
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the
@@ -131,9 +147,9 @@ setMethod("deathProbabilities", "mortalityTable.jointLives",
})
#' @describeIn getOmega Return the maximum age of the joint lives mortality table (returns the maximum age of the first table used for joint lives, as the ages of the joint lives are now known to the function)
-setMethod("getOmega", "mortalityTable.observed",
+setMethod("getOmega", "mortalityTable.jointLives",
function(object) {
- max(object@ages, na.rm = TRUE);
+ getOmega(c(object@table)[[1]])
})
@@ -145,6 +161,9 @@ setMethod("periodDeathProbabilities", "mortalityTable.jointLives",
# First death probabilities are characterized as p_x1x2x3.. = \prod p_xi, i.e.
# q_x1x2x3... = 1 - \prod (1 - p_xi)
qx = 1 - apply(1 - qxMatrix, 1, prod)
+ # Cut to same length as ages:
+ ages = ages(object);
+ qx = qx[1:length(ages)];
object@modification(qx * (1 + object@loading));
})
diff --git a/man/getOmega.Rd b/man/getOmega.Rd
index feed400..9a63a4e 100644
--- a/man/getOmega.Rd
+++ b/man/getOmega.Rd
@@ -4,6 +4,7 @@
\name{getOmega}
\alias{getOmega}
\alias{getOmega,mortalityTable.joined-method}
+\alias{getOmega,mortalityTable.jointLives-method}
\alias{getOmega,mortalityTable.mixed-method}
\alias{getOmega,mortalityTable.observed-method}
\alias{getOmega,mortalityTable.period-method}
@@ -19,7 +20,7 @@ getOmega(object)
\S4method{getOmega}{mortalityTable.observed}(object)
-\S4method{getOmega}{mortalityTable.observed}(object)
+\S4method{getOmega}{mortalityTable.jointLives}(object)
}
\arguments{
\item{object}{A life table object (instance of a \code{mortalityTable} class)}
@@ -37,6 +38,6 @@ Return the maximum age of the life table
\item \code{mortalityTable.observed}: Return the maximum age of the joined life table
-\item \code{mortalityTable.observed}: Return the maximum age of the joint lives mortality table (returns the maximum age of the first table used for joint lives, as the ages of the joint lives are now known to the function)
+\item \code{mortalityTable.jointLives}: Return the maximum age of the joint lives mortality table (returns the maximum age of the first table used for joint lives, as the ages of the joint lives are now known to the function)
}}
--
GitLab