30-12-2021

1 Introduccion

El objetivo será calcular el índice de vulnerabilidad climática al cambio climático utilizando los siguientes indicadores:

IVHCC

haremos el ejercicio sólo para un periodo (en realidad un grupo de años que van del 2016 al 2020), la última data de la que disponemos.

1.1 % de poblacion sobre los 65 y menor a los 15 años:

Extraemos la información de la proyección de la población del INE 2002-2035.

edades <- read_xlsx("estimaciones-y-proyecciones-2002-2035-comunas.xlsx")
edades <- edades[,c(5,6,8,17:28)]
comunas <- unique(edades$Comuna)
tabla3 <- tibble()
for (i in comunas) { 
  tabla2 <- tibble()
  for (j in 4:15) {
      filtro <- filter(edades, Comuna == i)
      filtro_15 <- filter(filtro, Edad < 15);filtro_65 <- filter(filtro, Edad > 65)
      tabla <- tibble(
        cod_com = i,
        año = str_replace_all(colnames(filtro[,j]),"Poblacion ",""),
        menores_15 = sum(filtro_15[,j])*100/sum(filtro[,j]),
        mayores_65 = sum(filtro_65[,j])*100/sum(filtro[,j]) 
      ) 
      tabla2 <- rbind(tabla2,tabla) 
  } 
  tabla3 <- rbind(tabla3,tabla2)
}

Agregamos un cero a las cifras del codigo comunal de 4 digitos:

codigos <- tabla3$cod_com
rango <- seq(1:nrow(tabla3))
cadena <- paste("0",codigos[rango], sep = "")
cadena <- substr(cadena,(nchar(cadena)[rango])-(4),6)
codigos <- as.data.frame(codigos)
cadena <- as.data.frame(cadena)
comuna_corr <- cbind(tabla3,cadena)
comuna_corr <- comuna_corr[,-c(1),drop=FALSE]
names(comuna_corr)[4] <- "codigo"

vulnerables <- comuna_corr

datatable(vulnerables , 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))

1.2 Porcentaje de pobreza

Para la tabla de porcentaje de pobreza se utiliza la base de datos que se construyó en un requerimiento anterior:

pobreza <- read_xlsx("pobreza2.xlsx")
codigos <- filter(pobreza, Año == "2006")
contenedor <- tibble("Código"=unique(codigos$Código))
for (i in unique(pobreza$Año)) {
  
  los_anios <- filter(pobreza, Año == i)
 
  Pobre <- filter(los_anios, los_anios$Pobreza == "Pobre")
  Pobre_extremo <- filter(los_anios, los_anios$Pobreza == "Pobre extremo") 
  pobres_definitivos <-  merge(Pobre,Pobre_extremo,by="Código")
  pobres_definitivos$pobres_definitivos <- pobres_definitivos$porcentaje_pobreza.x + pobres_definitivos$porcentaje_pobreza.y 
  pobres_definitivos <- pobres_definitivos[, -c(3,4,5,7,8,9,10,11)]
  pobres_definitivos <- pobres_definitivos[, -c(2,3)]
  colnames(pobres_definitivos) <- c("Código",paste0("pob_",i))
 contenedor = merge(contenedor,pobres_definitivos,by="Código",all = T)
  
}
 
tabla <- contenedor[,-2]
names(tabla)[1] <- "Código" 
tabla$pob_2010 <- NA
tabla$pob_2012 <- NA
tabla$pob_2014 <- NA
tabla$pob_2016 <- NA
tabla$pob_2018 <- NA
tabla$pob_2019 <- NA
tabla <- tabla[,c("Código","pob_2009","pob_2010","pob_2011","pob_2012","pob_2013","pob_2014","pob_2015","pob_2016","pob_2017","pob_2018","pob_2019","pob_2020")]
# tabla <- tabla[,-2]
datatable(tabla, 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))

