Análisis Explotarorio de Datos Faltantes con Paquete Naniar
Encuesta Suplementaria de Ingresos (ESI)
2024-05-08
# Cargar paquetes
library(tidyverse)
library(haven)
library(stringr)
library(magrittr)
library(ggthemes)
library(readxl)
library(naniar)
library(ggplot2)
library(visdat)
library(kableExtra)
library(scales)
# Abrir bases
setwd("C:/Users/akrause/OneDrive - Instituto Nacional de Estadisticas/CDC ESI/DOCUMENTO 2024/ESI 2024")
esi2020 <- readRDS("DATA/esi-2020---personas.rds")
esi2021 <- readRDS("DATA/esi-2021---personas.rds")
esi2022 <- readRDS("DATA/esi-2022---personas.rds")
esiy <- c("esi2020", "esi2021", "esi2022")Selección de variables
knitr::include_graphics("Tabla1.png")
# Filtro: Ocupados con más de 1 mes en el empleo actual
for (y in esiy) {
esi <- filter(get(y), ocup_ref==1)
# Selección: solo columnas con datos
esi %<>% select_if(colSums(!is.na(.))>0)
# Selección: columnas relevantes
# 1. Criterio: variables que deben responder todos los ocupados dependientes
# 2. Criterio: variables que deben responder todos los ocupados independientes
# 3. Criterio: variables que deben responder todos los ocupados dependientes excepto Servicio Doméstico
# 4. Criterio: variables que deben responder todos los ocupados independientes excepto Familiar no Remunerado
# Dependientes
esi %<>% select(1:22, categoria_ocupacion, b14_rev4cl_caenes, ocup_honorarios, b15_1, #-servicio doméstico
b1, b2, b8, b9, i1, b7a_1, b7a_2, b7a_3, b7b_1, b7b_2, b7b_3, b7b_4, b16, b17_ano, b17_mes, b18_codigo, b19, c2_1_1, c2_1_2, c2_1_3, c3_1, c3_2, c3_3, c7, c10, d1_monto, d2_1_opcion, d2_2_opcion, d2_3_opcion, d2_4_opcion, d2_5_opcion, d3_1_opcion, d3_2_opcion, d3_3_opcion, d3_4_opcion, d3_5_opcion, d3_6_opcion, d3_7_opcion, d4_horas, d4_dias, imp_d1_monto, imp_d4) %>%
# Filtro: solo dependientes
filter(., categoria_ocupacion %in% c(3:6))
# Marcar con "7770" a los que no deben responder en cada variable
esi %<>% mutate(b15_1 = ifelse(categoria_ocupacion %in% c(3:4), b15_1, 7770))
# Marcar con "NA" los No sabe/No responde
namis <- c("77","88","99", "888", "999", "8888", "9999", "88888", "99999")
esi %<>% mutate(ocup_honorarios=ifelse(ocup_honorarios==3, NA, ocup_honorarios))
# Otros códigos a NA
# Curso = 9, "Curso desconocido"
esi %<>% mutate(curso = ifelse(curso ==9, NA, curso),
# Pasa a NA d1_monto cuando imp_d1_monto es 1 (dato imputado)
d1_monto_obs = ifelse(imp_d1_monto==1, NA, d1_monto),
# Pasa a NA d4_horas cuando imp_d4_horas es 1 (dato imputado)
d4_horas_obs = ifelse(imp_d4==1, NA, d4_horas))
# Se elimina d1_monto y d4_horas porque incluyen datos imputados
esi %<>% subset(., select = -c(d1_monto, d4_horas, imp_d1_monto, imp_d4))
esi %<>% select(., -c(edad)) %>%
mutate_all(~replace(., . %in% namis, NA)) %>%
right_join(., esi[,c("idrph", "edad")])
assign(paste0("dep_",y),esi)
}## Joining with `by = join_by(idrph)`
## Joining with `by = join_by(idrph)`
## Joining with `by = join_by(idrph)`Análisis de datos faltantes
- ¿Hay datos faltantes en la base de datos?
naniar::any_na(dep_esi2020[,23:65])## [1] TRUE- ¿Cuántos datos faltantes hay en la base de datos?
naniar::n_miss(dep_esi2020[,23:65])## [1] 45470- ¿Cuál es el porcentaje de datos faltantes hay en la base de datos?
naniar::prop_miss(dep_esi2020[,23:65])*100## [1] 5.688229- ¿Cuáles son las variables afectadas?
varmiss_20 <- as.data.frame(dep_esi2020[,23:65] %>% is.na() %>% colSums())
knitr::kable((varmiss_20), "html", col.names = gsub("[.]", " ", c("Casos faltantes")))| Casos faltantes | |
|---|---|
| b14_rev4cl_caenes | 26 |
| ocup_honorarios | 36 |
| b15_1 | 598 |
| b1 | 8 |
| b2 | 0 |
| b8 | 43 |
| b9 | 153 |
| i1 | 976 |
| b7a_1 | 762 |
| b7a_2 | 766 |
| b7a_3 | 1029 |
| b7b_1 | 857 |
| b7b_2 | 857 |
| b7b_3 | 1296 |
| b7b_4 | 2214 |
| b16 | 636 |
| b17_ano | 57 |
| b17_mes | 5570 |
| b18_codigo | 13 |
| b19 | 15 |
| c2_1_1 | 7700 |
| c2_1_2 | 1870 |
| c2_1_3 | 53 |
| c3_1 | 7822 |
| c3_2 | 1899 |
| c3_3 | 58 |
| c7 | 802 |
| c10 | 293 |
| d2_1_opcion | 1100 |
| d2_2_opcion | 1149 |
| d2_3_opcion | 966 |
| d2_4_opcion | 1046 |
| d2_5_opcion | 1053 |
| d3_1_opcion | 210 |
| d3_2_opcion | 314 |
| d3_3_opcion | 204 |
| d3_4_opcion | 318 |
| d3_5_opcion | 202 |
| d3_6_opcion | 220 |
| d3_7_opcion | 266 |
| d4_dias | 0 |
| d1_monto_obs | 1693 |
| d4_horas_obs | 320 |
5. Número de datos faltantes por variable
snvarmiss_20 <- as.data.frame(naniar::miss_var_summary(dep_esi2020[,23:65]))
ggplot(data=snvarmiss_20, aes(x=variable, y=n_miss)) +
geom_bar(stat="identity", fill="steelblue") + coord_flip() +
labs(y="Número de faltantes\n", x= "Variables")
tabnvarmiss_20 <- as.data.frame(naniar::miss_var_table(dep_esi2020[,23:65])) # se podría recodificar, por ejem: 1-50 missing, 50-100 missing
kable((tabnvarmiss_20), "html", col.names = gsub("[.]", " ", c("Número de datos faltantes","Número de variables","Porcentaje"))) %>%
kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed"), font_size = 12.5)| Número de datos faltantes | Número de variables | Porcentaje |
|---|---|---|
| 0 | 2 | 4.651163 |
| 8 | 1 | 2.325581 |
| 13 | 1 | 2.325581 |
| 15 | 1 | 2.325581 |
| 26 | 1 | 2.325581 |
| 36 | 1 | 2.325581 |
| 43 | 1 | 2.325581 |
| 53 | 1 | 2.325581 |
| 57 | 1 | 2.325581 |
| 58 | 1 | 2.325581 |
| 153 | 1 | 2.325581 |
| 202 | 1 | 2.325581 |
| 204 | 1 | 2.325581 |
| 210 | 1 | 2.325581 |
| 220 | 1 | 2.325581 |
| 266 | 1 | 2.325581 |
| 293 | 1 | 2.325581 |
| 314 | 1 | 2.325581 |
| 318 | 1 | 2.325581 |
| 320 | 1 | 2.325581 |
| 598 | 1 | 2.325581 |
| 636 | 1 | 2.325581 |
| 762 | 1 | 2.325581 |
| 766 | 1 | 2.325581 |
| 802 | 1 | 2.325581 |
| 857 | 2 | 4.651163 |
| 966 | 1 | 2.325581 |
| 976 | 1 | 2.325581 |
| 1029 | 1 | 2.325581 |
| 1046 | 1 | 2.325581 |
| 1053 | 1 | 2.325581 |
| 1100 | 1 | 2.325581 |
| 1149 | 1 | 2.325581 |
| 1296 | 1 | 2.325581 |
| 1693 | 1 | 2.325581 |
| 1870 | 1 | 2.325581 |
| 1899 | 1 | 2.325581 |
| 2214 | 1 | 2.325581 |
| 5570 | 1 | 2.325581 |
| 7700 | 1 | 2.325581 |
| 7822 | 1 | 2.325581 |
tabnvarmiss_20 %<>% mutate(gr = cut(n_miss_in_var,
breaks = c( -1, 100, 200,300, 400, 500, 1000, 5000, 10000),
labels = c("0-100", "101-200", "201-300", "301-400", "401-500","501-1.000", "1.001-5.000", "Más de 5.000")))
grupos <- as.data.frame(table(tabnvarmiss_20$gr))
ggplot(data=grupos, aes(x=Var1, y=Freq)) +
geom_bar(stat="identity", fill="steelblue") +
labs(y="Número de variables\n", x= "Rango de datos faltantes") +
scale_y_continuous(
labels = scales::number_format(accuracy = 1),
limits = c(0,11),breaks=seq(0,10, by = 2),expand = c(0,0))+
scale_x_discrete( expand = c(.1,.1))
6. Datos faltantes y observados
dep_esi2020[,c(23:65)] %>% abbreviate_vars(., 8) %>%
summarise_all(list(~is.na(.)))%>%
pivot_longer(everything(),
names_to = "Variables", values_to="Faltantes") %>%
count(Variables, Faltantes) %>%
ggplot(aes(y=Variables,x=n,fill=Faltantes))+
geom_col()+
scale_fill_manual(values=c("skyblue3","gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(x="Número de observaciones\n", y= "\nVariables")
Visualización de datos faltantes
- Número y porcentaje de missing por variable (n y %)
gg_miss_var(dep_esi2020[,23:65]) + # missing variables
labs(y="Número de faltantes\n", x= "\nVariables")
8. Número y porcentaje de missing por variable desagregado por mes de encuestaje (n y %)
dep_esi2020$mes_encuesta <- factor(dep_esi2020$mes_encuesta,labels= c("Octubre", "Noviembre", "Diciembre"))
gg_miss_var(dep_esi2020[,c(11,23:65)], facet = mes_encuesta) + # missing variables
labs(y="Número de datos faltantes\n", x= "\nVariables")
9. Número y porcentaje de missing por casos (n y %)
sncasemiss_20 <- as.data.frame(naniar::miss_case_summary(dep_esi2020[,23:65]))
kable((head(sncasemiss_20)), "html", col.names = gsub("[.]", " ", c("Caso","Variables faltantes", "Porcentaje de variables")))%>%
kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed"), font_size = 12.5)| Caso | Variables faltantes | Porcentaje de variables |
|---|---|---|
| 2360 | 39 | 90.69767 |
| 9098 | 33 | 76.74419 |
| 9752 | 26 | 60.46512 |
| 7398 | 25 | 58.13953 |
| 7424 | 25 | 58.13953 |
| 8001 | 25 | 58.13953 |
tabncasemiss_20 <- naniar::miss_case_table(dep_esi2020[,23:65])
kable((head(tabncasemiss_20)), "html", col.names = gsub("[.]", " ", c("Variables faltantes", "Número de casos", "Porcentaje de casos"))) %>%
kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed"), font_size = 12.5)| Variables faltantes | Número de casos | Porcentaje de casos |
|---|---|---|
| 0 | 4957 | 26.664874 |
| 1 | 3174 | 17.073695 |
| 2 | 3849 | 20.704680 |
| 3 | 2396 | 12.888650 |
| 4 | 1489 | 8.009683 |
| 5 | 697 | 3.749328 |
- Visualización de datos faltantes por casos
vis_miss(dep_esi2020[,23:65])+
theme(axis.text.x = element_text(size = 6, angle = 60)) +
scale_fill_manual(values=c("skyblue3", "gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(y="Observaciones\n")## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
- Visualización de datos faltantes agrupando casos
vis_miss(dep_esi2020[,23:65], cluster = TRUE)+
theme(axis.text.x = element_text(size = 6, angle = 60)) +
scale_fill_manual(values=c("skyblue3", "gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(y="Observaciones\n")## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
12.
Visualización de datos faltantes ordenando variables
vis_miss(dep_esi2020[,23:65], sort_miss = T)+
theme(axis.text.x = element_text(size = 6, angle = 60)) +
scale_fill_manual(values=c("skyblue3", "gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(y="Observaciones\n")## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
- Visualización de datos faltantes ordenando variables
vis_miss(dep_esi2020[,c(11,23:65)], cluster = TRUE, sort_miss = T)+
theme(axis.text.x = element_text(size = 6, angle = 60)) +
scale_fill_manual(values=c("skyblue3", "gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(y="Observaciones\n")## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
14. Visualización de datos faltantes desagregado por mes
vis_miss(dep_esi2020[,c(11,23:65)], facet = mes_encuesta, cluster = TRUE, sort_miss = T)+
theme(axis.text.x = element_text(size = 6, angle = 60)) +
scale_fill_manual(values=c("skyblue3", "gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
labs(y="Observaciones\n")## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
- Mapa de calor de datos faltantes desagregado por sexo Estos gráficos permiten comparar el porcentaje de datos faltantes en todas las variables comparando con alguna variable de desagregación.
Si hay cambios de color horizontalmente significa que hay categorías de la variable de desagregación que tienen más o menos porcentaje de casos faltantes.
En este gráfico se ve que los hombres tiene un porcentaje mayor de datos faltantes que las mujeres en las variables c3_1, c2_1_1 y b17_mes.
dep_esi2020$sexo <- factor(dep_esi2020$sexo,labels= c("Hombre", "Mujer"))
gg_miss_fct(dep_esi2020[,c(14,23:65)], fct = sexo)
16. Mapa de calor de missing desagregado por region
En la desgregación por región, se observa que las regiones 3, 11 y 15 se presentan los porcentajes más altos de datos perdidos en las varaibles c3_1 y c2_1_1.
dep_esi2020$region <- factor(dep_esi2020$region)
gg_miss_fct(dep_esi2020[,c(3,23:65)], fct = region)+
scale_fill_gradientn(colours = c( "blue", "lightblue", "gold","yellow", "white")) ## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
17. Mapa de calor de missing desagregado por mes de encuesta de
levantamiento de la encuesta
Por mes de levantaimiento no se observan diferencias importantes en el porcentaje de datos perdidos en ninguna variable.
dep_esi2020$mes_encuesta <- factor(dep_esi2020$mes_encuesta,labels= c("Octubre", "Noviembre", "Diciembre"))
gg_miss_fct(dep_esi2020[,c(11,23:65)], fct = mes_encuesta)+
scale_fill_gradientn(colours = terrain.colors(11))## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.
- Datos faltantes acumulados Este gráfico muestra la suma acumulada de valores faltantes, leyendo columnas de izquierda a derecha la base de datos. Es interesante si se ordena la base siguiendo la secuencia del cuestionario
gg_miss_var_cumsum(dep_esi2020[,c(23:65)]) +
geom_line(color="red", fill="white", linewidth=1.1)## Warning in geom_line(color = "red", fill = "white", linewidth = 1.1): Ignoring
## unknown parameters: `fill`
19. Gráfico de dispersión con datos faltantes
En el gráfico de dispersión que aparece a continuación, los puntos “gold” son registros en los que el valor de una columna está presente pero falta el valor de la otra columna. Esto permite ver la distribución de los valores que faltan en relación con los valores que no faltan.
ggplot(data = dep_esi2020[,c(23:65)],
aes(x = d1_monto_obs/1000,
y = d4_horas_obs)) +
geom_miss_point() +
scale_x_continuous(labels = comma_format(big.mark = ".", decimal.mark = ",")) +
scale_color_manual(values=c("gold", "skyblue3"), name = "Datos faltantes", labels = c("Faltante", "Observado")) 
ggplot(data = dep_esi2020[,c(23:65)],
aes(x = b17_ano,
y = b17_mes)) +
geom_miss_point() +
scale_color_manual(values=c("gold", "skyblue3"), name = "Datos faltantes", labels = c("Faltante", "Observado")) 
20.
Matriz sombra
Los datos se pueden convertir en una matriz de sombra mediante la función bind_shadow, la cual adjunta una matriz sombra a la matriz original y las variables se quedan con el mismo nombre que en la matriz original, sólo se agrega el sufijo __NA_.
Esto permite visualizar valores faltantes utilizando geom_density y comparar la densidad de una variable para los datos faltantes y observados
dep_esi2020 %>%
bind_shadow() %>%
ggplot(aes(x = edad,
fill = b17_mes_NA)) +
geom_density(alpha = .4) +
scale_fill_manual(values=c("skyblue3","gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) 
También permite visualizar la relación entre dos variables cuando hay datos observados y faltantes para una tercera variable.
En este gráfico se visualizan las variables edad y d1_monto_obs cuando hay datos para b17_mes y para cuando no los hay.
dep_esi2020 %>%
bind_shadow() %>%
ggplot(aes(x = edad,
y = d1_monto_obs/1000,
color = b17_mes_NA)) +
geom_point(size=1.5) +
scale_color_manual(values=c("skyblue3","gold"), name = "Datos faltantes", labels = c("Observado", "Faltante")) +
scale_y_continuous(labels = comma_format(big.mark = ".",
decimal.mark = ","))## Warning: Removed 1693 rows containing missing values or values outside the scale range
## (`geom_point()`).
- Combinaciones de datos faltantes
La combinación más frecuente de datos faltantes ocurre cuando se combinan las variables c3_1 y c2_1_1, pero nada más. Luego, la variable b17_mes por sí sola. Estas tres variables combinadas son la tercera combinación más frecuente con 1797 casos.
gg_miss_upset(dep_esi2020[,c(23:65)])