# NOT RUN {
data(mxM, mxF, e0Fproj, e0Mproj, package = "wpp2017")
country <- "Brazil"
# estimate parameters from historical mortality data
mxm <- subset(mxM, name == country)[,4:16]
mxf <- subset(mxF, name == country)[,4:16]
rownames(mxm) <- rownames(mxf) <- c(0,1, seq(5, 100, by=5))
lcest <- lileecarter.estimate(mxm, mxf)
# project into future
e0f <- subset(e0Fproj, name == country)[-(1:2)]
e0m <- subset(e0Mproj, name == country)[-(1:2)]
# Blend LC and MLT
pred1 <- mortcast.blend(e0m, e0f, meth1 = "lc", meth2 = "mlt",
meth1.args = list(lc.pars = lcest),
meth2.args = list(type = "CD_North"),
weights = c(1,0.25))
# Blend PMD and MLT
pred2 <- mortcast.blend(e0m, e0f, meth1 = "pmd", meth2 = "mlt",
meth1.args = list(mxm0 = mxm[, "2010-2015"],
mxf0 = mxf[, "2010-2015"]))
# plot projection by time
plotmx <- function(pred, iage, main)
with(pred, {
# blended projections
plot(female$mx[iage,], type="l",
ylim=range(meth1res$female$mx[iage,],
meth2res$female$mx[iage,]),
ylab="female mx", xlab="Time", main=main, col = "red")
lines(meth1res$female$mx[iage,], lty = 2)
lines(meth2res$female$mx[iage,], lty = 3)
legend("topright", legend=c("blend", meth1, meth2),
lty = 1:3, col = c("red", "black", "black"), bty = "n")
})
age.group <- 3 # 5-9 years old
par(mfrow=c(1,2))
plotmx(pred1, age.group, "LC-MLT (age 5-9)")
plotmx(pred2, age.group, "PMD-MLT (age 5-9)")
# Blend LC and MLT for 1-year age groups
#########################################
# First interpolate e0 to get 1-year life expectancies (for first five years)
e0m1y <- approx(as.double(e0m[,1:2]), n = 5)$y
e0f1y <- approx(as.double(e0f[,1:2]), n = 5)$y
# derive toy mx in order to get some LC parameters
mxm1y <- mlt(seq(70, 72, length = 4), sex = "male", nx = 1)
mxf1y <- mlt(seq(78, 79, length = 4), sex = "female", nx = 1)
lcest1y <- lileecarter.estimate(mxm1y, mxf1y, nx = 1)
# projections
pred3 <- mortcast.blend(e0m1y, e0f1y, meth1 = "lc", meth2 = "mlt",
weights = c(1,0.25), min.age.groups = 131, nx = 1,
meth1.args = list(lc.pars = lcest1y),
kannisto.args = list(est.ages = 90:99, proj.ages = 100:130))
# plot results
par(mfrow=c(1,1))
plot(0:130, pred3$female$mx[,5], log = "y", type = "l", col = "red")
lines(0:130, pred3$male$mx[,5], col = "blue")
# }
Run the code above in your browser using DataLab