Importar paquetes y cargar datos

library(EnvStats)
library(outliers)
library(mice)
library(readr)
diabetes <- read_csv("diabetes.csv")
head(diabetes)
## # A tibble: 6 × 9
##   Pregnancies Glucose BloodPressure SkinThickness Insulin   BMI
##         <dbl>   <dbl>         <dbl>         <dbl>   <dbl> <dbl>
## 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
## # ℹ 3 more variables: DiabetesPedigreeFunction <dbl>, Age <dbl>, Outcome <dbl>

Reemplazar 0.0 por NA en las columnas especificadas

diabetes$Glucose[diabetes$Glucose == 0.0] <- NA
diabetes$BloodPressure[diabetes$BloodPressure == 0.0] <- NA
diabetes$SkinThickness[diabetes$SkinThickness == 0.0] <- NA
diabetes$Insulin[diabetes$Insulin == 0.0] <- NA
diabetes$BMI[diabetes$BMI == 0.0] <- NA
head(diabetes)
## # A tibble: 6 × 9
##   Pregnancies Glucose BloodPressure SkinThickness Insulin   BMI
##         <dbl>   <dbl>         <dbl>         <dbl>   <dbl> <dbl>
## 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
## # ℹ 3 more variables: DiabetesPedigreeFunction <dbl>, Age <dbl>, Outcome <dbl>

Verificar la cantidad de valores NA en cada columna

colSums(is.na(diabetes))
##              Pregnancies                  Glucose            BloodPressure 
##                        0                        5                       35 
##            SkinThickness                  Insulin                      BMI 
##                      227                      374                       11 
## DiabetesPedigreeFunction                      Age                  Outcome 
##                        0                        0                        0

Se aprecia que las variables “Glucose”, “BloodPressure” y “BMI” tienen pocos datos faltantes, por lo que no han de existir diferencias significativas entre los distintos métodos de imputación aplicados a ellas. Contrario a lo observado en “Insulin” y “SkinThickness”.

Evaluar la normalidad

A continuación, mediante histogramas y gráficos Q-Q se deduce que ninguna de las cinco variables con datos faltantes presenta normalidad con una confianza del 95%. Esto confirmado con la aplicación de pruebas de Lilliefors a cada una.

## Prueba de Lilliefors para Glucose :
## Estadístico = 0.0726954 , p-valor = 2.973285e-10

## Prueba de Lilliefors para BloodPressure :
## Estadístico = 0.04601776 , p-valor = 0.0008680965

## Prueba de Lilliefors para SkinThickness :
## Estadístico = 0.04621908 , p-valor = 0.007824551

## Prueba de Lilliefors para Insulin :
## Estadístico = 0.1446433 , p-valor = 4.241486e-22

## Prueba de Lilliefors para BMI :
## Estadístico = 0.03505063 , p-valor = 0.028025

Aplicar imputación

Puesto que las variables no presentan normalidad, es de esperar que el método PMM sea el que presente mejores resultados.

Método PMM

metodoPmm <- mice(diabetes, method = "pmm", m = 5, maxit = 50, seed = 500, printFlag = FALSE)
inputPmm <- complete(metodoPmm)
head(inputPmm)
##   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

Método Norm

metodoNorm <- mice(diabetes, method = "norm", m = 5, maxit = 50, seed = 500, printFlag = FALSE)
inputNorm <- complete(metodoNorm)
head(inputNorm)
##   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

Comparar antes y después de la imputación

A continuación, cada fila de histogramas representa una variable predictora, y se compara su distribución antes de la inputación (“Original”) y después de la misma para los métodos mencionados previamente.

## TableGrob (2 x 3) "arrange": 4 grobs
##   z     cells    name                grob
## 1 1 (2-2,1-1) arrange      gtable[layout]
## 2 2 (2-2,2-2) arrange      gtable[layout]
## 3 3 (2-2,3-3) arrange      gtable[layout]
## 4 4 (1-1,1-3) arrange text[GRID.text.509]

## TableGrob (2 x 3) "arrange": 4 grobs
##   z     cells    name                grob
## 1 1 (2-2,1-1) arrange      gtable[layout]
## 2 2 (2-2,2-2) arrange      gtable[layout]
## 3 3 (2-2,3-3) arrange      gtable[layout]
## 4 4 (1-1,1-3) arrange text[GRID.text.630]

## TableGrob (2 x 3) "arrange": 4 grobs
##   z     cells    name                grob
## 1 1 (2-2,1-1) arrange      gtable[layout]
## 2 2 (2-2,2-2) arrange      gtable[layout]
## 3 3 (2-2,3-3) arrange      gtable[layout]
## 4 4 (1-1,1-3) arrange text[GRID.text.751]

## TableGrob (2 x 3) "arrange": 4 grobs
##   z     cells    name                grob
## 1 1 (2-2,1-1) arrange      gtable[layout]
## 2 2 (2-2,2-2) arrange      gtable[layout]
## 3 3 (2-2,3-3) arrange      gtable[layout]
## 4 4 (1-1,1-3) arrange text[GRID.text.872]

