Rename haveAges -> givenAges, needAges -> neededAges in fillAges; Fix ifelse...

Rename haveAges -> givenAges, needAges -> neededAges in fillAges; Fix ifelse problem (vectorized, so we need to use if instead to return a vector); add missing age parameter to transitionProbabilities

R/deathProbabilities.R

@@ -21,8 +21,8 @@ setMethod("deathProbabilities", "mortalityTable.period",
           function(object, ..., ages = NULL, YOB = 1975) {
               fillAges(
                   object@modification(object@deathProbs * (1 + object@loading)),
-                  haveAges = ages(object),
-                  needAges = ages
+                  givenAges = ages(object),
+                  neededAges = ages
               );
           })
 
@@ -37,7 +37,7 @@ setMethod("deathProbabilities","mortalityTable.ageShift",
               } else if (shift < 0) {
                   qx = c(rep(0, -shift), qx[1:(length(qx) - (-shift))])
               }
-              fillAges(object@modification(qx), haveAges = ages(object), needAges = ages)
+              fillAges(object@modification(qx), givenAges = ages(object), neededAges = ages)
           })
 
 #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
@@ -46,9 +46,9 @@ setMethod("deathProbabilities","mortalityTable.trendProjection",
           function(object,  ..., ages = NULL, YOB = 1975) {
               qx = object@deathProbs * (1 + object@loading);
               if (is.null(object@trend2) || length(object@trend2) <= 1) {
-                  haveAges = object@ages;
+                  givenAges = object@ages;
                   damping = sapply(
-                      haveAges,
+                      givenAges,
                       function(age) { object@dampingFunction(YOB + age - object@baseYear) }
                   );
                   finalqx = exp(-object@trend * damping) * qx;
@@ -61,7 +61,7 @@ setMethod("deathProbabilities","mortalityTable.trendProjection",
                       -(object@trend * (1 - weights) + object@trend2 * weights) *
                           (YOB + 0:(length(qx) - 1) - object@baseYear))
               }
-              fillAges(object@modification(finalqx), givenAges = haveAges, neededAges = ages)
+              fillAges(object@modification(finalqx), givenAges = givenAges, neededAges = ages)
           })
 
 #' @describeIn deathProbabilities Return the (cohort) death probabilities of the
@@ -72,8 +72,8 @@ setMethod("deathProbabilities","mortalityTable.improvementFactors",
               impr = calculateImprovements(object, ..., YOB = YOB)
               fillAges(
                   object@modification(impr * qx),
-                  haveAges = ages(object),
-                  needAges = ages)
+                  givenAges = ages(object),
+                  neededAges = ages)
           })
 
 #' @describeIn deathProbabilities Return the (cohort) death probabilities of the

R/fillAges.R

@@ -6,12 +6,13 @@
 #' @param neededAges desired age range for output
 #'
 #' @export  fillAges
-fillAges = function(probs = c(), haveAges = c(), neededAges = NULL) {
+fillAges = function(probs = c(), givenAges = c(), neededAges = NULL, fill = NA_real_) {
     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)]
+        result = rep(fill, length(neededAges))
+        providedAges = intersect(neededAges, givenAges)
+        result[match(providedAges, neededAges)] = probs[match(providedAges, givenAges)]
+        result
     } else {
         probs
     }

R/pensionTable.R

