A few months ago, in Men set to live as long as women, figures show, it was mentioned that (in the U.K.)

the gap between male and female life expectancy is closing and men could catch up by 2030, according to an adviser for the Office for National Statistics.

(the slides are available online http://cass.city.ac.uk/…).

I don’t really know U.K. demography, but I was surprised to read such an optimistic conclusion. So I was wondering if similar values in France. The dataset I have is the following

> Deces=read.table("http://
  freakonometrics.free.fr/Deces-France.txt",
+ header=TRUE)
> Expo=read.table("http://
  freakonometrics.free.fr/Exposures-France.txt",
+ header=TRUE,skip=2)
> Deces$Age <- as.numeric(as.character(Deces$Age))
> Deces$Age[is.na(Deces$Age)] <- 110
> Expo$Age <- as.numeric(as.character(Expo$Age))
> Expo$Age[is.na(Expo$Age)] <- 110
> library(forecast)
> library(demography)
> YEAR <- unique(Deces$Year);nC=length(YEAR)
> AGE  <- unique(Deces$Age);nL=length(AGE)
> MUF  <- matrix(Deces$Female/Expo$Female,nL,nC)
> POPF <- matrix(Expo$Female,nL,nC)
> BASEF <- demogdata(data=MUF, pop=POPF,ages=AGE,
+ years=YEAR, type="mortality",
+ label="France", name="Femmes", lambda=1)
> MUM  <- matrix(Deces$Male/Expo$Male,nL,nC)
> POPM <- matrix(Expo$Male,nL,nC)
> BASEM <- demogdata(data=MUM, pop=POPM,ages=AGE,
+ years=YEAR, type="mortality",
+ label="France", name="Hommes", lambda=1)

To plot the residual expected lifetime, we can use the following code (we estimate Lee-Carter model, and then, forecast future mortality, and use it to estimate future survival probabilities)

> picture=function(a=50){
+  LCF <- lca(BASEF)
+  LCFf<-forecast(LCF,h=200)
+  A <- LCF$ax
+  B <- LCF$bx
+  K1 <- LCF$kt
+  K2 <- K1[length(K1)]+LCFf$kt.f$mean
+  K <- c(K1,K2)
+  MU <- matrix(NA,length(A),length(K))
+  for(i in 1:length(A)){
+  for(j in 1:length(K)){
+  MU[i,j] <- exp(A[i]+B[i]*K[j]) }}
+  esp.vie = function(xentier,T){
+  s <- seq(0,99-xentier-1)
+  MUd <- MU[xentier+1+s,T+s-1898]
+  Pxt <- cumprod(exp(-diag(MUd)))
+  ext <- sum(Pxt)
+  return(ext) }
+  E=function(T) esp.vie(a,T)
+  LEF=sapply(1900:2100,E)
+ 
+  LCF <- lca(BASEM)
+  LCFf<-forecast(LCF,h=200)
+  A <- LCF$ax
+  B <- LCF$bx
+  K1 <- LCF$kt
+  K2 <- K1[length(K1)]+LCFf$kt.f$mean
+  K <- c(K1,K2)
+  MU <- matrix(NA,length(A),length(K))
+  for(i in 1:length(A)){
+  for(j in 1:length(K)){
+  MU[i,j] <- exp(A[i]+B[i]*K[j]) }}
+  esp.vie = function(xentier,T){
+  s <- seq(0,99-xentier-1)
+  MUd <- MU[xentier+1+s,T+s-1898]
+  Pxt <- cumprod(exp(-diag(MUd)))
+  ext <- sum(Pxt)
+  return(ext) }
+  E=function(T) esp.vie(a,T)
+  LEM=sapply(1900:2100,E)
+ 
+ plot(1900:2100,LEM,col="blue",lwd=2,
+ ylim=range(c(LEM,LEF)),xlim=c(1890,2120),
+ xlab=paste("Age",a),type="l")
+ lines(1900:2100,LEF,col="red",lwd=2)
+ abline(v=c(2015,2100),lty=2)
+ points(2015,LEM[116],pch=19,col="blue")
+ points(2015,LEF[116],pch=19,col="red")
+ points(2015+85,LEM[116+85],pch=19,col="blue")
+ points(2015+85,LEF[116+85],pch=19,col="red")
+ text(2015+10,LEF[116],paste("+",trunc(1000*
+ (LEF[116]/LEM[116]-1))/10,"%",sep=""))
+ text(2100+10,LEF[116+85],paste("+",trunc(1000*
+ (LEF[110+85]/LEM[116+85]-1))/10,"%",sep=""))
+ text(1890,LEF[1],"F",col="red")
+ text(1890,LEM[1],"M",col="blue")
+ }

For instance, for the expected remaining lifetime, at age 30,

> picture(30)

How do we read this graph. In 2015, a man with age 30 should expect to live 52 years more, and a woman with age 30, almost 60 years. That +13.8% for women. In 2100, a man with age 30 should expect to live 59 years more, and a woman with age 30, 64.5 years. That +8.7% for women.

Yes, the difference is smaller (relatively, but also in absolute values, with 7.25 years difference in 2015, versus 5.5 years in 2100). But it is still large…

At birth, we have

> picture(0)

while at age 85,

> picture(85)

As we can see, that difference between 2100 and 2015 (between relative difference, men versus women) depends on the age.

> diffle=function(a=50){
+  LCF <- lca(BASEF)
+  LCFf<-forecast(LCF,h=200)
+  A <- LCF$ax
+  B <- LCF$bx
+  K1 <- LCF$kt
+  K2 <- K1[length(K1)]+LCFf$kt.f$mean
+  K <- c(K1,K2)
+  MU <- matrix(NA,length(A),length(K))
+  for(i in 1:length(A)){
+  for(j in 1:length(K)){
+  MU[i,j] <- exp(A[i]+B[i]*K[j]) }}
+  esp.vie = function(xentier,T){
+  s <- seq(0,99-xentier-1)
+  MUd <- MU[xentier+1+s,T+s-1898]
+  Pxt <- cumprod(exp(-diag(MUd)))
+  ext <- sum(Pxt)
+  return(ext) }
+  E=function(T) esp.vie(a,T)
+  LEF=sapply(1900:2100,E)
+ 
+  LCF <- lca(BASEM)
+  LCFf<-forecast(LCF,h=200)
+  A <- LCF$ax
+  B <- LCF$bx
+  K1 <- LCF$kt
+  K2 <- K1[length(K1)]+LCFf$kt.f$mean
+  K <- c(K1,K2)
+  MU <- matrix(NA,length(A),length(K))
+  for(i in 1:length(A)){
+  for(j in 1:length(K)){
+  MU[i,j] <- exp(A[i]+B[i]*K[j]) }}
+  esp.vie = function(xentier,T){
+  s <- seq(0,99-xentier-1)
+  MUd <- MU[xentier+1+s,T+s-1898]
+  Pxt <- cumprod(exp(-diag(MUd)))
+  ext <- sum(Pxt)
+  return(ext) }
+  E=function(T) esp.vie(a,T)
+  LEM=sapply(1900:2100,E)
+ 
+ return(c(LEF[116]/LEM[116]-1,
+ LEF[116+85]/LEM[116+85]-1))
+ }
> M=sapply(seq(0,95,by=5),diffle)
> plot(seq(0,95,by=5),M[1,],col="white",
+ ylim=100*range(c(0,as.numeric(M))))
> for(i in 1:ncol(M)){
+ arrows((i-1)*5,100*M[1,i],(i-1)*5,100*M[2,i],length=.1)}

The x-axis is the age. The starting point of the arrow is the relative difference men vs. women in 2015 (e.g. +13.8% at age 30) and the ending point of the arrow, is 2100 (e.g. +8.7% at age 30). This difference is changing with the age… but in 2100, women will still live longer than men (on average) ! But I do not know how sensitive to the model it could be…. Because it is surprising to have such a gender difference in France in 2100, while it might be gone in the UK in 2030.