## TableGrob (2 x 3) "arrange": 4 grobs
##   z     cells    name                grob
## 1 1 (2-2,1-1) arrange      gtable[layout]
## 2 2 (2-2,2-2) arrange      gtable[layout]
## 3 3 (2-2,3-3) arrange      gtable[layout]
## 4 4 (1-1,1-3) arrange text[GRID.text.993]

Como se anticipó, las columnas “Glucose”, “BloodPressure” y “BMI”, no presentan grandes diferencias en sus distribuciones antes y después de la imputación (con ambos métodos), sin embargo, tanto en los histogramas de “Insulin” como de “SkinThickness” se advierte una mayor similitud con la distribución original por parte del método PMM.

##Detección de valores atipicos

# Función para identificar valores atípicos usando IQR
identificar_atipicos <- function(variable) {
  Q1 <- quantile(variable, 0.25, na.rm = TRUE)
  Q3 <- quantile(variable, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  limite_inferior <- Q1 - 1.5 * IQR
  limite_superior <- Q3 + 1.5 * IQR
  atipicos <- variable[variable < limite_inferior | variable > limite_superior]
  return(atipicos)
}

# Identificar valores atípicos para cada variable
atipicos_pregnancies <- identificar_atipicos(diabetes$Pregnancies)
atipicos_glucose <- identificar_atipicos(diabetes$Glucose)
atipicos_bloodpressure <- identificar_atipicos(diabetes$BloodPressure)
atipicos_skinthickness <- identificar_atipicos(diabetes$SkinThickness)
atipicos_insulin <- identificar_atipicos(diabetes$Insulin)
atipicos_bmi <- identificar_atipicos(diabetes$BMI)
atipicos_diabetespedigree <- identificar_atipicos(diabetes$DiabetesPedigreeFunction)
atipicos_age <- identificar_atipicos(diabetes$Age)

# Mostrar los valores atípicos
print("Valores atípicos en Pregnancies:")
## [1] "Valores atípicos en Pregnancies:"
print(atipicos_pregnancies)
## [1] 15 17 14 14
print("Valores atípicos en Glucose:")
## [1] "Valores atípicos en Glucose:"
print(atipicos_glucose)
## [1] NA NA NA NA NA
print("Valores atípicos en Blood Pressure:")
## [1] "Valores atípicos en Blood Pressure:"
print(atipicos_bloodpressure)
##  [1]  NA  NA  30 110  NA  NA  NA  NA 108 122  30  NA 110  NA  NA  NA  NA  NA  NA
## [20]  NA  NA  NA  NA 108  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 110  NA  24  38
## [39]  NA  NA  NA  NA 106 106 106 114  NA  NA  NA
print("Valores atípicos en Skin Thickness:")
## [1] "Valores atípicos en Skin Thickness:"
print(atipicos_skinthickness)
##   [1] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 60 NA NA NA NA NA
##  [26] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [51] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
##  [76] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [101] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [126] NA NA NA NA NA NA NA 63 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [151] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 99 NA NA NA NA
## [176] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [201] NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
## [226] NA NA NA NA NA
print("Valores atípicos en Insulin:")
## [1] "Valores atípicos en Insulin:"
print(atipicos_insulin)
##   [1]  NA  NA  NA  NA  NA 543  NA  NA  NA  NA 846  NA  NA  NA  NA  NA  NA  NA
##  [19]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
##  [37]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
##  [55]  NA  NA  NA  NA  NA  NA  NA  NA 495  NA  NA  NA  NA  NA  NA  NA  NA  NA
##  [73]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 485  NA  NA  NA  NA  NA  NA
##  [91]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 495  NA  NA  NA  NA  NA  NA
## [109]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 478  NA  NA  NA  NA 744  NA 370
## [127]  NA  NA  NA  NA  NA  NA  NA  NA  NA 680 402  NA  NA  NA  NA  NA  NA  NA
## [145] 375  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 545
## [163]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [181]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 465
## [199]  NA  NA  NA  NA  NA 415  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 579
## [217]  NA 474  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [235]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 480
## [253]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [271]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [289]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 600  NA  NA  NA  NA  NA  NA  NA
## [307]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [325]  NA  NA  NA  NA  NA  NA  NA  NA 440  NA  NA 540  NA  NA  NA  NA  NA  NA
## [343]  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 480  NA  NA  NA
## [361]  NA  NA  NA  NA  NA 387  NA  NA 392  NA  NA  NA  NA  NA  NA  NA  NA  NA
## [379]  NA  NA  NA  NA  NA  NA  NA  NA  NA 510  NA  NA  NA  NA  NA  NA  NA  NA
## [397]  NA  NA
print("Valores atípicos en BMI:")
## [1] "Valores atípicos en BMI:"
print(atipicos_bmi)
##  [1]   NA   NA   NA   NA 53.2 55.0   NA 67.1 52.3 52.3 52.9   NA   NA 59.4   NA
## [16]   NA 57.3   NA   NA
print("Valores atípicos en Diabetes Pedigree Function:")
## [1] "Valores atípicos en Diabetes Pedigree Function:"
print(atipicos_diabetespedigree)
##  [1] 2.288 1.441 1.390 1.893 1.781 1.222 1.400 1.321 1.224 2.329 1.318 1.213
## [13] 1.353 1.224 1.391 1.476 2.137 1.731 1.268 1.600 2.420 1.251 1.699 1.258
## [25] 1.282 1.698 1.461 1.292 1.394
print("Valores atípicos en Age:")
## [1] "Valores atípicos en Age:"
print(atipicos_age)
## [1] 69 67 72 81 67 67 70 68 69
# Organizar los boxplots en una cuadrícula de 2x4
par(mfrow=c(2,4))

boxplot(diabetes$Pregnancies, main="Pregnancies", ylab="Number of times pregnant")
boxplot(diabetes$Glucose, main="Glucose", ylab="Glucose level")
boxplot(diabetes$BloodPressure, main="Blood Pressure", ylab="Blood Pressure (mm Hg)")
boxplot(diabetes$SkinThickness, main="Skin Thickness", ylab="Skin Thickness (mm)")
boxplot(diabetes$Insulin, main="Insulin", ylab="Insulin level (mu U/ml)")
boxplot(diabetes$BMI, main="BMI", ylab="Body Mass Index")
boxplot(diabetes$DiabetesPedigreeFunction, main="Diabetes Pedigree Function", ylab="Diabetes Pedigree Function")
boxplot(diabetes$Age, main="Age", ylab="Age (years)")

Podemos observar que hay variables que tienen datos atipicos que pueden influir mucho en los resultados y otras que tienen datos atipicos pero no significativamente importantes.

Observamos que la variable pregnacies tiene valores atipicos altos,al igual que la variable Age.

la variable insulin con un valor atípico extremadamente alto (cercano a 800) sugiere resistencia a la insulina o producción excesiva pero hay muchos datos faltantes al igual que con Skin Thickness.

##Imputacion de valores atipicos

test <- grubbs.test(diabetes$Glucose)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$Glucose
## G = 2.54413, U = 0.99149, p-value = 1
## alternative hypothesis: lowest value 44 is an outlier
test <- grubbs.test(diabetes$Insulin)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$Insulin
## G = 5.8131, U = 0.9138, p-value = 5.589e-07
## alternative hypothesis: highest value 846 is an outlier
test <- grubbs.test(diabetes$BloodPressure)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$BloodPressure
## G = 4.00535, U = 0.97805, p-value = 0.02077
## alternative hypothesis: highest value 122 is an outlier
test <- grubbs.test(diabetes$SkinThickness)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$SkinThickness
## G = 6.66667, U = 0.91754, p-value = 2.687e-09
## alternative hypothesis: highest value 99 is an outlier
test <- grubbs.test(diabetes$Pregnancies)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$Pregnancies
## G = 3.9040, U = 0.9801, p-value = 0.03367
## alternative hypothesis: highest value 17 is an outlier
test <- grubbs.test(diabetes$BMI)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$BMI
## G = 5.00254, U = 0.96685, p-value = 0.0001734
## alternative hypothesis: highest value 67.1 is an outlier
test <- grubbs.test(diabetes$DiabetesPedigreeFunction)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$DiabetesPedigreeFunction
## G = 5.87973, U = 0.95487, p-value = 1.056e-06
## alternative hypothesis: highest value 2.42 is an outlier
test <- grubbs.test(diabetes$Age)
test
## 
##  Grubbs test for one outlier
## 
## data:  diabetes$Age
## G = 4.06107, U = 0.97847, p-value = 0.01716
## alternative hypothesis: highest value 81 is an outlier

Una vez hemos identificado los datos atipicos en cada variable del dataset podemos hacer imputación de estos.

# Función de capping para manejar outliers
capping <- function(x) {
  if (is.numeric(x)) {
    qnt <- quantile(x, probs = c(.25, .75), na.rm = TRUE)  # Cuartiles Q1 y Q3
    caps <- quantile(x, probs = c(.05, .95), na.rm = TRUE) # Percentiles 5 y 95
    H <- 1.5 * IQR(x, na.rm = TRUE)  # Rango intercuartil (IQR)
    
    # Aplicar capping (reemplazar outliers)
    x[x < (qnt[1] - H)] <- caps[1]
    x[x > (qnt[2] + H)] <- caps[2]
  }
  return(x)
}

# Aplicar capping a todas las variables numéricas en diabetes
diabetes <- as.data.frame(lapply(diabetes, capping))

# Ver los primeros registros después del capping
head(diabetes)
##   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.62700  50       1
## 2                  0.35100  31       0
## 3                  0.67200  32       1
## 4                  0.16700  21       0
## 5                  1.13285  33       1
## 6                  0.20100  30       0

Aqui se muestran nuestras variables de estudio despues del camping para realizar imputaciones de los outliers.