10.4 Imputación por Hot-Deck

Esta imputación consiste en reemplazar los valores faltantes de una o más variables para un no respondiente (llamado receptor) con valores observados de un respondiente (el donante) similar al no respondiente con respecto a las características observadas en ambos casos. La técnica se basa en la idea de que las unidades similares pueden tener valores similares en las variables de interés. En este enfoque, se selecciona una observación donante que sea similar a la observación receptora en términos de características relevantes (por ejemplo, edad, género, ubicación geográfica, etc.), y se utiliza su valor observado para imputar el valor faltante en la observación receptora.

El término Hot-Deck hace referencia a una tarjeta perforada que se utilizaba en los primeros sistemas informáticos para almacenar y recuperar datos. Esta es una técnica relativamente simple y eficaz para imputar valores faltantes en conjuntos de datos pequeños o medianos, y se utiliza comúnmente en encuestas y estudios de investigación social. Sin embargo, puede ser menos efectiva en conjuntos de datos grandes o complejos, donde puede ser difícil encontrar observaciones similares o donde las características relevantes son difíciles de definir o medir de manera confiable.

A continuación, se presenta un código computacional que ejemplifica, para los datos que estamos usando en el capítulo, el uso del método.

donante <- which(!is.na(encuesta$Income_missing))
receptor <- which(is.na(encuesta$Income_missing))
encuesta$Income_imp <- encuesta$Income_missing

set.seed(1234)
for (ii in receptor) {
  don_ii <- sample(x = donante, size = 1)
  encuesta$Income_imp[ii] <- encuesta$Income_missing[don_ii]
}

sum(is.na(encuesta$Income_imp))

## [1] 0

En el código mostrado anteriormente se describe a continuación, la primera línea del código selecciona las observaciones que no tienen valores faltantes en la variable Income_missing, la segunda línea selecciona las observaciones que tienen valores faltantes en la variable Income_missing; luego se crea una nueva variable Income_imp para almacenar los valores imputados. Finalmente, se utiliza un bucle for para iterar a través de cada observación receptora. Dentro del bucle, se utiliza la función sample para seleccionar una observación donante aleatoria de entre las observaciones que no tienen valores faltantes en la variable Income_missing.

Una vez realizada la imputación, se calcula la media y la desviación de los datos completos e imputados:

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	618.2937	528.2157

Como en los métodos anteriores, el sesgo relativo de la imputación fue de 2.3%. Haciendo el mismo ejercicio, pero esta vez desagregada 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	503.7127	368.9137
Urban	730.8793	609.0304	725.6691	623.9875

El sesgo relativo de la estimación en la zona rural es de 7.4% y en al zona urbana es de 0.7%. El mismo ejercicio se puede realizar por sexo:

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	602.8075	503.0951
Male	621.7771	522.9428	636.3699	555.8522

A continuación, se muestra la gráfica de la distribución de los datos, tanto los completos como los imputados, observándose que la distribución de los datos imputados es muy similar a la de los datos no imputados:

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

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