The age-specific proportion of people that will outlive their remaining life expectancy

OutliveEx.R

#library(devtools)
#install_github("DemogBerkeley", subdir = "DemogBerkeley", username = "UCBdemography")
library(DemogBerkeley)
# this will only work if you have an HMD username and password...
# but see the rest inc ase you want to try it on some other lifetable

username <- userInput() # do these one at a time, enter text into console
                        # this assigns the text to a variable without you
                        # having to save it in the script.
password <- userInput()
mltper   <- readHMDweb(CNTRY = "USA",item = "mltper_1x1", username = username, password = password)
fltper   <- readHMDweb(CNTRY = "USA",item = "fltper_1x1", username = username, password = password)

# get 2010 index
i <- mltper$Year == 2010
exm <- mltper$ex[i]
lxm <- mltper$lx[i] / 1e5 # remove radix
exf <- fltper$ex[i]
lxf <- fltper$lx[i] / 1e5 # remove radix

a <- 0:110
#getwd()
#png("MedianvsMean.png")
par(xaxs = "i", yaxs = "i")
plot(a, lxm, type= 'l', col = "blue", xlab = "age",ylab="l(x)")
lines(a, lxf, col = "red")
abline(h=.5)
abline(v=c(exm[1],exf[1]),col=c("blue","red"), lty = 2)
text(c(exm[1],exf[1]),.95,c("male e(x)","female ex"),pos=c(2,4))
text(95,.5,"median",pos=3)
#dev.off()

# but the same observation holds for a long first phase of life:
propOutlive <- function(lx,ex){
  
  age <- 1:length(lx) - 1
  
  # the l(x) for each value of e(x), linear interpolation:
  lex <- approx(x = age, y = lx, xout = age + ex)$y
  
  # conditional on survival to age x:
  lex / lx # terminal NAs if x + e(x )> omega 
}

# males surviving to ages greater than or equal to their own e(x):
mgeex <- propOutlive(lxm,exm)
fgeex <- propOutlive(lxf,exf)

# the age where exacatly 1/2 of survivors will make it to e(x)
mCross <- approx(mgeex, 0:110,.5)$y
fCross <- approx(fgeex, 0:110,.5)$y

#png("LiveToEx.png")
par(xaxs = "i", yaxs = "i", mai = c(.8,.8,.8,.8))
plot(a, mgeex, type= 'l', col = "blue", xlab = "age",ylab="proportion", main = bquote(frac(l[e[x]],l[x])))
lines(a, fgeex, col = "red")
abline(h = .5)
points(mCross, .5, pch = 19, col = "blue")
points(fCross, .5, pch = 19, col = "red")
text(mCross, .49, paste("Male crossover, age",round(mCross,2)),pos=2)
text(fCross, .51, paste("Female crossover, age",round(fCross,2)),pos=4, xpd=TRUE)
#dev.off()