lt_rule_m_extrapolate: Extrapolate old-age human mortality curve using mortality...

View source: R/extra_mortality.R

lt_rule_m_extrapolateR Documentation

Extrapolate old-age human mortality curve using mortality laws

Description

Extrapolate old-age human mortality curve using mortality laws

Usage

lt_rule_m_extrapolate(
  mx,
  x,
  x_fit = x,
  x_extr,
  law = "kannisto",
  opt.method = "LF2",
  ...
)

Arguments

mx

Vector or matrix of age specific death-rates.

x

Vector of ages at the beginning of the age interval.

x_fit

Ages to be considered in estimating the mortality model parameters. x_fit can be a subset of x. However, after the model is identifies fitted values and residuals are computed for all ages in x.

x_extr

Ages for which to extrapolate the death-rates.

law

The name of the mortality law/model to be used. The following options are available:

  • "kannisto" – The Kannisto model;

  • "kannisto_makeham" – The Kannisto-Makeham model;

  • "gompertz" – The Gompertz model;

  • "ggompertz" – The Gamma-Gompertz model;

  • "makeham" – The Makeham model;

  • "beard" – The Beard model;

  • "beard_makeham" – The Beard-Makeham model;

  • "quadratic" – The Quadratic model.

opt.method

character. Default "LF2", see MortalityLaws::MortalityLaw for a description of choices.

...

Other arguments to be passed on to the MortalityLaw function.

Details

If fitting fails to converge, then we refit assuming Gompertz mortality with explicit starting parameters of parS = c(A = 0.005, B = 0.13) and a warning is issued.

Value

An object of class lt_rule_m_extrapolate with the following components:

input

List with arguments provided in input. Saved for convenience.

call

An unevaluated function call, that is, an unevaluated expression that consists of the named function applied to the given arguments.

fitted.model

An object of class MortalityLaw. Here one can find fitted values, residuals, goodness of fit measures etc.

values

A vector or matrix containing the complete mortality data, that is the modified input data following the extrapolation procedure.

Author(s)

Marius D. Pascariu rpascariu@outlook.com

See Also

MortalityLaw predict.MortalityLaw

Examples

# Example 1 - abridged data

# Age-specific death rates
mx <- c(.0859, .0034, .0009, .0007, .0016, .0029, .0036, .0054,
        .0053, .0146, .0127, .0269, .0170, .0433, .0371, .0784,
        .0930, .1399, .1875, .2250, .2500, .3000)
# Vector of ages
x <- c(0, 1, seq(5, 100, by = 5))
names(mx) <- x

# Fit the models / Extrapolate the mortality curve
x_fit  = c(80, 85, 90, 95, 100)
x_extr = 90:110
f1 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "kannisto")
f2 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "kannisto_makeham")
f3 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "gompertz")
f4 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "ggompertz")
 # makeham falls back to gompertz for this data
suppressWarnings(f5 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "makeham"))
f6 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "beard")
f7 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "beard_makeham")
f8 <- lt_rule_m_extrapolate(mx, x, x_fit, x_extr, law = "quadratic")

# Plot the results
## Not run: 
par(mfrow = c(1, 2))
plot(x, mx, pch = 16, xlim = c(60, 110), ylim = c(0, 0.6), cex = 1.5)
points(x_fit, mx[paste(x_fit)], pch = 16, col = 4, cex = 1.5)
lines(x_extr, f1$values[paste(x_extr)], lty = 1, col = 2, lwd = 2)
lines(x_extr, f2$values[paste(x_extr)], lty = 2, col = 3, lwd = 2)
lines(x_extr, f3$values[paste(x_extr)], lty = 3, col = 4, lwd = 2)
lines(x_extr, f4$values[paste(x_extr)], lty = 4, col = 5, lwd = 2)
lines(x_extr, f5$values[paste(x_extr)], lty = 5, col = 6, lwd = 2)
lines(x_extr, f6$values[paste(x_extr)], lty = 6, col = 7, lwd = 2)
lines(x_extr, f7$values[paste(x_extr)], lty = 7, col = 8, lwd = 2)
lines(x_extr, f8$values[paste(x_extr)], lty = 8, col = 9, lwd = 2)

legend("topleft", bty = "n",
       legend = c("Obs. Values", "Obs. Values used in fitting",
                  "Kannisto", "Kannisto-Makeham", "Gompertz", "Gamma-Gompertz",
                  "Makeham", "Beard", "Beard-Makeham", "Quadratic"),
       lty = c(NA, NA, 1:8), pch = c(16, 16, rep(NA, 8)),
       col = c(1, 4, 2:9), lwd = 2, pt.cex = 2)

## End(Not run)

# ----------------------------------------------
# Example 2 - 1-year age data

# Age-specific death rates
mx1 <- c(.0070, .0082, .0091, .0096, .0108, .0122, .0141, .0150, .0165, .0186,
         .0205, .0229, .0259, .0294, .0334, .0379, .0426, .0482, .0550, .0628,
         .0716, .0806, .0897, .1003, .1149, .1264, .1558, .1563, .1812, .2084,
         .2298, .2536, .2813, .3143, .3352, .3651, .4128)
# Vector of ages
x1 <- 65:101
names(mx1) <- x1

# Fit the models / Extrapolate the mortality curve
x_fit = 80:95
x_extr = 80:125
g1 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "kannisto")
g2 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "kannisto_makeham")
g3 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "gompertz")
g4 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "ggompertz")
g5 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "makeham")
g6 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "beard")
g7 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "beard_makeham")
g8 <- lt_rule_m_extrapolate(mx1, x1, x_fit, x_extr, law = "quadratic")

# Plot
## Not run: 
plot(x1, mx1, log = "y", ylim = c(0.001, 5),
     pch = 16, xlim = c(65, 125), cex = 1.3)
points(x_fit, mx1[paste(x_fit)], pch = 16, col = 4, cex = 1.5)
lines(x_extr, g1$values[paste(x_extr)], lty = 1, col = 2, lwd = 2)
lines(x_extr, g2$values[paste(x_extr)], lty = 2, col = 3, lwd = 2)
lines(x_extr, g3$values[paste(x_extr)], lty = 3, col = 4, lwd = 2)
lines(x_extr, g4$values[paste(x_extr)], lty = 4, col = 5, lwd = 2)
lines(x_extr, g5$values[paste(x_extr)], lty = 5, col = 6, lwd = 2)
lines(x_extr, g6$values[paste(x_extr)], lty = 6, col = 7, lwd = 2)
lines(x_extr, g7$values[paste(x_extr)], lty = 7, col = 8, lwd = 2)
lines(x_extr, g8$values[paste(x_extr)], lty = 8, col = 9, lwd = 2)

legend("topleft", bty = "n",
       legend = c("Obs. Values", "Obs. Values used in fitting",
                  "Kannisto", "Kannisto-Makeham", "Gompertz", "Gamma-Gompertz",
                  "Makeham", "Beard", "Beard-Makeham", "Quadratic"),
       lty = c(NA, NA, 1:8), pch = c(16, 16, rep(NA, 8)),
       col = c(1, 4, 2:9), lwd = 2, pt.cex = 2)

## End(Not run)

timriffe/DemoTools documentation built on Jan. 28, 2024, 5:13 a.m.