actividad
actividad
2025
Dataset
df = read.csv("C:/Users/johan/Downloads/diabetes.csv", sep=",", header=TRUE, fileEncoding = "UTF-8")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)
library(outliers)
library(EnvStats)
library(tidyr)
})## 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##
## Adjuntando el paquete: 'outliers'## The following object is masked from 'package:psych':
##
## outlier##
## Adjuntando el paquete: 'EnvStats'## The following object is masked from 'package:Hmisc':
##
## stripChart## The following objects are masked from 'package:e1071':
##
## kurtosis, skewness## The following objects are masked from 'package:stats':
##
## predict, predict.lm## The following object is masked from 'package:base':
##
## print.default##
## Adjuntando el paquete: 'tidyr'## The following object is masked from 'package:reshape2':
##
## smithsMostramos las primeras y ultimas filas de la base de datos para ver como esta estructurado.
## 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 0Ahora analizaremos la naturaleza de las variables de nuestra base de datos.
## 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] <- NAPruebas 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:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$Pregnancies
##
## Test Statistic: W = 0.9042813
##
## P-value: 1.609257e-21## [1] "Resultado para Glucose:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$Glucose
##
## Test Statistic: W = 0.9696409
##
## P-value: 1.720326e-11# BloodPressure
shapiro_bloodpressure <- shapiro.test(df$BloodPressure)
print("Resultado para BloodPressure:")## [1] "Resultado para BloodPressure:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$BloodPressure
##
## Test Statistic: W = 0.9903145
##
## P-value: 9.45138e-05# SkinThickness
shapiro_skinthickness <- shapiro.test(df$SkinThickness)
print("Resultado para SkinThickness:")## [1] "Resultado para SkinThickness:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$SkinThickness
##
## Test Statistic: W = 0.9679992
##
## P-value: 1.775691e-09## [1] "Resultado para Insulin:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$Insulin
##
## Test Statistic: W = 0.8040996
##
## P-value: 1.698218e-21## [1] "Resultado para BMI:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$BMI
##
## Test Statistic: W = 0.9795543
##
## P-value: 8.557785e-09# DiabetesPedigreeFunction
shapiro_dpf <- shapiro.test(df$DiabetesPedigreeFunction)
print("Resultado para DiabetesPedigreeFunction:")## [1] "Resultado para DiabetesPedigreeFunction:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$DiabetesPedigreeFunction
##
## Test Statistic: W = 0.8365181
##
## P-value: 2.477506e-27## [1] "Resultado para Age:"##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df$Age
##
## Test Statistic: W = 0.8747669
##
## P-value: 2.402274e-24Vemos que todas nuestras variables coinciden en que no siguen una distribución normal.
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
## 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 0Aplicamos 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## Pregnancies Glucose BloodPressure
## 0 0 0
## SkinThickness Insulin BMI
## 0 0 0
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Aná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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_pmm$SkinThickness
##
## Test Statistic: W = 0.9731303
##
## P-value: 1.121809e-10- 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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_pmm$Insulin
##
## Test Statistic: W = 0.7981324
##
## P-value: 7.952825e-30norm.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
## 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 0Aplicamos 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## Pregnancies Glucose BloodPressure
## 0 0 0
## SkinThickness Insulin BMI
## 0 0 0
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Aná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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_predict$SkinThickness
##
## Test Statistic: W = 0.9709169
##
## P-value: 3.126631e-11- 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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_predict$Insulin
##
## Test Statistic: W = 0.8478726
##
## P-value: 1.654757e-26norm.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
## 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 0Aplicamos 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## Pregnancies Glucose BloodPressure
## 0 0 0
## SkinThickness Insulin BMI
## 0 0 0
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Aná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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_nob$SkinThickness
##
## Test Statistic: W = 0.9790628
##
## P-value: 4.944505e-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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_nob$Insulin
##
## Test Statistic: W = 0.9274439
##
## P-value: 8.41167e-19norm
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.
## 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 0Aplicamos 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## Pregnancies Glucose BloodPressure
## 0 0 0
## SkinThickness Insulin BMI
## 0 0 0
## DiabetesPedigreeFunction Age Outcome
## 0 0 0Aná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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_nob$SkinThickness
##
## Test Statistic: W = 0.9790628
##
## P-value: 4.944505e-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="blue", 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="red", 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`.
##
## Results of Hypothesis Test
## --------------------------
##
## Alternative Hypothesis:
##
## Test Name: Shapiro-Wilk normality test
##
## Data: df_norm_nob$Insulin
##
## Test Statistic: W = 0.9274439
##
## P-value: 8.41167e-19Datos 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 Descriptivo
Resumen descriptivo inicial para identificar outliers en los datos.
## 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.000Realizamos un boxplot multiple para saber que variables tienen datos atipicos.
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 variablesggplot(df_melted, aes(x = "", y = value)) +
geom_boxplot(fill = "blue", color = "red") +
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())
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")
cat("\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: 17Hampel
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")
}
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: 81grubbs
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.
Realizamos un resumen de nuestros datos debido a que Grubbs por defecto toma como valor objetivo el maximo de esa variable
## 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.000Para la primera prueba usaremos la variable
Pregnancies.
##
## Grubbs test for one outlier
##
## data: df_pmm$Pregnancies
## G = 3.9040, U = 0.9801, p-value = 0.03367
## alternative hypothesis: highest value 17 is an outlierPara la segunda prueba usaremos la variable Glucose.
##
## Grubbs test for one outlier
##
## data: df_pmm$Glucose
## G = 2.53239, U = 0.99163, p-value = 1
## alternative hypothesis: lowest value 44 is an outlierPara la tercera prueba usaremos la variable
BloodPressure.
##
## Grubbs test for one outlier
##
## data: df_pmm$BloodPressure
## G = 4.01506, U = 0.97895, p-value = 0.02096
## alternative hypothesis: highest value 122 is an outlierPara la cuarta prueba usaremos la variable
BloodPressure.
##
## Grubbs test for one outlier
##
## data: df_pmm$SkinThickness
## G = 6.76548, U = 0.94025, p-value = 2.505e-09
## alternative hypothesis: highest value 99 is an outlierPara la quinta prueba usaremos la variable Insulin.
##
## Grubbs test for one outlier
##
## data: df_pmm$Insulin
## G = 6.0952, U = 0.9515, p-value = 2.637e-07
## alternative hypothesis: highest value 846 is an outlierPara la sexta prueba usaremos la variable BMI.
##
## Grubbs test for one outlier
##
## data: df_pmm$BMI
## G = 5.01023, U = 0.96723, p-value = 0.0001693
## alternative hypothesis: highest value 67.1 is an outlierPara la septima prueba usaremos la variable
DiabetesPedigreeFunction.
##
## Grubbs test for one outlier
##
## data: df_pmm$DiabetesPedigreeFunction
## G = 5.87973, U = 0.95487, p-value = 1.056e-06
## alternative hypothesis: highest value 2.42 is an outlierPara la octava prueba usaremos la variable Age.
##
## Grubbs test for one outlier
##
## data: df_pmm$Age
## G = 4.06107, U = 0.97847, p-value = 0.01716
## alternative hypothesis: highest value 81 is an outlier