#Cargamos las librerías a usar
library(dplyr)
library(mice)
library(VIM)
library(outliers)
library(ggplot2)
library(gridExtra)
library(hrbrthemes)
#Cargamos la base de datos
library(readr)
diabetes<- read_csv("C:/Users/adria/Desktop/diabetes(1).csv")
## Rows: 768 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (9): Pregnancies, Glucose, BloodPressure, SkinThickness, Insulin, BMI, D...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
Sustituimos los valores ausentes y nulos por NaN en la base de datos.
diabetes<- diabetes %>%
mutate(
Glucose = ifelse(Glucose == 0.0, NA, Glucose),
BloodPressure = ifelse(BloodPressure == 0.0, NA, BloodPressure),
SkinThickness = ifelse(SkinThickness == 0.0, NA, SkinThickness),
Insulin = ifelse(Insulin == 0.0, NA, Insulin),
BMI = ifelse(BMI == 0.0, NA, BMI)
)
Haremos primero un análisis exploratorio sencillo, para mirar la diferencia entre estos datos y ya cuando están tratados.
summary(diabetes)
## 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
##
Ahora visualizaremos si hay datos faltantes.
aggr(diabetes, col=c('navyblue','red'), numbers=TRUE, sortVars=TRUE, labels=names(diabetes), cex.axis=.7, gap=3, ylab=c("Histograma de datos faltantes","Patrón"))
##
## Variables sorted by number of missings:
## Variable Count
## Insulin 0.486979167
## SkinThickness 0.295572917
## BloodPressure 0.045572917
## BMI 0.014322917
## Glucose 0.006510417
## Pregnancies 0.000000000
## DiabetesPedigreeFunction 0.000000000
## Age 0.000000000
## Outcome 0.000000000
Luego de confirmar su existencia, procederemos al tratamiento de estos datos.
imp_pmm <- mice(diabetes, method = "pmm", printFlag = FALSE)
diabetes_pmm <- complete(imp_pmm)
Ya hecha la imputación, veremos cómo cambiaron las variables donde se presentaban datos faltantes.
comparar_imputacion <- function(variables, datos_originales, datos_imputados) {
plots <- list() # Lista para almacenar gráficos
for (var in variables) {
# Crear gráfico para los datos originales
ggp1 <- ggplot(data.frame(value = datos_originales[[var]]), aes(x = value)) +
geom_histogram(fill = "#FBD000", color = "#E52521", alpha = 0.9, bins = 30) +
ggtitle(paste("Original -", var)) +
xlab(var) + ylab('Frequency') +
theme_minimal() +
theme(plot.title = element_text(size=15))
# Crear gráfico para los datos imputados
ggp2 <- ggplot(data.frame(value = datos_imputados[[var]]), aes(x = value)) +
geom_histogram(fill = "#43B047", color = "#049CD8", alpha = 0.9, bins = 30) +
ggtitle(paste("PMM Imputation -", var)) +
xlab(var) + ylab('Frequency') +
theme_minimal() +
theme(plot.title = element_text(size=15))
# Agregar los gráficos a la lista
plots[[var]] <- list(ggp1, ggp2)
}
# Mostrar los gráficos en pares
for (var in variables) {
grid.arrange(plots[[var]][[1]], plots[[var]][[2]], ncol = 2)
}
}
# Lista de variables a comparar
variables_a_comparar <- c("Insulin", "SkinThickness", "BloodPressure", "BMI", "Glucose")
# Llamar a la función con los datos originales e imputados
comparar_imputacion(variables_a_comparar, diabetes, diabetes_pmm)
library(dplyr)
library(ggplot2)
library(outliers)
library(EnvStats)
##
## Attaching package: 'EnvStats'
## The following objects are masked from 'package:stats':
##
## predict, predict.lm
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ gridExtra::combine() masks dplyr::combine()
## ✖ mice::filter() masks dplyr::filter(), stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
df <- read.csv("C:/Users/adria/Desktop/diabetes(1).csv")
variables <- c("Glucose", "BloodPressure", "SkinThickness", "Insulin", "BMI")
# Reemplazar ceros por NA
df[variables] <- lapply(df[variables], function(x) ifelse(x == 0, NA, x))
# Guardar los datos originales para compararlos después
df_original <- df
# Test de Kolmogorov-Smirnov para cada variable
for (var in variables) {
cat("\n---", var, "---\n")
ks_result <- ks.test(df[[var]], "pnorm", mean(df[[var]], na.rm = TRUE), sd(df[[var]], na.rm = TRUE))
cat("Kolmogorov-Smirnov p-value:", ks_result$p.value, "\n")
}
##
## --- Glucose ---
## Kolmogorov-Smirnov p-value: 0.000629123
##
## --- BloodPressure ---
## Kolmogorov-Smirnov p-value: 0.08969012
##
## --- SkinThickness ---
## Kolmogorov-Smirnov p-value: 0.1980573
##
## --- Insulin ---
## Kolmogorov-Smirnov p-value: 1.383958e-07
##
## --- BMI ---
## Kolmogorov-Smirnov p-value: 0.3101818
vemos que no hay normalidad en insulina por lo cual no podemos usar prueba de rosner.
# Boxplot para visualizar los valores atípicos
df_long <- pivot_longer(df, cols = all_of(variables), names_to = "Variable", values_to = "Valor")
ggplot(df_long, aes(x = Variable, y = Valor)) +
geom_boxplot(fill = "skyblue", outlier.color = "red") +
theme_minimal() +
labs(title = "Boxplot de variables con valores atípicos")
# Calcular percentiles 1% y 99% para Insulin
percentil_1 <- quantile(df$Insulin, 0.01, na.rm = TRUE)
percentil_99 <- quantile(df$Insulin, 0.99, na.rm = TRUE)
# Identificar valores atípicos para Insulin
df$Insulin_outlier <- ifelse(df$Insulin < percentil_1 | df$Insulin > percentil_99, "Outlier", "Normal")
# Reemplazar valores atípicos con la mediana
df$Insulin <- ifelse(df$Insulin_outlier == "Outlier", median(df$Insulin, na.rm = TRUE), df$Insulin)
como en insulina no podemos usar atipicos usamos icr anteriormente probamos rosner
# Test de Rosner para BloodPressure
cat("\nTest de Rosner para BloodPressure\n")
##
## Test de Rosner para BloodPressure
print(rosnerTest(df$BloodPressure, k = 8))
##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: df$BloodPressure
##
## Number NA/NaN/Inf's Removed: 35
##
## Sample Size: 733
##
## Test Statistics: R.1 = 4.005345
## R.2 = 3.944655
## R.3 = 3.495498
## R.4 = 3.527576
## R.5 = 3.473483
## R.6 = 3.167534
## R.7 = 3.191841
## R.8 = 3.216716
##
## Test Statistic Parameter: k = 8
##
## Alternative Hypothesis: Up to 8 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 1
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 72.40518 12.38216 122 107 4.005345 3.962273 TRUE
## 2 1 72.33743 12.25391 24 598 3.944655 3.961926 FALSE
## 3 2 72.40356 12.13090 30 19 3.495498 3.961579 FALSE
## 4 3 72.46164 12.03706 30 126 3.527576 3.961231 FALSE
## 5 4 72.51989 11.94194 114 692 3.473483 3.960883 FALSE
## 6 5 72.46291 11.85057 110 44 3.167534 3.960534 FALSE
## 7 6 72.41128 11.77650 110 178 3.191841 3.960185 FALSE
## 8 7 72.35950 11.70153 110 550 3.216716 3.959835 FALSE
# Test de Rosner para SkinThickness
cat("\nTest de Rosner para SkinThickness\n")
##
## Test de Rosner para SkinThickness
print(rosnerTest(df$SkinThickness, k = 3))
##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: df$SkinThickness
##
## Number NA/NaN/Inf's Removed: 227
##
## Sample Size: 541
##
## Test Statistics: R.1 = 6.666670
## R.2 = 3.382357
## R.3 = 3.120465
##
## Test Statistic Parameter: k = 3
##
## Alternative Hypothesis: Up to 3 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 1
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 29.15342 10.476982 99 580 6.666670 3.883895 TRUE
## 2 1 29.02407 10.045046 63 446 3.382357 3.883409 FALSE
## 3 2 28.96104 9.946902 60 58 3.120465 3.882923 FALSE
# Test de Rosner para BMI
cat("\nTest de Rosner para BMI\n")
##
## Test de Rosner para BMI
print(rosnerTest(df$BMI, k = 7))
##
## Results of Outlier Test
## -------------------------
##
## Test Method: Rosner's Test for Outliers
##
## Hypothesized Distribution: Normal
##
## Data: df$BMI
##
## Number NA/NaN/Inf's Removed: 11
##
## Sample Size: 757
##
## Test Statistics: R.1 = 5.002541
## R.2 = 3.960861
## R.3 = 3.694118
## R.4 = 3.386725
## R.5 = 3.144160
## R.6 = 3.121733
## R.7 = 3.052909
##
## Test Statistic Parameter: k = 7
##
## Alternative Hypothesis: Up to 7 observations are not
## from the same Distribution.
##
## Type I Error: 5%
##
## Number of Outliers Detected: 1
##
## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 32.45746 6.924988 67.1 178 5.002541 3.970442 TRUE
## 2 1 32.41164 6.813761 59.4 446 3.960861 3.970107 FALSE
## 3 2 32.37589 6.746971 57.3 674 3.694118 3.969772 FALSE
## 4 3 32.34284 6.689992 55.0 126 3.386725 3.969437 FALSE
## 5 4 32.31275 6.643189 53.2 121 3.144160 3.969101 FALSE
## 6 5 32.28497 6.603713 52.9 304 3.121733 3.968764 FALSE
## 7 6 32.25752 6.565042 52.3 194 3.052909 3.968427 FALSE
vemos que no capta casi ninguno de los datos atipicos marcados por lo cual nos vemos forzados a usar icr.
for (var in variables) {
if (var != "Glucose" && var != "Insulin") {
# Definir el valor de k para cada variable
k_value <- switch(var,
"BloodPressure" = 8,
"SkinThickness" = 3,
"BMI" = 7,
5) # Valor por defecto para otras variables
# Detectar valores atípicos en la variable
percentil_1 <- quantile(df[[var]], 0.01, na.rm = TRUE)
percentil_99 <- quantile(df[[var]], 0.99, na.rm = TRUE)
# Reemplazar los valores atípicos con la mediana
df[[var]] <- ifelse(df[[var]] < percentil_1 | df[[var]] > percentil_99,
median(df[[var]], na.rm = TRUE), df[[var]])
}
}
Comparamos distribuciones y vemos que no hay cambios significativos por lo cual usamos el metodo correcto
# Graficar la comparación de distribuciones originales vs imputadas
df_long_original <- pivot_longer(df_original, cols = all_of(variables), names_to = "Variable", values_to = "Valor")
df_long_imputed <- pivot_longer(df, cols = all_of(variables), names_to = "Variable", values_to = "Valor")
ggplot() +
geom_density(data = df_long_original, aes(x = Valor, fill = "Original"), alpha = 0.3) +
geom_density(data = df_long_imputed, aes(x = Valor, fill = "Imputed"), alpha = 0.3) +
facet_wrap(~Variable, scales = "free") +
theme_minimal() +
labs(title = "Comparación de Distribuciones de Densidad: Original vs Imputado") +
scale_fill_manual(values = c("Original" = "blue", "Imputed" = "red"))
ggplot(df_long_imputed, aes(x = Variable, y = Valor)) +
geom_boxplot(fill = "skyblue", outlier.color = "red") +
theme_minimal() +
labs(title = "Boxplot de variables con valores atípicos")
Aqui observamos que ya no hay casi atipicos y los que hay son propios de
los datos.