Dataset

df = read.csv("C:/Users/johan/Downloads/diabetes.csv", sep=",", header=TRUE, fileEncoding = "UTF-8")

Variables

Pregnancies: Número de embarazos.
Glucose: Concentración de glucosa.
BloodPressure: Presión arterial diastólica.
SkinThickness: Grosor del pliegue cutáneo del tríceps.
Insulin: Insulina sérica.
BMI: Índice de masa corporal (peso en kg / (altura en m)^2).
DiabetesPedigreeFunction: Una función que pondera genéticamente el riesgo de diabetes en relación con la historia familiar.
Age: Edad del paciente.
Outcome: La variable de resultado, donde 1 indica que el paciente tiene diabetes y 0 indica que no la tiene.

suppressWarnings({

require(dplyr)
require(tibble)
library(pracma)
require(stringr)
require(ggplot2)
require(ggpubr)
require(e1071)
require(psych)
library(reshape2)
library(Hmisc)
library(Amelia)
library(mice)
library(foreign)
library(ggplot2)
library(gridExtra)
library(hrbrthemes)
    
})

## Cargando paquete requerido: 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, union

## Cargando paquete requerido: tibble

## Cargando paquete requerido: stringr

## Cargando paquete requerido: ggplot2

## Cargando paquete requerido: ggpubr

## Cargando paquete requerido: e1071

## 
## Adjuntando el paquete: 'e1071'

## The following object is masked from 'package:pracma':
## 
##     sigmoid

## Cargando paquete requerido: psych

## 
## Adjuntando el paquete: 'psych'

## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha

## The following objects are masked from 'package:pracma':
## 
##     logit, polar

## 
## Adjuntando el paquete: 'Hmisc'

## The following object is masked from 'package:psych':
## 
##     describe

## The following object is masked from 'package:e1071':
## 
##     impute

## The following object is masked from 'package:pracma':
## 
##     ceil

## The following objects are masked from 'package:dplyr':
## 
##     src, summarize

## The following objects are masked from 'package:base':
## 
##     format.pval, units

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

## 
## Adjuntando el paquete: 'mice'

## The following object is masked from 'package:stats':
## 
##     filter

## The following objects are masked from 'package:base':
## 
##     cbind, rbind

## 
## Adjuntando el paquete: 'gridExtra'

## The following object is masked from 'package:dplyr':
## 
##     combine

Mostramos las primeras y ultimas filas de la base de datos para ver como esta estructurado.

head(df)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35       0 33.6
## 2           1      85            66            29       0 26.6
## 3           8     183            64             0       0 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74             0       0 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

tail(df)

##     Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 763           9      89            62             0       0 22.5
## 764          10     101            76            48     180 32.9
## 765           2     122            70            27       0 36.8
## 766           5     121            72            23     112 26.2
## 767           1     126            60             0       0 30.1
## 768           1      93            70            31       0 30.4
##     DiabetesPedigreeFunction Age Outcome
## 763                    0.142  33       0
## 764                    0.171  63       0
## 765                    0.340  27       0
## 766                    0.245  30       0
## 767                    0.349  47       1
## 768                    0.315  23       0

Ahora analizaremos la naturaleza de las variables de nuestra base de datos.

glimpse(df)

## Rows: 768
## Columns: 9
## $ Pregnancies              <int> 6, 1, 8, 1, 0, 5, 3, 10, 2, 8, 4, 10, 10, 1, …
## $ Glucose                  <int> 148, 85, 183, 89, 137, 116, 78, 115, 197, 125…
## $ BloodPressure            <int> 72, 66, 64, 66, 40, 74, 50, 0, 70, 96, 92, 74…
## $ SkinThickness            <int> 35, 29, 0, 23, 35, 0, 32, 0, 45, 0, 0, 0, 0, …
## $ Insulin                  <int> 0, 0, 0, 94, 168, 0, 88, 0, 543, 0, 0, 0, 0, …
## $ BMI                      <dbl> 33.6, 26.6, 23.3, 28.1, 43.1, 25.6, 31.0, 35.…
## $ DiabetesPedigreeFunction <dbl> 0.627, 0.351, 0.672, 0.167, 2.288, 0.201, 0.2…
## $ Age                      <int> 50, 31, 32, 21, 33, 30, 26, 29, 53, 54, 30, 3…
## $ Outcome                  <int> 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 1, …

