Descomposición de las diferencias en "Life Expectancy" entre dos poblaciones. Usa las tabla de vida oficiales del INE como entrada ..

diff_LEx_CCAA.R

## ----------------------------------------------------------------------------
## Descomposición de las diferencias en "Life Expectancy" entre dos poblaciones
## Usa las tabla de vida oficiales del INE como entrada ..
## ----------------------------------------------------------------------------

rm(list = ls())
require(pxR)
require(data.table)
require(ggplot2)

# download.file('https://www.ine.es/jaxiT3/files/t/es/px/27154.px', destfile = 'INEbase_27154.px')
read.px('https://www.ine.es/jaxiT3/files/t/es/px/27154.px',encoding = 'latin1') -> tv.px

setDT (as.data.frame(tv.px)) -> tv
## Cambio nombre y formato de variables para facilitar su tratamiento posterior ...
setnames(tv,'Comunidades.y.Ciudades.Autónomas','CCAA')  # Cambio nombre variable
tv <- tv[!Sexo=='Ambos sexos'] # suprimo "ambos sexos"
tv <- tv[!Edad=='90 y más años'] # suprimo "90 y más años"  redundante

tv <- tv[ ! (CCAA %in% c("18 Ceuta","19 Melilla") ) ] # suprimo ceuta y melilla

levels( tv$CCAA )

tv[,Periodo:=as.integer(as.character(Periodo))]
levels(tv$Funciones) -> et.INE
et.formales <- c('nmx','nax','nqx','lx','ndx','nLx','Tx','ex')
cbind(et.formales,et.INE)
#  "nmx"       "Tasa de mortalidad"                            
#  "nax"       "Promedio de años vividos el último año de vida"
#  "nqx"       "Riesgo de muerte"                              
#  "lx"        "Supervivientes"                                
#  "ndx"       "Defunciones teóricas"                          
#  "nLx"       "Población estacionaria"                        
#  "Tx"        "Tiempo por vivir"                              
#  "ex"        "Esperanza de vida"    
levels(tv$Funciones) <- et.formales
tv[Funciones %in% c('nmx','nqx'),  value:=value/1000]  # escalo tasas y riesgos  por 1
tv[,cCCAA:= substr(as.character(CCAA),1,2)]
levels(tv$CCAA) <- substr(levels(tv$CCAA), 4,50 )
levels(tv$Edad)
tv[,x:=  as.integer( substr( gsub('^De ', '', as.character(Edad)), 1,2) )]
tv[,n:= as.double(0)]
tv[,.(cCCAA,CCAA,Sexo,Periodo,Edad,Funciones,x,n,value)] -> tv
setkey(tv,cCCAA,CCAA,Sexo,Periodo,Funciones,x )
tv[,n:= as.double(   shift(x,-1)-x )]
tv[x==95, n:= Inf]
tv[, ggEdad:=  as.character(cut(x, c(0,15,35,55,75,95,100), right = F))] 


# ==== Pivotar tabla de vida (LT)  de formato LARGO a formato  ANCHO ================
dcast(tv,cCCAA+CCAA+Sexo+Periodo+ggEdad+Edad+x+n~Funciones) -> tv2

# = Calcular Vida Perdida (Life Lost: llx) (en relacion a la expectativa a cada edad) = 


# =========== Agrupar LT en grande grupo de edad: ggEdad =============== 
tv2[,.(x=first(x),n=sum(n),lx=first(lx),ndx=sum(ndx),
               nLx=sum(nLx),Tx=first(Tx),ex=first(ex)),
    keyby=.(cCCAA,CCAA,Sexo,Periodo,ggEdad)] -> tv3

tv3[,':='(nqx=ndx/lx,nex=nLx/(10^5*n))]

tv3[1:6]
tv2[1:21]

# Función para calcular la descomposición por edad de la diferencia en 
# Life Expactancy (LE) entre dos zonas/grupos poblacionales

