11.6 Imputación por el vecino más cercano con regresión

An las secciones anteriores se realizaron las descripciones delas técnicas: vecino más cercano e imputación vía regresión, a continuación, se presentan los pasos que se deben tener en cuenta para realizar la imputación utilizando el vecino más cernado mediante una regresión:

Paso 1: Ajustar un modelo de regresión.
Paso 2: Realizar la predicción de los valores observados y no observados.
Paso 3: Comparar las predicciones obtenidas para los valores observados y no observados.
Paso 4: Para la \(i\)-ésima observación identificar el donante con la menor distancia al receptor.
Paso 5: Reemplazar el valor faltante con la información proveniente del donante.

NOTA Se toma es la información observada en el donante.

A continuación, se ejemplifica la técnica imputando los ingresos en los hogares realizando un modelo en el cual se toman como covariables el sexo, la zona y los gastos:

encuesta$Income_imp <- encuesta$Income_missin
encuesta$Employment_imp <- encuesta$Employment_missin
encuesta_obs <- filter(encuesta, !is.na(Income_missin))
encuesta_no_obs <- filter(encuesta, is.na(Income_missin))
mod <- lm(Income ~ Zone + Sex + Expenditure, data = encuesta_obs)

Luego, se predicen los valores observados y no observados con el modelo ajustado anteriormente y se imputa el valor faltante calculando las diferencias entre las predicciones de los datos observados y no observados:

pred_Obs <- predict(mod, encuesta_obs)
pred_no_Obs <- predict(mod, encuesta_no_obs)

for(ii in 1:nrow(encuesta_no_obs)){

don_ii <- which.min(abs(pred_no_Obs[ii] - pred_Obs))
encuesta_no_obs$Income_imp[[ii]] <- encuesta_obs$Income_missin[[don_ii]]
encuesta_no_obs$Employment_imp[[ii]] <- encuesta_obs$Employment_missin[[don_ii]]
}

encuesta <- bind_rows(encuesta_obs,encuesta_no_obs)

Una vez imputada la información, se puede chequear el pocentaje de datos faltantes que habían y una vez impuatado, cómo cambia la distribución:

kable(
prop.table(table(encuesta$Employment_missin, useNA = "a"))
)

Var1	Freq
Unemployed	0.0340607
Inactive	0.2990953
Employed	0.4667376
NA	0.2001064

kable(
prop.table(table(encuesta$Employment_imp, useNA = "a"))
)

Var1	Freq
Unemployed	0.0399148
Inactive	0.3730708
Employed	0.5870144
NA	0.0000000

El mismo ejercicio se puede realizar por zona:

kable(
prop.table( table(encuesta$Zone, encuesta$Employment_missin, useNA = "a")) %>% addmargins()
)

	Unemployed	Inactive	Employed	NA	Sum
Rural	0.0117084	0.1506120	0.2208622	0.1005854	0.483768
Urban	0.0223523	0.1484832	0.2458755	0.0995210	0.516232
NA	0.0000000	0.0000000	0.0000000	0.0000000	0.000000
Sum	0.0340607	0.2990953	0.4667376	0.2001064	1.000000

kable(
prop.table( table(encuesta$Zone, encuesta$Employment_imp,useNA = "a")) %>% addmargins()
)

	Unemployed	Inactive	Employed	Sum
Rural	0.0138371	0.1905269	0.2794039	0.483768
Urban	0.0260777	0.1825439	0.3076104	0.516232
NA	0.0000000	0.0000000	0.0000000	0.000000
Sum	0.0399148	0.3730708	0.5870144	1.000000

Y por sexo:

kable(
prop.table( table(encuesta$Sex, encuesta$Employment_missin, useNA = "a")) %>% addmargins()
)

	Unemployed	Inactive	Employed	NA	Sum
Female	0.0106440	0.2277807	0.2011708	0.0989888	0.5385844
Male	0.0234167	0.0713145	0.2655668	0.1011176	0.4614156
NA	0.0000000	0.0000000	0.0000000	0.0000000	0.0000000
Sum	0.0340607	0.2990953	0.4667376	0.2001064	1.0000000

kable(
prop.table( table(encuesta$Sex, encuesta$Employment_imp,useNA = "a")) %>% addmargins()
)

	Unemployed	Inactive	Employed	Sum
Female	0.0122406	0.2724854	0.2538584	0.5385844
Male	0.0276743	0.1005854	0.3331559	0.4614156
NA	0.0000000	0.0000000	0.0000000	0.0000000
Sum	0.0399148	0.3730708	0.5870144	1.0000000

Por último, se calcula la media de los ingresos y su desviación estándar para los datos completos e imputado como se ha realizado anteriormente:

encuesta %>% summarise(
  Income_ = mean(Income),
  Income_sd = sd(Income),
  Income_imp_ = mean(Income_imp),
  Income_imp_sd = sd(Income_imp))

Income_	Income_sd	Income_imp_	Income_imp_sd
604.2494	513.1078	608.0657	515.5472

De la anterior imputación se puede observar que, la diferencia entre los datos reales y los imputados es cercano a 4 unidades monetarias.

El mismo ejercicio realizado por zona arroja los siguientes resultados:

encuesta %>%group_by(Zone) %>%  summarise(
  Income_ = mean(Income),
  Income_sd = sd(Income),
  Income_imp_ = mean(Income_imp),
  Income_imp_sd = sd(Income_imp))

Zone	Income_	Income_sd	Income_imp_	Income_imp_sd
Rural	469.1217	336.5861	476.0558	342.6870
Urban	730.8793	609.0304	731.7739	611.0741

y se puede observar también que la diferencia entre los ingresos reales y los estimados en las dos zonas con inferiores a 6 unidades monetarias.

Por sexo, los resultados son los siguientes:

encuesta %>%group_by(Sex) %>%  summarise(
  Income_ = mean(Income),
  Income_sd = sd(Income),
  Income_imp_ = mean(Income_imp),
  Income_imp_sd = sd(Income_imp))

Sex	Income_	Income_sd	Income_imp_	Income_imp_sd
Female	589.2330	504.3041	592.6043	508.3581
Male	621.7771	522.9428	626.1128	523.5303

Teniendo como diferencia máxima para la variable ingreso de 5 unidades monetarias. A continuación, se presentan la gráfica distribucional del ingreso real y del ingreso imputado por el método del vecino más cercano mediante un modelo. Se puede observar que, las dos distribuciones con muy similares.

dat_plot9 <- tidyr::gather(
  encuesta %>% dplyr::select(Zone,Sex,Income, Income_imp),
  key = "Caso", value = "Income2", -Zone,-Sex)

p1 <- ggplot(dat_plot9, aes(x = Income2, fill = Caso)) + 
  geom_density(alpha = 0.2) + theme_bw() +
   theme(legend.position = "bottom") +
  geom_vline(
    xintercept = mean(encuesta$Income), 
             col = "red") +
  geom_vline(
    xintercept = mean(encuesta$Income_imp), 
             col = "blue")
p1

Realizando ahora unos boxplot por sexo y zona para la variable ingreso tanto la completa como la imputada se tiene:

p1 <- ggplot(dat_plot9, aes(x= Caso, y = Income2)) + 
   geom_hline(yintercept = mean(encuesta$Income),
              col = "red") +  geom_boxplot() +
  facet_grid(Zone~Sex) + theme_bw()
p1

Se puede observar que los boxplot son muy similares.