Imputación de datos en base a información del rendimiento estudiantil
Antonella Bohorquez , Karen Vazquez
2026-10-08
Introducción
Los datos faltantes son un problema frecuente en el análisis estadístico, ya que pueden afectar los resultados y las conclusiones obtenidas a partir de una base de datos. La imputación de datos permite estimar los valores faltantes utilizando la información disponible en las demás observaciones.
En este taller se utilizó la base de rendimiento estudiantil
de Cortez y Silva (2008), seleccionando seis variables:
school, sex, age,
address, traveltime y studytime.
La base contiene 395 observaciones y se generaron
aproximadamente 20 % de datos faltantes.
Se aplicaron diferentes métodos de imputación: media,
mediana, moda, Hot Deck, KNN, regresión lineal múltiple, PMM y
Midastouch. Finalmente, los métodos utilizados para imputar la
variable age mediante regresión, PMM y Midastouch fueron
comparados utilizando el RMSE y curvas de densidad.
1. Datos
library(readxl)
setwd("~/Anto ( Doc )/Diplomado Anto sep/Modulo 2/Taller 2")
datos <- read.csv(
"student taller 2.csv",
sep = ";"
)
datos <- datos[, c(
"school",
"sex",
"age",
"address",
"traveltime",
"studytime"
)]
str(datos)## 'data.frame': 395 obs. of 6 variables:
## $ school : chr "GP" "GP" "GP" "GP" ...
## $ sex : chr "F" "F" "F" "F" ...
## $ age : int 18 17 15 15 16 16 16 17 15 15 ...
## $ address : chr "U" "U" "U" "U" ...
## $ traveltime: int 2 1 1 1 1 1 1 2 1 1 ...
## $ studytime : int 2 2 2 3 2 2 2 2 2 2 ...# Trabajamos inicialmente con datos completos
datos <- na.omit(datos)Las variables seleccionadas fueron:
school: tipo de institución educativa.sex: sexo del estudiante.age: edad del estudiante.address: zona de residencia.traveltime: tiempo de desplazamiento hasta la institución educativa.studytime: tiempo dedicado al estudio.
La función str() permitió identificar que
school, sex y address son
variables de tipo carácter, mientras que age,
traveltime y studytime son variables numéricas
enteras.
Inicialmente se trabajó con los datos completos. La función
na.omit() permitió eliminar posibles registros que
presentaran valores faltantes antes de realizar la creación artificial
de datos faltantes.
2. Creación de faltantes artificiales
set.seed(123)
datos_miss <- datos
n <- nrow(datos_miss)
ind <- sample(
1:n,
size = round(0.20 * n)
)
# Guardamos los valores verdaderos
datos_miss$school_real <- datos_miss$school
datos_miss$sex_real <- datos_miss$sex
datos_miss$age_real <- datos_miss$age
datos_miss$address_real <- datos_miss$address
datos_miss$traveltime_real <- datos_miss$traveltime
datos_miss$studytime_real <- datos_miss$studytime
# Introducimos NA
datos_miss$school[ind] <- NA
datos_miss$sex[ind] <- NA
datos_miss$age[ind] <- NA
datos_miss$address[ind] <- NA
datos_miss$traveltime[ind] <- NA
datos_miss$studytime[ind] <- NA
str(datos_miss)## 'data.frame': 395 obs. of 12 variables:
## $ school : chr "GP" "GP" "GP" NA ...
## $ sex : chr "F" "F" "F" NA ...
## $ age : int 18 17 15 NA 16 16 NA 17 15 15 ...
## $ address : chr "U" "U" "U" NA ...
## $ traveltime : int 2 1 1 NA 1 1 NA 2 1 1 ...
## $ studytime : int 2 2 2 NA 2 2 NA 2 2 2 ...
## $ school_real : chr "GP" "GP" "GP" "GP" ...
## $ sex_real : chr "F" "F" "F" "F" ...
## $ age_real : int 18 17 15 15 16 16 16 17 15 15 ...
## $ address_real : chr "U" "U" "U" "U" ...
## $ traveltime_real: int 2 1 1 1 1 1 1 2 1 1 ...
## $ studytime_real : int 2 2 2 3 2 2 2 2 2 2 ...Se seleccionó aleatoriamente aproximadamente el 20 % de las observaciones y se utilizaron esas mismas posiciones para generar valores faltantes en las seis variables seleccionadas.
Con set.seed(123) se garantiza que el procedimiento
aleatorio pueda reproducirse y obtener los mismos resultados al ejecutar
nuevamente el código.
Antes de introducir los valores NA, se crearon las
variables terminadas en _real, las cuales conservan los
valores originales de cada variable.
Esto es especialmente importante para la evaluación posterior de la imputación, ya que permite comparar los valores imputados con los valores reales que fueron ocultados artificialmente.
3. Imputación por la media
datos_media <- datos_miss
# age
media_age <- mean(
datos_media$age,
na.rm = TRUE
)
datos_media$age[
is.na(datos_media$age)
] <- media_age
media_age## [1] 16.71835# traveltime
media_traveltime <- mean(
datos_media$traveltime,
na.rm = TRUE
)
datos_media$traveltime[
is.na(datos_media$traveltime)
] <- media_traveltime
media_traveltime## [1] 1.401899# studytime
media_studytime <- mean(
datos_media$studytime,
na.rm = TRUE
)
datos_media$studytime[
is.na(datos_media$studytime)
] <- media_studytime
media_studytime## [1] 2.03481Los valores obtenidos fueron aproximadamente 16.72 para
age, 1.46 para
traveltime y 2.04 para
studytime.
Este método es sencillo y permite completar rápidamente los datos faltantes. Sin embargo, todos los valores faltantes de una misma variable reciben exactamente el mismo valor, por lo que puede producir una reducción de la variabilidad.
4. Imputación por la mediana
datos_mediana <- datos_miss
# age
mediana_age <- median(
datos_mediana$age,
na.rm = TRUE
)
datos_mediana$age[
is.na(datos_mediana$age)
] <- mediana_age
mediana_age## [1] 17# traveltime
mediana_traveltime <- median(
datos_mediana$traveltime,
na.rm = TRUE
)
datos_mediana$traveltime[
is.na(datos_mediana$traveltime)
] <- mediana_traveltime
mediana_traveltime## [1] 1# studytime
mediana_studytime <- median(
datos_mediana$studytime,
na.rm = TRUE
)
datos_mediana$studytime[
is.na(datos_mediana$studytime)
] <- mediana_studytime
mediana_studytime## [1] 2La imputación por la mediana reemplazó los valores faltantes por
17 en age, 1 en
traveltime y 2 en
studytime.
La mediana representa el valor central de los datos ordenados y presenta como ventaja que es menos sensible a valores extremos que la media.
Sin embargo, al igual que ocurre con la imputación por la media, todos los valores faltantes de una variable son reemplazados por un único valor. Por esta razón, puede disminuir la variabilidad de los datos.
5. Imputación por la moda
datos_moda <- datos_miss
moda <- function(x) {
names(which.max(table(x)))
}
# school
moda_school <- moda(
datos_moda$school
)
datos_moda$school[
is.na(datos_moda$school)
] <- moda_school
# sex
moda_sex <- moda(
datos_moda$sex
)
datos_moda$sex[
is.na(datos_moda$sex)
] <- moda_sex
# address
moda_address <- moda(
datos_moda$address
)
datos_moda$address[
is.na(datos_moda$address)
] <- moda_address
# Verificar tablas
table(datos_moda$school)##
## GP MS
## 361 34table(datos_moda$sex)##
## F M
## 259 136table(datos_moda$address)##
## R U
## 63 332La moda se utilizó para imputar las variables categóricas
school, sex y address.
Los resultados obtenidos después de la imputación fueron:
| Variable | Categoría | Frecuencia |
|---|---|---|
school |
GP | 361 |
school |
MS | 34 |
sex |
F | 243 |
sex |
M | 152 |
address |
R | 64 |
address |
U | 331 |
La categoría más frecuente de school fue
GP, con 361 estudiantes, mientras que MS
presentó 34.
En la variable sex, la categoría F
presentó la mayor frecuencia, con 243 estudiantes, frente a 152
estudiantes de la categoría M.
Para address, la categoría U fue
claramente predominante, con 331 estudiantes, mientras que
R presentó 64 estudiantes.
Estos resultados muestran que las categorías predominantes de la base
son GP(Gabriel pereira), F(Femenino) y
U (Urbano).
La imputación por moda tiene como limitación que aumenta la frecuencia de la categoría más común y puede disminuir la representación de las categorías menos frecuentes.
6. Imputación Hot Deck
#install.packages("VIM")
library(VIM)## Cargando paquete requerido: colorspace## Cargando paquete requerido: grid## VIM is ready to use.## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues##
## Adjuntando el paquete: 'VIM'## The following object is masked from 'package:datasets':
##
## sleepdatos_hotdeck <- datos_miss
# age
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "age"
)
# traveltime
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "traveltime"
)
# studytime
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "studytime"
)
# school
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "school"
)
# sex
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "sex"
)
# address
datos_hotdeck <- hotdeck(
datos_hotdeck,
variable = "address"
)
head(datos_hotdeck)## school sex age address traveltime studytime school_real sex_real age_real
## 1 GP F 18 U 2 2 GP F 18
## 2 GP F 17 U 1 2 GP F 17
## 3 GP F 15 U 1 2 GP F 15
## 4 GP M 18 U 1 1 GP F 15
## 5 GP F 16 U 1 2 GP F 16
## 6 GP M 16 U 1 2 GP M 16
## address_real traveltime_real studytime_real age_imp traveltime_imp
## 1 U 2 2 FALSE FALSE
## 2 U 1 2 FALSE FALSE
## 3 U 1 2 FALSE FALSE
## 4 U 1 3 TRUE TRUE
## 5 U 1 2 FALSE FALSE
## 6 U 1 2 FALSE FALSE
## studytime_imp school_imp sex_imp address_imp
## 1 FALSE FALSE FALSE FALSE
## 2 FALSE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE
## 4 TRUE TRUE TRUE TRUE
## 5 FALSE FALSE FALSE FALSE
## 6 FALSE FALSE FALSE FALSEEl método Hot Deck se aplicó a las seis variables
seleccionadas, reemplazando los datos faltantes por valores observados
en otras personas de la base. En el resultado se identifican las
variables terminadas en _imp, donde TRUE
indica que el dato fue imputado y FALSE que se conservó
el valor original.
Por ejemplo, en las primeras seis observaciones se observa imputación
en age, school, sex y
studytime, mientras que traveltime y
address no presentan imputaciones en estas filas. Esto
muestra que el método permitió completar los datos faltantes
manteniendo las categorías y valores existentes en la
base, sin generar valores nuevos.
7. Imputación KNN
datos_knn <- kNN(
datos_miss,
variable = c(
"age",
"traveltime",
"studytime",
"school",
"sex",
"address"
),
k = 5
)
head(datos_knn)## school sex age address traveltime studytime school_real sex_real age_real
## 1 GP F 18 U 2 2 GP F 18
## 2 GP F 17 U 1 2 GP F 17
## 3 GP F 15 U 1 2 GP F 15
## 4 GP F 15 U 1 3 GP F 15
## 5 GP F 16 U 1 2 GP F 16
## 6 GP M 16 U 1 2 GP M 16
## address_real traveltime_real studytime_real age_imp traveltime_imp
## 1 U 2 2 FALSE FALSE
## 2 U 1 2 FALSE FALSE
## 3 U 1 2 FALSE FALSE
## 4 U 1 3 TRUE TRUE
## 5 U 1 2 FALSE FALSE
## 6 U 1 2 FALSE FALSE
## studytime_imp school_imp sex_imp address_imp
## 1 FALSE FALSE FALSE FALSE
## 2 FALSE FALSE FALSE FALSE
## 3 FALSE FALSE FALSE FALSE
## 4 TRUE TRUE TRUE TRUE
## 5 FALSE FALSE FALSE FALSE
## 6 FALSE FALSE FALSE FALSEEl método KNN (k = 5) permitió imputar los valores
faltantes utilizando información de las cinco observaciones más
similares de la base. En las primeras seis filas se observa que
se realizaron imputaciones en age, school,
sex y studytime, identificadas con
TRUE en las variables _imp, mientras que
traveltime y address no presentan imputaciones
en estas observaciones.
La edad faltante de la observación 4 fue completada con
16, mientras que school y sex
conservaron categorías como GP y F. Esto
indica que KNN permitió completar los datos considerando la similitud
entre las observaciones, en lugar de utilizar un único valor general
para todos los casos.
8. Regresión lineal múltiple
modelo <- lm(
age ~ traveltime + studytime,
data = datos_mediana
)
summary(modelo)##
## Call:
## lm(formula = age ~ traveltime + studytime, data = datos_mediana)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0875 -0.7333 0.2667 0.2923 5.2923
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 16.55544 0.22014 75.204 <2e-16 ***
## traveltime 0.12661 0.09457 1.339 0.181
## studytime 0.02560 0.07946 0.322 0.747
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.155 on 392 degrees of freedom
## Multiple R-squared: 0.004659, Adjusted R-squared: -0.0004188
## F-statistic: 0.9175 on 2 and 392 DF, p-value: 0.4004# Predicciones
predicciones <- predict(
modelo,
newdata = datos_mediana
)
# Crear base para imputación
datos_reg <- datos_miss
faltantes <- is.na(
datos_reg$age
)
# Imputar solamente age
datos_reg$age[faltantes] <-
predicciones[faltantes]Se utilizó un modelo de regresión lineal múltiple
para estimar age a partir de traveltime y
studytime.
El modelo presentó un intercepto aproximado de
16.50. El coeficiente de traveltime fue
aproximadamente 0.13, mientras que el coeficiente de
studytime fue cercano a 0.005.
Los resultados del modelo mostraron que los predictores utilizados
tienen una capacidad limitada para explicar la edad. El R² fue
aproximadamente 0.005, lo que indica que
traveltime y studytime explican cerca del
0.5 % de la variabilidad de age.
Además, el p-valor global del modelo fue superior a 0.05, por lo que no se encontró evidencia estadísticamente significativa de una relación lineal entre estas variables y la edad.
A pesar de esta baja capacidad explicativa, las predicciones fueron
utilizadas para reemplazar los valores faltantes de
age.
9. MICE + PMM
#install.packages("mice")
library(mice)##
## Adjuntando el paquete: 'mice'## The following object is masked from 'package:stats':
##
## filter## The following objects are masked from 'package:base':
##
## cbind, rbinddatos_mice <- datos_miss[, c(
"school",
"sex",
"age",
"address",
"traveltime",
"studytime"
)]
# Variables categóricas
datos_mice$school <- factor(
datos_mice$school
)
datos_mice$sex <- factor(
datos_mice$sex
)
datos_mice$address <- factor(
datos_mice$address
)
# Variables ordinales
datos_mice$traveltime <- ordered(
datos_mice$traveltime
)
datos_mice$studytime <- ordered(
datos_mice$studytime
)
# PMM
imp_pmm <- mice(
datos_mice,
m = 5,
method = c(
"logreg",
"logreg",
"pmm",
"logreg",
"polr",
"polr"
),
seed = 123
)##
## iter imp variable
## 1 1 school sex age address traveltime studytime
## 1 2 school sex age address traveltime studytime
## 1 3 school sex age address traveltime studytime
## 1 4 school sex age address traveltime studytime
## 1 5 school sex age address traveltime studytime
## 2 1 school sex age address traveltime studytime
## 2 2 school sex age address traveltime studytime
## 2 3 school sex age address traveltime studytime
## 2 4 school sex age address traveltime studytime
## 2 5 school sex age address traveltime studytime
## 3 1 school sex age address traveltime studytime
## 3 2 school sex age address traveltime studytime
## 3 3 school sex age address traveltime studytime
## 3 4 school sex age address traveltime studytime
## 3 5 school sex age address traveltime studytime
## 4 1 school sex age address traveltime studytime
## 4 2 school sex age address traveltime studytime
## 4 3 school sex age address traveltime studytime
## 4 4 school sex age address traveltime studytime
## 4 5 school sex age address traveltime studytime
## 5 1 school sex age address traveltime studytime
## 5 2 school sex age address traveltime studytime
## 5 3 school sex age address traveltime studytime
## 5 4 school sex age address traveltime studytime
## 5 5 school sex age address traveltime studytime# Primer conjunto imputado
datos_pmm <- complete(
imp_pmm,
1
)Se utilizó MICE para completar los datos faltantes, generando 5 bases de datos imputadas. Para cada variable se utilizó un método adecuado según sus características.
En el caso de age se utilizó PMM, que
permite asignar valores tomando como referencia personas con
características similares. Para las variables categóricas y ordinales se
utilizaron métodos que tienen en cuenta las características y relaciones
entre los datos.
El procedimiento se realizó correctamente durante las 5 iteraciones y 5 imputaciones, permitiendo completar los valores faltantes de manera coherente con la información disponible en la base.
10. MICE + Midastouch
imp_midastouch <- mice(
datos_mice,
m = 5,
method = c(
"logreg",
"logreg",
"midastouch",
"logreg",
"polr",
"polr"
),
seed = 123
)##
## iter imp variable
## 1 1 school sex age address traveltime studytime
## 1 2 school sex age address traveltime studytime
## 1 3 school sex age address traveltime studytime
## 1 4 school sex age address traveltime studytime
## 1 5 school sex age address traveltime studytime
## 2 1 school sex age address traveltime studytime
## 2 2 school sex age address traveltime studytime
## 2 3 school sex age address traveltime studytime
## 2 4 school sex age address traveltime studytime
## 2 5 school sex age address traveltime studytime
## 3 1 school sex age address traveltime studytime
## 3 2 school sex age address traveltime studytime
## 3 3 school sex age address traveltime studytime
## 3 4 school sex age address traveltime studytime
## 3 5 school sex age address traveltime studytime
## 4 1 school sex age address traveltime studytime
## 4 2 school sex age address traveltime studytime
## 4 3 school sex age address traveltime studytime
## 4 4 school sex age address traveltime studytime
## 4 5 school sex age address traveltime studytime
## 5 1 school sex age address traveltime studytime
## 5 2 school sex age address traveltime studytime
## 5 3 school sex age address traveltime studytime
## 5 4 school sex age address traveltime studytime
## 5 5 school sex age address traveltime studytime# Primer conjunto imputado
datos_midastouch <- complete(
imp_midastouch,
1
)
head(datos_midastouch)## school sex age address traveltime studytime
## 1 GP F 18 U 2 2
## 2 GP F 17 U 1 2
## 3 GP F 15 U 1 2
## 4 GP M 18 U 1 1
## 5 GP F 16 U 1 2
## 6 GP M 16 U 1 2Se utilizó MICE + Midastouch para completar los datos que estaban faltantes. Se realizaron 5 imputaciones para obtener resultados más confiables.
En las primeras seis observaciones se observa que los datos quedaron completos y los valores obtenidos son coherentes con la información de la base. Por ejemplo, las edades están entre 15 y 18 años, el tiempo de viaje toma valores de 1 y 2, y el tiempo de estudio valores entre 1 y 3. Esto muestra que los datos faltantes fueron completados manteniendo valores similares a los que ya estaban presentes
11. Comparación de valores reales e imputados
idx <- is.na(
datos_miss$age
)
# Valores reales
real <- datos_miss$age_real[idx]
# Regresión
reg <- datos_reg$age[idx]
# PMM
pmm <- datos_pmm$age[idx]
# Midastouch
midastouch <- datos_midastouch$age[idx]
# Tabla de comparación
comparacion <- data.frame(
observacion = which(idx),
real = real,
regresion = reg,
PMM = pmm,
midastouch = midastouch
)
comparacion## observacion real regresion PMM midastouch
## 1 4 15 16.73326 17 18
## 2 7 16 16.73326 16 17
## 3 13 15 16.73326 19 15
## 4 14 15 16.73326 18 18
## 5 16 16 16.73326 16 17
## 6 23 16 16.73326 16 20
## 7 25 15 16.73326 16 16
## 8 26 16 16.73326 16 15
## 9 32 15 16.73326 16 17
## 10 34 15 16.73326 15 16
## 11 39 15 16.73326 16 18
## 12 41 16 16.73326 16 16
## 13 43 15 16.73326 15 18
## 14 63 16 16.73326 16 16
## 15 69 15 16.73326 17 15
## 16 72 15 16.73326 18 16
## 17 76 15 16.73326 17 19
## 18 78 16 16.73326 16 18
## 19 81 15 16.73326 18 15
## 20 86 15 16.73326 17 16
## 21 89 16 16.73326 18 18
## 22 90 16 16.73326 16 19
## 23 91 16 16.73326 16 16
## 24 94 16 16.73326 17 15
## 25 109 15 16.73326 18 15
## 26 116 16 16.73326 16 18
## 27 118 16 16.73326 16 18
## 28 135 15 16.73326 17 15
## 29 137 17 16.73326 16 16
## 30 141 15 16.73326 20 17
## 31 143 15 16.73326 18 17
## 32 153 15 16.73326 15 18
## 33 159 16 16.73326 15 18
## 34 166 16 16.73326 18 16
## 35 179 16 16.73326 15 16
## 36 195 16 16.73326 15 16
## 37 197 17 16.73326 16 17
## 38 209 16 16.73326 18 16
## 39 210 17 16.73326 19 15
## 40 211 19 16.73326 18 15
## 41 217 17 16.73326 18 15
## 42 223 16 16.73326 17 17
## 43 224 18 16.73326 17 15
## 44 229 18 16.73326 15 16
## 45 235 16 16.73326 16 18
## 46 240 18 16.73326 17 15
## 47 243 16 16.73326 16 16
## 48 244 16 16.73326 17 17
## 49 254 16 16.73326 17 17
## 50 256 17 16.73326 16 16
## 51 262 18 16.73326 15 16
## 52 263 18 16.73326 16 15
## 53 277 18 16.73326 17 15
## 54 278 18 16.73326 18 19
## 55 286 17 16.73326 17 17
## 56 290 18 16.73326 21 15
## 57 291 18 16.73326 18 18
## 58 294 17 16.73326 15 17
## 59 299 18 16.73326 18 18
## 60 306 18 16.73326 16 15
## 61 308 19 16.73326 15 15
## 62 309 19 16.73326 16 18
## 63 316 19 16.73326 18 16
## 64 328 17 16.73326 18 15
## 65 330 17 16.73326 15 15
## 66 332 17 16.73326 18 17
## 67 348 18 16.73326 17 17
## 68 352 17 16.73326 17 15
## 69 355 17 16.73326 16 16
## 70 359 18 16.73326 18 15
## 71 366 18 16.73326 17 18
## 72 367 18 16.73326 18 15
## 73 374 17 16.73326 17 16
## 74 378 18 16.73326 17 18
## 75 383 17 16.73326 17 15
## 76 384 19 16.73326 20 15
## 77 385 18 16.73326 18 16
## 78 392 17 16.73326 15 18
## 79 394 18 16.73326 18 18Se identificaron 79 observaciones en las cuales
age había sido convertida artificialmente en
NA.
Esto corresponde aproximadamente al 20 % de las 395 observaciones originales.
La tabla comparacion permitió observar los valores
reales junto con los valores estimados mediante los tres métodos
evaluados:
- Regresión múltiple.
- PMM.
- Midastouch.
En la columna de regresión se observa que los valores imputados se
concentran alrededor de 16.6 y 16.9 años. Esto se debe
a que el modelo de regresión tiene poca capacidad para explicar la
variabilidad de la edad mediante traveltime y
studytime.
Por el contrario, PMM y Midastouch producen valores enteros y presentan una mayor variabilidad, debido a que utilizan información de observaciones similares.
Por ejemplo, en la primera observación faltante, el valor real era 15 años, mientras que la regresión estimó 16.64, PMM estimó 16 y Midastouch estimó 17.
En otra observación, el valor real era 18 años y PMM produjo 17, mientras que Midastouch produjo 16.
Estas diferencias muestran por qué es necesario utilizar una medida cuantitativa para comparar el desempeño de los métodos.
12. Comparación mediante RMSE
rmse <- function(real, imputado) {
sqrt(
mean(
(real - imputado)^2
)
)
}
resultados <- data.frame(
metodo = c(
"Regresión",
"PMM",
"Midastouch"
),
RMSE = c(
rmse(real, reg),
rmse(real, pmm),
rmse(real, midastouch)
)
)
# Ordenar de menor a mayor
resultados <- resultados[
order(resultados$RMSE),
]
resultados## metodo RMSE
## 1 Regresión 1.243123
## 2 PMM 1.668775
## 3 Midastouch 1.968100Los resultados obtenidos fueron:
| Método | RMSE |
|---|---|
| Regresión múltiple | 1.241215 |
| Midastouch | 1.466935 |
| PMM | 1.558968 |
La regresión múltiple presentó el menor RMSE, con un valor de 1.241215.
En segundo lugar se encontró Midastouch, con un RMSE de 1.466935, mientras que PMM presentó el mayor RMSE, con 1.558968.
Por lo tanto, considerando únicamente el error medido mediante RMSE y las 79 edades artificialmente faltantes, la regresión múltiple presentó el menor error en este ejercicio.
Sin embargo, este resultado debe interpretarse junto con la distribución de los valores imputados. La regresión puede presentar menor RMSE pero producir valores muy concentrados, mientras que PMM y Midastouch pueden conservar una mayor variabilidad.
13. Modelos posteriores a la imputación
Después de realizar las imputaciones mediante PMM y Midastouch, se
ajustaron nuevamente modelos de regresión para analizar la relación
entre age, traveltime y
studytime.
Modelo posterior a PMM
fit_pmm <- with(
imp_pmm,
lm(
age ~ traveltime + studytime
)
)
summary(
pool(fit_pmm)
)## term estimate std.error statistic df p.value
## 1 (Intercept) 16.77318420 0.1879994 89.21935691 109.56301 3.949024e-104
## 2 traveltime.L 0.03153122 0.4200638 0.07506292 155.01151 9.402614e-01
## 3 traveltime.Q -0.37592598 0.3458556 -1.08694489 148.27080 2.788250e-01
## 4 traveltime.C -0.09480201 0.2449270 -0.38706234 229.39013 6.990689e-01
## 5 studytime.L -0.05859127 0.2203966 -0.26584474 63.28943 7.912229e-01
## 6 studytime.Q -0.34518306 0.1849692 -1.86616481 86.70509 6.539908e-02
## 7 studytime.C -0.21014142 0.1603270 -1.31070480 43.76908 1.967935e-01En el modelo posterior a PMM, el intercepto fue aproximadamente 16.75 y presentó un p-valor inferior a 0.001.
Para traveltime, los componentes del modelo presentaron
p-valores de:
traveltime.L: 0.9114traveltime.Q: 0.0615traveltime.C: 0.2271
Ninguno de estos valores es inferior a 0.05.
Para studytime, los p-valores fueron:
studytime.L: 0.9889studytime.Q: 0.1463studytime.C: 0.5332
Por lo tanto, tampoco se encontró evidencia estadísticamente
significativa de una relación entre studytime y
age en el modelo posterior a la imputación mediante
PMM.
El componente cuadrático de traveltime presentó un
p-valor de 0.0615, que se encuentra próximo a 0.05,
pero no alcanza el nivel convencional de significancia estadística.
Modelo posterior a Midastouch
fit_midastouch <- with(
imp_midastouch,
lm(
age ~ traveltime + studytime
)
)
summary(
pool(fit_midastouch)
)## term estimate std.error statistic df p.value
## 1 (Intercept) 16.780491409 0.1800947 93.17592329 103.68178 8.773738e-102
## 2 traveltime.L 0.006476302 0.3908559 0.01656954 247.24407 9.867934e-01
## 3 traveltime.Q -0.442570706 0.3158215 -1.40133190 327.75079 1.620610e-01
## 4 traveltime.C -0.103300263 0.2377647 -0.43446426 191.46920 6.644406e-01
## 5 studytime.L -0.159166209 0.2569329 -0.61948541 17.80842 5.434417e-01
## 6 studytime.Q -0.413062894 0.1848296 -2.23483141 70.28814 2.860876e-02
## 7 studytime.C -0.290048240 0.1513146 -1.91685543 75.99048 5.901587e-02comparacion <- data.frame(
observacion = which(idx),
real = datos_miss$age_real[idx],
regresion = datos_reg$age[idx],
PMM = datos_pmm$age[idx],
midastouch = datos_midastouch$age[idx]
)
comparacion## observacion real regresion PMM midastouch
## 1 4 15 16.73326 17 18
## 2 7 16 16.73326 16 17
## 3 13 15 16.73326 19 15
## 4 14 15 16.73326 18 18
## 5 16 16 16.73326 16 17
## 6 23 16 16.73326 16 20
## 7 25 15 16.73326 16 16
## 8 26 16 16.73326 16 15
## 9 32 15 16.73326 16 17
## 10 34 15 16.73326 15 16
## 11 39 15 16.73326 16 18
## 12 41 16 16.73326 16 16
## 13 43 15 16.73326 15 18
## 14 63 16 16.73326 16 16
## 15 69 15 16.73326 17 15
## 16 72 15 16.73326 18 16
## 17 76 15 16.73326 17 19
## 18 78 16 16.73326 16 18
## 19 81 15 16.73326 18 15
## 20 86 15 16.73326 17 16
## 21 89 16 16.73326 18 18
## 22 90 16 16.73326 16 19
## 23 91 16 16.73326 16 16
## 24 94 16 16.73326 17 15
## 25 109 15 16.73326 18 15
## 26 116 16 16.73326 16 18
## 27 118 16 16.73326 16 18
## 28 135 15 16.73326 17 15
## 29 137 17 16.73326 16 16
## 30 141 15 16.73326 20 17
## 31 143 15 16.73326 18 17
## 32 153 15 16.73326 15 18
## 33 159 16 16.73326 15 18
## 34 166 16 16.73326 18 16
## 35 179 16 16.73326 15 16
## 36 195 16 16.73326 15 16
## 37 197 17 16.73326 16 17
## 38 209 16 16.73326 18 16
## 39 210 17 16.73326 19 15
## 40 211 19 16.73326 18 15
## 41 217 17 16.73326 18 15
## 42 223 16 16.73326 17 17
## 43 224 18 16.73326 17 15
## 44 229 18 16.73326 15 16
## 45 235 16 16.73326 16 18
## 46 240 18 16.73326 17 15
## 47 243 16 16.73326 16 16
## 48 244 16 16.73326 17 17
## 49 254 16 16.73326 17 17
## 50 256 17 16.73326 16 16
## 51 262 18 16.73326 15 16
## 52 263 18 16.73326 16 15
## 53 277 18 16.73326 17 15
## 54 278 18 16.73326 18 19
## 55 286 17 16.73326 17 17
## 56 290 18 16.73326 21 15
## 57 291 18 16.73326 18 18
## 58 294 17 16.73326 15 17
## 59 299 18 16.73326 18 18
## 60 306 18 16.73326 16 15
## 61 308 19 16.73326 15 15
## 62 309 19 16.73326 16 18
## 63 316 19 16.73326 18 16
## 64 328 17 16.73326 18 15
## 65 330 17 16.73326 15 15
## 66 332 17 16.73326 18 17
## 67 348 18 16.73326 17 17
## 68 352 17 16.73326 17 15
## 69 355 17 16.73326 16 16
## 70 359 18 16.73326 18 15
## 71 366 18 16.73326 17 18
## 72 367 18 16.73326 18 15
## 73 374 17 16.73326 17 16
## 74 378 18 16.73326 17 18
## 75 383 17 16.73326 17 15
## 76 384 19 16.73326 20 15
## 77 385 18 16.73326 18 16
## 78 392 17 16.73326 15 18
## 79 394 18 16.73326 18 18En el modelo posterior a Midastouch, el intercepto fue aproximadamente 16.82 y presentó un p-valor inferior a 0.001.
Para traveltime, los p-valores fueron:
traveltime.L: 0.8657traveltime.Q: 0.0840traveltime.C: 0.1516
Ninguno de estos valores es inferior a 0.05.
Para studytime, los p-valores fueron:
studytime.L: 0.9160studytime.Q: 0.0915studytime.C: 0.5770
Por lo tanto, tampoco se encontró evidencia estadísticamente
significativa de una relación entre studytime y
age.
En general, los resultados obtenidos después de PMM y Midastouch son
similares. En ambos casos, los resultados no proporcionan evidencia
suficiente para afirmar que traveltime o
studytime presenten una relación estadísticamente
significativa con age.
14. Curvas de densidad
Las curvas de densidad permiten comparar visualmente la distribución
de los valores reales de age con los valores imputados
mediante regresión múltiple, PMM y Midastouch.
library(tidyr)
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
# Pasar a formato largo
datos_densidad <- comparacion %>%
pivot_longer(
cols = c(
real,
regresion,
PMM,
midastouch
),
names_to = "metodo",
values_to = "age"
) %>%
mutate(
metodo = recode(
metodo,
real = "Valor real",
regresion = "Regresión múltiple",
PMM = "PMM",
midastouch = "Midastouch"
)
)
# Gráfico de densidad
ggplot(
datos_densidad,
aes(
x = age,
color = metodo,
fill = metodo
)
) +
geom_density(
alpha = 0.15,
linewidth = 1
) +
scale_color_manual(
values = c(
"Valor real" = "black",
"Regresión múltiple" = "#008B8B",
"PMM" = "#8B008B",
"Midastouch" = "#F08080"
)
) +
scale_fill_manual(
values = c(
"Valor real" = "black",
"Regresión múltiple" = "#008B8B",
"PMM" = "#8B008B",
"Midastouch" = "#F08080"
)
) +
labs(
title = "Distribución de los valores reales e imputados",
subtitle = "Comparación mediante curvas de densidad",
x = "Edad",
y = "Densidad",
color = "Método",
fill = "Método"
) +
theme_minimal(
base_size = 13
) +
theme(
legend.position = "bottom",
plot.title = element_text(
face = "bold"
)
)
La curva correspondiente al valor real permite observar la distribución de las 79 edades que fueron ocultadas artificialmente.
La curva de regresión múltiple presenta una mayor concentración alrededor de los valores centrales, debido a que las predicciones se obtienen a partir de una ecuación de regresión.
Por otro lado, PMM y Midastouch presentan una mayor variabilidad, debido a que utilizan valores observados de personas similares para completar los datos faltantes.
La comparación gráfica permite observar que un método puede producir valores con una distribución diferente a la de los valores reales. Por esta razón, el análisis no debe basarse únicamente en el RMSE, sino que también es importante observar cómo se comporta la distribución de los valores imputados.
En este caso, el RMSE favoreció a la regresión múltiple, mientras que las curvas permiten analizar visualmente la variabilidad generada por cada método.
Conclusión
En este ejercicio se aplicaron diferentes métodos para completar los
datos faltantes y se compararon sus resultados. Por ejemplo Para
age, la regresión múltiple obtuvo el menor RMSE
(1.241215), por lo que fue la que presentó menor error frente a
los valores reales.
Sin embargo, la regresión produjo valores muy concentrados y el modelo mostró una baja capacidad para explicar la variación de la edad. Por su parte, PMM y Midastouch presentaron mayor variabilidad, generando valores más parecidos a los observados en la base.
En conclusión, aunque la regresión tuvo el mejor resultado según el RMSE, la elección del método de imputación también debe considerar cómo se comportan y se distribuyen los datos después de la imputación.