receptaculo <- data.frame()
for (n in 1:335 ) {
  # calculado <- na.approx(c(tabla[n,c(2:ncol(tabla))]))
  # tryCatch({
  # calculado <- c(paste0(tabla[n,c(1)]),calculado)
  # receptaculo <- rbind(receptaculo,calculado)
  # }, error = function(msg){  })
    calculado <- na.approx(c(tabla[n,c(2:ncol(tabla))])) #<<<------------  Codigo de interpolacion
  receptaculo <- rbind(receptaculo,calculado)
  
}
colnames(receptaculo) <- c("pob_2009","pob_2010","pob_2011","pob_2012","pob_2013","pob_2014","pob_2015","pob_2016","pob_2017","pob_2018","pob_2019","pob_2020")
receptaculo <- merge(tabla[,1:2],receptaculo,by="pob_2009")
pobreza <- receptaculo[,-1];names(pobreza)[1] <- "codigo"


datatable(pobreza, 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))

1.3 Enfermedades respiratorias

Las enfermedades respiratorias se obtuvieron del Ine para los años del 2014 al 2016 por mes

Tomamos el 2016

receptaculo <- data.frame()
for(i in unique(enf_resp_2016$comuna)){
    enfermedades <- filter(enf_resp_2016,enf_resp_2016$comuna == i)
    tabla <- tibble(
        comuna = i,
        total = sum(as.numeric(enfermedades$total)),
        año = unique(enfermedades$año)
    )
    receptaculo <- rbind(receptaculo,tabla)
}
datatable(receptaculo, 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))

Debemos ingresar la poblacion del 2016 y agregar los codigos comunales

poblacion_2016 <- readxl::read_xlsx("poblacion2016porcomuna.xlsx")

Proyecciones de Población por comuna y región 2015-2020
Fuente: INE 2015.

total_enfermed <- merge(receptaculo,poblacion_2016,by="comuna")

total_enfermed$porcentaje <- total_enfermed$total*100/total_enfermed$cantidad

Añadimos códigos comunales

cod_com <- readxl::read_xls("codigos_comunales.xls")

## New names:
## * `` -> ...8

names(cod_com)[7] <- "comuna"
total_enfermedw <- merge(total_enfermed,cod_com,by="comuna")
total_enfermedt <- total_enfermedw[, -c(2,4,6, 7,8,9,10,12:19)]

names(total_enfermedt)[4] <- "codigo"

datatable(total_enfermedt, 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))

1.4 IDH

Leemos el IDH

debemos agregar un cero al codigo comunal de cuatro cifras:

idh <- readxl::read_xlsx("idh.xlsx")

codigos <- idh$cod_com
rango <- seq(1:nrow(idh))
cadena <- paste("0",codigos[rango], sep = "")
cadena <- substr(cadena,(nchar(cadena)[rango])-(4),6)
codigos <- as.data.frame(codigos)
cadena <- as.data.frame(cadena)
comuna_corr <- cbind(idh,cadena)
idh <- comuna_corr[,-c(1),drop=FALSE]
datatable(idh, 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))

names(idh)[12] <- "codigo"
idh <- idh[,c(12,1:11)]
datatable(idh, 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))

1.5 Union total

datatable(IVHCC, 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))

2 La ponderacion

\[ 0.1* menores\_15 + 0.1*mayores\_65 + 0.2 *pobres\_definitivos + 0.4* porcentaje + 0.2* HDI \]

3 IVHCC

datatable(IVHCC, 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))

IVHCC2 <- IVHCC
  IVHCC2 <- IVHCC2[!is.na(IVHCC2[,c("IVHCC")]),]

normalizadas

IVHCC2 <- IVHCC
IVHCC2 <- IVHCC2[!is.na(IVHCC2[,c("IVHCC")]),]
columnas <- c("menores_15_norm","mayores_65_norm","pobreza_norm","enfermedades_norm","IDH_norm","IVHCC_norm")#<--- nombres columnas normalizadas
columnas2 <- c("menores_15_norm_rango","mayores_65_norm_rango","pobreza_norm_rango","enfermedades_norm_rango","IDH_norm_rango","IVHCC_norm_rango")#<--- nombres columnas rangos
columnas3 <- c("menores_15_norm_rango_cat","mayores_65_norm_rango_cat","pobreza_norm_rango_cat","enfermedades_norm_rango_cat","IDH_norm_rango_cat","IVHCC_norm_rango_cat")#<--- nombres columnas categorias

