Skip to content

Instantly share code, notes, and snippets.

@viciana
Created March 12, 2024 09:22
Show Gist options
  • Save viciana/da2392cf81d3da7e0de6be11e9e8b349 to your computer and use it in GitHub Desktop.
Save viciana/da2392cf81d3da7e0de6be11e9e8b349 to your computer and use it in GitHub Desktop.
Descomposición de las diferencias en "Life Expectancy" entre dos poblaciones. Usa las tabla de vida oficiales del INE como entrada ..
## ----------------------------------------------------------------------------
## 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 ...
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment