Correlaciones entre variables del CENSO de Viviendas, Hogares y Personas e Ingresos promedios comunales de la CASEN 2017.

VE-CC-AJ

DataIntelligence

Lunes 12-07-2021


1 Nivel nacional URBANO (código 1)

1.1 Pregunta P13: Residencia habitual

Categorías de respuesta:

1 Sí
2 No asiste actualmente
3 Nunca asistió

1.2 Generación de tabla de contingencia para la variable P13

tabla_con_clave <- readRDS("censos/censo_personas_con_clave_17")
tabla_con_clave_u <- filter(tabla_con_clave, tabla_con_clave$AREA == 1)
b <- tabla_con_clave_u$COMUNA
c <- tabla_con_clave_u$P13
cross_tab =  xtabs( ~ unlist(b) + unlist(c))
tabla <- as.data.frame(cross_tab)
d <-tabla[!(tabla$Freq == 0),]
d$anio <- "2017"

d_t <- filter(d,d$unlist.c. == 1)
for(i in 2:3){
  d_i <- filter(d,d$unlist.c. == i)
  d_t = merge( x = d_t, y = d_i, by = "unlist.b.", all.x = TRUE)
}
codigos <- d_t$unlist.b.
rango <- seq(1:nrow(d_t))
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(d_t,cadena)
comuna_corr <- comuna_corr[,-c(1),drop=FALSE] 
names(comuna_corr)[ncol(comuna_corr)] <- "código"
quitar <- seq(3,(ncol(comuna_corr)-1),3)
comuna_corr <- comuna_corr[,-c(quitar),drop=FALSE]
names(comuna_corr)[2] <- "Sí"
names(comuna_corr)[4] <- "No asiste actualmente"
names(comuna_corr)[6] <- "Nunca asistió"
quitar <- seq(1,(ncol(comuna_corr)-1),2)
comuna_corr <- comuna_corr[,-c(quitar),drop=FALSE]
ingresos_expandidos_2017 <- readRDS("Ingresos_expandidos_urbano_17.rds")
df_2017_2 = merge( x = comuna_corr, y = ingresos_expandidos_2017, by = "código", all.x = TRUE)
union_final_urb <- df_2017_2[,-c(1,(ncol(df_2017_2)-1))]
write_xlsx(union_final_urb, "P13_urbano.xlsx")
data_sum <- summary(union_final_urb)
kbl(head(data_sum)) %>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  kable_paper() %>%
  scroll_box(width = "100%", height = "500px")
No asiste actualmente Nunca asistió ingresos_expandidos
Min. : 223 Min. : 676 Min. : 24.0 Min. :7.054e+08
1st Qu.: 1510 1st Qu.: 3622 1st Qu.: 261.5 1st Qu.:2.954e+09
Median : 3916 Median : 8755 Median : 601.0 Median :5.697e+09
Mean : 14607 Mean : 30763 Mean : 1900.6 Mean :1.784e+10
3rd Qu.: 14484 3rd Qu.: 30839 3rd Qu.: 2128.0 3rd Qu.:1.857e+10
Max. :182653 Max. :349802 Max. :22569.0 Max. :1.870e+11

Graficas:

library(plotly)

df_2017_fig <- df_2017_2[,-c((ncol(df_2017_2)-1))]

fig <- plot_ly(df_2017_fig, x = df_2017_fig$código, y = df_2017_fig[,2]
, name = colnames(df_2017_fig[2]), type = 'scatter', mode = 'lines',
                 width=7000, height=400) 

grafica_fn <- function(g){
  fig <<- fig %>% add_trace(y = ~df_2017_fig[,g]
, name = colnames(df_2017_fig[g]), mode = 'lines',
                 width=7000, height=400) 
}
for (g in 3:(ncol(df_2017_2)-1)) {
grafica_fn(g)

}

fig <- fig %>% layout(autosize = T )
fig 

2 Correlaciones

La distribución es asimétrica, poseyendo un sesgo positivo.

2.1 Kendall

df_2017_2f <- filter(union_final_urb, union_final_urb$ingresos_expandidos != 'is.na')
III <- seq(1,(ncol(df_2017_2f)-1),1)
my_data <- df_2017_2f[, c(III)]
tabla <- cor(x=my_data, y=df_2017_2f$ingresos_expandidos, method=c("kendall"), use = "pairwise")
tabla <- as.data.frame(tabla)
tabla <- tabla %>% drop_na()
colnames(tabla) <- "Correlación"
saveRDS(tabla,"tablas_de_corr/C_P13_URB.rds") 
tabla %>%
  rownames_to_column("Asiste actualmente a la educación forma") %>%  
  mutate(Correlación = cell_spec(Correlación, background=ifelse(Correlación == max(Correlación), "#fc0303", "#5cb81f"))) %>% 
  kbl(booktabs = T, linesep = "", escape=FALSE) %>% 
    kable_paper(full_width = F) %>%
    column_spec(1, color = "black")%>%
    column_spec(2, color = "white")
Asiste actualmente a la educación forma Correlación
0.861840731803511
No asiste actualmente 0.861757214035088
Nunca asistió 0.839537651996292
chart.Correlation(union_final_urb, histogram=TRUE, method = c( "kendall"), pch=20)

2.2 Pearson

