Commit 0d0425f6 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Add fillAges function, ages argument to deathProbabilities function

All probs will be intersected with the desired ages, missing values will be filled with NA
parent 2e3613af
...@@ -34,6 +34,7 @@ Collate: ...@@ -34,6 +34,7 @@ Collate:
'ages.R' 'ages.R'
'baseTable.R' 'baseTable.R'
'baseYear.R' 'baseYear.R'
'fillAges.R'
'pensionTable.R' 'pensionTable.R'
'commutationNumbers.R' 'commutationNumbers.R'
'mortalityTable.improvementFactors.R' 'mortalityTable.improvementFactors.R'
......
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
S3method(plot,mortalityTable) S3method(plot,mortalityTable)
export(deathProbabilitiesIndividual) export(deathProbabilitiesIndividual)
export(fillAges)
export(generateAgeShift) export(generateAgeShift)
export(makeQxDataFrame) export(makeQxDataFrame)
export(mortalityComparisonTable) export(mortalityComparisonTable)
......
#' @include mortalityTable.R mortalityTable.period.R mortalityTable.ageShift.R mortalityTable.trendProjection.R mortalityTable.improvementFactors.R mortalityTable.mixed.R #' @include mortalityTable.R mortalityTable.period.R mortalityTable.ageShift.R mortalityTable.trendProjection.R mortalityTable.improvementFactors.R mortalityTable.mixed.R fillAges.R
NULL NULL
#' Return the (cohort) death probabilities of the life table given the birth year (if needed) #' Return the (cohort) death probabilities of the life table given the birth year (if needed)
...@@ -13,19 +13,23 @@ NULL ...@@ -13,19 +13,23 @@ NULL
#' deathProbabilities(AVOe2005R.male, YOB = 2017) #' deathProbabilities(AVOe2005R.male, YOB = 2017)
#' #'
#' @exportMethod deathProbabilities #' @exportMethod deathProbabilities
setGeneric("deathProbabilities", function(object, ..., YOB = 1975) standardGeneric("deathProbabilities")); setGeneric("deathProbabilities", function(object, ..., ages = NULL, YOB = 1975) standardGeneric("deathProbabilities"));
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
#' life table given the birth year (if needed) #' life table given the birth year (if needed)
setMethod("deathProbabilities", "mortalityTable.period", setMethod("deathProbabilities", "mortalityTable.period",
function(object, ..., YOB = 1975) { function(object, ..., ages = NULL, YOB = 1975) {
object@modification(object@deathProbs * (1 + object@loading)); fillAges(
object@modification(object@deathProbs * (1 + object@loading)),
haveAges = ages(object),
needAges = ages
);
}) })
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
#' life table given the birth year (if needed) #' life table given the birth year (if needed)
setMethod("deathProbabilities","mortalityTable.ageShift", setMethod("deathProbabilities","mortalityTable.ageShift",
function(object, ..., YOB = 1975) { function(object, ..., ages = NULL, YOB = 1975) {
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
shift = ageShift(object, YOB); shift = ageShift(object, YOB);
if (shift > 0) { if (shift > 0) {
...@@ -33,18 +37,18 @@ setMethod("deathProbabilities","mortalityTable.ageShift", ...@@ -33,18 +37,18 @@ setMethod("deathProbabilities","mortalityTable.ageShift",
} else if (shift < 0) { } else if (shift < 0) {
qx = c(rep(0, -shift), qx[1:(length(qx) - (-shift))]) qx = c(rep(0, -shift), qx[1:(length(qx) - (-shift))])
} }
object@modification(qx) fillAges(object@modification(qx), haveAges = ages(object), needAges = ages)
}) })
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
#' life table given the birth year (if needed) #' life table given the birth year (if needed)
setMethod("deathProbabilities","mortalityTable.trendProjection", setMethod("deathProbabilities","mortalityTable.trendProjection",
function(object, ..., YOB = 1975) { function(object, ..., ages = NULL, YOB = 1975) {
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
if (is.null(object@trend2) || length(object@trend2) <= 1) { if (is.null(object@trend2) || length(object@trend2) <= 1) {
ages = object@ages; haveAges = object@ages;
damping = sapply( damping = sapply(
ages, haveAges,
function(age) { object@dampingFunction(YOB + age - object@baseYear) } function(age) { object@dampingFunction(YOB + age - object@baseYear) }
); );
finalqx = exp(-object@trend * damping) * qx; finalqx = exp(-object@trend * damping) * qx;
...@@ -57,24 +61,28 @@ setMethod("deathProbabilities","mortalityTable.trendProjection", ...@@ -57,24 +61,28 @@ setMethod("deathProbabilities","mortalityTable.trendProjection",
-(object@trend * (1 - weights) + object@trend2 * weights) * -(object@trend * (1 - weights) + object@trend2 * weights) *
(YOB + 0:(length(qx) - 1) - object@baseYear)) (YOB + 0:(length(qx) - 1) - object@baseYear))
} }
object@modification(finalqx) fillAges(object@modification(finalqx), givenAges = haveAges, neededAges = ages)
}) })
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
#' life table given the birth year (if needed) #' life table given the birth year (if needed)
setMethod("deathProbabilities","mortalityTable.improvementFactors", setMethod("deathProbabilities","mortalityTable.improvementFactors",
function(object, ..., YOB = 1975) { function(object, ..., ages = NULL, YOB = 1975) {
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
impr = calculateImprovements(object, ..., YOB = YOB) impr = calculateImprovements(object, ..., YOB = YOB)
object@modification(impr * qx) fillAges(
object@modification(impr * qx),
haveAges = ages(object),
needAges = ages)
}) })
#' @describeIn deathProbabilities Return the (cohort) death probabilities of the #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
#' life table given the birth year (if needed) #' life table given the birth year (if needed)
setMethod("deathProbabilities","mortalityTable.mixed", setMethod("deathProbabilities","mortalityTable.mixed",
function(object, ..., YOB = 1975) { function(object, ..., ages = NULL, YOB = 1975) {
qx1 = deathProbabilities(object@table1, ..., YOB); qx1 = deathProbabilities(object@table1, ..., ages = ages, YOB = YOB);
qx2 = deathProbabilities(object@table2, ..., YOB); qx2 = deathProbabilities(object@table2, ..., ages = ages, YOB = YOB);
mixedqx = (object@weight1 * qx1 + object@weight2 * qx2)/(object@weight1 + object@weight2) * (1 + object@loading); mixedqx = (object@weight1 * qx1 + object@weight2 * qx2)/(object@weight1 + object@weight2) * (1 + object@loading);
# We already have the correct ages from the deathProbabilities call above
object@modification(mixedqx) object@modification(mixedqx)
}) })
#' Fill the given probabilities with NA to match the desired age range.
#'
#' @param probs Numeric vector
#' @param haveAges ages assigned to the given vector
#' @param neededAges desired age range for output
#'
#' @export fillAges
fillAges = function(probs = c(), haveAges = c(), neededAges = NULL) {
if (!is.null(neededAges)) {
# initialize result with NA, then fill in all known ages from probs
result = rep(NA_real_, length(neededAges))
providedAges = intersect(neededAges, haveAges)
result[match(providedAges, neededAges)] = probs[match(providedAges, haveAges)]
} else {
probs
}
}
#
# haveAges = c(12,16,20, 23:30, 32, 40)
# neededAges = c(0:24, 49:25)
# probs = c(12,16,20, 23:30, 32, 40)/10
#
# providedAges = intersect(neededAges, haveAges)
# result = rep(NA_real_, length(neededAges))
#
#
#
#
# names(result) = neededAges
# result
...@@ -187,12 +187,12 @@ setMethod("baseYear", "mortalityTable.jointLives", ...@@ -187,12 +187,12 @@ setMethod("baseYear", "mortalityTable.jointLives",
#' deathProbabilities(table.JL, YOB = 1977, ageDifferences = c(1, 5, 16)) #' deathProbabilities(table.JL, YOB = 1977, ageDifferences = c(1, 5, 16))
#' #'
setMethod("deathProbabilities", "mortalityTable.jointLives", setMethod("deathProbabilities", "mortalityTable.jointLives",
function(object, ..., ageDifferences = c(), YOB = 1975) { function(object, ..., ageDifferences = c(), ages = NULL, YOB = 1975) {
qxMatrix = deathProbabilitiesIndividual(c(object@table), YOB = YOB, ageDifferences = ageDifferences); qxMatrix = deathProbabilitiesIndividual(c(object@table), YOB = YOB, ageDifferences = ageDifferences);
# First death probabilities are characterized as p_x1x2x3.. = \prod p_xi, i.e. # First death probabilities are characterized as p_x1x2x3.. = \prod p_xi, i.e.
# q_x1x2x3... = 1 - \prod (1 - p_xi) # q_x1x2x3... = 1 - \prod (1 - p_xi)
qx = 1 - apply(1 - qxMatrix, 1, prod) qx = 1 - apply(1 - qxMatrix, 1, prod)
object@modification(qx * (1 + object@loading)); object@modification(qx * (1 + object@loading))
}) })
#' @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) #' @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)
...@@ -218,7 +218,7 @@ setMethod("getOmega", "mortalityTable.jointLives", ...@@ -218,7 +218,7 @@ setMethod("getOmega", "mortalityTable.jointLives",
#' #'
setMethod("periodDeathProbabilities", "mortalityTable.jointLives", setMethod("periodDeathProbabilities", "mortalityTable.jointLives",
function(object, ..., ageDifferences = c(), Period = 1975) { function(object, ..., ageDifferences = c(), ages = NULL, Period = 1975) {
qxMatrix = periodDeathProbabilitiesIndividual(c(object@table), period = Period, ageDifferences = ageDifferences); qxMatrix = periodDeathProbabilitiesIndividual(c(object@table), period = Period, ageDifferences = ageDifferences);
# First death probabilities are characterized as p_x1x2x3.. = \prod p_xi, i.e. # First death probabilities are characterized as p_x1x2x3.. = \prod p_xi, i.e.
# q_x1x2x3... = 1 - \prod (1 - p_xi) # q_x1x2x3... = 1 - \prod (1 - p_xi)
......
#' @include mortalityTable.R #' @include mortalityTable.R fillAges.R
NULL NULL
...@@ -127,7 +127,7 @@ setGeneric("transitionProbabilities", function(object, ...) standardGeneric("tra ...@@ -127,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, ..., OverallMortality = FALSE, Period = NULL, retirement = NULL, function(object, YOB = 1982, ..., ages = 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) {
if (!missing(Period) && !is.null(Period)) { if (!missing(Period) && !is.null(Period)) {
return(periodTransitionProbabilities( return(periodTransitionProbabilities(
...@@ -135,11 +135,12 @@ setMethod("transitionProbabilities", "pensionTable", ...@@ -135,11 +135,12 @@ setMethod("transitionProbabilities", "pensionTable",
invalids.retire = invalids.retire, invalids.retire = invalids.retire,
as.data.frame = as.data.frame)) as.data.frame = as.data.frame))
} }
x = ages(object@qx); x = ifelse(is.null(ages), ages(object@qx), ages);
q = deathProbabilities(object@qx, ..., YOB = YOB); # TODO: Make sure all sub-tables have the same age range!
i = deathProbabilities(object@ix, ..., YOB = YOB); q = deathProbabilities(object@qx, ..., ages = ages, YOB = YOB);
qi = deathProbabilities(object@qix, ..., YOB = YOB); i = deathProbabilities(object@ix, ..., ages = ages, YOB = YOB);
r = deathProbabilities(object@rx, ..., YOB = YOB); qi = deathProbabilities(object@qix, ..., ages = ages, YOB = YOB);
r = deathProbabilities(object@rx, ..., ages = ages, YOB = YOB);
apTab = object@apx apTab = object@apx
if (!missing(retirement) && !is.null(retirement)) { if (!missing(retirement) && !is.null(retirement)) {
if (inherits(retirement, "mortalityTable")) { if (inherits(retirement, "mortalityTable")) {
...@@ -157,7 +158,7 @@ setMethod("transitionProbabilities", "pensionTable", ...@@ -157,7 +158,7 @@ setMethod("transitionProbabilities", "pensionTable",
apTab = mortalityTable.zeroes(ages = x) apTab = mortalityTable.zeroes(ages = x)
} }
} }
ap = deathProbabilities(apTab, ..., YOB = YOB); ap = deathProbabilities(apTab, ..., ages = ages, YOB = YOB);
if (!missing(retirement) && !is.null(retirement)) { if (!missing(retirement) && !is.null(retirement)) {
if (inherits(retirement, "mortalityTable")) { if (inherits(retirement, "mortalityTable")) {
...@@ -173,13 +174,13 @@ setMethod("transitionProbabilities", "pensionTable", ...@@ -173,13 +174,13 @@ setMethod("transitionProbabilities", "pensionTable",
if (invalids.retire) { if (invalids.retire) {
api = ap api = ap
} else { } else {
api = deathProbabilities(mortalityTable.zeroes(ages = x), ..., YOB = YOB) api = deathProbabilities(mortalityTable.zeroes(ages = x), ..., ages = ages, YOB = YOB)
} }
qp = deathProbabilities(object@qpx, ..., YOB = YOB); qp = deathProbabilities(object@qpx, ..., ages = ages, YOB = YOB);
h = deathProbabilities(object@hx, ..., YOB = YOB); h = deathProbabilities(object@hx, ..., ages = ages, YOB = YOB);
qw = deathProbabilities(object@qwy, ..., YOB = YOB); qw = deathProbabilities(object@qwy, ..., ages = ages, YOB = YOB);
yx = deathProbabilities(object@yx, ..., YOB = YOB); yx = deathProbabilities(object@yx, ..., ages = ages, YOB = YOB);
qg = deathProbabilities(object@qgx, ..., YOB = YOB); qg = deathProbabilities(object@qgx, ..., ages = ages, YOB = YOB);
if (!OverallMortality) { if (!OverallMortality) {
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame) pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame)
} else { } else {
...@@ -219,11 +220,11 @@ setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneri ...@@ -219,11 +220,11 @@ 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, ..., OverallMortality = FALSE, 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 = ifelse(is.null(ages), ages(object@qx), ages);
q = periodDeathProbabilities(object@qx, ..., Period = Period); q = periodDeathProbabilities(object@qx, ..., ages = ages, Period = Period);
i = periodDeathProbabilities(object@ix, ..., Period = Period); i = periodDeathProbabilities(object@ix, ..., ages = ages, Period = Period);
qi = periodDeathProbabilities(object@qix, ..., Period = Period); qi = periodDeathProbabilities(object@qix, ..., ages = ages, Period = Period);
r = periodDeathProbabilities(object@rx, ..., Period = Period); r = periodDeathProbabilities(object@rx, ..., ages = ages, Period = Period);
apTab = object@apx apTab = object@apx
if (!missing(retirement) && !is.null(retirement)) { if (!missing(retirement) && !is.null(retirement)) {
if (inherits(retirement, "mortalityTable")) { if (inherits(retirement, "mortalityTable")) {
...@@ -241,17 +242,17 @@ setMethod("periodTransitionProbabilities", "pensionTable", ...@@ -241,17 +242,17 @@ setMethod("periodTransitionProbabilities", "pensionTable",
apTab = mortalityTable.zeroes(ages = x) apTab = mortalityTable.zeroes(ages = x)
} }
} }
ap = deathProbabilities(apTab, ..., Period = Period) ap = deathProbabilities(apTab, ..., ages = ages, Period = Period)
if (invalids.retire) { if (invalids.retire) {
api = ap api = ap
} else { } else {
api = deathProbabilities(mortalityTable.zeroes(ages = x), ..., Period = Period) api = deathProbabilities(mortalityTable.zeroes(ages = x), ..., ages = ages, Period = Period)
} }
qp = periodDeathProbabilities(object@qpx, ..., Period = Period); qp = periodDeathProbabilities(object@qpx, ..., ages = ages, Period = Period);
h = periodDeathProbabilities(object@hx, ..., Period = Period); h = periodDeathProbabilities(object@hx, ..., ages = ages, Period = Period);
qw = periodDeathProbabilities(object@qwy, ..., Period = Period); qw = periodDeathProbabilities(object@qwy, ..., ages = ages, Period = Period);
yx = periodDeathProbabilities(object@yx, ..., Period = Period); yx = periodDeathProbabilities(object@yx, ..., ages = ages, Period = Period);
qg = periodDeathProbabilities(object@qgx, ..., Period = Period); qg = periodDeathProbabilities(object@qgx, ..., ages = ages, Period = Period);
if (!OverallMortality) { if (!OverallMortality) {
pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame) pensionTableProbArrange(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg, as.data.frame = as.data.frame)
} else { } else {
......
#' @include mortalityTable.R mortalityTable.period.R mortalityTable.trendProjection.R mortalityTable.improvementFactors.R mortalityTable.mixed.R #' @include mortalityTable.R mortalityTable.period.R mortalityTable.trendProjection.R mortalityTable.improvementFactors.R mortalityTable.mixed.R fillAges.R
NULL NULL
#' Return the (period) death probabilities of the life table for a given #' Return the (period) death probabilities of the life table for a given
...@@ -9,31 +9,34 @@ NULL ...@@ -9,31 +9,34 @@ NULL
#' @param Period The observation year for which the period death probabilities should be determined #' @param Period The observation year for which the period death probabilities should be determined
#' #'
#' @exportMethod periodDeathProbabilities #' @exportMethod periodDeathProbabilities
setGeneric("periodDeathProbabilities", function(object, ..., Period = 1975) standardGeneric("periodDeathProbabilities")); setGeneric("periodDeathProbabilities", function(object, ..., ages = NULL, Period = 1975) standardGeneric("periodDeathProbabilities"));
#' @describeIn periodDeathProbabilities Return the (period) death probabilities #' @describeIn periodDeathProbabilities Return the (period) death probabilities
#' of the life table for a given observation year #' of the life table for a given observation year
setMethod("periodDeathProbabilities", "mortalityTable.period", setMethod("periodDeathProbabilities", "mortalityTable.period",
function(object, ..., Period = 1975) { function(object, ..., ages = NULL, Period = 1975) {
object@modification(object@deathProbs * (1 + object@loading)); object@modification(object@deathProbs * (1 + object@loading));
}) })
#' @describeIn periodDeathProbabilities Return the (period) death probabilities #' @describeIn periodDeathProbabilities Return the (period) death probabilities
#' of the life table for a given observation year #' of the life table for a given observation year
setMethod("periodDeathProbabilities", "mortalityTable.ageShift", setMethod("periodDeathProbabilities", "mortalityTable.ageShift",
function (object, ..., Period = 1975) { function (object, ..., ages = NULL, Period = 1975) {
# TODO # TODO
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
# TODO!!! # TODO!!!
# shift.index = match(YOB, object@shifts, 0); # shift.index = match(YOB, object@shifts, 0);
# if (shift.index) {} # if (shift.index) {}
object@modification(qx) fillAges(
object@modification(qx),
haveAges = ages(object),
needAges = ages)
}) })
#' @describeIn periodDeathProbabilities Return the (period) death probabilities #' @describeIn periodDeathProbabilities Return the (period) death probabilities
#' of the life table for a given observation year #' of the life table for a given observation year
setMethod("periodDeathProbabilities", "mortalityTable.trendProjection", setMethod("periodDeathProbabilities", "mortalityTable.trendProjection",
function(object, ..., Period = 1975) { function(object, ..., ages = NULL, Period = 1975) {
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
if (is.null(object@trend2) || length(object@trend2) <= 1) { if (is.null(object@trend2) || length(object@trend2) <= 1) {
# ages = 0:(length(qx)-1); # ages = 0:(length(qx)-1);
...@@ -46,25 +49,32 @@ setMethod("periodDeathProbabilities", "mortalityTable.trendProjection", ...@@ -46,25 +49,32 @@ setMethod("periodDeathProbabilities", "mortalityTable.trendProjection",
-(object@trend * (1 - weight) + object@trend2 * weight) * -(object@trend * (1 - weight) + object@trend2 * weight) *
(Period - object@baseYear)) (Period - object@baseYear))
} }
object@modification(finalqx) fillAges(
object@modification(finalqx),
haveAges = ages(object),
needAges = ages)
}) })
#' @describeIn periodDeathProbabilities Return the (period) death probabilities #' @describeIn periodDeathProbabilities Return the (period) death probabilities
#' of the life table for a given observation year #' of the life table for a given observation year
setMethod("periodDeathProbabilities", "mortalityTable.improvementFactors", setMethod("periodDeathProbabilities", "mortalityTable.improvementFactors",
function(object, ..., Period = 1975) { function(object, ..., ages = NULL, Period = 1975) {
qx = object@deathProbs * (1 + object@loading); qx = object@deathProbs * (1 + object@loading);
impr = calculateImprovements(object, ..., Period = Period) impr = calculateImprovements(object, ..., Period = Period)
object@modification(qx * impr) fillAges(
object@modification(qx * impr),
haveAges = ages(object),
needAges = ages)
}) })
#' @describeIn periodDeathProbabilities Return the (period) death probabilities #' @describeIn periodDeathProbabilities Return the (period) death probabilities
#' of the life table for a given observation year #' of the life table for a given observation year
setMethod("periodDeathProbabilities", "mortalityTable.mixed", setMethod("periodDeathProbabilities", "mortalityTable.mixed",
function(object, ..., Period = 1975) { function(object, ..., ages = NULL, Period = 1975) {
qx1 = periodDeathProbabilities(object@table1, ..., Period = Period); qx1 = periodDeathProbabilities(object@table1, ..., ages = ages, Period = Period);
qx2 = periodDeathProbabilities(object@table2, ..., Period = Period); qx2 = periodDeathProbabilities(object@table2, ..., ages = ages, Period = Period);
mixedqx = (object@weight1 * qx1 + object@weight2 * qx2) / (object@weight1 + object@weight2) * (1 + object@loading); mixedqx = (object@weight1 * qx1 + object@weight2 * qx2) / (object@weight1 + object@weight2) * (1 + object@loading);
# We already have the correct ages from the deathProbabilities call above
object@modification(mixedqx) object@modification(mixedqx)
}) })
...@@ -12,23 +12,25 @@ ...@@ -12,23 +12,25 @@
\alias{deathProbabilities,mortalityTable.jointLives-method} \alias{deathProbabilities,mortalityTable.jointLives-method}
\title{Return the (cohort) death probabilities of the life table given the birth year (if needed)} \title{Return the (cohort) death probabilities of the life table given the birth year (if needed)}
\usage{ \usage{
deathProbabilities(object, ..., YOB = 1975) deathProbabilities(object, ..., ages = NULL, YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.period}(object, ..., YOB = 1975) \S4method{deathProbabilities}{mortalityTable.period}(object, ..., ages = NULL,
YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.ageShift}(object, ..., \S4method{deathProbabilities}{mortalityTable.ageShift}(object, ...,
YOB = 1975) ages = NULL, YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.trendProjection}(object, ..., \S4method{deathProbabilities}{mortalityTable.trendProjection}(object, ...,
YOB = 1975) ages = NULL, YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.improvementFactors}(object, ..., \S4method{deathProbabilities}{mortalityTable.improvementFactors}(object, ...,
YOB = 1975) ages = NULL, YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.mixed}(object, ..., YOB = 1975) \S4method{deathProbabilities}{mortalityTable.mixed}(object, ..., ages = NULL,
YOB = 1975)
\S4method{deathProbabilities}{mortalityTable.jointLives}(object, ..., \S4method{deathProbabilities}{mortalityTable.jointLives}(object, ...,
ageDifferences = c(), YOB = 1975) ageDifferences = c(), ages = NULL, YOB = 1975)
} }
\arguments{ \arguments{
\item{object}{The life table object (class inherited from mortalityTable)} \item{object}{The life table object (class inherited from mortalityTable)}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/fillAges.R
\name{fillAges}
\alias{fillAges}
\title{Fill the given probabilities with NA to match the desired age range.}
\usage{
fillAges(probs = c(), haveAges = c(), neededAges = NULL)
}
\arguments{
\item{probs}{Numeric vector}
\item{haveAges}{ages assigned to the given vector}
\item{neededAges}{desired age range for output}
}
\description{
Fill the given probabilities with NA to match the desired age range.
}
...@@ -13,25 +13,25 @@ ...@@ -13,25 +13,25 @@
\title{Return the (period) death probabilities of the life table for a given \title{Return the (period) death probabilities of the life table for a given
observation year} observation year}
\usage{ \usage{
periodDeathProbabilities(object, ..., Period = 1975) periodDeathProbabilities(object, ..., ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.period}(object, ..., \S4method{periodDeathProbabilities}{mortalityTable.period}(object, ...,
Period = 1975) ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.ageShift}(object, ..., \S4method{periodDeathProbabilities}{mortalityTable.ageShift}(object, ...,
Period = 1975) ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.trendProjection}(object, ..., \S4method{periodDeathProbabilities}{mortalityTable.trendProjection}(object, ...,
Period = 1975) ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.improvementFactors}(object, \S4method{periodDeathProbabilities}{mortalityTable.improvementFactors}(object,
..., Period = 1975) ..., ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.mixed}(object, ..., \S4method{periodDeathProbabilities}{mortalityTable.mixed}(object, ...,
Period = 1975) ages = NULL, Period = 1975)
\S4method{periodDeathProbabilities}{mortalityTable.jointLives}(object, ..., \S4method{periodDeathProbabilities}{mortalityTable.jointLives}(object, ...,
ageDifferences = c(), Period = 1975) ageDifferences = c(), ages = NULL, Period = 1975)
} }
\arguments{ \arguments{
\item{object}{The life table object (class inherited from mortalityTable)} \item{object}{The life table object (class inherited from mortalityTable)}
......
...@@ -9,8 +9,9 @@ ...@@ -9,8 +9,9 @@
transitionProbabilities(object, ...) transitionProbabilities(object, ...)
\S4method{transitionProbabilities}{pensionTable}(object, YOB = 1982, ..., \S4method{transitionProbabilities}{pensionTable}(object, YOB = 1982, ...,
OverallMortality = FALSE, Period = NULL, retirement = NULL, ages = NULL, OverallMortality = FALSE, Period = NULL,
invalids.retire = object@invalids.retire, as.data.frame = TRUE) retirement = NULL, invalids.retire = object@invalids.retire,
as.data.frame = TRUE)
} }