Reemplazaremos los valores 0.0 por Na para luego realizar el tratamiento de estos datos.

df$Glucose[df$Glucose == 0.0] <- NA
df$BloodPressure[df$BloodPressure == 0.0] <- NA
df$SkinThickness[df$SkinThickness == 0.0] <- NA
df$Insulin[df$Insulin == 0.0] <- NA
df$BMI[df$BMI == 0.0] <- NA

Calculamos el número de valores faltantes para cada variable del DataFrame.

colSums(is.na(df))

##              Pregnancies                  Glucose            BloodPressure 
##                        0                        5                       35 
##            SkinThickness                  Insulin                      BMI 
##                      227                      374                       11 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

colMeans(is.na(df)) * 100

##              Pregnancies                  Glucose            BloodPressure 
##                0.0000000                0.6510417                4.5572917 
##            SkinThickness                  Insulin                      BMI 
##               29.5572917               48.6979167                1.4322917 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                0.0000000                0.0000000                0.0000000

missmap(df, col = c("red", "blue"), legend = TRUE)

Imputación de datos

Vamos a realizar la imputación de los datos usando diversas tecnicas.

Las variables a las que le vamos a aplicar las tecnicas de imputacion son las siguientes:

SkinThickness: 29.55 % de datos faltantes
Insulin: 48.69 % de datos faltantes
Glucose: 0.65 % de datos faltantes
BloodPressure: 4.55 % de datos faltantes
BMI: 1.43 % de datos faltantes

Pruebas de normalidad

Guardamos el dataframe original y verificamos sus distribuciones para luego compararlos con los nuevos datos.

#dataset original
previo_df <- df

# Pregnancies
shapiro_pregnancies <- shapiro.test(df$Pregnancies)
print("Resultado para Pregnancies:")

## [1] "Resultado para Pregnancies:"

print(shapiro_pregnancies)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$Pregnancies
## W = 0.90428, p-value < 2.2e-16

# Glucose
shapiro_glucose <- shapiro.test(df$Glucose)
print("Resultado para Glucose:")

## [1] "Resultado para Glucose:"

print(shapiro_glucose)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$Glucose
## W = 0.96964, p-value = 1.72e-11

# BloodPressure
shapiro_bloodpressure <- shapiro.test(df$BloodPressure)
print("Resultado para BloodPressure:")

## [1] "Resultado para BloodPressure:"

print(shapiro_bloodpressure)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$BloodPressure
## W = 0.99031, p-value = 9.451e-05

# SkinThickness
shapiro_skinthickness <- shapiro.test(df$SkinThickness)
print("Resultado para SkinThickness:")

## [1] "Resultado para SkinThickness:"

print(shapiro_skinthickness)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$SkinThickness
## W = 0.968, p-value = 1.776e-09

# Insulin
shapiro_insulin <- shapiro.test(df$Insulin)
print("Resultado para Insulin:")

## [1] "Resultado para Insulin:"

print(shapiro_insulin)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$Insulin
## W = 0.8041, p-value < 2.2e-16

# BMI
shapiro_bmi <- shapiro.test(df$BMI)
print("Resultado para BMI:")

## [1] "Resultado para BMI:"

print(shapiro_bmi)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$BMI
## W = 0.97955, p-value = 8.558e-09

# DiabetesPedigreeFunction
shapiro_dpf <- shapiro.test(df$DiabetesPedigreeFunction)
print("Resultado para DiabetesPedigreeFunction:")

## [1] "Resultado para DiabetesPedigreeFunction:"

print(shapiro_dpf)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$DiabetesPedigreeFunction
## W = 0.83652, p-value < 2.2e-16

# Age
shapiro_age <- shapiro.test(df$Age)
print("Resultado para Age:")

## [1] "Resultado para Age:"

print(shapiro_age)

## 
##  Shapiro-Wilk normality test
## 
## data:  df$Age
## W = 0.87477, p-value < 2.2e-16

Vemos que todas nuestras variables coinciden en que no siguen una distribución normal por lo que se espera que al realizar las imputaciones, los nuevos dataframe sigan la misma distribución.

Imputación por PMM