categorias <- c("a población - menor a 15","a población - mayor a 65","o nivel - pobreza","o porcentaje - de enfermedades","o nivel - IDH","o nivel - IVHCC")#<--- string de las categorias
 
for (i in 1:6) {
  
  tabla_norm <- tibble()
  for (j in seq(2010,2020,1)) {
    
    filtro <- filter(IVHCC2, año == j)
    minimo <- min(filtro[,i+2])
    maximo <- max(filtro[,i+2])
    
    filtro <- cbind(filtro,columnas[i]);names(filtro)[ncol(filtro)] <- filtro[1,ncol(filtro)]
  
    filtro[,ncol(filtro)] <- (filtro[,i+2]-minimo)/(maximo-minimo)
  
    df <- filtro
    maxi <- max(df[,ncol(df)]) 
    mini <- min(df[,ncol(df)])
    incremento <- (maxi-mini)/5
    
    uno <- mini
    dos <- mini + incremento
    tres <- dos  + incremento
    cuatro <- tres  + incremento
    quinto <- cuatro  + incremento
    sexto <- quinto  + incremento
    rango <- c(1, 2, 3, 4, 5)
    uno <- round(uno, digits = 3)
    dos <- round(dos, digits = 3)
    primer_rango <- paste(uno, "-", dos) 
    dos <- round(dos, digits = 3)
    tres <- round(tres, digits = 3)
    segundo_rango <- paste(dos, "-", tres) 
    tres <- round(tres, digits = 3)
    cuatro <- round(cuatro, digits = 3)
    tercer_rango <- paste(tres, "-", cuatro) 
    cuatro <- round(cuatro, digits = 3)
    quinto <- round(quinto, digits = 3)
    cuarto_rango <- paste(cuatro, "-", quinto) 
    quinto <- round(quinto, digits = 3)
    sexto <- round(sexto, digits = 3)
    quinto_rango <- paste(quinto, "-", sexto) 
    rango <- c(1,2,3,4,5)
    intervalos <- c(primer_rango, segundo_rango , tercer_rango , cuarto_rango , quinto_rango )
    df2 <- data.frame(rango, intervalos)
    # print(df2)
    df <- cbind(df,columnas2[i]);names(df)[ncol(df)] <- df[1,ncol(df)]
      
    df[,ncol(df)] <-  ifelse(df[,ncol(df)-1] >= uno     & df[,ncol(df)-1] < dos , 1, 
                      ifelse(df[,ncol(df)-1] >= dos     & df[,ncol(df)-1] < tres , 2, 
                      ifelse(df[,ncol(df)-1] >= tres    & df[,ncol(df)-1] < cuatro , 3, 
                      ifelse(df[,ncol(df)-1] >= cuatro  & df[,ncol(df)-1] < quinto ,4, 
                      ifelse(df[,ncol(df)-1] >= quinto ,5,"")))))
    
    df <- cbind(df,columnas3[i]);names(df)[ncol(df)] <- df[1,ncol(df)]
    
    df[,ncol(df)] <- ifelse(df[,ncol(df)-1] == 1 , paste0("muy baj",categorias[i]), 
                     ifelse(df[,ncol(df)-1] == 2 , paste0("baj",categorias[i]), 
                     ifelse(df[,ncol(df)-1] == 3 , paste0("moderad",categorias[i]), 
                     ifelse(df[,ncol(df)-1] == 4 , paste0("alt",categorias[i]),
                     ifelse(df[,ncol(df)-1] == 5 , paste0("muy alt",categorias[i]),"")))))
    
    tabla_norm <- rbind(tabla_norm,df)
  } 
  IVHCC2 <- cbind(IVHCC2,tabla_norm[,c((ncol(tabla_norm)-2):ncol(tabla_norm))])
}

writexl::write_xlsx(IVHCC2, "ivhcc.xlsx")