Problema 1: Historiales clínicos de insuficiencia cardíaca

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.

Paso 1: Preparacion inicial y limpieza de datos

+ 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

Variables predictoras y variables respuesta:

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)

Paso 2: Dividir los datos en conjunto de entrenamiento y prueba

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]]]

Paso 3: Construcion del Arbol de Decision

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.

Paso 4: Validar la estabilidad del modelo

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.

Paso 5: Interpretacion de los resdultados

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.

Conclusion:

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.