#' parametos:
#'   @param a.edad  Diferencias en LE medida a determinada edad.
#'   @param sexo    Hombres o Mujeres (no hay ambos sexos)
#'   @param periodo Año
#'   @param ccaa.1  CCAA, región 1º 
#'   @param ccaa.2  CCAA, región.. 2º
#'   @param db.lt   Objeto data,table con tablas de vida pivotadas, con esta estructura:
#'  
# cCCA      CCAA    Sexo Periodo   ggEdad  x   n     lx   ndx     nLx      Tx     ex      nqx     nex
#   01 Andalucía Hombres    1991   [0,15)  0  15 100000  1376 1482421 7256757 72.567 0.013769 0.98828
#   01 Andalucía Hombres    1991  [15,35) 15  20  98623  2746 1949802 5774336 58.549 0.027851 0.97490
#   01 Andalucía Hombres    1991  [35,55) 35  20  95876  7445 1862911 3824533 39.890 0.077653 0.93145
#   01 Andalucía Hombres    1991  [55,75) 55  20  88431 35110 1492704 1961622 22.182 0.397032 0.74635
#   01 Andalucía Hombres    1991  [75,95) 75  20  53321 51651  464868  468917  8.794 0.968692 0.23243
#   01 Andalucía Hombres    1991 [95,100) 95 Inf   1669  1669    4049    4049  2.425 1.000000 0.00000
#'   
#'   @return vector con "numbers of life-year-lost" (YLL) descompuesto por el papel 
#'           de cada grupos de edad en estas  diferencias  
#'   

Diff.YLL <- function(db.lt=tv2, 
                     ccaa.1='Andalucía', 
                     ccaa.2='Cataluña', 
                     time = 2022, 
                     sex = 'Hombres', a.edad =0) {
   
  db.lt[x>= a.edad & Sexo==sex & CCAA  == ccaa.1 & Periodo == time,  .(x,n,nmx,lx,ndx,nax,nLx,Tx,ex)]  -> lt1 
  db.lt[x>= a.edad & Sexo==sex & CCAA  == ccaa.2 & Periodo == time,  .(x,n,nmx,lx,ndx,nax,nLx,Tx,ex)]  -> lt2 
  
  ### nm95 o e95 estan mal calculadas.... hay que modificar nmx = 1/ex .. para consistencia 
  # lt1[,nd2x:=round(nLx*nmx-ndx,5)]
   lt1[x==95, nmx:=1/ex]    # ahora si encaja nmx ...
   lt2[x==95, nmx:=1/ex]    # ahora si encaja nmx ...
  merge(lt1,lt2,by =c('x','n'))  ->  lt12 
  # la esperanza perdida es una media entre e_x y e_x+1
  lt12[    ,YLL2_1:=(nmx.x-nmx.y)*(nLx.x/10^5)*(ex.y + shift(ex.y,-1))/2]
  lt12[x==95,YLL2_1:=   (ex.y - ex.x) * lx.x/10^5 ]
  
  # # prueba del 9
  # lt12[,.(e0.y=first(ex.y),e0.x=first(ex.x),
  #         Cero1=first(ex.y)-sum(nLx.y)/10^5,
  #         Cero2=first(ex.x)-sum(nLx.x/10^5),
  #         YLL=sum(nLx.y)/10^5-sum(nLx.x/10^5), 
  #         YLL.alt=sum(YLL2_1)/10^5 )]  # ok
  
  attr(lt12,'para') <- paste0 (sex,'. Año ',time)
  attr(lt12,'para') <- paste0 (sex,'. Año ',time)
  attr(lt12,'compara') <- paste0 ( ccaa.1,' frente a ',ccaa.2)
  
  return( lt12)
}  
## .......
## .......  ( Continuara )
# ====  graficos ===
  
Diff.YLL(db.lt=tv2, ccaa.1='Andalucía', ccaa.2='Cataluña', 
         time = 2022, sex = 'Hombres', a.edad =0) -> A2C

str(A2C)

# Por aqui me quede ...