@@ -131,11 +131,11 @@ setMethod("transitionProbabilities", "pensionTable",
                    invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
               if (!missing(Period) && !is.null(Period)) {
                   return(periodTransitionProbabilities(
-                      object, ..., Period = Period, retirement = retirement,
+                      object, ..., ages = ages, Period = Period, retirement = retirement,
                       invalids.retire = invalids.retire,
                       as.data.frame = as.data.frame))
               }
-              x   = ifelse(is.null(ages), ages(object@qx), ages);
+              x   = if (is.null(ages)) ages(object@qx) else  ages;
               # TODO: Make sure all sub-tables have the same age range!
               q   = deathProbabilities(object@qx, ..., ages = ages, YOB = YOB);
               i   = deathProbabilities(object@ix, ..., ages = ages, YOB = YOB);
@@ -219,8 +219,8 @@ setGeneric("periodTransitionProbabilities", function(object, ...) standardGeneri
 
 #' @describeIn periodTransitionProbabilities Return all transition probabilities of the pension table for the period Period
 setMethod("periodTransitionProbabilities", "pensionTable",
-          function(object, Period = 2017, ..., OverallMortality = FALSE, retirement = NULL, invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
-              x   = ifelse(is.null(ages), ages(object@qx), ages);
+          function(object, Period = 2017, ..., ages = NULL, OverallMortality = FALSE, retirement = NULL, invalids.retire = object@invalids.retire, as.data.frame = TRUE) {
+              x   = if (is.null(ages)) ages(object@qx) else  ages;
               q   = periodDeathProbabilities(object@qx, ..., ages = ages, Period = Period);
               i   = periodDeathProbabilities(object@ix, ..., ages = ages, Period = Period);
               qi  = periodDeathProbabilities(object@qix, ..., ages = ages, Period = Period);
@@ -272,3 +272,4 @@ avoe08p.period = periodTransitionProbabilities(AVOe2008P.male, Period = 2007, as
 pensionTables.list(package = "MortalityTablesPrivate")
 pensionTables.load("Austria_AVOe1999P")
 }
+

R/periodDeathProbabilities.R

@@ -15,7 +15,10 @@ setGeneric("periodDeathProbabilities", function(object, ..., ages = NULL, Period
 #'             of the life table for a given observation year
 setMethod("periodDeathProbabilities", "mortalityTable.period",
           function(object, ..., ages = NULL, Period = 1975) {
-              object@modification(object@deathProbs * (1 + object@loading));
+              fillAges(
+                  object@modification(object@deathProbs * (1 + object@loading)),
+                  givenAges = ages(object),
+                  neededAges = ages)
           })
 
 #' @describeIn periodDeathProbabilities Return the (period) death probabilities
@@ -29,8 +32,8 @@ setMethod("periodDeathProbabilities", "mortalityTable.ageShift",
               # if (shift.index) {}
               fillAges(
                   object@modification(qx),
-                  haveAges = ages(object),
-                  needAges = ages)
+                  givenAges = ages(object),
+                  neededAges = ages)
           })
 
 #' @describeIn periodDeathProbabilities Return the (period) death probabilities
@@ -51,8 +54,8 @@ setMethod("periodDeathProbabilities", "mortalityTable.trendProjection",
               }
               fillAges(
                   object@modification(finalqx),
-                  haveAges = ages(object),
-                  needAges = ages)
+                  givenAges = ages(object),
+                  neededAges = ages)
           })
 
 #' @describeIn periodDeathProbabilities Return the (period) death probabilities
@@ -63,8 +66,8 @@ setMethod("periodDeathProbabilities", "mortalityTable.improvementFactors",
               impr = calculateImprovements(object, ..., Period = Period)
               fillAges(
                   object@modification(qx * impr),
-                  haveAges = ages(object),
-                  needAges = ages)
+                  givenAges = ages(object),
+                  neededAges = ages)
           })
 
 #' @describeIn periodDeathProbabilities Return the (period) death probabilities

man/fillAges.Rd

@@ -4,14 +4,15 @@
 \alias{fillAges}
 \title{Fill the given probabilities with NA to match the desired age range.}
 \usage{
-fillAges(probs = c(), haveAges = c(), neededAges = NULL)
+fillAges(probs = c(), givenAges = c(), neededAges = NULL,
+  fill = NA_real_)
 }
 \arguments{
 \item{probs}{Numeric vector}
 
-\item{haveAges}{ages assigned to the given vector}
-
 \item{neededAges}{desired age range for output}
+
+\item{haveAges}{ages assigned to the given vector}
 }
 \description{
 Fill the given probabilities with NA to match the desired age range.

man/periodTransitionProbabilities.Rd

@@ -9,7 +9,7 @@
 periodTransitionProbabilities(object, ...)
 
 \S4method{periodTransitionProbabilities}{pensionTable}(object, Period = 2017,
-  ..., OverallMortality = FALSE, retirement = NULL,
+  ..., ages = NULL, OverallMortality = FALSE, retirement = NULL,
   invalids.retire = object@invalids.retire, as.data.frame = TRUE)
 }
 \arguments{