Visualización de datos en R: Datos faltantes

library(dplyr)
library(readr)
library(ggplot2)
library(data.table)
library(tidyr)
data=read.csv("https://raw.githubusercontent.com/lihkir/Data/main/diabetes.csv")
head(data)
##   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
data$Glucose <- replace(data$Glucose, data$Glucose == '0', NA)
data$BloodPressure <- replace(data$BloodPressure, data$BloodPressure == '0', NA)
data$SkinThickness <- replace(data$SkinThickness, data$SkinThickness == '0', NA)
data$Insulin <- replace(data$Insulin, data$Insulin == '0', NA)
data$BMI <- replace(data$BMI, data$BMI == '0', NA)
head(data)
##   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
str(data)
## 'data.frame':    768 obs. of  9 variables:
##  $ Pregnancies             : int  6 1 8 1 0 5 3 10 2 8 ...
##  $ Glucose                 : int  148 85 183 89 137 116 78 115 197 125 ...
##  $ BloodPressure           : int  72 66 64 66 40 74 50 NA 70 96 ...
##  $ SkinThickness           : int  35 29 NA 23 35 NA 32 NA 45 NA ...
##  $ Insulin                 : int  NA NA NA 94 168 NA 88 NA 543 NA ...
##  $ BMI                     : num  33.6 26.6 23.3 28.1 43.1 25.6 31 35.3 30.5 NA ...
##  $ DiabetesPedigreeFunction: num  0.627 0.351 0.672 0.167 2.288 ...
##  $ Age                     : int  50 31 32 21 33 30 26 29 53 54 ...
##  $ Outcome                 : int  1 0 1 0 1 0 1 0 1 1 ...

Vemos que todas las variables son numéricas, siendo Outcome una variable categórica binaria.

Ahora vamos a visualizar los datos faltantes:

library(mice)
md.pattern(data, plot = TRUE, rotate.names = TRUE)

##     Pregnancies DiabetesPedigreeFunction Age Outcome Glucose BMI BloodPressure
## 392           1                        1   1       1       1   1             1
## 140           1                        1   1       1       1   1             1
## 192           1                        1   1       1       1   1             1
## 2             1                        1   1       1       1   1             0
## 26            1                        1   1       1       1   1             0
## 1             1                        1   1       1       1   0             1
## 1             1                        1   1       1       1   0             1
## 2             1                        1   1       1       1   0             1
## 7             1                        1   1       1       1   0             0
## 1             1                        1   1       1       0   1             1
## 4             1                        1   1       1       0   1             1
##               0                        0   0       0       5  11            35
##     SkinThickness Insulin    
## 392             1       1   0
## 140             1       0   1
## 192             0       0   2
## 2               1       0   2
## 26              0       0   3
## 1               1       1   1
## 1               1       0   2
## 2               0       0   3
## 7               0       0   4
## 1               1       1   1
## 4               1       0   2
##               227     374 652

Podemos visualizar que las variables Glucose, BMI, Bloodpressure, SkinThickness e Insulin tienes datos faltantes. En la muestra de 768 observaciones, hay 140 filas con datos faltantes de insulin, 192 con dos datos faltantes, 28 con 3 datos faltantes y 7 filas con hasta 4 datos faltantes.

summary(data)
##   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.:22.00  
##  Median : 3.000   Median :117.0   Median : 72.00   Median :29.00  
##  Mean   : 3.845   Mean   :121.7   Mean   : 72.41   Mean   :29.15  
##  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  
##                   NA's   :5       NA's   :35       NA's   :227    
##     Insulin            BMI        DiabetesPedigreeFunction      Age       
##  Min.   : 14.00   Min.   :18.20   Min.   :0.0780           Min.   :21.00  
##  1st Qu.: 76.25   1st Qu.:27.50   1st Qu.:0.2437           1st Qu.:24.00  
##  Median :125.00   Median :32.30   Median :0.3725           Median :29.00  
##  Mean   :155.55   Mean   :32.46   Mean   :0.4719           Mean   :33.24  
##  3rd Qu.:190.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  
##  NA's   :374      NA's   :11                                              
##     Outcome     
##  Min.   :0.000  
##  1st Qu.:0.000  
##  Median :0.000  
##  Mean   :0.349  
##  3rd Qu.:1.000  
##  Max.   :1.000  
##

vemos que las columnas con más datos faltantes son “insulin” y “skinthickness”.

Imputación de datos faltantes

Método de imputación por emparejamiento predictivo medio (PMM)

library(foreign)
imp <- mice(data, m=5, maxit=50, method ='pmm', seed=500, printFlag = FALSE)
imp_df <- complete(imp)
head(imp_df)
##   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

Ahora visualizamos los datos luego de la imputación:

summary(imp_df)
##   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

Podemos ver que:

  • Glucose: hay registros entre 44 hasta 199, con una media aproximada de 121.7.

  • Los registros de insulina en promedio son 148.57

  • Las personas encuestadas tienen un rango de edad entre 21 y 81 años.

library(gridExtra)

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

