diff --git a/R/mortalityTable.jointLives.R b/R/mortalityTable.jointLives.R index 4808b1e06ac5b7efc61c1956437afb8a7fc6bc73..d79ae95b88e2d6af544bf78baad82132adc6b27a 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 feed400213f527636e55ef6e92cc427869a1ae34..9a63a4e1586485ca2b3392210f306200d3c22896 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) }}