chart.Correlation(union_final_urb, histogram=TRUE, method = c( "pearson"), pch=20)

2.3 Spearman

chart.Correlation(union_final_urb, histogram=TRUE, method = c( "spearman"), pch=20)

3 Nivel nacional RURAL (código 2)

tabla_con_clave <- readRDS("censos/censo_personas_con_clave_17")
tabla_con_clave_u <- filter(tabla_con_clave, tabla_con_clave$AREA == 2)
b <- tabla_con_clave_u$COMUNA
c <- tabla_con_clave_u$P13
cross_tab =  xtabs( ~ unlist(b) + unlist(c))
tabla <- as.data.frame(cross_tab)
d <-tabla[!(tabla$Freq == 0),]
d$anio <- "2017"

d_t <- filter(d,d$unlist.c. == 1)
for(i in 2:3){
  d_i <- filter(d,d$unlist.c. == i)
  d_t = merge( x = d_t, y = d_i, by = "unlist.b.", all.x = TRUE)
}
codigos <- d_t$unlist.b.
rango <- seq(1:nrow(d_t))
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(d_t,cadena)
comuna_corr <- comuna_corr[,-c(1),drop=FALSE] 
names(comuna_corr)[ncol(comuna_corr)] <- "código"
quitar <- seq(3,(ncol(comuna_corr)-1),3)
comuna_corr <- comuna_corr[,-c(quitar),drop=FALSE]
names(comuna_corr)[2] <- "Sí"
names(comuna_corr)[4] <- "No asiste actualmente"
names(comuna_corr)[6] <- "Nunca asistió"
quitar <- seq(1,(ncol(comuna_corr)-1),2)
comuna_corr <- comuna_corr[,-c(quitar),drop=FALSE]
ingresos_expandidos_2017 <- readRDS("Ingresos_expandidos_rural_17.rds")
df_2017_2 = merge( x = comuna_corr, y = ingresos_expandidos_2017, by = "código", all.x = TRUE)
union_final_urb <- df_2017_2[,-c(1,(ncol(df_2017_2)-1))]
write_xlsx(union_final_urb, "P13_rural.xlsx")
data_sum <- summary(union_final_urb)
kbl(head(data_sum)) %>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  kable_paper() %>%
  scroll_box(width = "100%", height = "500px")
No asiste actualmente Nunca asistió ingresos_expandidos
Min. : 3 Min. : 9 Min. : 2.0 Min. :2.792e+08
1st Qu.: 603 1st Qu.: 1915 1st Qu.: 151.0 1st Qu.:1.809e+09
Median : 1188 Median : 3573 Median : 312.0 Median :3.546e+09
Mean : 1667 Mean : 4494 Mean : 408.0 Mean :8.206e+09
3rd Qu.: 2125 3rd Qu.: 6034 3rd Qu.: 539.5 3rd Qu.:7.252e+09
Max. :13811 Max. :33274 Max. :3105.0 Max. :7.585e+10

Graficas:

library(plotly)

df_2017_fig <- df_2017_2[,-c((ncol(df_2017_2)-1))]
df_2017_fig <- df_2017_fig[,-c(19,20)]
fig <- plot_ly(df_2017_fig, x = df_2017_fig$código, y = df_2017_fig[,2]
, name = colnames(df_2017_fig[2]), type = 'scatter', mode = 'lines',
                 width=7000, height=400) 

grafica_fn <- function(g){
  fig <<- fig %>% add_trace(y = ~df_2017_fig[,g]
, name = colnames(df_2017_fig[g]), mode = 'lines',
                 width=7000, height=400) 
}
for (g in 3:(ncol(df_2017_2)-3)) {
grafica_fn(g)

}

fig <- fig %>% layout(autosize = T)
fig 

4 Correlaciones

La distribución es asimétrica, poseyendo un sesgo positivo.

4.1 Kendall

df_2017_2f <- filter(union_final_urb, union_final_urb$ingresos_expandidos != 'is.na')
III <- seq(1,(ncol(df_2017_2f)-1),1)
my_data <- df_2017_2f[, c(III)]
tabla <- cor(x=my_data, y=df_2017_2f$ingresos_expandidos, method=c("kendall"), use = "pairwise")
tabla <- as.data.frame(tabla)
tabla <- tabla %>% drop_na()
colnames(tabla) <- "Correlación" 
saveRDS(tabla,"tablas_de_corr/C_P13_RU.rds") 
tabla %>%
  rownames_to_column("Asiste actualmente a la educación forma") %>%  
  mutate(Correlación = cell_spec(Correlación, background=ifelse(Correlación == max(Correlación), "#fc0303", "#5cb81f"))) %>% 
  kbl(booktabs = T, linesep = "", escape=FALSE) %>% 
    kable_paper(full_width = F) %>%
    column_spec(1, color = "black")%>%
    column_spec(2, color = "white")
Asiste actualmente a la educación forma Correlación
0.390733717725004
No asiste actualmente 0.364582647869388
Nunca asistió 0.255384229797476
chart.Correlation(union_final_urb, histogram=TRUE, method = c( "kendall"), pch=20)

4.2 Pearson

chart.Correlation(union_final_urb, histogram=TRUE, method = c( "pearson"), pch=20)

4.3 Spearman

chart.Correlation(union_final_urb, histogram=TRUE, method = c( "spearman"), pch=20)