11.5 Imputación por el vecino más cercano

La imputación por el vecino más cercano (K-nearest neighbor imputation en inglés) es una técnica de análisis de datos utilizada para estimar los valores faltantes en un conjunto de datos. En esta técnica, los valores faltantes se reemplazan por valores de otras observaciones que son similares a la observación con valores faltantes.

La imputación por el vecino más cercano se basa en la idea de que los registros similares tienden a tener valores similares para una determinada variable. La técnica consiste en encontrar los \(k\) registros más similares a la observación con valores faltantes en función de las variables disponibles en el conjunto de datos y utilizar los valores de estas observaciones para estimar el valor faltante.

Para calcular la similitud entre observaciones, se pueden utilizar diferentes medidas de distancia, como la distancia euclidiana o la distancia de Manhattan. La técnica también permite ajustar el valor de \(k\), que representa el número de vecinos más cercanos utilizados para estimar el valor faltante.

Es importante destacar que la imputación por el vecino más cercano es una técnica relativamente simple y fácil de implementar. Sin embargo, su eficacia puede verse limitada por la cantidad y la calidad de los datos disponibles, así como por la elección de los parámetros (como el valor de \(k\) y la medida de distancia) que pueden afectar significativamente los resultados obtenidos. Por lo tanto, es importante evaluar cuidadosamente la calidad de los datos y los resultados obtenidos antes de utilizar esta técnica.

Teniendo en cuenta lo anterior, se presentan 3 pasos a tener en cuenta al momento de utilizar esta técnica:

  • Paso 1: Definir una magnitud de distancia (Distancia euclidiana, k-media, K-Medioides, entre otras).
  • Paso 2: Para la \(i\)-ésimo elemento identificar el donante, cual será el más cercano al receptor según la magnitud de distancia previamente definida.
  • Paso 3: Se imputa el valor faltante con la información del donante identificado previamente.

Para ejemplificar esta metología, se va a imputar la variable ingresos y empleado utilizando como variable de apoyo los gastos del individuo. Se utilizará como distancia la euclidiana.

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))

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

Expen_ii <- encuesta_no_obs$Expenditure[[ii]]
don_ii <- which.min(abs(Expen_ii - encuesta_obs$Expenditure))
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)

Como se hizo la revisión anterior, se calculan los porcentajes de datos faltantes y se revisa nuevamente la distribución de la imputación en las categorías de la variable empleado.

prop.table(table(encuesta$Employment_missin, useNA = "a"))
Unemployed Inactive Employed NA
0.0340607 0.2990953 0.4667376 0.2001064 
prop.table(table(encuesta$Employment_imp, useNA = "a"))
Unemployed Inactive Employed NA
0.0436402 0.3650878 0.591272 0

Haciendo el mismo ejercicio por zona se tiene:

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 NA Sum
Rural 0.0127728 0.1873337 0.2836615 0 0.483768
Urban 0.0308675 0.1777541 0.3076104 0 0.516232
NA 0.0000000 0.0000000 0.0000000 0 0.000000
Sum 0.0436402 0.3650878 0.5912720 0 1.000000

Al igual que en el caso anterior, la distribución marginal por zona no se altera. Ahora por sexo la distribución es la siguiente:

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 NA Sum
Female 0.0159659 0.2527940 0.2698244 0 0.5385844
Male 0.0276743 0.1122938 0.3214476 0 0.4614156
NA 0.0000000 0.0000000 0.0000000 0 0.0000000
Sum 0.0436402 0.3650878 0.5912720 0 1.0000000

Ahora, haciendo el cálculo del promedio de los ingresos para los datos completos y estimados se tienen los siguientes resultados:

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 610.505 513.6812

Se observa que hay una diferencia de 6 unidades monetarias entre el promedio real y el estimado. Realizando este mismo ejercicio por zona tenemos:

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 477.9160 344.1316
Urban 730.8793 609.0304 734.7559 607.0266

Obteniéndose diferencias de 7 unidades monetarias en el ingreso para la zona rural y de 4 para la urbana. Este mismo ejercicio se realiza por sexo teniendo los siguientes resultados:

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 597.8052 504.5971
Male 621.7771 522.9428 625.3287 523.9882

Obteniéndose diferencias pequeñas entre el ingreso real y el estimado en ambos sexos.

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

p1 <- ggplot(dat_plot8, 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

Se puede observar que la distribución de los datos imputados son muy próximos que los datos reales. Haciendo este mismo ejercicio pero por zona y sexo se obtienen resultados similares a los anteriores:

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