Este metodo reemplaza los valores faltantes con valores observados que son similares en términos de predicción, manteniendo la coherencia y la distribución original de los datos. Este enfoque es especialmente útil para evitar imputaciones irreales y preservar las características estadísticas del conjunto de datos.

mostramos nuevamente la tabla para ver como se ven las primeras filas de SKinThickess y Insulin

head(previo_df)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35      NA 33.6
## 2           1      85            66            29      NA 26.6
## 3           8     183            64            NA      NA 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74            NA      NA 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

Aplicamos ahora el metodo de imputación por emparejamiento predictivo medio

imp <- mice(df, m=5, maxit=50, method ='pmm', seed=500, printFlag = FALSE)

df_pmm <- complete(imp, 1)

head(df_pmm)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35      83 33.6
## 2           1      85            66            29      55 26.6
## 3           8     183            64            20     175 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74            24     175 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

colSums(is.na(df_pmm))

##              Pregnancies                  Glucose            BloodPressure 
##                        0                        0                        0 
##            SkinThickness                  Insulin                      BMI 
##                        0                        0                        0 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

Análisis de Conservación de la Distribución Post-Imputación

Realizaremos un histograma y una prueba de normalidad para ver si luego de hacer la imputación a la variable SkinThickness, se mantiene la distribucion.