ggp2 <- ggplot(data.frame(value=imp_df$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("PMM imputation") +
  xlab('Skinthickness') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

podemos visualizar cierta similitud en la distribución de los datos para la variable Skinthickness a pesar de la imputación realizada.

library(gridExtra)

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

ggp2 <- ggplot(data.frame(value=imp_df$Glucose), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("PMM imputation") +
  xlab('Glucose') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

Vamos a comparar las distribuciones de los datos originales e imputados utilizando el gráfico de densidad, Lo que queremos ver es que la forma de los puntos rojos (imputados) coincida con la de los azules (observados).

La densidad de los datos imputados para cada conjunto de datos imputados se muestra en color rojo, mientras que la densidad de los datos observados se muestra en azul. De nuevo, según nuestros supuestos anteriores, esperamos que las distribuciones sean similares

La coincidencia de la forma en la Variable SkinThickness e insulin, nos indican que la imputación por el método de emparejamiento medio fue apropiada en estas variables. Lo mismo ocurre en BloodPressure y BMI. en la variable Glucosa se ve variabilidad entre los datos reales y los imputados.

densityplot(imp)

Comprobamos visualmente la convergencia, mostrando gráficos de seguimiento de la media y desviación estándar de todas las variables implicadas en las imputaciones.

plot(imp)

Como se puede ver en el gráfico de trazado anterior sobre imp, no hay tendencias claras y las variables se superponen de una iteración a la siguiente. Se ha logrado la convergencia.

imputación por regresión

data1 <- data[, c("SkinThickness", "Glucose")]
imp.regress <- mice(data1, method="norm.predict", m=1, maxit=1)
## 
##  iter imp variable
##   1   1  SkinThickness  Glucose
imp.regress$imp$Glucose
##            1
## 76  113.2393
## 183 113.2393
## 343 126.9971
## 350 124.2455
## 503 132.5002
imp.regress$imp$SkinThickness
##            1
## 3   34.01699
## 6   28.77089
## 8   28.69259
## 10  29.47559
## 11  28.30109
## 12  32.84249
## 13  30.57179
## 16  27.51810
## 18  28.06619
## 22  27.43980
## 23  35.03488
## 27  31.19819
## 30  28.84919
## 34  26.89170
## 37  30.49349
## 42  30.10199
## 45  32.13779
## 47  31.11989
## 50  27.90959
## 59  31.11989
## 61  26.26530
## 62  30.10199
## 63  23.13330
## 65  28.61429
## 68  28.22279
## 73  29.55389
## 77  24.54270
## 79  29.94539
## 82  25.48230
## 85  30.41519
## 91  25.95210
## 94  30.18029
## 101 32.45099
## 102 31.51139
## 103 29.47559
## 105 26.34360
## 107 27.20490
## 114 25.63890
## 116 31.11989
## 117 29.39729
## 118 25.79550
## 124 30.02369
## 125 28.53599
## 130 27.90959
## 132 29.24069
## 139 29.78879
## 141 29.71049
## 144 28.14449
## 149 31.19819
## 152 28.61429
## 155 34.40849
## 165 29.94539
## 168 29.08409
## 169 28.30109
## 171 27.67470
## 177 26.34360
## 179 30.88499
## 180 29.86709
## 181 26.50020
## 184 25.40400
## 185 30.72839
## 191 28.37939
## 193 32.13779
## 194 30.25859
## 197 27.90959
## 202 30.49349
## 208 32.37269
## 220 28.45769
## 222 32.05949
## 223 29.00579
## 227 27.59640
## 231 30.80669
## 234 29.24069
## 236 33.07739
## 240 27.83129
## 243 30.57179
## 247 29.24069
## 251 27.98789
## 252 29.78879
## 262 30.72839
## 265 29.31899
## 267 30.49349
## 269 27.67470
## 270 31.11989
## 273 29.24069
## 275 27.98789
## 279 28.61429
## 281 31.11989
## 284 32.29439
## 285 28.14449
## 295 32.29439
## 300 28.45769
## 301 32.76419
## 304 28.69259
## 305 31.43309
## 318 33.93869
## 320 34.87828
## 328 33.70379
## 333 33.78209
## 334 27.98789
## 337 28.84919
## 338 28.69259
## 340 33.62549
## 344 29.24069
## 345 27.12660
## 348 28.77089
## 351 26.89170
## 352 30.41519
## 355 26.73510
## 356 32.60759
## 362 32.05949
## 364 31.11989
## 367 29.39729
## 379 31.90289
## 392 32.68589
## 395 32.05949
## 399 26.10870
## 401 27.12660
## 402 30.41519
## 405 32.84249
## 407 28.69259
## 408 27.59640
## 409 35.11318
## 419 26.18700
## 427 27.04830
## 431 27.43980
## 434 30.57179
## 436 30.72839
## 438 31.19819
## 440 28.06619
## 444 28.14449
## 452 30.18029
## 454 29.00579
## 457 30.25859
## 462 25.24740
## 465 28.69259
## 469 29.08409
## 474 30.33689
## 475 28.61429
## 485 31.04159
## 490 34.87828
## 495 25.95210
## 496 32.68589
## 497 28.30109
## 506 25.56060
## 510 29.08409
## 513 26.81340
## 514 26.81340
## 518 29.47559
## 519 25.63890
## 523 28.61429
## 524 29.86709
## 525 29.47559
## 530 28.37939
## 532 28.06619
## 534 26.81340
## 536 30.02369
## 537 27.90959
## 538 24.15120
## 553 28.61429
## 558 28.30109
## 560 26.34360
## 561 29.47559
## 565 26.81340
## 571 25.79550
## 572 29.86709
## 578 28.92749
## 579 30.10199
## 584 27.51810
## 587 30.88499
## 588 27.75299
## 590 25.40400
## 593 30.02369
## 597 24.93420
## 599 33.23399
## 602 27.20490
## 605 34.01699
## 616 27.98789
## 617 28.84919
## 620 29.00579
## 623 34.01699
## 625 28.14449
## 627 29.47559
## 628 30.02369
## 629 29.71049
## 631 28.61429
## 633 28.37939
## 635 26.89170
## 636 27.83129
## 637 27.83129
## 642 29.71049
## 643 31.19819
## 644 26.73510
## 654 29.08409
## 659 29.63219
## 661 32.37269
## 675 26.81340
## 676 34.95658
## 677 31.90289
## 678 26.97000
## 679 29.16239
## 684 29.47559
## 685 30.33689
## 687 29.86709
## 691 28.06619
## 692 32.05949
## 695 26.73510
## 698 27.43980
## 700 28.92749
## 704 29.78879
## 707 28.69259
## 709 32.52929
## 715 27.67470
## 725 28.37939
## 729 33.39059
## 730 26.89170
## 732 29.08409
## 735 27.90959
## 740 27.67470
## 744 30.65009
## 750 32.37269
## 751 30.33689
## 758 29.31899
## 759 27.98789
## 760 34.56509
## 763 26.65680
## 767 29.55389

Imputación de regresión estocástica

imp2 <- mice(data, m=5, maxit=50, method ='norm.nob', seed=500, printFlag = FALSE)
imp_df1 <- complete(imp2)
head(imp_df1)
##   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
library(gridExtra)

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

ggp2 <- ggplot(data.frame(value=imp_df1$Glucose), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Regresión estocástica") +
  xlab('Glucose') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

Las distribuciones en la variable Glucose tanto para los datos reales como los imputados son parecidas.

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

ggp2 <- ggplot(data.frame(value=imp_df1$Glucose), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Regresión estocástica") +
  xlab('Skinthickness') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

Vamos a comparar las distribuciones de los datos originales e imputados utilizando el gráfico de densidad:

densityplot(imp2)

Puede verse que la imputación para la variable SkinThickness con la técnica de regresión estocástica es bastante buena. Se espera que las distribuciones para las demás variables sean similares.

plot(imp2);

visualizando la convergencia, no se ve una tendencia entre las variables y se superponen de una iteración a la siguiente. Se ha logrado la convergencia.

imputación de regresión estocástica Bayesiana

imp3 <- mice(data, m=5, maxit=50, method ='norm', seed=500, printFlag = FALSE)
imp_df3 <- complete(imp3)
head(imp_df1)
##   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
ggp1 <- ggplot(data.frame(value=data$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#FBD000", color="#E52521", alpha=0.9) +
  ggtitle("Original data") +
  xlab('Skinthickness') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

ggp2 <- ggplot(data.frame(value=imp_df3$SkinThickness), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Reg Estocástica bayesiana") +
  xlab('Skinthickness') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

Se visualizan diferencias entre las dos distribuciones para la variable Skinthickness.

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

ggp2 <- ggplot(data.frame(value=imp_df3$Glucose), aes(x=value)) +
  geom_histogram(fill="#43B047", color="#049CD8", alpha=0.9) +
  ggtitle("Regresión estocástica bayesiana") +
  xlab('Glucose') + ylab('Frequency') +
  theme_classic() +
  theme(plot.title = element_text(size=15))

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

Hay cierta similitud entre las distribuciones de la variable glucosa.

Posiblemente esta técnica fue apropiada en la variable glucose, pero no tanto en la variable Skinthickness. Visualicemos la similitud en todas las variables:

densityplot(imp3)

El resto de variables muestran cierta similitud, La variable glucosa muestra diferencias entre la distribución de los datos reales y los imputados. Analicemos la convergencia:

plot(imp3);

No se observan tendencias claras y hay superposición en las variables. Se ha logrado la convergencia.

Detección de valores atípicos

Identifique datos atípicos para cada variable en el dataset usando las técnicas estudiadas en clase. Además, realice imputación de los datos atípicos con base en lo desarrollado en el ítem anterior.

Estadística descriptiva:

summary(imp_df3)
##   Pregnancies        Glucose      BloodPressure    SkinThickness   
##  Min.   : 0.000   Min.   : 44.0   Min.   : 24.00   Min.   : 5.032  
##  1st Qu.: 1.000   1st Qu.: 99.0   1st Qu.: 64.00   1st Qu.:21.000  
##  Median : 3.000   Median :117.0   Median : 72.00   Median :28.155  
##  Mean   : 3.845   Mean   :121.7   Mean   : 72.25   Mean   :28.752  
##  3rd Qu.: 6.000   3rd Qu.:141.0   3rd Qu.: 80.00   3rd Qu.:36.000  
##  Max.   :17.000   Max.   :199.0   Max.   :122.00   Max.   :99.000  
##     Insulin            BMI        DiabetesPedigreeFunction      Age       
##  Min.   :-211.5   Min.   :18.20   Min.   :0.0780           Min.   :21.00  
##  1st Qu.:  76.0   1st Qu.:27.50   1st Qu.:0.2437           1st Qu.:24.00  
##  Median : 135.6   Median :32.30   Median :0.3725           Median :29.00  
##  Mean   : 158.8   Mean   :32.45   Mean   :0.4719           Mean   :33.24  
##  3rd Qu.: 210.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

Histograma:

hist(imp_df3$SkinThickness, xlab = "Skinthickness", col="pink", main="Histograma")

hist(imp_df3$Glucose, xlab = "Glucose", col="pink", main="Histograma")

hist(imp_df3$BloodPressure, xlab = "BloodPressure", col="pink", main="Histograma")

hist(imp_df3$DiabetesPedigreeFunction, xlab = "DiabetePedigreeFunction", col="pink", main="Histograma")

Para este caso (DiabetePedigreeFunction) se ven algunos datos con registros elevados, posibles datos atípicos.

Boxplot:

data2 <- imp_df3 %>% select(-Outcome)  

lapply(names(data2), function(column_name) {
  # Crea el boxplot horizontal
  boxplot(data2[[column_name]], horizontal = TRUE, main = column_name, col = "skyblue", border = "black")
  
  # Identifica y etiqueta los valores atípicos
  out <- boxplot(data2[[column_name]], plot = FALSE)$out
  if(length(out) > 0) {
    mtext(paste("Outliers: ", paste(out, collapse = ", ")), side = 1, line = 2)
  }
})

## [[1]]
## NULL
## 
## [[2]]
## NULL
## 
## [[3]]
## NULL
## 
## [[4]]
## NULL
## 
## [[5]]
## NULL
## 
## [[6]]
## NULL
## 
## [[7]]
## NULL
## 
## [[8]]
## NULL

Las observaciones consideradas como posibles valores atípicos según el criterio IQR se muestran como puntos en el diagrama de caja. Se visualiza la presencia de posibles datos atípicos en las variables Pregnancies, BoodPressure, skinthickness, insulin, BMI, DiabetesPedigreeFunction, y Age. Vemos que la salida de los boxplot nos permite identificar esos datos atípicos

También es posible extraer los valores de los posibles valores atípicos basándose en el criterio IQR:

boxplot.stats(imp_df3$SkinThickness)$out
## [1] 60.00000 58.74558 63.00000 99.00000

Como puede verse, el boxplot identifica 4 datos atípicos , y el criterio IQR identifica 4 datos atípicos en la variable Skinthickness.

De la misma manera se peude hacer para el resto de variables:

boxplot.stats(imp_df3$Glucose)$out
## numeric(0)

No se observan datos atípicos para la variable Glucose.

boxplot.stats(imp_df3$Age)$out
## [1] 69 67 72 81 67 67 70 68 69

Se identifican 9 datos atípicos en la variable “age”, mientras que el boxplot solo había identificado 6.

boxplot.stats(imp_df3$BMI)$out
## [1] 53.2 55.0 67.1 52.3 52.3 52.9 59.4 57.3

Los datos atípicos con el criterio IQR coinciden con los detectados por el boxplot para la variable BMI.

boxplot.stats(imp_df3$DiabetesPedigreeFunction)$out
##  [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

Vemos que para la variable DiabetesPedigreeFunction se encontró varios datos atípicos, el boxplot de esta variable también evidenciaba varios puntos como posibles atípicos.

Detección de datos atípicos mediante 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. También pueden considerarse otros percentiles, como el 1 y el 99, o el 5 y el 95, para construir el intervalo.

  • Pregnancies:
lower_bound <- quantile(imp_df3$Pregnancies, 0.025)
lower_bound
## 2.5% 
##    0
upper_bound <- quantile(imp_df3$Pregnancies, 0.975)
upper_bound
## 97.5% 
##    12

Según este método, todas las observaciones por debajo de 0 y por encima de 12 se considerarán posibles valores atípicos

outlier_ind <- which(imp_df3$Pregnancies < lower_bound | imp_df3$Pregnancies > upper_bound)
outlier_ind
##  [1]  29  73  87  89 160 275 299 324 358 456 519 636 692 745

Se detectan 14 datos atípicos para la variable “Pregnancies”

  • Glucose:
lower_bound <- quantile(imp_df3$Glucose, 0.025)
lower_bound
##   2.5% 
## 73.175
upper_bound <- quantile(imp_df3$Glucose, 0.975)
upper_bound
## 97.5% 
##   189
outlier_ind <- which(imp_df3$Glucose < lower_bound | imp_df3$Glucose > upper_bound)
outlier_ind
##  [1]   9  23  48  56  63  77  98 147 183 184 186 207 229 259 261 274 320 353 360
## [20] 400 404 409 462 490 499 521 538 562 580 590 597 618 662 673 676 681 738 760

Se detectan varios datos atípicos en la variable glucose, las técnicas aplciadas anteriormente no detectaron datos atípicos.

  • BloodPressure:
lower_bound <- quantile(imp_df3$BloodPressure, 0.025)
lower_bound
## 2.5% 
##   50
upper_bound <- quantile(imp_df3$BloodPressure, 0.975)
upper_bound
## 97.5% 
##    96
outlier_ind <- which(imp_df3$BloodPressure < lower_bound | imp_df3$BloodPressure > upper_bound)
outlier_ind
##  [1]   5  19  44  76  81  85  98 107 118 126 178 188 208 270 294 301 304 347 363
## [20] 370 380 388 406 431 441 465 550 576 577 598 600 659 663 673 674 692 708 742

Vemos que se detectaron bastantes datos atípicos para la variable “BloodPressure”. Los métodos aplicados anteriormente también detectaron datos atípicos (8 datos ).

  • Skinthickness:
lower_bound <- quantile(imp_df3$SkinThickness, 0.025)
lower_bound
##     2.5% 
## 10.84915
upper_bound <- quantile(imp_df3$SkinThickness, 0.975)
upper_bound
## 97.5% 
##    49
outlier_ind <- which(imp_df3$SkinThickness < lower_bound | imp_df3$SkinThickness > upper_bound)
outlier_ind
##  [1]  56  58  61  68  87 100 121 151 152 179 212 255 274 276 280 304 314 320 333
## [20] 348 379 383 431 435 446 462 467 520 533 572 580 590 592 599 602 637 644 672

Vemos que esta técnica detecta aproximadamente 30 datos atípicos en la variable Skinthickness.

Otra técnica que se puede aplicar para detectar datos atípicos es el Filtro de Hampel.

Filtro de Hampel

Otro método, conocido como filtro de Hampel, consiste en considerar como valores atípicos los valores fuera del intervalo formado por la mediana, más o menos 3 desviaciones absolutas de la mediana

  • BloodPressure:
lower_bound <- median(imp_df3$BloodPressure) - 3 * mad(imp_df3$BloodPressure, constant = 1)
lower_bound
## [1] 48
upper_bound <- median(imp_df3$BloodPressure) + 3 * mad(imp_df3$BloodPressure, constant = 1)
upper_bound
## [1] 96

Según este método, todas las observaciones por debajo de 48 y por encima de 96 se considerarán como posibles valores atípicos

outlier_ind <- which(imp_df3$BloodPressure < lower_bound | imp_df3$BloodPressure > upper_bound)
outlier_ind
##  [1]   5  19  44  81  85 107 126 178 188 208 301 304 347 363 370 380 388 441 465
## [20] 550 576 577 598 600 659 663 673 674 692 708 742

Vemos que esta técnica detectó bastantes datos atípicos en la variable BloodPressure, 30 datos en total.

  • SkinThickness
lower_bound <- median(imp_df3$SkinThickness) - 3 * mad(imp_df3$SkinThickness, constant = 1)
lower_bound
## [1] 5.697524
upper_bound <- median(imp_df3$SkinThickness) + 3 * mad(imp_df3$SkinThickness, constant = 1)
upper_bound
## [1] 50.61176
outlier_ind <- which(imp_df3$SkinThickness < lower_bound | imp_df3$SkinThickness > upper_bound)
outlier_ind
##  [1]  58  68  87 100 121 179 212 276 348 379 446 533 580 599 637

Se detectaron 15 datos atípicos en esta variable, mientras que la técnica anterior había detectado muchos más.

  • Insulin
lower_bound <- median(imp_df3$Insulin) - 3 * mad(imp_df3$Insulin, constant = 1)
upper_bound <- median(imp_df3$Insulin) + 3 * mad(imp_df3$Insulin, constant = 1)
outlier_ind <- which(imp_df3$Insulin < lower_bound | imp_df3$Insulin > upper_bound)
outlier_ind
##  [1]   1   9  11  14  16  23  30  45  46  47  55  59  63  73  85 101 102 112 124
## [20] 154 155 187 201 208 212 213 221 229 232 238 248 249 258 259 267 281 287 295
## [39] 297 318 328 333 340 350 371 393 399 409 410 416 436 472 487 496 497 580 585
## [58] 599 623 628 630 635 646 656 662 676 696 704 708 711 716 721 729 754 760

Para el caso de la variable insulin, se detectaron 59 datos atípicos, el boxplot había mostrado también la presencia de varios datos atípicos en esta variable.

  • BMI:
lower_bound <- median(imp_df3$BMI) - 3 * mad(imp_df3$BMI, constant = 1)
upper_bound <- median(imp_df3$BMI) + 3 * mad(imp_df3$BMI, constant = 1)
outlier_ind <- which(imp_df3$BMI< lower_bound | imp_df3$BMI > upper_bound)
outlier_ind
##  [1]  58  85  93 100 121 126 155 156 178 194 232 240 248 304 336 379 419 439 446
## [20] 488 527 559 591 674 682 747 748

Aunque el boxplot había detectado solo 8 datos atípicos, esta técnica detectó otros más.

imp_df3[outlier_ind, ]
##     Pregnancies Glucose BloodPressure SkinThickness   Insulin  BMI
## 58            0     100      88.00000      60.00000 110.00000 46.8
## 85            5     137     108.00000      35.33011 390.28136 48.8
## 93            7      81      78.00000      40.00000  48.00000 46.7
## 100           1     122      90.00000      51.00000 220.00000 49.7
## 121           0     162      76.00000      56.00000 100.00000 53.2
## 126           1      88      30.00000      42.00000  99.00000 55.0
## 155           8     188      78.00000      47.21192 391.89411 47.9
## 156           7     152      88.00000      44.00000 259.59083 50.0
## 178           0     129     110.00000      46.00000 130.00000 67.1
## 194          11     135      84.42399      41.74915 198.13698 52.3
## 232           6     134      80.00000      37.00000 370.00000 46.2
## 240           0     104      76.00000      19.14591 166.37571 18.4
## 248           0     165      90.00000      33.00000 680.00000 52.3
## 304           5     115      98.00000      50.38516  15.63523 52.9
## 336           0     165      76.00000      43.00000 255.00000 47.9
## 379           4     156      75.00000      54.63718 154.59617 48.3
## 419           1      83      68.00000      24.03987 121.56703 18.2
## 439           1      97      70.00000      15.00000 -44.94707 18.2
## 446           0     180      78.00000      63.00000  14.00000 59.4
## 488           0     173      78.00000      32.00000 265.00000 46.5
## 527           1      97      64.00000      19.00000  82.00000 18.2
## 559          11     103      68.00000      40.00000  42.98788 46.2
## 591          11     111      84.00000      40.00000  78.90455 46.8
## 674           3     123     100.00000      35.00000 240.00000 57.3
## 682           0     162      76.00000      36.00000 235.29728 49.6
## 747           1     147      94.00000      41.00000 264.90316 49.3
## 748           1      81      74.00000      41.00000  57.00000 46.3
##     DiabetesPedigreeFunction Age Outcome
## 58                     0.962  31       0
## 85                     0.227  37       1
## 93                     0.261  42       0
## 100                    0.325  31       1
## 121                    0.759  25       1
## 126                    0.496  26       1
## 155                    0.137  43       1
## 156                    0.337  36       1
## 178                    0.319  26       1
## 194                    0.578  40       1
## 232                    0.238  46       1
## 240                    0.582  27       0
## 248                    0.427  23       0
## 304                    0.209  28       1
## 336                    0.259  26       0
## 379                    0.238  32       1
## 419                    0.624  27       0
## 439                    0.147  21       0
## 446                    2.420  25       1
## 488                    1.159  58       0
## 527                    0.299  21       0
## 559                    0.126  42       0
## 591                    0.925  45       1
## 674                    0.880  22       0
## 682                    0.364  26       1
## 747                    0.358  27       1
## 748                    1.096  32       0

La tabla anterior nos muestra los datos atípicos detectados en la variable BMI mediante según el filtro de Hambel.

Prueba de Grubbs

La prueba de Grubbs permite detectar si el valor más alto o más bajo de un conjunto de datos es un valor atípico.

H0: El valor más alto/bajo no es un valor atípico

H1: El valor más alto/bajo es un valor atípico

  • BloodPressure
library(outliers)
test <- grubbs.test(imp_df3$BloodPressure)
test
## 
##  Grubbs test for one outlier
## 
## data:  imp_df3$BloodPressure
## G = 3.99446, U = 0.97917, p-value = 0.02291
## alternative hypothesis: highest value 122 is an outlier

Dado que el p-valor es menor que el nivel de significancia (0.05), se rechaza la hipótesis nula y se concluye que el valor más bajo/más alto (122) es un valor atípico en la variable BloodPressure

  • SkinThickness
library(outliers)
test <- grubbs.test(imp_df3$SkinThickness)
test
## 
##  Grubbs test for one outlier
## 
## data:  imp_df3$SkinThickness
## G = 6.6311, U = 0.9426, p-value = 6.646e-09
## alternative hypothesis: highest value 99 is an outlier

Dado que el p-valor es menor que el nivel de significancia (0.05), se rechaza la hipótesis nula y se concluye que el valor más bajo/más alto (99) es un valor atípico en la variable SkinThickness.

Hacemos la verificación para el valor más bajo:

library(outliers)
test <- grubbs.test(imp_df3$SkinThickness, opposite = TRUE)
test
## 
##  Grubbs test for one outlier
## 
## data:  imp_df3$SkinThickness
## G = 2.23905, U = 0.99346, p-value = 1
## alternative hypothesis: lowest value 5.03161526330395 is an outlier

Vemos que la prueba considera al valor más bajo como un dato no atípico. (p-valor = 1)

  • Glucose:
library(outliers)
test <- grubbs.test(imp_df3$Glucose)
test
## 
##  Grubbs test for one outlier
## 
## data:  imp_df3$Glucose
## G = 2.54503, U = 0.99154, p-value = 1
## alternative hypothesis: lowest value 44 is an outlier

Para el caso de la variable glucose, la prueba no considera que este valor (44) sea un dato atípico, lo cual coindice con las otras técnicas donde se concluyó que no había datos atípicos en esta variable.

Prueba de Dixon

Al igual que la prueba de Grubbs, la prueba de Dixon se utiliza para comprobar si un único valor bajo o alto es un valor atípico. Por lo tanto, si se sospecha que hay más de un valor atípico, la prueba tiene que realizarse en estos valores atípicos sospechosos individualmente.

subdat <- imp_df3[1:20, ]
  • Glucose:
test <- dixon.test(subdat$Glucose, opposite =TRUE)
test
## 
##  Dixon test for outliers
## 
## data:  subdat$Glucose
## Q = 0.10476, p-value = 0.2898
## alternative hypothesis: lowest value 78 is an outlier

Los datos muestran que el valor más bajo, 78 no es un dato atípico en la variable Glucose.

out <- boxplot.stats(subdat$Glucose)$out
boxplot(subdat$Glucose, ylab = "Glucose")
mtext(paste("Outliers: ", paste(out, collapse = ", ")))

El boxplot de la variable nos muestra que en efecto, este dato no se considera atípico.

  • SkinThickness
test <- dixon.test(subdat$SkinThickness, opposite =TRUE)
test
## 
##  Dixon test for outliers
## 
## data:  subdat$SkinThickness
## Q = 0.083333, p-value = 0.1886
## alternative hypothesis: highest value 47 is an outlier

Para el caso de la variable skinthickness , la prueba no consideró el valor más alto (47) como un dato atípico.

out <- boxplot.stats(subdat$SkinThickness)$out
boxplot(subdat$SkinThickness, ylab = "SkinThickness")
mtext(paste("Outliers: ", paste(out, collapse = ", ")))

lo cual podemos evidenciar en el boxplot anterior, donde no se muestran registros de datos atípicos.

Prueba de Rosner

  • SkinThickness
library(EnvStats)
test <- rosnerTest(imp_df3$SkinThickness, k = 3)
test$all.stats
##   i   Mean.i     SD.i Value Obs.Num    R.i+1 lambda.i+1 Outlier
## 1 0 28.75169 10.59382    99     580 6.631066   3.974092    TRUE
## 2 1 28.66010 10.29198    63     446 3.336570   3.973762   FALSE
## 3 2 28.61527 10.22349    60      58 3.069865   3.973432   FALSE

Basándonos en esta prueba, vemos que solo detecta un dato atípico, la observación número 580.

  • insulin:
library(EnvStats)
test <- rosnerTest(imp_df3$Insulin, k = 3)
test$all.stats
##   i   Mean.i     SD.i Value Obs.Num    R.i+1 lambda.i+1 Outlier
## 1 0 158.8214 122.2810   846      14 5.619669   3.974092    TRUE
## 2 1 157.9254 119.8119   744     229 4.891623   3.973762    TRUE
## 3 2 157.1603 118.0003   680     248 4.430834   3.973432    TRUE

mientras que para el caso de la variable Insulin, considera 3 datos atípicos.

  • Glucose:
library(EnvStats)
test <- rosnerTest(imp_df3$Glucose, k = 3)
test$all.stats
##   i   Mean.i     SD.i Value Obs.Num    R.i+1 lambda.i+1 Outlier
## 1 0 121.7102 30.53414    44      63 2.545026   3.974092   FALSE
## 2 1 121.8115 30.42461   199     662 2.537041   3.973762   FALSE
## 3 2 121.7107 30.31614   198     562 2.516457   3.973432   FALSE

Ésta prueba coíncide con otras aplicadas en no considerar datos atípicos en la variable Glucose.

Tratamiento de los valores atípicos

CAPPING:

Para los valores que se encuentran fuera de los límites de 15⋅IQR, podríamos poner un tope sustituyendo las observaciones que se encuentran fuera del límite inferior por el valor del 5th percentíl y las que se encuentran por encima del límite superior, por el valor del 95th percentíl:

  • SkinThickness
x <- imp_df3$SkinThickness
qnt <- quantile(x, probs=c(.25, .75), na.rm = T)
caps <- quantile(x, probs=c(.05, .95), na.rm = T)
H <- 1.5 * IQR(x, na.rm = T)
x[x < (qnt[1] - H)] <- caps[1]
x[x > (qnt[2] + H)] <- caps[2]
head(x)
## [1] 35.00000 29.00000 16.75604 23.00000 35.00000 23.76877
  • BMI
x <- imp_df3$BMI
qnt <- quantile(x, probs=c(.25, .75), na.rm = T)
caps <- quantile(x, probs=c(.05, .95), na.rm = T)
H <- 1.5 * IQR(x, na.rm = T)
x[x < (qnt[1] - H)] <- caps[1]
x[x > (qnt[2] + H)] <- caps[2]
head(x)
## [1] 33.6 26.6 23.3 28.1 43.1 25.6
  • BloodPressure
x <- imp_df3$BloodPressure
qnt <- quantile(x, probs=c(.25, .75), na.rm = T)
caps <- quantile(x, probs=c(.05, .95), na.rm = T)
H <- 1.5 * IQR(x, na.rm = T)
x[x < (qnt[1] - H)] <- caps[1]
x[x > (qnt[2] + H)] <- caps[2]
head(x)
## [1] 72 66 64 66 40 74

Imputación de datos atípicos mediante predicción

Primeramente identificamos el valor atípico y lo reemplazamos por NA:

summary(imp_df)
##   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

primero aplicamos la técnica de percentiles a la data para identificar los datos atípicos:

lower_bound <- quantile(imp_df$Glucose, 0.025)
upper_bound <- quantile(imp_df$Glucose, 0.975)
outlier_ind <- which(imp_df$Glucose < lower_bound | imp_df$Glucose > upper_bound)
imp_df$Glucose[outlier_ind]
##  [1] 197 196  71  73  44  62  71  57  71  73 194 196 197 193 191  71 194  61 196
## [20] 193  72 197  71 194 195 198  68  57 198 197  73  67  68 199  68 195  56  65
## [39] 190

estas son las filas con datos atípicos para la variable Glucose.

Ahora procedemos a cambiar estos datos por NA:

imp_df$Glucose[outlier_ind]
##  [1] 197 196  71  73  44  62  71  57  71  73 194 196 197 193 191  71 194  61 196
## [20] 193  72 197  71 194 195 198  68  57 198 197  73  67  68 199  68 195  56  65
## [39] 190
imp_df$Glucose[outlier_ind]<-NA

Repetimos el mismo proceso para el resto de variables:

lower_bound <- quantile(imp_df$BloodPressure, 0.025)
upper_bound <- quantile(imp_df$BloodPressure, 0.975)
outlier_ind <- which(imp_df$BloodPressure < lower_bound | imp_df$BloodPressure > upper_bound)
imp_df$BloodPressure[outlier_ind]<-NA
lower_bound <- quantile(imp_df$SkinThickness, 0.025)
upper_bound <- quantile(imp_df$SkinThickness, 0.975)
outlier_ind <- which(imp_df$SkinThickness < lower_bound | imp_df$Glucose > upper_bound)
imp_df$BloodPressure[outlier_ind]<-NA
lower_bound <- quantile(imp_df$Insulin, 0.025)
upper_bound <- quantile(imp_df$Insulin, 0.975)
outlier_ind <- which(imp_df$Insulin < lower_bound | imp_df$Insulin > upper_bound)
imp_df$Insulin[outlier_ind]<-NA
lower_bound <- quantile(imp_df$BMI, 0.025)
upper_bound <- quantile(imp_df$BMI, 0.975)
outlier_ind <- which(imp_df$BMI < lower_bound | imp_df$BMI > upper_bound)
imp_df$BMI[outlier_ind]<-NA
lower_bound <- quantile(imp_df$DiabetesPedigreeFunction, 0.025)
upper_bound <- quantile(imp_df$DiabetesPedigreeFunction, 0.975)
outlier_ind <- which(imp_df$DiabetesPedigreeFunction < lower_bound | imp_df$DiabetesPedigreeFunction > upper_bound)
imp_df$DiabetesPedigreeFunction[outlier_ind]<-NA
lower_bound <- quantile(imp_df$Pregnancies, 0.025)
upper_bound <- quantile(imp_df$Pregnancies, 0.975)
outlier_ind <- which(imp_df$Pregnancies < lower_bound | imp_df$Pregnancies > upper_bound)
imp_df$Pregnancies[outlier_ind]<-NA
lower_bound <- quantile(imp_df$Age, 0.025)
upper_bound <- quantile(imp_df$Age, 0.975)
outlier_ind <- which(imp_df$Age < lower_bound | imp_df$Age > upper_bound)
imp_df$Age[outlier_ind]<-NA

Ahora tenemos todos los datos atípicos como registros NA. Esto puede verificarse con un summary:

summary(imp_df)
##   Pregnancies        Glucose      BloodPressure   SkinThickness  
##  Min.   : 0.000   Min.   : 74.0   Min.   :50.00   Min.   : 7.00  
##  1st Qu.: 1.000   1st Qu.:100.0   1st Qu.:68.00   1st Qu.:21.00  
##  Median : 3.000   Median :117.0   Median :70.00   Median :29.00  
##  Mean   : 3.664   Mean   :121.3   Mean   :71.39   Mean   :28.82  
##  3rd Qu.: 6.000   3rd Qu.:139.0   3rd Qu.:76.50   3rd Qu.:36.00  
##  Max.   :12.000   Max.   :189.0   Max.   :92.00   Max.   :99.00  
##  NA's   :14       NA's   :39      NA's   :732                    
##     Insulin           BMI        DiabetesPedigreeFunction      Age       
##  Min.   : 29.0   Min.   :21.00   Min.   :0.1260           Min.   :21.00  
##  1st Qu.: 76.0   1st Qu.:27.60   1st Qu.:0.2480           1st Qu.:24.00  
##  Median :120.0   Median :32.30   Median :0.3725           Median :29.00  
##  Mean   :140.5   Mean   :32.29   Mean   :0.4490           Mean   :32.46  
##  3rd Qu.:180.0   3rd Qu.:36.30   3rd Qu.:0.6050           3rd Qu.:40.00  
##  Max.   :480.0   Max.   :46.50   Max.   :1.2920           Max.   :63.00  
##  NA's   :39      NA's   :39      NA's   :40               NA's   :17     
##     Outcome     
##  Min.   :0.000  
##  1st Qu.:0.000  
##  Median :0.000  
##  Mean   :0.349  
##  3rd Qu.:1.000  
##  Max.   :1.000  
##

puede verse que ahora la data tiene datos faltantes, los cuales imputaremos con el método de predicción.

at <- mice(data, m=5, maxit=50, method ='pmm', seed=500, printFlag = FALSE)
atipico_imp <- complete(at)
head(atipico_imp)
##   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
summary(atipico_imp)
##   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

puede verse que los datos atípicos fueron imputados.