Las enfermedades cardíacas son una de las principales causas de muerte en el mundo. En este trabajo, usamos el modelo k-Nearest Neighbors (k-NN) para predecir si un paciente con insuficiencia cardíaca podría fallecer, basándonos en su historial clínico.
Para ello, organizamos y normalizamos los datos, aplicamos el modelo y validamos su precisión. Evaluamos los resultados con métricas como exactitud y sensibilidad, analizando qué tan bien funciona el modelo y cómo podría mejorarse para hacer predicciones más precisas en el futuro.
+ Cargar los datosdata <- read.csv("Mortalidad.csv")
head(data)## age anaemia creatinine_phosphokinase diabetes ejection_fraction
## 1 75 0 582 0 20
## 2 55 0 7861 0 38
## 3 65 0 146 0 20
## 4 50 1 111 0 20
## 5 65 1 160 1 20
## 6 90 1 47 0 40
## high_blood_pressure platelets serum_creatinine serum_sodium sex smoking time
## 1 1 265000 1.9 130 1 0 4
## 2 0 263358 1.1 136 1 0 6
## 3 0 162000 1.3 129 1 1 7
## 4 0 210000 1.9 137 1 0 7
## 5 0 327000 2.7 116 0 0 8
## 6 1 204000 2.1 132 1 1 8
## DEATH_EVENT
## 1 1
## 2 1
## 3 1
## 4 1
## 5 1
## 6 1Vemos el resumen estadistico:
summary(data)## age anaemia creatinine_phosphokinase diabetes
## Min. :40.00 Min. :0.0000 Min. : 23.0 Min. :0.0000
## 1st Qu.:51.00 1st Qu.:0.0000 1st Qu.: 116.5 1st Qu.:0.0000
## Median :60.00 Median :0.0000 Median : 250.0 Median :0.0000
## Mean :60.83 Mean :0.4314 Mean : 581.8 Mean :0.4181
## 3rd Qu.:70.00 3rd Qu.:1.0000 3rd Qu.: 582.0 3rd Qu.:1.0000
## Max. :95.00 Max. :1.0000 Max. :7861.0 Max. :1.0000
## ejection_fraction high_blood_pressure platelets serum_creatinine
## Min. :14.00 Min. :0.0000 Min. : 25100 Min. :0.500
## 1st Qu.:30.00 1st Qu.:0.0000 1st Qu.:212500 1st Qu.:0.900
## Median :38.00 Median :0.0000 Median :262000 Median :1.100
## Mean :38.08 Mean :0.3512 Mean :263358 Mean :1.394
## 3rd Qu.:45.00 3rd Qu.:1.0000 3rd Qu.:303500 3rd Qu.:1.400
## Max. :80.00 Max. :1.0000 Max. :850000 Max. :9.400
## serum_sodium sex smoking time
## Min. :113.0 Min. :0.0000 Min. :0.0000 Min. : 4.0
## 1st Qu.:134.0 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 73.0
## Median :137.0 Median :1.0000 Median :0.0000 Median :115.0
## Mean :136.6 Mean :0.6488 Mean :0.3211 Mean :130.3
## 3rd Qu.:140.0 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:203.0
## Max. :148.0 Max. :1.0000 Max. :1.0000 Max. :285.0
## DEATH_EVENT
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.3211
## 3rd Qu.:1.0000
## Max. :1.0000Death Event es nuestra variable respuesta, es la variable que utilizare para predecir con el modelo k-NN.
Las variables predictoras seran todas las demas. Tenemos las numericas: age, creatinine_phosphokinase, ejection_fraction, platelets, serum_creatinine, serum_sodium y time. Tambien tenemos las categoricas: anaemia, diabetes, high_blood_pressure, sex y smoking.
+ Explorar los datosIndentificamos valores faltantes:
colSums(is.na(data))## age anaemia creatinine_phosphokinase
## 0 0 0
## diabetes ejection_fraction high_blood_pressure
## 0 0 0
## platelets serum_creatinine serum_sodium
## 0 0 0
## sex smoking time
## 0 0 0
## DEATH_EVENT
## 0Registros Duplicados:
sum(duplicated(data))## [1] 0Errores Tipograficos:
sapply(data, function(x) if(is.character(x) | is.factor(x)) unique(x))## $age
## NULL
##
## $anaemia
## NULL
##
## $creatinine_phosphokinase
## NULL
##
## $diabetes
## NULL
##
## $ejection_fraction
## NULL
##
## $high_blood_pressure
## NULL
##
## $platelets
## NULL
##
## $serum_creatinine
## NULL
##
## $serum_sodium
## NULL
##
## $sex
## NULL
##
## $smoking
## NULL
##
## $time
## NULL
##
## $DEATH_EVENT
## NULLNo hay datos faltantes, duplicados, ni errores ortograficos.
+ Normalizar los datosProcedemos a normalizar las variables numericas.
num_vars <- c("age", "creatinine_phosphokinase", "ejection_fraction",
"platelets", "serum_creatinine", "serum_sodium", "time")
data[, num_vars] <- scale(data[, num_vars])
str(data)## 'data.frame': 299 obs. of 13 variables:
## $ age : num 1.191 -0.49 0.35 -0.911 0.35 ...
## $ anaemia : int 0 0 0 1 1 1 1 1 0 1 ...
## $ creatinine_phosphokinase: num 0.000165 7.502063 -0.449186 -0.485257 -0.434757 ...
## $ diabetes : int 0 0 0 0 1 0 0 1 0 0 ...
## $ ejection_fraction : num -1.528 -0.00706 -1.528 -1.528 -1.528 ...
## $ high_blood_pressure : int 1 0 0 0 0 1 0 0 0 1 ...
## $ platelets : num 1.68e-02 7.52e-09 -1.04 -5.46e-01 6.51e-01 ...
## $ serum_creatinine : num 0.4892 -0.2841 -0.0907 0.4892 1.2625 ...
## $ serum_sodium : num -1.5015 -0.1417 -1.7281 0.0849 -4.6743 ...
## $ sex : int 1 1 1 1 0 1 1 1 0 1 ...
## $ smoking : int 0 0 1 0 0 1 0 1 0 1 ...
## $ time : num -1.63 -1.6 -1.59 -1.59 -1.58 ...
## $ DEATH_EVENT : int 1 1 1 1 1 1 1 1 1 1 ...library(caret)## Loading required package: ggplot2## Loading required package: latticeset.seed(2025)
folds <- createFolds(data$DEATH_EVENT, k = 5)
entrenamiento <- data[-folds[[5]], ]
prueba <- data[folds[[5]], ]
entrenamiento_labels <- data$DEATH_EVENT[-folds[[5]]]
prueba_labels <- data$DEATH_EVENT[folds[[5]]]+ Calcular la distancia entre observaciones
+ Seleccion de los K vecinos mas cercanos
+ Clasificacion segun la mayorialibrary(kknn)##
## Attaching package: 'kknn'## The following object is masked from 'package:caret':
##
## contr.dummyentrenamiento$DEATH_EVENT <- as.factor(entrenamiento$DEATH_EVENT)
modelo <- train.kknn(DEATH_EVENT ~ ., data = entrenamiento, kmax = 5)
modelo##
## Call:
## train.kknn(formula = DEATH_EVENT ~ ., data = entrenamiento, kmax = 5)
##
## Type of response variable: nominal
## Minimal misclassification: 0.334728
## Best kernel: optimal
## Best k: 5Se encuentra como valor optimo k = 8. Verificamos el margen de error.
Pres <- predict(modelo, entrenamiento[,-13])
tt <- table(entrenamiento[,13],Pres)
tt## Pres
## 0 1
## 0 158 0
## 1 13 68library(class)
library(caret)
# Guardar la exactitud de cada fold
exactitud <- numeric(length = 5)
for(i in 1:5){
# Definir conjuntos de entrenamiento y prueba segun el fold actual
prueba <- data[folds[[i]], ]
entrenamiento <- data[-folds[[i]], ]
# Etiquetas (convertimos a factor para evitar errores)
entrenamiento_labels <- factor(data$DEATH_EVENT[-folds[[i]]], levels = c(0,1))
prueba_labels <- factor(data$DEATH_EVENT[folds[[i]]], levels = c(0,1))
pred_knn <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 5)
# Convertir predicciones a factor y asegurarnos de que tengan los mismos niveles
pred_knn <- factor(pred_knn, levels = c(0,1))
# Evaluar exactitud del modelo con cada fold
cm <- confusionMatrix(pred_knn, prueba_labels)
exactitud[i] <- cm$overall["Accuracy"]
# Mostrar resultado del fold
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.8833333
## Fold 2 - Exactitud: 0.9166667
## Fold 3 - Exactitud: 0.9152542
## Fold 4 - Exactitud: 0.9
## Fold 5 - Exactitud: 0.9166667# Exactitud promedio de validación cruzada
Exactitud_promedio <- round(mean(exactitud), 4) * 100
paste("Exactitud promedio: ", Exactitud_promedio, "%", sep = "")## [1] "Exactitud promedio: 90.64%"set.seed(2025)
data$DEATH_EVENT <- factor(data$DEATH_EVENT, levels = c(0,1))
train_control <- trainControl(method = "cv", number = 10, savePredictions = TRUE)
knn_cv <- train(DEATH_EVENT ~ ., data = data, # Se usa directamente `data` en lugar de `cbind(prueba, ...)`
method = "knn", trControl = train_control, tuneGrid = data.frame(k = 5))
# Resultados de la validación cruzada
print(knn_cv)## k-Nearest Neighbors
##
## 299 samples
## 12 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 269, 269, 268, 270, 270, 268, ...
## Resampling results:
##
## Accuracy Kappa
## 0.7932851 0.4747292
##
## Tuning parameter 'k' was held constant at a value of 5# Matriz de confusión usando predicciones guardadas por caret
confusionMatrix(knn_cv$pred$pred, knn_cv$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 189 48
## 1 14 48
##
## Accuracy : 0.7926
## 95% CI : (0.7422, 0.8372)
## No Information Rate : 0.6789
## P-Value [Acc > NIR] : 8.397e-06
##
## Kappa : 0.4754
##
## Mcnemar's Test P-Value : 2.777e-05
##
## Sensitivity : 0.9310
## Specificity : 0.5000
## Pos Pred Value : 0.7975
## Neg Pred Value : 0.7742
## Prevalence : 0.6789
## Detection Rate : 0.6321
## Detection Prevalence : 0.7926
## Balanced Accuracy : 0.7155
##
## 'Positive' Class : 0
## Podemos observar en los resultados una precisión del 79.26%, lo que implica un error del 20.74% en la clasificación de los pacientes. Al evaluar el modelo en el conjunto de prueba, encontramos que logra predecir correctamente aproximadamente 79% de los casos, lo que sugiere un desempeño estable en datos no vistos. Es importante recarcar que para efectos de la vida real un porcentaje de 20.74% de error es muy alto y se deberia buscar la manera de disminuirlo con metodos como la curva de ROC, lo que permitiría evaluar su capacidad de discriminación entre sobrevivientes y fallecidos.