suppressWarnings({
ggp1 <- ggplot(data.frame(value=previo_df$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp2 <- ggplot(data.frame(value=df_pmm$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp1, ggp2, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_pmm <- shapiro.test(df_pmm$SkinThickness)
print(shapiro_pmm)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_pmm$SkinThickness
## W = 0.97313, p-value = 1.122e-10

Como el p-valor (1.122e-10) es menor que el nivel de significancia (0.05), nuestra variable no sigue una distribución normal al igual que la original, por lo que esta preservandose la distribución luego de la imputacion de los datos.

Ahora realizaremos el analisis anterior a la variable Insulin, estos es, un histograma y una prueba de normalidad para ver si luego de hacer la imputación se mantiene la distribucion.

suppressWarnings({
ggp3 <- ggplot(data.frame(value=previo_df$Insulin), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp4 <- ggplot(data.frame(value=df_pmm$Insulin), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp3, ggp4, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_pmm_2 <- shapiro.test(df_pmm$Insulin)
print(shapiro_pmm_2)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_pmm$Insulin
## W = 0.79813, p-value < 2.2e-16

Como el p-valor (2.2e-16) es menor que el nivel de significancia (0.05), nuestra variable no sigue una distribución normal al igual que la original, por lo que esta preservandose la distribución luego de la imputacion de los datos.

Imputación por norm.predict

Este método utiliza un modelo de regresión lineal para predecir los valores faltantes. Para cada variable con datos faltantes, se ajusta un modelo de regresión lineal que usa las otras variables del conjunto de datos como predictores.

mostramos nuevamente la tabla para ver como se ven las primeras filas de SKinThickess y Insulin

head(previo_df)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35      NA 33.6
## 2           1      85            66            29      NA 26.6
## 3           8     183            64            NA      NA 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74            NA      NA 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

Aplicamos ahora el metodo de norm.predict

imp_norm <- mice(df, m=5, maxit=50, method = 'norm.predict', seed = 500, printFlag = FALSE)

df_norm_predict <- complete(imp_norm, 1)

head(df_norm_predict)

##   Pregnancies Glucose BloodPressure SkinThickness   Insulin  BMI
## 1           6     148            72      35.00000 220.41825 33.6
## 2           1      85            66      29.00000  69.60061 26.6
## 3           8     183            64      21.44380 256.23203 23.3
## 4           1      89            66      23.00000  94.00000 28.1
## 5           0     137            40      35.00000 168.00000 43.1
## 6           5     116            74      21.87459 117.51189 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

colSums(is.na(df_norm_predict))

##              Pregnancies                  Glucose            BloodPressure 
##                        0                        0                        0 
##            SkinThickness                  Insulin                      BMI 
##                        0                        0                        0 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

Análisis de Conservación de la Distribución Post-Imputación

Realizaremos un histograma y una prueba de normalidad para ver si luego de hacer la imputación a la variable SkinThickness, se mantiene la distribucion.

suppressWarnings({
ggp1 <- ggplot(data.frame(value=previo_df$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp2 <- ggplot(data.frame(value=df_norm_predict$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp1, ggp2, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm_predict <- shapiro.test(df_norm_predict$SkinThickness)
print(shapiro_norm_predict)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_predict$SkinThickness
## W = 0.97092, p-value = 3.127e-11

Como el p-valor (3.127e-11) es menor que el nivel de significancia (0.05), nuestra variable no sigue una distribución normal al igual que la original, por lo que esta preservandose la distribución luego de la imputacion de los datos.

Ahora realizaremos el analisis anterior a la variable Insulin, estos es, un histograma y una prueba de normalidad para ver si luego de hacer la imputación se mantiene la distribucion.

suppressWarnings({
ggp3 <- ggplot(data.frame(value=previo_df$Insulin), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp4 <- ggplot(data.frame(value=df_norm_predict$Insulin), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp3, ggp4, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm_predict_2 <- shapiro.test(df_norm_predict$Insulin)
print(shapiro_norm_predict_2)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_predict$Insulin
## W = 0.84787, p-value < 2.2e-16

Imputación por norm.nob

Este método utiliza un modelo de regresión lineal para predecir los valores faltantes. La principal diferencia con norm.predict es que norm.nob agrega un residuo aleatorio a cada valor predicho. Este residuo se extrae de la distribución de los residuos del modelo de regresión.

mostramos nuevamente la tabla para ver como se ven las primeras filas de SKinThickess y Insulin

head(previo_df)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35      NA 33.6
## 2           1      85            66            29      NA 26.6
## 3           8     183            64            NA      NA 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74            NA      NA 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

Aplicamos ahora el metodo de norm.nob

imp_norm_nob <- mice(df, m=5, maxit=50, method = 'norm.nob', seed = 500, printFlag = FALSE)

df_norm_nob <- complete(imp_norm_nob, 1)

head(df_norm_nob)

##   Pregnancies Glucose BloodPressure SkinThickness   Insulin  BMI
## 1           6     148            72      35.00000  282.7451 33.6
## 2           1      85            66      29.00000  130.6682 26.6
## 3           8     183            64      10.33126  253.1314 23.3
## 4           1      89            66      23.00000   94.0000 28.1
## 5           0     137            40      35.00000  168.0000 43.1
## 6           5     116            74      20.24396 -130.7138 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

colSums(is.na(df_norm_nob))

##              Pregnancies                  Glucose            BloodPressure 
##                        0                        0                        0 
##            SkinThickness                  Insulin                      BMI 
##                        0                        0                        0 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

Análisis de Conservación de la Distribución Post-Imputación

Realizaremos un histograma y una prueba de normalidad para ver si luego de hacer la imputación a la variable SkinThickness, se mantiene la distribucion.

suppressWarnings({
ggp1 <- ggplot(data.frame(value=previo_df$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp2 <- ggplot(data.frame(value=df_norm_nob$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp1, ggp2, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm_nob <- shapiro.test(df_norm_nob$SkinThickness)
print(shapiro_norm_nob)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_nob$SkinThickness
## W = 0.97906, p-value = 4.945e-09

Como el p-valor (4.945e-09) es menor que el nivel de significancia (0.05), nuestra variable no sigue una distribución normal al igual que la original, por lo que esta preservandose la distribución luego de la imputacion de los datos.

Ahora realizaremos el analisis anterior a la variable Insulin, estos es, un histograma y una prueba de normalidad para ver si luego de hacer la imputación se mantiene la distribucion.

suppressWarnings({
ggp3 <- ggplot(data.frame(value=previo_df$Insulin), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp4 <- ggplot(data.frame(value=df_norm_nob$Insulin), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp3, ggp4, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm_nob_2 <- shapiro.test(df_norm_nob$Insulin)
print(shapiro_norm_nob_2)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_nob$Insulin
## W = 0.92744, p-value < 2.2e-16

Imputación por norm

Este método utiliza un modelo de regresión lineal para predecir los valores faltantes. La diferencia principal es cómo genera ese error. Mientras norm.nob usa los residuos del modelo de regresión, norm usa un método de “muestreo bayesiano” para la distribución de los parámetros del modelo.

Mostramos nuevamente la tabla para ver como se ven las primeras filas de SKinThickess y Insulin del dataset original.

head(previo_df)

##   Pregnancies Glucose BloodPressure SkinThickness Insulin  BMI
## 1           6     148            72            35      NA 33.6
## 2           1      85            66            29      NA 26.6
## 3           8     183            64            NA      NA 23.3
## 4           1      89            66            23      94 28.1
## 5           0     137            40            35     168 43.1
## 6           5     116            74            NA      NA 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

Aplicamos ahora el metodo de norm.nob

imp_norm <- mice(df, m=5, maxit=50, method = 'norm', seed = 500, printFlag = FALSE)

df_norm <- complete(imp_norm, 1)

head(df_norm)

##   Pregnancies Glucose BloodPressure SkinThickness   Insulin  BMI
## 1           6     148            72      35.00000 456.01723 33.6
## 2           1      85            66      29.00000  60.66381 26.6
## 3           8     183            64      16.75604 186.58545 23.3
## 4           1      89            66      23.00000  94.00000 28.1
## 5           0     137            40      35.00000 168.00000 43.1
## 6           5     116            74      23.76877 299.81798 25.6
##   DiabetesPedigreeFunction Age Outcome
## 1                    0.627  50       1
## 2                    0.351  31       0
## 3                    0.672  32       1
## 4                    0.167  21       0
## 5                    2.288  33       1
## 6                    0.201  30       0

colSums(is.na(df_norm))

##              Pregnancies                  Glucose            BloodPressure 
##                        0                        0                        0 
##            SkinThickness                  Insulin                      BMI 
##                        0                        0                        0 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

Análisis de Conservación de la Distribución Post-Imputación

Realizaremos un histograma y una prueba de normalidad para ver si luego de hacer la imputación a la variable SkinThickness, se mantiene la distribucion.

suppressWarnings({
ggp1 <- ggplot(data.frame(value=previo_df$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp2 <- ggplot(data.frame(value=df_norm$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('SkinThickness') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp1, ggp2, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm <- shapiro.test(df_norm$SkinThickness)
print(shapiro_norm_nob)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_nob$SkinThickness
## W = 0.97906, p-value = 4.945e-09

Ahora realizaremos el analisis anterior a la variable Insulin, estos es, un histograma y una prueba de normalidad para ver si luego de hacer la imputación se mantiene la distribucion.

suppressWarnings({
ggp3 <- ggplot(data.frame(value=previo_df$Insulin), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

ggp4 <- ggplot(data.frame(value=df_norm$Insulin), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Imputación") +
  xlab('Insulin') + ylab('Frequency') +
  theme_ipsum() +
  theme(plot.title = element_text(size=15))

grid.arrange(ggp3, ggp4, ncol = 2)
})

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

shapiro_norm_2 <- shapiro.test(df_norm$Insulin)
print(shapiro_norm_nob_2)

## 
##  Shapiro-Wilk normality test
## 
## data:  df_norm_nob$Insulin
## W = 0.92744, p-value < 2.2e-16

Metodo Seleccionado

Los analisis de datos atipicos y el eda lo voy a realizar con la base de datos que se encuentra imputada con la tecnica PMM debido a que los datos no tienen distribucion normal, y en este caso PMM se adapta mejor porque no hace suposiciones sobre la distribución de la variable y utiliza valores reales del dataset, a diferencia de las demas porque estos otros metodos utilizan regresión lineal y tienden a imputar valores que se ajustan a una distribución normal, lo que es un problema debido a que tiende a cambiar la forma de la distribución.

Datos atípicos

En esta sección vamos a identificar los valores atipicos de las variables de la base de datos utilizando las tecnicas que aprendimos en clase.

Resumen inicial de los datos.

summary(df_pmm)

##   Pregnancies        Glucose      BloodPressure    SkinThickness  
##  Min.   : 0.000   Min.   : 44.0   Min.   : 24.00   Min.   : 7.00  
##  1st Qu.: 1.000   1st Qu.: 99.0   1st Qu.: 64.00   1st Qu.:21.00  
##  Median : 3.000   Median :117.0   Median : 72.00   Median :29.00  
##  Mean   : 3.845   Mean   :121.7   Mean   : 72.42   Mean   :28.82  
##  3rd Qu.: 6.000   3rd Qu.:141.0   3rd Qu.: 80.00   3rd Qu.:36.00  
##  Max.   :17.000   Max.   :199.0   Max.   :122.00   Max.   :99.00  
##     Insulin            BMI        DiabetesPedigreeFunction      Age       
##  Min.   : 14.00   Min.   :18.20   Min.   :0.0780           Min.   :21.00  
##  1st Qu.: 73.75   1st Qu.:27.50   1st Qu.:0.2437           1st Qu.:24.00  
##  Median :120.00   Median :32.30   Median :0.3725           Median :29.00  
##  Mean   :148.57   Mean   :32.47   Mean   :0.4719           Mean   :33.24  
##  3rd Qu.:182.00   3rd Qu.:36.60   3rd Qu.:0.6262           3rd Qu.:41.00  
##  Max.   :846.00   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

Realizamos un boxplot multiple para saber que variables tienen datos atipicos y explorar con las tecnicas vistas en clase mas a profundidad estos valores.

df_analisis <- df_pmm[, c('Pregnancies', 'Glucose', 'BloodPressure', 'SkinThickness', 'Insulin', 'BMI', 'DiabetesPedigreeFunction', 'Age')]

df_melted <- melt(df_analisis)

## No id variables; using all as measure variables

ggplot(df_melted, aes(x = "", y = value)) +
  geom_boxplot(fill = "#0c4c8a") +
  theme_minimal() +
  labs(y = "Valor", x = "") +
  facet_wrap(~variable, scales = "free_y", ncol = 4) +
  theme(panel.grid.major = element_line(color = "gray80", linetype = "dotted"),
        panel.grid.minor = element_blank())

Metodo de percentiles

variables_predictores <- setdiff(names(df_pmm), "Outcome")

percentil_bajo <- 0.025
percentil_alto <- 0.975

cat("Valores atípicos detectados por el método de percentiles (", percentil_bajo * 100, "% y ", percentil_alto * 100, "%):\n\n")

## Valores atípicos detectados por el método de percentiles ( 2.5 % y  97.5 %):

for (col in variables_predictores) {

  lower_bound <- quantile(df_pmm[[col]], percentil_bajo, na.rm = TRUE)
  upper_bound <- quantile(df_pmm[[col]], percentil_alto, na.rm = TRUE)
  

  outliers_low <- df_pmm[[col]][df_pmm[[col]] < lower_bound]
  outliers_high <- df_pmm[[col]][df_pmm[[col]] > upper_bound]

  total_outliers <- length(outliers_low) + length(outliers_high)
  
  cat("---", col, "---\n")
  cat("Límite inferior (", percentil_bajo * 100, "%):", lower_bound, "\n")
  cat("Límite superior (", percentil_alto * 100, "%):", upper_bound, "\n")
  
  if (length(outliers_low) > 0) {
    cat("Valores por debajo del límite inferior:\n")
    print(outliers_low)
  }
  
  if (length(outliers_high) > 0) {
    cat("Valores por encima del límite superior:\n")
    print(outliers_high)
  }
  
  cat("Total de outliers encontrados:", total_outliers, "\n")

}

## --- Pregnancies ---
## Límite inferior ( 2.5 %): 0 
## Límite superior ( 97.5 %): 12 
## Valores por encima del límite superior:
##  [1] 13 13 13 15 17 13 14 13 13 14 13 13 13 13
## Total de outliers encontrados: 14 
## --- Glucose ---
## Límite inferior ( 2.5 %): 73.175 
## Límite superior ( 97.5 %): 189 
## Valores por debajo del límite inferior:
##  [1] 71 73 44 62 71 57 71 73 71 61 72 71 68 57 73 67 68 68 56 65
## Valores por encima del límite superior:
##  [1] 197 196 194 196 197 193 191 194 196 193 197 194 195 198 198 197 199 195 190
## Total de outliers encontrados: 39 
## --- BloodPressure ---
## Límite inferior ( 2.5 %): 50 
## Límite superior ( 97.5 %): 97.65 
## Valores por debajo del límite inferior:
##  [1] 40 30 48 44 48 48 30 48 46 48 44 44 24 38 44 46 44
## Valores por encima del límite superior:
##  [1] 110 108 122 110  98 104  98 100 108 102 100 100 104  98 110 106 106 106 100
## [20] 114
## Total de outliers encontrados: 37 
## --- SkinThickness ---
## Límite inferior ( 2.5 %): 11 
## Límite superior ( 97.5 %): 48 
## Valores por debajo del límite inferior:
##  [1] 10 10  7  7 10 10  8  8 10  8  7 10  7
## Valores por encima del límite superior:
##  [1] 49 60 54 51 56 50 54 50 52 60 49 49 63 52 49 99 50 60 49
## Total de outliers encontrados: 32 
## --- Insulin ---
## Límite inferior ( 2.5 %): 25.7 
## Límite superior ( 97.5 %): 480 
## Valores por debajo del límite inferior:
##  [1] 23 23 15 18 23 23 15 14 16 23 18 25 25 25 15 18 23 23 22 16
## Valores por encima del límite superior:
##  [1] 543 545 846 495 485 495 744 680 680 545 540 579 540 543 600 540 846 510 510
## Total de outliers encontrados: 39 
## --- BMI ---
## Límite inferior ( 2.5 %): 21 
## Límite superior ( 97.5 %): 46.665 
## Valores por debajo del límite inferior:
##  [1] 19.9 19.4 19.6 19.1 20.4 20.4 18.4 20.8 19.3 20.0 18.2 18.2 19.6 20.8 19.6
## [16] 18.2 19.5 20.1 19.5
## Valores por encima del límite superior:
##  [1] 46.8 46.8 48.8 46.7 49.7 53.2 55.0 47.9 50.0 67.1 52.3 52.3 52.9 47.9 48.3
## [16] 59.4 46.8 57.3 49.6 49.3
## Total de outliers encontrados: 39 
## --- DiabetesPedigreeFunction ---
## Límite inferior ( 2.5 %): 0.123525 
## Límite superior ( 97.5 %): 1.31345 
## Valores por debajo del límite inferior:
##  [1] 0.102 0.088 0.096 0.085 0.084 0.101 0.089 0.092 0.078 0.123 0.122 0.108
## [13] 0.107 0.121 0.085 0.088 0.100 0.115 0.118 0.121
## Valores por encima del límite superior:
##  [1] 2.288 1.441 1.390 1.893 1.781 1.400 1.321 2.329 1.318 1.353 1.391 1.476
## [13] 2.137 1.731 1.600 2.420 1.699 1.698 1.461 1.394
## Total de outliers encontrados: 40 
## --- Age ---
## Límite inferior ( 2.5 %): 21 
## Límite superior ( 97.5 %): 63 
## Valores por encima del límite superior:
##  [1] 69 65 66 65 65 67 72 81 67 66 64 67 66 70 68 69 66
## Total de outliers encontrados: 17

Filtro de Hampel

variables_predictores <- setdiff(names(df_pmm), "Outcome")

cat("Valores atípicos detectados por el método de Hampel manual:\n\n")

## Valores atípicos detectados por el método de Hampel manual:

for (col in variables_predictores) {
    mediana <- median(df_pmm[[col]])
    mad_valor <- mad(df_pmm[[col]], constant = 1)
    
    lower_bound <- mediana - (3 * mad_valor)
    upper_bound <- mediana + (3 * mad_valor)
    
    outliers <- df_pmm[[col]][df_pmm[[col]] < lower_bound | df_pmm[[col]] > upper_bound]
    total_outliers <- length(outliers)

    cat("---", col, "---\n")
    cat("Límite inferior:", lower_bound, "\n")
    cat("Límite superior:", upper_bound, "\n")
    
    if (total_outliers > 0) {
        cat("Valores atípicos:\n")
        print(outliers)
        cat("Total de outliers encontrados:", total_outliers, "\n")
    } else {
        cat("No se encontraron outliers.\n")
    }
    
    cat("\n")
}

## --- Pregnancies ---
## Límite inferior: -3 
## Límite superior: 9 
## Valores atípicos:
##  [1] 10 10 10 11 10 13 10 11 13 13 15 10 17 11 12 10 12 11 10 13 10 14 10 13 10
## [26] 12 13 12 12 12 14 10 10 10 12 13 10 11 11 10 12 11 11 10 13 11 11 10 10 10
## [51] 13 10 10 10 11 13 12 10
## Total de outliers encontrados: 58 
## 
## --- Glucose ---
## Límite inferior: 57 
## Límite superior: 177 
## Valores atípicos:
##  [1] 183 197 189 196 180 180 187  44 188 179 194 181 196 184 179 197 181 179 184
## [20] 193 191 182 194 179 180 178 196 189 193 197 184 181 189 180 194 195 198 180
## [39] 186 187 189 198 197 188 183 181 183 179 199 195  56 187 187 181 190
## Total de outliers encontrados: 55 
## 
## --- BloodPressure ---
## Límite inferior: 48 
## Límite superior: 96 
## Valores atípicos:
##  [1]  40  30 110  44 108 122  30 110  98 104  98  46 100 108 102 100 100 104  98
## [20] 110  44  44  24  38 106 106 106 100 114  44  46  44
## Total de outliers encontrados: 32 
## 
## --- SkinThickness ---
## Límite inferior: 8 
## Límite superior: 50 
## Valores atípicos:
##  [1] 60 54 51 56  7 54  7 52 60 63  7 52 99 60  7
## Total de outliers encontrados: 15 
## 
## --- Insulin ---
## Límite inferior: -42 
## Límite superior: 282 
## Valores atípicos:
##  [1] 543 545 846 342 480 300 342 304 415 440 495 325 325 284 485 285 370 392 495
## [20] 285 318 300 478 744 330 370 680 285 680 402 375 293 480 545 360 330 480 325
## [39] 293 465 325 285 321 415 540 579 310 474 540 370 285 328 480 375 321 543 326
## [58] 330 370 600 321 293 321 440 540 846 318 510 321 480 335 387 291 392 480 480
## [77] 510 318
## Total de outliers encontrados: 78 
## 
## --- BMI ---
## Límite inferior: 18.5 
## Límite superior: 46.1 
## Valores atípicos:
##  [1] 46.8 46.8 48.8 46.7 49.7 53.2 55.0 47.9 50.0 67.1 52.3 46.2 18.4 52.3 52.9
## [16] 47.9 48.3 18.2 18.2 59.4 46.5 18.2 46.2 46.8 57.3 49.6 49.3 46.3
## Total de outliers encontrados: 28 
## 
## --- DiabetesPedigreeFunction ---
## Límite inferior: -0.13 
## Límite superior: 0.875 
## Valores atípicos:
##  [1] 2.288 1.441 0.966 1.390 1.893 0.962 1.781 1.222 0.930 1.114 1.400 1.189
## [13] 0.956 1.321 0.905 1.224 1.072 2.329 1.318 1.213 0.926 1.353 0.997 0.933
## [25] 1.101 1.136 0.881 1.224 1.391 1.127 1.476 0.932 0.893 0.962 2.137 1.731
## [37] 1.021 0.947 1.268 0.949 1.600 0.944 1.191 1.076 1.095 1.138 0.955 2.420
## [49] 1.001 1.022 1.159 1.144 0.968 0.917 1.251 0.968 1.034 0.892 1.154 0.925
## [61] 1.699 1.258 0.878 1.282 1.698 1.461 1.162 1.292 1.394 0.880 0.886 0.904
## [73] 0.905 0.970 1.174 1.096 1.182 1.057
## Total de outliers encontrados: 78 
## 
## --- Age ---
## Límite inferior: 8 
## Límite superior: 50 
## Valores atípicos:
##  [1] 53 54 57 59 51 51 57 60 56 54 58 54 60 61 69 62 55 65 60 55 57 52 60 66 61
## [26] 51 51 63 52 57 52 51 65 58 59 57 63 65 67 58 58 55 72 62 51 81 59 63 58 67
## [51] 66 55 64 58 53 51 60 67 56 53 66 58 54 62 62 52 52 54 51 54 70 68 53 69 52
## [76] 56 52 53 52 66 63
## Total de outliers encontrados: 81

Actividad #3 - Análisis de datos faltantes y atípicos

Johan David Diaz Lopez

2025-08-12

Dataset

Variables

Imputación de datos

Pruebas de normalidad

Imputación por PMM

Imputación por norm.predict

Imputación por norm.nob

Imputación por norm

Metodo Seleccionado

Datos atípicos

Metodo de percentiles

Filtro de Hampel