Usaremos un conjunto de datos que incluye varias variables médicas predictoras (independientes) y una variable objetivo (dependiente), que es el resultado de interés. Entre las variables independientes se encuentran el número de embarazos de la paciente, el índice de masa corporal (BMI, calculado como peso en kg(altura en m)2peso en kg(altura enm)2), el nivel de insulina, la edad, entre otras. En este ejercicio, sustituiremos todos los valores ausentes o nulos por NAN y realizaremos el análisis correspondiente de los datos faltantes.
Realizaremos un EDA
# Cargar librerías necesariaslibrary(dplyr)
Warning: package 'dplyr' was built under R version 4.4.3
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, union
library(ggplot2)library(mice)
Adjuntando el paquete: 'mice'
The following object is masked from 'package:stats':
filter
The following objects are masked from 'package:base':
cbind, rbind
Pregnancies Glucose BloodPressure SkinThickness
Min. : 0.000 Min. : 0.0 Min. : 0.00 Min. : 0.00
1st Qu.: 1.000 1st Qu.: 99.0 1st Qu.: 62.00 1st Qu.: 0.00
Median : 3.000 Median :117.0 Median : 72.00 Median :23.00
Mean : 3.845 Mean :120.9 Mean : 69.11 Mean :20.54
3rd Qu.: 6.000 3rd Qu.:140.2 3rd Qu.: 80.00 3rd Qu.:32.00
Max. :17.000 Max. :199.0 Max. :122.00 Max. :99.00
Insulin BMI DiabetesPedigreeFunction Age
Min. : 0.0 Min. : 0.00 Min. :0.0780 Min. :21.00
1st Qu.: 0.0 1st Qu.:27.30 1st Qu.:0.2437 1st Qu.:24.00
Median : 30.5 Median :32.00 Median :0.3725 Median :29.00
Mean : 79.8 Mean :31.99 Mean :0.4719 Mean :33.24
3rd Qu.:127.2 3rd Qu.:36.60 3rd Qu.:0.6262 3rd Qu.:41.00
Max. :846.0 Max. :67.10 Max. :2.4200 Max. :81.00
Outcome
Min. :0.000
1st Qu.:0.000
Median :0.000
Mean :0.349
3rd Qu.:1.000
Max. :1.000
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ tidyr::extract() masks magrittr::extract()
✖ mice::filter() masks dplyr::filter(), stats::filter()
✖ dplyr::lag() masks stats::lag()
✖ purrr::set_names() masks magrittr::set_names()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
Definimos las columnas donde 0 representa datos faltantes, los cuales posteriormente remplazaremos con NA.
cols_to_replace <-c("Glucosa", "Presion_Arterial", "Grosor_de_Piel", "Insulina", "IMC")# Reemplazamos los ceros por NA en estas columnasdf[cols_to_replace] <-lapply(df[cols_to_replace], function(x) ifelse(x ==0, NA, x))# Verificamos si ahora hay valores NAcolSums(is.na(df)) # Muestra cuántos valores NA hay en cada columna
Queremos verificar estos datos faltantes, así que miramos el porcentaje de datos faltantes por variables de distintas formas.
# Instalar y cargar librerías necesariaslibrary(naniar)gg_miss_var(df, show_pct =TRUE) # Vemos el porcentaje de valores faltantes por variable
# Visualizamos los valores faltantes después de reemplazar 0 por NAlibrary(naniar)vis_miss(df)
# Realizamos un Missing map de los NAlibrary(Amelia)
Cargando paquete requerido: Rcpp
##
## Amelia II: Multiple Imputation
## (Version 1.8.3, built: 2024-11-07)
## Copyright (C) 2005-2025 James Honaker, Gary King and Matthew Blackwell
## Refer to http://gking.harvard.edu/amelia/ for more information
##
missmap(df, col =c("red", "blue"), legend =TRUE)
Podemos observar que aproximademente el 9% de los datos, son valores faltantes, una gran parte de estos datos se encuentra concentrada en las variables Insulina y Grosor de Piel, por lo que tenemos que tener un tratamiento especial con esats variables.
#Revisar el porcentaje exacto sapply(df, function(x) mean(is.na(x)) *100)
Aqui podemos observar los porcentajes exactos de datos faltantes en esats variables, de aqui podemos notar que la presion arterial , el IMC y la glucosa tienen menos del 5% de datos faltantes por lo que no es necesaria una imputación, ya que la cantidad es pequeña, podemos simplemente usar la función drop_na.
Histogramas para comparar distribuciones antes y después de la modificación.
library(tidyr)library(tidyselect)library(tidyverse)# Histograma de las variables numéricas en el dataset después de la imputacióndf %>%select(-Resultado) %>%# Excluye la variable objetivopivot_longer(cols =everything()) %>%# Convierte columnas en una sola columna "name" con valores en "value"ggplot(aes(value)) +geom_histogram(fill="green", color="black", bins=30, na.rm=TRUE) +facet_wrap(~ name, scales="free") +theme_minimal()
# Histograma del dataset original (antes de la imputación)df_orig %>%select(-Resultado) %>%pivot_longer(cols =everything()) %>%ggplot(aes(value)) +geom_histogram(fill="blue", color="black", bins=30) +facet_wrap(~ name, scales="free") +theme_minimal()
ks.test(df$Glucosa, df_orig$Glucosa)
Warning in ks.test.default(df$Glucosa, df_orig$Glucosa): p-value will be
approximate in the presence of ties
Asymptotic two-sample Kolmogorov-Smirnov test
data: df$Glucosa and df_orig$Glucosa
D = 0.0081218, p-value = 1
alternative hypothesis: two-sided
Warning in ks.test.default(df$Presion_Arterial, df_orig$Presion_Arterial):
p-value will be approximate in the presence of ties
Asymptotic two-sample Kolmogorov-Smirnov test
data: df$Presion_Arterial and df_orig$Presion_Arterial
D = 0.045688, p-value = 0.4181
alternative hypothesis: two-sided
ks.test(df$IMC, df_orig$IMC)
Warning in ks.test.default(df$IMC, df_orig$IMC): p-value will be approximate in
the presence of ties
Asymptotic two-sample Kolmogorov-Smirnov test
data: df$IMC and df_orig$IMC
D = 0.015798, p-value = 1
alternative hypothesis: two-sided
Como el p-valor (> 0.05) en todos los casos, entonces no hay evidencia para rechazar la hipótesis nula. De manera que la distribución de las variables no cambió significativamente después de la imputación/eliminación.
Tratamiento de Insulina y Grosor de Piel
Como la variable insulina tiene al rededor del 50% de datos faltantes debiamos encontrar una mejor manera de tratar estos datos, pero todos los métodos de imputación nos mostraron diferencias significativas entre las distribuciones antes y después de imputar los valores faltantes, y finalmente decidimos optar por usar method="pmm"
library(mice)# Imputación de la variable 'Insulina' usando el método pmmimputed_data <-mice(df, method ="pmm", m =5)
Debemos verificar que no haya una diferencia estadísticamente significativa entre las distribuciones de los datos de Insulina originales y los datos imputados.
library(ggplot2)# Histograma para los datos originalesggplot(df, aes(x = Insulina)) +geom_histogram(fill ="blue", color ="black", bins =30) +ggtitle("Distribución de Insulina Original")
Warning: Removed 332 rows containing non-finite outside the scale range
(`stat_bin()`).
# Histograma para los datos imputadosggplot(df_imputed, aes(x = Insulina)) +geom_histogram(fill ="red", color ="black", bins =30) +ggtitle("Distribución de Insulina Imputada")
ks.test(df_imputed$Insulina, df$Insulina) # Test de Kolmogorov-Smirnov para comparar distribuciones
Warning in ks.test.default(df_imputed$Insulina, df$Insulina): p-value will be
approximate in the presence of ties
Asymptotic two-sample Kolmogorov-Smirnov test
data: df_imputed$Insulina and df$Insulina
D = 0.035263, p-value = 0.9099
alternative hypothesis: two-sided
Dado que el p-valor es muy alto (1) y D=0, podemos concluir que no hay una diferencia estadísticamente significativa entre las distribuciones de los datos de Insulina antes y después de la imputación. Esto sugiere que el proceso de imputación no alteró significativamente la distribución de los datos de esa variable.
# Imputar solo la variable 'Grosor_de_Piel' usando el método 'norm.predict'imputed_data <-mice(df, method =c("", "norm.predict", "", "", "", "", "", "", ""), m =5)
Aqui observamos las filas que contienen datos atipicos, con el summary podemos observar que el valor de la media y de la mediana estan muy cercanos, los que nos lleva a pensar que sigue un distribucion normal, y que estos valores se encuentran demasiado alejados de la media, por lo que son posibles valores atipicos.
summary(df_imputed$Grosor_de_Piel)
Min. 1st Qu. Median Mean 3rd Qu. Max.
7.00 21.00 29.00 29.34 36.00 99.00
Entonces decidimos aplicar el metodo de percentiles. Este método de detección de valores atípicos se basa en los percentiles. Con el método de los percentiles, todas las observaciones que se encuentren fuera del intervalo formado por los percentiles 2.5 y 97.5 se considerarán como posibles valores atípicos 7
Aquí podemos observar que los valores que estan fuera del intervalo [29,485] son los considerados atipicos.
summary(df_imputed$Insulina)
Min. 1st Qu. Median Mean 3rd Qu. Max.
14.0 74.0 122.0 150.2 188.0 846.0
# Aplicar capping a todas las columnas numéricas en df_imputedfor (col innames(df_imputed)) {if (is.numeric(df_imputed[[col]])) { lower_bound <-quantile(df_imputed[[col]], 0.025, na.rm =TRUE) upper_bound <-quantile(df_imputed[[col]], 0.975, na.rm =TRUE) df_imputed[[col]][df_imputed[[col]] < lower_bound] <- lower_bound df_imputed[[col]][df_imputed[[col]] > upper_bound] <- upper_bound }}# Verificar algunos valores después del cappingsummary(df_imputed)
Embarazo Glucosa Presion_Arterial Grosor_de_Piel
Min. : 0.000 Min. : 74.00 Min. :50.00 Min. :11.00
1st Qu.: 1.000 1st Qu.: 99.75 1st Qu.:64.00 1st Qu.:21.00
Median : 3.000 Median :117.00 Median :72.00 Median :29.00
Mean : 3.837 Mean :121.95 Mean :72.38 Mean :29.17
3rd Qu.: 6.000 3rd Qu.:142.00 3rd Qu.:80.00 3rd Qu.:36.00
Max. :12.000 Max. :189.00 Max. :97.85 Max. :49.92
Insulina IMC Función_Genética_de_Diabetes Edad
Min. : 32.3 Min. :21.00 Min. :0.1260 Min. :21.00
1st Qu.: 74.0 1st Qu.:27.50 1st Qu.:0.2450 1st Qu.:24.00
Median :122.0 Median :32.40 Median :0.3790 Median :29.00
Mean :148.3 Mean :32.38 Mean :0.4660 Mean :33.26
3rd Qu.:188.0 3rd Qu.:36.60 3rd Qu.:0.6275 3rd Qu.:41.00
Max. :480.0 Max. :46.48 Max. :1.3160 Max. :62.92
Resultado
Min. :0.0000
1st Qu.:0.0000
Median :0.0000
Mean :0.3439
3rd Qu.:1.0000
Max. :1.0000
# Convertir a formato largo para ggplotdf_long <- df_imputed %>%pivot_longer(cols =c(Glucosa, Presion_Arterial, Grosor_de_Piel, Insulina, IMC),names_to ="Variable", values_to ="Valor")# Crear boxplots con facetasggplot(df_long, aes(x = Variable, y = Valor)) +geom_boxplot(fill ="lightblue", color ="black") +facet_wrap(~ Variable, scales ="free") +theme_minimal() +labs(title ="Boxplots")
Como podemos observar despues de aplicar el capping , vemos que aun hay datos atipicos presentes en nuestra variable Insulina , esto es debido a que los percentiles elegidos (2.5% y 97.5%) no son suficientes para eliminar todos los valores extremos.
Por ello, usaremos el criterio de 1.5*IQR en lugar de los percentiles
for (col innames(df_imputed)) {if (is.numeric(df_imputed[[col]])) { qnt <-quantile(df_imputed[[col]], probs =c(0.25, 0.75), na.rm =TRUE) # Cuartiles Q1 y Q3 IQR_value <-IQR(df_imputed[[col]], na.rm =TRUE) # Rango intercuartílico lower_bound <- qnt[1] -1.5* IQR_value upper_bound <- qnt[2] +1.5* IQR_value# Aplicar capping df_imputed[[col]][df_imputed[[col]] < lower_bound] <- lower_bound df_imputed[[col]][df_imputed[[col]] > upper_bound] <- upper_bound }}# Revisar si todavía hay atípicos en Insulinaboxplot(df_imputed$Insulina, col="lightblue")
Con este boxplot observamos que ya no hay presentes valores atipicos en nuestra variable Insulina.
Con una vista más general, podemos observar que ya no hay valores atípicos presentes en ninguna de nuestras variables, lo que indica que el proceso de tratamiento ha sido exitoso. Esto nos permite asegurar que los datos son ahora más representativos y adecuados para su análisis, reduciendo la influencia de valores extremos que podrían sesgar los resultados.
En conclusión, hemos completado satisfactoriamente la imputación de los datos faltantes (NA) y la corrección de valores atípicos en nuestra base de datos de diabetes, garantizando así una mayor calidad y fiabilidad en los análisis posteriores que se realicen sobre este conjunto de datos.
