1 Introducción
Nuestro objetivo es determinar el IDH por comuna en Chile y su evolución en el tiempo, según lo calcula el PNUD:
\[ HDI = (LEI \cdot EI \cdot II) ^\frac{1}{3} \] Donde:
- Índice de esperanza de vida (LEI)
- Índice de educación (IE)
- Índice de ingresos (II)
En éste informe establecemos la metodología para el cálculo del LEI para el año 2010, la cual es extensible a todos los años:
2 La tabla de mortalidad
¿Qué es una tabla de mortalidad?
También conocida como tabla de vida o tabla actuarial, la tabla de mortalidad muestra la tasa de muertes que ocurren en una población definida durante un intervalo de tiempo seleccionado, o las tasas de supervivencia desde el nacimiento hasta la muerte. Una tabla de mortalidad generalmente muestra la probabilidad general de muerte de una persona antes de su próximo cumpleaños, según su edad actual. Estas tablas se utilizan normalmente para informar la construcción de pólizas de seguro y otras formas de gestión de responsabilidad.
La siguiente tabla nos muestra un ejemplo de tabla de mortalidad:
Tabla de mortalidad
Desde una aplicación del INE1 podemos obtener la información de la cantidad de muertes que se producen en cada año vivido. Tratamos el resultado obtenido para obtener la tabla original sobre la cual empezar a trabajar:
def_comunas <- read_xlsx("defunciones_comunas_2010.xlsx")
fila <- seq(1,nrow(def_comunas),1)
def_comunas <- cbind(def_comunas,fila)
f_area <- data.frame(filter(def_comunas,grepl("AREA #",...2)))$fila
vacio <- data.frame(filter(def_comunas,grepl("Tabla vacía",...2)))$fila
f_total <- data.frame(filter(def_comunas,grepl("Total",...2)))$fila
f_total <- c(f_total,vacio)
f_total <- sort(f_total)
lim <- length(f_total)-1
# lim
# f_total
tabla_comunas <- data.frame()
for (i in 1:lim) {#length(f_area)
m_comunas <- def_comunas[c(f_area[i]:f_total[i]),2:3]
m_comunas$cod_com <- str_replace_all(paste0(m_comunas[1,1]),"AREA # ","")
m_comunas$comuna <- paste0(m_comunas[1,2])
colnames(m_comunas) <- c("Edad","Casos","cod_com","comuna")
m_comunas <- m_comunas[-c(1:3,nrow(m_comunas)),]
tabla_comunas <- rbind(tabla_comunas,m_comunas)
}
tabla_comunas$Casos <- as.numeric(tabla_comunas$Casos)
tabla_comunas <- tabla_comunas[,c(3,4,1,2)]
tabla_comunas$fila <- seq(1,nrow(tabla_comunas))
# head(tabla_comunas)
datatable(tabla_comunas, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'tabla'),
list(extend='pdf',
filename= 'tabla')),
text = 'Download')), scrollX = TRUE))3 Digresión
Expliquemos la forma en la que se calcula la esperanza de vida en términos teóricos utilizando a la vez un ejemplo:
3.1 x: Edad
comunas <- unique(tabla_comunas$comuna)
tabla2 <- data.frame()
for (i in comunas[1:346]) {
tabla <- filter(tabla_comunas, comuna == i)
suma <- filter(tabla_comunas, comuna == i)
if(nrow(filter(tabla, Edad == "1 año")) == 0){
}else{
tabla_1 <- filter(tabla, Edad == "1 año")
tabla_1$Edad <- "1 años"
tabla <- rbind(tabla_1,tabla)
tabla <- filter(tabla, Edad != "1 año")
}
tabla <- filter(tabla, grepl("año",Edad))
anio_0 <- tabla[1,]
anio_0$Edad <- "0 años"
anio_0$Casos <- sum(filter(suma, !grepl("año",Edad))[4])
tabla <- rbind(anio_0,tabla)
tabla <- filter(tabla, !grepl("más",Edad))
tabla2 <- rbind(tabla2,tabla)
}
datatable(tabla2)Agregamos el registro de “año 0” sumando las defunciones que ocurrieron antes de cumplir un año. También agregamos como registro un valor de 0 en las edades en los que no hubo decesos para cada comuna.
de ésta manera los registros pasan a ser de 18529 a 35595
3.2 m(x): Probabilidad de muerte
l.x. es sólo una columna vacía representante de un valor hipotético inicial de 10000 personas vivas decreciente en el tiempo que utilizaremos más adelante.
x son los años de vida y m.x. es la probabilidad de morir a esa edad, calculado con las personas muertas a la edad n dividido por la cantidad de personas vivas a esa misma edad.
Agregamos en la columna Edad, el registro “0 años”, que suma las defunciones que ocurrieron antes de cumplir un año. También agregamos como registro un valor de 0 en las edades en los que no hubo decesos para cada comuna.
tabla3 <- data.frame()
for (j in comunas) {
filtro <- filter(tabla2, comuna == j)
n_edades <- data.frame()
for (i in 0:104) {
seq_años <- paste(i," años")
n_edades <- rbind(n_edades,seq_años)
}
names(n_edades)[1] <- "Edad"
tablaf = merge(x = n_edades, y = filtro, by = "Edad", all.x = TRUE)
tablaf <- mutate_all(tablaf, ~replace(., is.na(.), 0))
tablaf$comuna <- j
tabla3 <- rbind(tabla3,tablaf)
}
tabla_f <- tabla3
# tabla3
for (i in 1:104) {
tabla_f$tasa_m[i] <- (tabla_f$Casos[i]/sum(tabla_f$Casos))
}
tabla_de_muerte <- data.frame(
x = seq(0,104,1),
"l(x)" = round(0,0),
"m(x)" = tabla_f$tasa_m
)
# head(tabla_de_muerte)
datatable(tabla_de_muerte)3.3 l(x)
Paso siguiente es la construcción de la función de supervivencia, que es la gente que va quedando viva con el transcurso de los años. Empezamos con l(0) = 100000 siguiendo la convención.
tabla_de_muerte$l.x.[1] <- 100000
mx <- tabla_de_muerte$m.x.
for (j in 2:length(mx)) {
tabla_de_muerte$l.x.[j] <- ceiling(tabla_de_muerte$l.x.[j-1]*exp(-tabla_de_muerte$m.x.[j-1]))
}
head(tabla_de_muerte,5)## x l.x. m.x.
## 1 0 100000 1.787344e-04
## 2 1 99983 9.407072e-06
## 3 2 99983 0.000000e+00
## 4 3 99983 2.822122e-05
## 5 4 99981 0.000000e+003.4 d(x)
Añadimos el numero de muertes en la columna d(x).
tabla_de_muerte$d.x. <- 0
for (j in 1:105) {
tabla_de_muerte$d.x.[j] <- tabla_de_muerte$l.x.[j]-tabla_de_muerte$l.x.[j+1]
}
tabla_de_muerte <- tabla_de_muerte[,c(1,2,4,3)]
head(tabla_de_muerte,5)## x l.x. d.x. m.x.
## 1 0 100000 17 1.787344e-04
## 2 1 99983 0 9.407072e-06
## 3 2 99983 0 0.000000e+00
## 4 3 99983 2 2.822122e-05
## 5 4 99981 0 0.000000e+00# tabla_de_muerte$q.x. <- 0
# for (j in 1:105) {
# # tabla_de_muerte$q.x.[j] <- tabla_de_muerte$d.x.[j]/tabla_de_muerte$l.x.[j]
# tabla_de_muerte$q.x.[j] <- 1- exp(-tabla_de_muerte$m.x.[j])
#
# }
# tabla_de_muerte <- tabla_de_muerte[,c(1,2,3,5,4)]
# head(tabla_de_muerte,5)3.5 L(x)
Agregamos el número de años-persona vividos entre las edades exactas x y x + 1.
tabla_de_muerte$L.x. <- 0
for (j in 1:105) {
tabla_de_muerte$L.x.[j] <- (tabla_de_muerte$l.x.[j+1])+(0.5*tabla_de_muerte$d.x.[j] )
}
head(tabla_de_muerte,5)## x l.x. d.x. m.x. L.x.
## 1 0 100000 17 1.787344e-04 99991.5
## 2 1 99983 0 9.407072e-06 99983.0
## 3 2 99983 0 0.000000e+00 99983.0
## 4 3 99983 2 2.822122e-05 99982.0
## 5 4 99981 0 0.000000e+00 99981.03.6 T(x)
El número de años-persona vividos después de la edad exacta x.
tabla_de_muerte$T.x. <- 0
tabla_de_muerte <- tabla_de_muerte[1:104,]
for (j in 1:104) {
tabla_de_muerte$T.x.[j] <- sum( tabla_de_muerte$L.x.[j:104] )
}
head(tabla_de_muerte,5)## x l.x. d.x. m.x. L.x. T.x.
## 1 0 100000 17 1.787344e-04 99991.5 10372836
## 2 1 99983 0 9.407072e-06 99983.0 10272845
## 3 2 99983 0 0.000000e+00 99983.0 10172862
## 4 3 99983 2 2.822122e-05 99982.0 10072879
## 5 4 99981 0 0.000000e+00 99981.0 99728973.7 e(x)
Calculamos el número medio de años de vida que quedan a la edad exacta x.
tabla_de_muerte$e.x. <- 0
for (j in 1:104) {
tabla_de_muerte$e.x.[j] <- tabla_de_muerte$T.x.[j]/tabla_de_muerte$l.x.[j]
}
head(tabla_de_muerte,5)## x l.x. d.x. m.x. L.x. T.x. e.x.
## 1 0 100000 17 1.787344e-04 99991.5 10372836 103.72836
## 2 1 99983 0 9.407072e-06 99983.0 10272845 102.74591
## 3 2 99983 0 0.000000e+00 99983.0 10172862 101.74591
## 4 3 99983 2 2.822122e-05 99982.0 10072879 100.74591
## 5 4 99981 0 0.000000e+00 99981.0 9972897 99.747923.7.1 Para Iquique la tabla de muerte sería entonces:
datatable(tabla_de_muerte, extensions = 'Buttons',
options = list(dom = 'Bfrtip',
buttons = list(list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'tabla'),
list(extend='pdf',
filename= 'tabla')),
text = 'Descargar'))))3.7.2 A nivel nacional
comunas <- unique(tabla_comunas$cod_com)
tabla2 <- data.frame()
for (i in comunas[1:lim]) {
tabla <- filter(tabla_comunas, cod_com == i)
suma <- filter(tabla_comunas, cod_com == i)
if(nrow(filter(tabla, Edad == "1 año")) == 0){
}else{
tabla_1 <- filter(tabla, Edad == "1 año")
tabla_1$Edad <- "1 años"
tabla <- rbind(tabla_1,tabla)
tabla <- filter(tabla, Edad != "1 año")
}
tabla <- filter(tabla, grepl("año",Edad))
anio_0 <- tabla[1,]
anio_0$Edad <- "0 años"
anio_0$Casos <- sum(filter(suma, !grepl("año",Edad))[4])
tabla <- rbind(anio_0,tabla)
tabla <- filter(tabla, !grepl("más",Edad))
tabla2 <- rbind(tabla2,tabla)
}
tabla3 <- data.frame()
for (j in comunas) {
filtro <- filter(tabla2, cod_com == j)
n_edades <- data.frame()
for (i in 0:104) {
seq_años <- paste(i," años")
n_edades <- rbind(n_edades,seq_años)
}
names(n_edades)[1] <- "Edad"
tablaf = merge(x = n_edades, y = filtro, by = "Edad", all.x = TRUE)
tablaf <- mutate_all(tablaf, ~replace(., is.na(.), 0))
tablaf$cod_com <- j
tabla3 <- rbind(tabla3,tablaf)
}
datatable(tabla3, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'tabla'),
list(extend='pdf',
filename= 'tabla')),
text = 'Download')), scrollX = TRUE))fin de la digresión.
4 Automatización para todas las comunas de Chile del 2010 al 2017.
esp_d_vida_def <- tibble("n"=339)
for (a in seq(2010,2017,1)) {
direccion <- paste0("defunciones_comunas_",a,".xlsx")
def_comunas <- read_xlsx(direccion)
fila <- seq(1,nrow(def_comunas),1)
def_comunas <- cbind(def_comunas,fila)
f_area <- data.frame(filter(def_comunas,grepl("AREA #",...2)))$fila
vacio <- data.frame(filter(def_comunas,grepl("Tabla vacía",...2)))$fila
f_total <- data.frame(filter(def_comunas,grepl("Total",...2)))$fila
f_total <- c(f_total,vacio)
f_total <- sort(f_total)
lim <- length(f_total)-1
# lim
# f_total
tabla_comunas <- data.frame()
for (i in 1:lim) {#length(f_area)
m_comunas <- def_comunas[c(f_area[i]:f_total[i]),2:3]
m_comunas$cod_com <- str_replace_all(paste0(m_comunas[1,1]),"AREA # ","")
m_comunas$comuna <- paste0(m_comunas[1,2])
colnames(m_comunas) <- c("Edad","Casos","cod_com","comuna")
m_comunas <- m_comunas[-c(1:3,nrow(m_comunas)),]
tabla_comunas <- rbind(tabla_comunas,m_comunas)
}
tabla_comunas$Casos <- as.numeric(tabla_comunas$Casos)
tabla_comunas <- tabla_comunas[,c(3,4,1,2)]
tabla_comunas$fila <- seq(1,nrow(tabla_comunas))
##################################################################################################################################################
comunas <- unique(tabla_comunas$cod_com)
tabla2 <- data.frame()
for (i in comunas[1:lim]) {
tabla <- filter(tabla_comunas, cod_com == i)
suma <- filter(tabla_comunas, cod_com == i)
if(nrow(filter(tabla, Edad == "1 año")) == 0){
}else{
tabla_1 <- filter(tabla, Edad == "1 año")
tabla_1$Edad <- "1 años"
tabla <- rbind(tabla_1,tabla)
tabla <- filter(tabla, Edad != "1 año")
}
tabla <- filter(tabla, grepl("año",Edad))
anio_0 <- tabla[1,]
anio_0$Edad <- "0 años"
anio_0$Casos <- sum(filter(suma, !grepl("año",Edad))[4])
tabla <- rbind(anio_0,tabla)
tabla <- filter(tabla, !grepl("más",Edad))
tabla2 <- rbind(tabla2,tabla)
}
tabla3 <- data.frame()
for (j in comunas) {
filtro <- filter(tabla2, cod_com == j)
n_edades <- data.frame()
for (i in 0:104) {
seq_años <- paste(i," años")
n_edades <- rbind(n_edades,seq_años)
}
names(n_edades)[1] <- "Edad"
tablaf = merge(x = n_edades, y = filtro, by = "Edad", all.x = TRUE)
tablaf <- mutate_all(tablaf, ~replace(., is.na(.), 0))
tablaf$cod_com <- j
tabla3 <- rbind(tabla3,tablaf)
}
#############################################################################################################################################
comunas <- unique(tabla3$cod_com)
esp_d_vid <- data.frame()
fn_esperanza <- function(i){
mortalidad <- filter(tabla3, cod_com == comunas[i])
for (j in 1:105) {
mortalidad$tasa_m[j] <- (mortalidad$Casos[j]/sum(mortalidad$Casos))
}
tabla_de_muerte <- data.frame(
cod_com = comunas[i],
x = seq(0,104,1),
"l(x)" = round(0,0),
"m(x)" = mortalidad$tasa_m
)
tabla_de_muerte$l.x.[1] <- 100000
tabla_de_muerte$l.x.[2] <- ceiling(tabla_de_muerte$l.x.[1]*exp(-tabla_de_muerte$m.x.[1]))
mx <- tabla_de_muerte$m.x.
for (j in 3:length(mx)) {
tabla_de_muerte$l.x.[j] <- ceiling(tabla_de_muerte$l.x.[j-1]*exp(-tabla_de_muerte$m.x.[j-1]))
}
tabla_de_muerte$d.x. <- 0
for (j in 1:105) {
tabla_de_muerte$d.x.[j] <- tabla_de_muerte$l.x.[j]-tabla_de_muerte$l.x.[j+1]
}
tabla_de_muerte <- tabla_de_muerte[,c(1,2,3,5,4)]
tabla_de_muerte$q.x. <- 0
for (j in 1:105) {
# tabla_de_muerte$q.x.[j] <- (tabla_de_muerte$d.x.[j]/tabla_de_muerte$l.x.[j])
tabla_de_muerte$q.x.[j] <- 1- exp(-tabla_de_muerte$m.x.[j])
}
tabla_de_muerte <- tabla_de_muerte[,c(1,2,3,4,6,5)]
tabla_de_muerte$L.x. <- 0
for (j in 1:105) {
tabla_de_muerte$L.x.[j] <- tabla_de_muerte$l.x.[j+1]+(0.5*tabla_de_muerte$d.x.[j] )
}
tabla_de_muerte$T.x. <- 0
tabla_de_muerte <- tabla_de_muerte[1:104,]
for (j in 1:104) {
tabla_de_muerte$T.x.[j] <- sum( tabla_de_muerte$L.x.[j:104] )
}
tabla_de_muerte$e.x. <- 0
for (j in 1:104) {
tabla_de_muerte$e.x.[j] <- tabla_de_muerte$T.x.[j]/tabla_de_muerte$l.x.[j]
}
tabla_de_muerte2 <<- tabla_de_muerte
}
for (i in 1:339) {
fn_esperanza(i)
esp_d_vid <- rbind(esp_d_vid,tabla_de_muerte2)
}
esp_d_vida <- filter(esp_d_vid, x == 0)
esp_d_vida <- esp_d_vida[!is.na(esp_d_vida[,c("e.x.")]),]
esp_d_vida <- filter(esp_d_vida, x == 0 )
maximo_ex <- max(esp_d_vid$e.x.)
minimo_ex <- min(esp_d_vid$e.x.)
esp_d_vida$LEI <- (esp_d_vida$e.x. - minimo_ex)/(maximo_ex-minimo_ex)
esp_d_vida <- esp_d_vida[,c("cod_com","LEI")]
colnames(esp_d_vida) <- c("cod_com",paste0("LEI_",a))
esp_d_vida_def <- cbind(esp_d_vida_def,esp_d_vida)
}
esp_d_vida_def <- esp_d_vida_def[,c(2,3,5,7,9,11,13,15,17)]datatable(esp_d_vida_def, extensions = 'Buttons', escape = FALSE, rownames = TRUE,
options = list(dom = 'Bfrtip',
buttons = list('colvis', list(extend = 'collection',
buttons = list(
list(extend='copy'),
list(extend='excel',
filename = 'tabla'),
list(extend='pdf',
filename= 'tabla')),
text = 'Download')), scrollX = TRUE))