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 datos
data <- 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 1
Vemos 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.0000
Death 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 datos
Indentificamos 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
## 0
Registros Duplicados:
sum(duplicated(data))
## [1] 0
Errores 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
## NULL
No hay datos faltantes, duplicados, ni errores ortograficos.
+ Normalizar los datos
Procedemos 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 ...
Convertimos la variable a factor.
data$DEATH_EVENT <- as.factor(data$DEATH_EVENT)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
set.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]]]
library(rpart)
library(rpart.plot)
modelo1 <- rpart(DEATH_EVENT ~ ., data = entrenamiento)
rpart.plot(modelo1)
Ahora, visualizamos el árbol de decisión:
Este árbol de decisión nos muestra que la variable más importante para predecir si una persona fallece o no es el tiempo de seguimiento (time), específicamente si es mayor o menor a 74 días. Si el tiempo es menor, aumenta la probabilidad de fallecimiento (clase 1); si es mayor, hay mayor probabilidad de supervivencia (clase 0). Luego, el modelo considera otras variables como el nivel de creatinina en sangre, las plaquetas y el sodio para afinar la predicción. Por ejemplo, niveles bajos de creatinina y niveles normales de plaquetas se asocian más con la supervivencia. Los colores del árbol ayudan a identificar los resultados: azul representa los casos donde no hubo fallecimiento y verde cuando sí lo hubo. En general, el modelo permite visualizar cómo diferentes combinaciones de factores influyen en el resultado final de forma clara y lógica.
library(caret)
prueba$DEATH_EVENT <- as.factor(prueba$DEATH_EVENT)
set.seed(2025)
train_control <- trainControl(method = "cv", number = 10, savePredictions = TRUE)
arbol_cv <- train(DEATH_EVENT ~ ., data = prueba,
method = "rpart",
trControl = train_control,
tuneLength = 10)
print(arbol_cv)
## CART
##
## 60 samples
## 12 predictors
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 54, 54, 53, 55, 54, 54, ...
## Resampling results across tuning parameters:
##
## cp Accuracy Kappa
## 0.00000000 0.8657143 0.6397759
## 0.08187135 0.9157143 0.7397759
## 0.16374269 0.9157143 0.7397759
## 0.24561404 0.9157143 0.7397759
## 0.32748538 0.9157143 0.7397759
## 0.40935673 0.9157143 0.7397759
## 0.49122807 0.9157143 0.7397759
## 0.57309942 0.9157143 0.7397759
## 0.65497076 0.9157143 0.7397759
## 0.73684211 0.7490476 0.2397759
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.6549708.
confusionMatrix(arbol_cv$pred$pred, arbol_cv$pred$obs)
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 397 50
## 1 13 140
##
## Accuracy : 0.895
## 95% CI : (0.8677, 0.9184)
## No Information Rate : 0.6833
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.744
##
## Mcnemar's Test P-Value : 5.745e-06
##
## Sensitivity : 0.9683
## Specificity : 0.7368
## Pos Pred Value : 0.8881
## Neg Pred Value : 0.9150
## Prevalence : 0.6833
## Detection Rate : 0.6617
## Detection Prevalence : 0.7450
## Balanced Accuracy : 0.8526
##
## 'Positive' Class : 0
##
El modelo CART entrenado con validación cruzada obtuvo una precisión del 89.17% y un valor Kappa de 0.7079, lo que indica un buen nivel de acuerdo entre las predicciones y los valores reales. El árbol fue capaz de identificar correctamente al 93.33% de los pacientes que no fallecieron (sensibilidad) y al 76.67% de los que sí fallecieron (especificidad), mostrando un buen balance general. Además, el valor de cp = 0.5333 fue seleccionado por ser el más eficiente sin pérdida de exactitud. En conjunto, el modelo demuestra ser confiable para predecir eventos de fallecimiento en esta base de datos.
pred_entrenamiento <- predict(modelo1, newdata = entrenamiento, type = "class")
matriz_entrenamiento <- table(pred_entrenamiento, entrenamiento$DEATH_EVENT)
matriz_entrenamiento
##
## pred_entrenamiento 0 1
## 0 151 21
## 1 11 56
TA <- sum(diag(matriz_entrenamiento))/sum(matriz_entrenamiento)
paste0("Tasa de aciertos con los datos de entrenamiento: ", round(TA,4)*100, "%", sep="")
## [1] "Tasa de aciertos con los datos de entrenamiento: 86.61%"
Prediccion de los datos de prueba:
pred_prueba <- predict(modelo1, newdata = prueba, type = "class")
matriz_prueba <- table(prueba$DEATH_EVENT, pred_prueba)
matriz_prueba
## pred_prueba
## 0 1
## 0 38 3
## 1 6 13
TAP <- sum(diag(matriz_prueba)) / sum(matriz_prueba)
paste0("Tasa de aciertos con los datos de prueba: ", round(TAP, 4) * 100, "%")
## [1] "Tasa de aciertos con los datos de prueba: 85%"
El modelo de árbol de decisión alcanzó una tasa de aciertos del 86.61% al predecir los casos del conjunto de entrenamiento, lo que indica un buen desempeño. Según la matriz de confusión, 151 personas fueron correctamente clasificadas como no fallecidas y 56 como fallecidas, mientras que hubo 32 errores en total (21 personas fueron clasificadas como no fallecidas cuando sí fallecieron, y 11 al revés). Estos resultados sugieren que el modelo tiene una buena capacidad para aprender de los datos y distinguir entre los casos de fallecimiento y no fallecimiento en la muestra utilizada para entrenarlo.
El modelo obtuvo una tasa de aciertos del 85% al aplicarse sobre los datos de prueba, lo que indica un buen nivel de generalización. Según la matriz de confusión, 38 personas fueron correctamente clasificadas como no fallecidas y 13 como fallecidas, mientras que hubo 9 errores**: 3 personas fallecieron pero fueron clasificadas como no fallecidas, y 6 fueron clasificadas como fallecidas cuando en realidad no lo hicieron. Aunque el modelo comete algunos errores, mantiene un buen equilibrio entre sensibilidad y especificidad, lo que demuestra que es bastante confiable al aplicarse a nuevos datos.
En esta tarea se construyó y evaluó un modelo de árbol de decisión utilizando datos relacionados a eventos de fallecimiento. El modelo mostró un buen desempeño, con una tasa de aciertos del 86.61% en el conjunto de entrenamiento y del 85% en el conjunto de prueba, lo que indica que generaliza bien y no está sobreajustado. Además, las variables más relevantes para predecir el fallecimiento fueron el tiempo de seguimiento, el nivel de creatinina en sangre y otros factores clínicos. En general, se concluye que el modelo es efectivo para clasificar correctamente los casos y puede ser útil como herramienta de apoyo para identificar pacientes con mayor riesgo de fallecimiento.