1 Preámbulo
Necesitamos construir 3 índices que representamos en las siguientes gráficas:
IVHCC
IDH
IBH
Podemos observar que el indicador madre de todos es el índice de desarrollo humano.
En éste trabajo abordaremos la construcción del índice del PIB del IDH pero a nivel comunal y sobre una serie de tiempo.
Nuestro objetivo es construir una tabla del siguiente tipo:
Tabla objetivo
Tenemos m(x), la tasa de mortalidad general de una comuna que se multiplica por la proporción de población que muere a cada edad y le adjuntamos una columna con el valor correspondiente de edad. Aquí no está el error porque la suma de la columna m(x) nos da la tasa de mortalidad que publica el gobierno de Chile, el que para Arica es de 5,3 cada 1000 habitantes.
def_comunas <- read_xlsx("defunciones_comunas.xlsx")
fila <- seq(1,21277,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)
length(f_total)## [1] 347Homologamos el formato de la tabla original para poder trabajar sobre ella
tabla_comunas <- data.frame()
for (i in 1:346) {#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)2 x(x): Edad
Agregamos el registro de “año 0” sumando las defunciones que ocurrieron antes de cumplir un año. También agregamos como registro con valor de 0 en las edades en los que no hubo decesos para cada comuna.
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)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 l(x)
Paso siguiente es la construcción de la función de supervivencia. 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+004 d(x)
Ahora calculamos 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+005 q(x)
Calculemos la probabilidad de morir a la edad x.
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)## x l.x. d.x. q.x. m.x.
## 1 0 100000 17 1.787184e-04 1.787344e-04
## 2 1 99983 0 9.407028e-06 9.407072e-06
## 3 2 99983 0 0.000000e+00 0.000000e+00
## 4 3 99983 2 2.822082e-05 2.822122e-05
## 5 4 99981 0 0.000000e+00 0.000000e+006 L(x)
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. q.x. m.x. L.x.
## 1 0 100000 17 1.787184e-04 1.787344e-04 99991.5
## 2 1 99983 0 9.407028e-06 9.407072e-06 99983.0
## 3 2 99983 0 0.000000e+00 0.000000e+00 99983.0
## 4 3 99983 2 2.822082e-05 2.822122e-05 99982.0
## 5 4 99981 0 0.000000e+00 0.000000e+00 99981.07 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. q.x. m.x. L.x. T.x.
## 1 0 100000 17 1.787184e-04 1.787344e-04 99991.5 10372836
## 2 1 99983 0 9.407028e-06 9.407072e-06 99983.0 10272845
## 3 2 99983 0 0.000000e+00 0.000000e+00 99983.0 10172862
## 4 3 99983 2 2.822082e-05 2.822122e-05 99982.0 10072879
## 5 4 99981 0 0.000000e+00 0.000000e+00 99981.0 99728978 e(x)
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. q.x. m.x. L.x. T.x. e.x.
## 1 0 100000 17 1.787184e-04 1.787344e-04 99991.5 10372836 103.72836
## 2 1 99983 0 9.407028e-06 9.407072e-06 99983.0 10272845 102.74591
## 3 2 99983 0 0.000000e+00 0.000000e+00 99983.0 10172862 101.74591
## 4 3 99983 2 2.822082e-05 2.822122e-05 99982.0 10072879 100.74591
## 5 4 99981 0 0.000000e+00 0.000000e+00 99981.0 9972897 99.747929 Automatización
comunas <- unique(tabla3$comuna)
esp_d_vid <- data.frame()
fn_esperanza <- function(i){
mortalidad <- filter(tabla3, comuna == comunas[i])
for (j in 1:105) {
mortalidad$tasa_m[j] <- (mortalidad$Casos[j]/sum(mortalidad$Casos))
}
tabla_de_muerte <- data.frame(
comuna = 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)
}10 Esperanza de vida al nacer
# datatable(filter(esp_d_vid, x == 0 ), 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'))))esp_d_vida <- filter(esp_d_vid, x == 0)
esp_d_vida <- esp_d_vida[!is.na(esp_d_vida[,c("e.x.")]),]
datatable(filter(esp_d_vid, x == 0 ), 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'))))esp_d_vida$IEV <- (esp_d_vida$e.x. - 20)/(85-20)
esp_d_vida <- esp_d_vida[,c("comuna","IEV")]
saveRDS(esp_d_vida,"esp_d_vida_0.rds")11 Cálculo del IEV
datatable(esp_d_vida)