#' Generate Ages at Death
#'
#' This function generates ages at death depending on a mortality table. If n=1, the function
#' will return the life expectancy.
#'
#' @param curAge Current age of individual. Assumes just turned this age.
#' @param gender 'Male' or 'Female'
#' @param n Number of ages to generate
#' @param mort.factor A value multiplied by each mortality value. Higher than 1 shortens lifespan
#'
#' @return Vector of ages at death
#' @export
#'
#' @examples \dontrun{generateAgesAtDeath(51, "Male", 10, 1.0)}
#'
generateAgesAtDeath <- function(curAge, gender, n = 1, mort.factor=1.0) {
# load(file="./data/mortality.rdata")
# mortality <- readRDS("./inst/extdata/mortality.rds")
#mortality <- load("./data/mortality.rda") # load mortality table
utils::data("mortality")
maxAge <- mortality[nrow(mortality), "age"]
out <- integer(n)
if (curAge < 0)
curAge <- 0
if (curAge > maxAge) {
out[1:n] <- maxAge
return(out)
}
mortalityColumn <- ifelse(substr(toupper(gender), 1, 1) == "M", 2, 3)
numLivesRemaining <- numeric(maxAge - curAge + 2)
intLivesRemaining <- integer(maxAge - curAge + 2)
numLivesRemaining[1] <- n
intLivesRemaining[1] <- n
j = 2
k = 1
for (i in curAge:maxAge) {
numLivesRemaining[j] <-
numLivesRemaining[j - 1] * (1 - mort.factor * mortality[i + 1, mortalityColumn])
intLivesRemaining[j] <- round(numLivesRemaining[j])
l <- intLivesRemaining[j - 1] - intLivesRemaining[j]
if (l > 0){
out[k:(k+l-1)] <- i
k <- k + l
}
j <- j + 1
}
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.