IVACC

tmmx v 2.0

Equipo Data Science

DataIntelligence
30-12-2021 
library('DT')
library('tidyverse')
library('expss')

1 Introducción

2 Parte I

2.1 El código comunal

Leemos la data con la informacion administrativa comunal actualizada, desplegando solo los primeros diez registros:

codigos_comunales_actuales <- readxl::read_xls("CUT_2018_v04.xls")
names(codigos_comunales_actuales)[6] <- "Comuna"
codigos_comunales_actuales$Comuna  <- as.numeric(codigos_comunales_actuales$Comuna)

abc <- codigos_comunales_actuales[c(1:10),]

datatable(abc, 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.2 tmmx

Leemos los datos de temperaturas máximas imputadas (pero aún no corregidas por 0.1) desplegando solo los primeros diez registros::

rangos GEE

2.3 Tabla imputada de temperaturas máximas

Leemos la tabla imputada de temperaturas máximas

df_0 <- readRDS("TERRACLIMATE_MEDIA_tmmx_imp.rds")
names(df_0)[253] <- 'Comuna'
df_1 <- df_0[,c(253,1:252)]

abc <- df_1[c(1:10),]

datatable(abc, 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.4 Corregimos por 0.1

for (i in 2:253){
    df_1[,i] <- (df_1[,i]*.1)
}
options(digits=20)

abc <- df_1[c(1:10),]

datatable(abc, 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.5 Enero

Calculamos las sd y los promedios para el mes de Enero de todo el conjunto de años, estableciendo para las sd 5 categorías divididas en partes iguales cuyos extremos son los máximos y mínimos de la sd, asociando a cada comuna su pertenencia al quintil y el rango al que está asociado.

Observemos los perimeros 10 registros:

minimas <- tibble()
df_min <- df_1[,c(1,seq(2, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
# quedan las columnas quintiles_rango_n y quintiles_rango_n_valores como strings, debemos dejarlas como doubles
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[4] <- 'quintiles_rango_n_Enero'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Enero'
r_Enero <- r_enero

abc <- r_Enero[c(1:10),]

datatable(abc, 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.6 Febrero

minimas <- tibble()
df_min <- df_1[,c(1,seq(3, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Febrero'
names(r_enero)[3] <- 'mean_Febrero'
names(r_enero)[4] <- 'quintiles_rango_n_Febrero'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Febrero'
r_febrero <- r_enero

abc <- r_febrero[c(1:10),]

datatable(abc, 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.7 Marzo

minimas <- tibble()
df_min <- df_1[,c(1,seq(4, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Marzo'
names(r_enero)[3] <- 'mean_Marzo'
names(r_enero)[4] <- 'quintiles_rango_n_Marzo'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Marzo'
r_marzo <- r_enero

abc <- r_marzo[c(1:10),]

datatable(abc, 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.8 Abril

minimas <- tibble()
df_min <- df_1[,c(1,seq(5, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Abril'
names(r_enero)[3] <- 'mean_Abril'
names(r_enero)[4] <- 'quintiles_rango_n_Abril'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Abril'
r_abril <- r_enero

abc <- r_abril[c(1:10),]

datatable(abc, 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.9 Mayo

minimas <- tibble()
df_min <- df_1[,c(1,seq(6, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Mayo'
names(r_enero)[3] <- 'mean_Mayo'
names(r_enero)[4] <- 'quintiles_rango_n_Mayo'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Mayo'
r_mayo <- r_enero

abc <- r_mayo[c(1:10),]

datatable(abc, 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.10 Junio

minimas <- tibble()
df_min <- df_1[,c(1,seq(7, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Junio'
names(r_enero)[3] <- 'mean_Junio'
names(r_enero)[4] <- 'quintiles_rango_n_Junio'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Junio'
r_junio <- r_enero

abc <- r_junio[c(1:10),]

datatable(abc, 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.11 Julio

minimas <- tibble()
df_min <- df_1[,c(1,seq(8, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Julio'
names(r_enero)[3] <- 'mean_Julio'
names(r_enero)[4] <- 'quintiles_rango_n_Julio'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Julio'
r_julio <- r_enero

abc <- r_julio[c(1:10),]

datatable(abc, 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.12 Agosto

minimas <- tibble()
df_min <- df_1[,c(1,seq(9, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Agosto'
names(r_enero)[3] <- 'mean_Agosto'
names(r_enero)[4] <- 'quintiles_rango_n_Agosto'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Agosto'
r_agosto <- r_enero

abc <- r_agosto[c(1:10),]

datatable(abc, 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.13 Septiembre

minimas <- tibble()
df_min <- df_1[,c(1,seq(10, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Septiembre'
names(r_enero)[3] <- 'mean_Septiembre'
names(r_enero)[4] <- 'quintiles_rango_n_Septiembre'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Septiembre'
r_septiembre <- r_enero

abc <- r_septiembre[c(1:10),]

datatable(abc, 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.14 Octubre

minimas <- tibble()
df_min <- df_1[,c(1,seq(11, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Octubre'
names(r_enero)[3] <- 'mean_Octubre'
names(r_enero)[4] <- 'quintiles_rango_n_Octubre'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Octubre'
r_octubre <- r_enero

abc <- r_octubre[c(1:10),]

datatable(abc, 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.15 Noviembre

minimas <- tibble()
df_min <- df_1[,c(1,seq(12, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Noviembre'
names(r_enero)[3] <- 'mean_Noviembre'
names(r_enero)[4] <- 'quintiles_rango_n_Noviembre'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Noviembre'
r_noviembre <- r_enero

abc <- r_noviembre[c(1:10),]

datatable(abc, 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.16 Diciembre

minimas <- tibble()
df_min <- df_1[,c(1,seq(13, 253, 12))]
minimas <- rbind(minimas,df_min)
minimas <- minimas[order(minimas$Comuna),]
minimas$sd =  round(apply(minimas[,-1], 1, sd),3)
minimas$mean = rowMeans(minimas[,c(-1)])
names(minimas)[23] <- "sd_Enero"
names(minimas)[24] <- "mean_Enero"
minimas <- minimas[,-c(2:22,25)]
max <- max(minimas$sd_Enero)
min <- min(minimas$sd_Enero)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
receptaculo <- minimas
receptaculo$quintiles_rango_n <-
ifelse(receptaculo$sd_Enero >= uno & receptaculo$sd_Enero < dos , 1, ifelse(receptaculo$sd_Enero >= dos   & receptaculo$sd_Enero <  tres , 2, ifelse(receptaculo$sd_Enero >= tres   & receptaculo$sd_Enero < cuatro, 3, ifelse(receptaculo$sd_Enero >= cuatro    & receptaculo$sd_Enero < quinto , 4 , ifelse(receptaculo$sd_Enero >= quinto  & receptaculo$sd_Enero <  sexto,5,"")))))
receptaculo$quintiles_rango_n_valores <-
ifelse(receptaculo$quintiles_rango_n == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n == 5,df[5,2],"")))))
r_enero <- receptaculo
r_enero$Comuna <- as.double(r_enero$Comuna) 
r_enero$quintiles_rango_n <- as.double(r_enero$quintiles_rango_n) 
names(r_enero)[2] <- 'sd_Diciembre'
names(r_enero)[3] <- 'mean_Diciembre'
names(r_enero)[4] <- 'quintiles_rango_n_Diciembre'
names(r_enero)[5] <- 'quintiles_rango_n_valores_Diciembre'
r_diciembre <- r_enero

abc <- r_diciembre[c(1:10),]

datatable(abc, 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.17 Hay que apilar horizontalmente

Y vemos los primeros 10 registros:

datos_tmmn = cbind(r_Enero, r_febrero, r_marzo, r_abril, r_mayo, r_junio, r_julio, r_agosto,  r_septiembre, r_octubre, r_noviembre, r_diciembre)

abc <- datos_tmmn[c(1:10),]

datatable(abc, 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.18 Suma de los rangos

Añadimos una columna final en la que hacemos una suma de los quintiles sobre los que caen cada uno de los meses llamada suma de rangos:

datos_tmmn$suma_de_rangos <- datos_tmmn$quintiles_rango_n_Enero + datos_tmmn$quintiles_rango_n_Febrero + datos_tmmn$quintiles_rango_n_Marzo + datos_tmmn$quintiles_rango_n_Abril + datos_tmmn$quintiles_rango_n_Mayo +
datos_tmmn$quintiles_rango_n_Junio + datos_tmmn$quintiles_rango_n_Julio + datos_tmmn$quintiles_rango_n_Agosto +
datos_tmmn$quintiles_rango_n_Septiembre + datos_tmmn$quintiles_rango_n_Octubre + datos_tmmn$quintiles_rango_n_Noviembre +
datos_tmmn$quintiles_rango_n_Diciembre 

abc <- datos_tmmn[c(1:10),]

datatable(abc, 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.19 Quintilización de la suma de los rangos

Hacemos el mismo proceso de quintilización para la última columna creada agregando los campos del quintil al cual pertenece y el intervalo asociado:

max <- max(datos_tmmn$suma_de_rangos)
min <- min(datos_tmmn$suma_de_rangos)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)

receptaculo <- datos_tmmn

receptaculo$quintiles_rango_n_suma <-
ifelse(receptaculo$suma_de_rangos >= uno & receptaculo$suma_de_rangos < dos , 1, ifelse(receptaculo$suma_de_rangos >= dos   & receptaculo$suma_de_rangos <  tres , 2, ifelse(receptaculo$suma_de_rangos >= tres   & receptaculo$suma_de_rangos < cuatro, 3, ifelse(receptaculo$suma_de_rangos >= cuatro    & receptaculo$suma_de_rangos < quinto , 4 , ifelse(receptaculo$suma_de_rangos >= quinto  & receptaculo$suma_de_rangos <  sexto,5,"")))))

receptaculo$quintiles_rango_n_valores_suma <-
ifelse(receptaculo$quintiles_rango_n_suma == 1 , df[1,2], ifelse(receptaculo$quintiles_rango_n_suma == 2 , df[2,2], ifelse(receptaculo$quintiles_rango_n_suma == 3, df[3,2], ifelse(receptaculo$quintiles_rango_n_suma == 4, df[4,2] , ifelse(receptaculo$quintiles_rango_n_suma == 5,df[5,2],"")))))

abc <- receptaculo[c(1:10),]

datatable(abc, 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.20 Eliminemos los campos de comuna repetidos

receptaculo <- receptaculo[, -c(6,11,16,21,26,31,36,41,46,51,56)]

abc <- receptaculo[c(1:10),]

datatable(abc, 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.21 Agrupamos al final la información administrativa comunal

aaa <- merge(receptaculo, y = codigos_comunales_actuales)

abc <- aaa[c(1:10),]

datatable(abc, 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))
saveRDS(aaa, "tmmx.rds")
bbb <- readRDS("tmmx.rds")

2.22 Promedio de las sd, su estandarización y asociación a la categoria de rango al cual pertenece

Calculamos el promedio de las sd de cada mes agregando la columna promedios_sd_parte_tmmx_del_ivacc:

bbb$promedios_sd_parte_tmmx_del_ivacc <- (bbb[, 2] +  bbb[, 6] + bbb[, 10] +  bbb[, 14] + bbb[, 18] +  bbb[, 22] + bbb[, 26] +  bbb[, 30] +
    bbb[, 34] +  bbb[, 38] + bbb[, 42] +  bbb[, 46])/12

abc <- bbb[c(1:10),]

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

Anadimos columna de promedios_sd_parte_tmmx_del_ivacc estandarizada y la categoria string a la que pertenece la categorizacion quintilica de quintiles_rango_n_suma

maxi <- max(bbb$promedios_sd_parte_tmmx_del_ivacc)
mini <- min(bbb$promedios_sd_parte_tmmx_del_ivacc)
bbb$promedios_sd_estandarizado <- (bbb$promedios_sd_parte_tmmx_del_ivacc - mini)/(maxi - mini)
bbb$tmmn_quintiles_rango_n_suma_leyenda <- ifelse(bbb$quintiles_rango_n_suma == 1 , "muy baja vulnerabilidad - tmmx", ifelse(bbb$quintiles_rango_n_suma == 2 ,"baja vulnerabilidad - tmmx", ifelse(bbb$quintiles_rango_n_suma == 3, "moderada vulnerabilidad - tmmx", ifelse(bbb$quintiles_rango_n_suma == 4, "alta vulnerabilidad - tmmx" , ifelse(bbb$quintiles_rango_n_suma == 5,"muy alta vulnerabilidad - tmmx","")))))

abc <- bbb[c(1:10),]

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

Ordenamos las columnas:

Juntemos las últimas tres columnas creadas al final de conjunto de columnas no administrativas, separando ambos ámbitos por un * y como siempre observemos los primeros 10 registros:

bbb$x <-  "*"

bbb1 <- bbb[, c(  1,  2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 ,10, 11, 12, 13, 14, 15 ,16 ,17, 18 ,19 ,20 ,21 ,22 ,23 ,24 ,25 ,26 ,27 ,28 ,29 ,30 ,31 ,32 ,33 ,34 ,35 ,36 ,37 ,38 ,39 ,40 ,41 ,42 ,43, 44 ,45 ,46 ,47,48 ,49 ,62, 50, 51 ,52 ,59 ,60, 61 ,56 ,57 ,58 ,53 ,54 ,55)]

abc <- bbb1[c(1:10),]

datatable(abc, 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 Asignación exacta de nombres a las cabeceras

Asignemosle correctos nombres a las columnas desde el *:

names(bbb1)[51] <- "suma de los quintiles de sd por mes"
names(bbb1)[52] <- "quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes"
names(bbb1)[53] <- "rango"
names(bbb1)[54] <- "promedios_sd.parte_del_ivacc"
names(bbb1)[55] <- "promedios_sd_estandarizados"
names(bbb1)[56] <- "categoría"

Le agregamos a las cabeceras el postfijo tmmx

colnames(bbb1)[1:62] <- str_c( colnames(bbb1)[1:62], "_tmmx" )

Observemos los primeros 10 registros:

datatable(bbb1, 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 = 'tmmx.xlsx'),
          list(extend='pdf',
            filename= 'tabla')),
          text = 'Download')), scrollX = TRUE))

4 Parte II

Establecemos quintiles para la columna promedios_sd.parte_del_ivacc_tmmx

max <- max(bbb1$promedios_sd.parte_del_ivacc_tmmx)
min <- min(bbb1$promedios_sd.parte_del_ivacc_tmmx)
incremento <- (max-min)/5
dos <- min + incremento
tres <- dos  + incremento
cuatro <- tres  + incremento
quinto <- cuatro  + incremento
sexto <- quinto  + incremento + 0.001
rango <- c(1, 2, 3, 4, 5)
uno <- round(min, 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 )
df <- data.frame(rango, intervalos)
df
##   rango    intervalos
## 1     1 0.516 - 0.672
## 2     2 0.672 - 0.828
## 3     3 0.828 - 0.984
## 4     4  0.984 - 1.14
## 5     5  1.14 - 1.297

Asociamos promedios_sd.parte_del_ivacc_tmmx con su quintil, su rango y su categoría ordenando las columnas:

receptaculo <- bbb1
receptaculo$valor_del_rango_de_pro_sd <-
ifelse(receptaculo$promedios_sd.parte_del_ivacc_tmmx >= 0.515 & receptaculo$promedios_sd.parte_del_ivacc_tmmx < 0.672 , 1, ifelse(receptaculo$promedios_sd.parte_del_ivacc_tmmx >= 0.672   & receptaculo$promedios_sd.parte_del_ivacc_tmmx <  0.828 , 2, ifelse(receptaculo$promedios_sd.parte_del_ivacc_tmmx >= 0.828   & receptaculo$promedios_sd.parte_del_ivacc_tmmx < 0.984, 3, ifelse(receptaculo$promedios_sd.parte_del_ivacc_tmmx >= 0.984    & receptaculo$promedios_sd.parte_del_ivacc_tmmx < 1.14 , 4 , ifelse(receptaculo$promedios_sd.parte_del_ivacc_tmmx >= 1.14  & receptaculo$promedios_sd.parte_del_ivacc_tmmx <  1.298,5,"")))))
receptaculo$rango <-
ifelse(receptaculo$valor_del_rango_de_pro_sd == 1 , df[1,2], ifelse(receptaculo$valor_del_rango_de_pro_sd == 2 , df[2,2], ifelse(receptaculo$valor_del_rango_de_pro_sd == 3, df[3,2], ifelse(receptaculo$valor_del_rango_de_pro_sd == 4, df[4,2] , ifelse(receptaculo$valor_del_rango_de_pro_sd == 5,df[5,2],"")))))
receptaculo$nombre_del_rango <- ifelse(receptaculo$quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes_tmmx == 1 , "muy baja vulnerabilidad - tmmx", ifelse(receptaculo$quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes_tmmx == 2 ,"baja vulnerabilidad - tmmx", ifelse(receptaculo$quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes_tmmx == 3, "moderada vulnerabilidad - tmmx", ifelse(receptaculo$quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes_tmmx == 4, "alta vulnerabilidad - tmmx" , ifelse(receptaculo$quintiles_sobre_la_suma_de_los_quintiles_de_sd_por_mes_tmmx == 5,"muy alta vulnerabilidad - tmmx","")))))
receptaculo_final <- receptaculo[, c(  1,  2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 ,10, 11, 12, 13, 14, 15 ,16 ,17, 18 ,19 ,20 ,21 ,22 ,23 ,24 ,25 ,26 ,27 ,28 ,29 ,30 ,31 ,32 ,33 ,34 ,35 ,36 ,37 ,38 ,39 ,40 ,41 ,42 ,43, 44 ,45 ,46 ,47,48 ,49 ,50, 51 ,52 ,53 ,54, 63,64,65, 55 ,56, 57 ,58 ,59, 60 ,61 ,62)]
receptaculo_final$categoría_tmmx <- NULL

Requerimiento final

datatable(receptaculo_final, 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 = 'tmmx_z.xlsx'),
          list(extend='pdf',
            filename= 'tabla')),
          text = 'Download')), scrollX = TRUE))

4.1 Extracción de las columnas de interés:

tabla_tmmx <- tibble(
    comuna = receptaculo_final$Comuna_tmmx,
    promedios_sd.parte_del_ivacc_tmmx = receptaculo_final$promedios_sd.parte_del_ivacc_tmmx,
    nombre_del_rango = receptaculo_final$nombre_del_rango,
    promedios_sd_estandarizados_tmmx = receptaculo_final$promedios_sd_estandarizados_tmmx
)

tabla_tmmx
## # A tibble: 345 x 4
##    comuna promedios_sd.parte_del_ivacc_tmmx nombre_del_rango   promedios_sd_est~
##     <dbl>                             <dbl> <chr>                          <dbl>
##  1   1101                             0.753 baja vulnerabilid~             0.304
##  2   1107                             0.765 baja vulnerabilid~             0.320
##  3   1401                             0.831 baja vulnerabilid~             0.404
##  4   1402                             0.904 moderada vulnerab~             0.497
##  5   1403                             0.997 moderada vulnerab~             0.617
##  6   1404                             0.845 baja vulnerabilid~             0.423
##  7   1405                             0.938 moderada vulnerab~             0.542
##  8   2101                             1.06  alta vulnerabilid~             0.693
##  9   2102                             0.893 baja vulnerabilid~             0.484
## 10   2103                             1.00  moderada vulnerab~             0.621
## # ... with 335 more rows
saveRDS(tabla_tmmx, "tabla_tmmx.rds")

La fórmula aplicada al conjunto de variables IVACC se hace sobre los promedios_sd.parte_del_ivacc_tmmx para todas las variables!!!

Se extrae para construir una nueva tabla, de cada variable los siguientes campos:

1 promedios_sd.parte_del_ivacc_tmmx
2 nombre_del_rango y
3 promedios_sd_estandarizados_tmmx

Se deben pintar sobre un shp:

promedios_sd.parte_del_ivacc_tmmx y
promedios_sd_estandarizados_tmmx