Ejercicio de clase | Árboles de decisión
Natalia Almeyda y Axel Pereles
2026-03-19
Problema 1: Historiales clínicos de insuficiencia cardíaca.
Paso 1. Preparación inicial y limpieza de los datos:
heart <- read.csv("heart_failure_clinical_records_dataset.csv")head(heart)## 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 1dim(heart)## [1] 299 13summary(heart)## 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.0000heart$DEATH_EVENT <- as.factor(heart$DEATH_EVENT)
colSums(is.na(heart))## 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
## 0Paso 2: Dividir los datos en conjunto de entrenamiento y prueba:
library(caret)## Loading required package: ggplot2## Loading required package: latticeset.seed(123)
folds <- createFolds(heart$DEATH_EVENT, k = 6)
entrenamiento <- heart[-folds[[6]], ]
prueba <- heart[folds[[6]], ]
dim(entrenamiento)## [1] 249 13dim(prueba)## [1] 50 13La base de datos fue dividida en 6 grupos, utilizando 5 grupos como conjunto de entrenamiento y 1 grupo como conjunto de prueba. Esta división permite entrenar el modelo con la mayor parte de los datos y luego evaluar su capacidad predictiva con observaciones nuevas.
Paso 3: Construcción del árbol de decisión:
library(rpart)
library(rpart.plot)
arbol <- rpart(DEATH_EVENT ~ ., data = entrenamiento, method = "class")
rpart.plot(arbol)
El árbol de decisión permite identificar las variables más importantes para clasificar si ocurre o no el evento de muerte. La primera partición del árbol representa la variable de mayor relevancia en el proceso de clasificación, mientras que las demás ramas muestran reglas adicionales que ayudan a separar los casos.
Paso 4: Validar la estabilidad del modelo
set.seed(123)
train_control <- trainControl(method = "cv", number = 5)
arbol_cv <- train(DEATH_EVENT ~ ., data = entrenamiento, method = "rpart", trControl = train_control, tuneLength = 5)
pred_arbol <- predict(arbol_cv, newdata = prueba)
confusionMatrix(pred_arbol, prueba$DEATH_EVENT)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 31 5
## 1 3 11
##
## Accuracy : 0.84
## 95% CI : (0.7089, 0.9283)
## No Information Rate : 0.68
## P-Value [Acc > NIR] : 0.008598
##
## Kappa : 0.6198
##
## Mcnemar's Test P-Value : 0.723674
##
## Sensitivity : 0.9118
## Specificity : 0.6875
## Pos Pred Value : 0.8611
## Neg Pred Value : 0.7857
## Prevalence : 0.6800
## Detection Rate : 0.6200
## Detection Prevalence : 0.7200
## Balanced Accuracy : 0.7996
##
## 'Positive' Class : 0
## La estabilidad del modelo se validó mediante validación cruzada de 5 grupos. La matriz de confusión permite observar cuantos casos fueron clasificados correctamente y evaluar si el modelo mantiene un desempeño aceptable en el conjunto de prueba.
Paso 5: Interpretación de los resultados finales:
### **Entrenamiento**
pred_ent <- predict(arbol, entrenamiento, type = "class")
tt_ent <- table(Prediccion = pred_ent, Real = entrenamiento$DEATH_EVENT)
tt_ent## Real
## Prediccion 0 1
## 0 157 19
## 1 12 61TA_ent <- sum(diag(tt_ent)) / sum(tt_ent)
paste0("Tasa de aciertos con los datos de entrenamiento: ", round(TA_ent, 4) * 100, "%")## [1] "Tasa de aciertos con los datos de entrenamiento: 87.55%"La tasa de aciertos en entrenamiento muestra que tan bien el modelo clasifica los datos con los que fue construido.
### **Prueba**
pred_prueba <- predict(arbol, prueba, type = "class")
tt_prueba <- table(Prediccion = pred_prueba, Real = prueba$DEATH_EVENT)
tt_prueba## Real
## Prediccion 0 1
## 0 32 6
## 1 2 10TA_prueba <- sum(diag(tt_prueba)) / sum(tt_prueba)
paste0("Tasa de aciertos con los datos de prueba: ", round(TA_prueba, 4) * 100, "%")## [1] "Tasa de aciertos con los datos de prueba: 84%"La tasa de aciertos en el conjunto de prueba permite evaluar la capacidad predictiva real del modelo. Si el desempeño en prueba es parecido al de entrenamiento, entonces el modelo no presenta un sobreajuste fuerte y su clasificación puede considerarse estable.
Problema 2: Calidad del Vino.
Paso 1. Preparación inicial y limpieza de los datos:
red <- read.csv("winequality-red.csv",sep=";")
white <- read.csv("winequality-white.csv",sep=";")
vino_total <- rbind(red, white)
library(rpart.plot)
library(caret)head(vino_total)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1 7.4 0.70 0.00 1.9 0.076
## 2 7.8 0.88 0.00 2.6 0.098
## 3 7.8 0.76 0.04 2.3 0.092
## 4 11.2 0.28 0.56 1.9 0.075
## 5 7.4 0.70 0.00 1.9 0.076
## 6 7.4 0.66 0.00 1.8 0.075
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1 11 34 0.9978 3.51 0.56 9.4
## 2 25 67 0.9968 3.20 0.68 9.8
## 3 15 54 0.9970 3.26 0.65 9.8
## 4 17 60 0.9980 3.16 0.58 9.8
## 5 11 34 0.9978 3.51 0.56 9.4
## 6 13 40 0.9978 3.51 0.56 9.4
## quality
## 1 5
## 2 5
## 3 5
## 4 6
## 5 5
## 6 5dim(vino_total)## [1] 6497 12summary(vino_total)## fixed.acidity volatile.acidity citric.acid residual.sugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.600
## 1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.800
## Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.000
## Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.443
## 3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.100
## Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :65.800
## chlorides free.sulfur.dioxide total.sulfur.dioxide density
## Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
## 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
## Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
## Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
## 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
## Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0390
## pH sulphates alcohol quality
## Min. :2.720 Min. :0.2200 Min. : 8.00 Min. :3.000
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.50 1st Qu.:5.000
## Median :3.210 Median :0.5100 Median :10.30 Median :6.000
## Mean :3.219 Mean :0.5313 Mean :10.49 Mean :5.818
## 3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.30 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.90 Max. :9.000vino_total$quality <- as.factor(vino_total$quality)
colSums(is.na(vino_total))## fixed.acidity volatile.acidity citric.acid
## 0 0 0
## residual.sugar chlorides free.sulfur.dioxide
## 0 0 0
## total.sulfur.dioxide density pH
## 0 0 0
## sulphates alcohol quality
## 0 0 0La base de datos de vinos no presenta valores faltantes. Además, las variables muestran suficiente variabilidad, lo que permite realizar un análisis exploratorio adecuado y construir el modelo de árboles de decisión. Por tanto, el conjunto de datos está listo para utilizarse en la investigación.
Paso 2: Dividir los datos en conjunto de entrenamiento y prueba:
set.seed(123)
folds <- createFolds(vino_total$quality, k = 6)
entrenamiento <- vino_total[-folds[[6]],]
prueba <- vino_total[folds[[6]],]
dim(entrenamiento)## [1] 5413 12dim(prueba)## [1] 1084 12La base de datos fue dividida en 6 grupos, utilizando 5 de ellos como conjunto de entrenamiento y 1 como conjunto de prueba.
Paso 3: Construcción del árbol de decisión:
arbol <- rpart(quality ~ ., data = entrenamiento, method = "class")
rpart.plot(arbol)
El modelo mostró que las variables más relevantes en la clasificación fueron alcohol y volatile.acidity. La primera partición del árbol se realizó con la variable alcohol, indicando que esta es la de mayor importancia. Luego la variable volatile.acidity permitió diferenciar principalmente entre vinos de calidad 5 y 6.
Paso 4: Validar la estabilidad del modelo
set.seed(123)
train_control <- trainControl(method = "cv", number = 5)
entrenamiento$quality <- as.factor(entrenamiento$quality)
prueba$quality <- as.factor(prueba$quality)
arbol_cv <- train(quality ~ .,
data = entrenamiento,
method = "rpart",
trControl = train_control,
tuneLength = 5)
pred_arbol <- predict(arbol_cv, newdata = prueba)
confusionMatrix(pred_arbol, prueba$quality)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 0 18 188 100 4 0 0
## 6 5 18 166 359 158 26 0
## 7 0 0 3 14 18 6 1
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5212
## 95% CI : (0.491, 0.5513)
## No Information Rate : 0.4363
## P-Value [Acc > NIR] : 1.219e-08
##
## Kappa : 0.2083
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.000000 0.00000 0.5266 0.7590 0.10000 0.00000
## Specificity 1.000000 1.00000 0.8322 0.3895 0.97345 1.00000
## Pos Pred Value NaN NaN 0.6065 0.4904 0.42857 NaN
## Neg Pred Value 0.995387 0.96679 0.7817 0.6761 0.84453 0.97048
## Prevalence 0.004613 0.03321 0.3293 0.4363 0.16605 0.02952
## Detection Rate 0.000000 0.00000 0.1734 0.3312 0.01661 0.00000
## Detection Prevalence 0.000000 0.00000 0.2860 0.6753 0.03875 0.00000
## Balanced Accuracy 0.500000 0.50000 0.6794 0.5743 0.53673 0.50000
## Class: 9
## Sensitivity 0.0000000
## Specificity 1.0000000
## Pos Pred Value NaN
## Neg Pred Value 0.9990775
## Prevalence 0.0009225
## Detection Rate 0.0000000
## Detection Prevalence 0.0000000
## Balanced Accuracy 0.5000000Se validó la estabilidad del modelo, obteniéndose una exactitud de 52.12%. Esto indica que el árbol de decisión clasifica mejor que la categoría más frecuente.
Paso 5: Interpretación de los resultados finales:
pred_ent <- predict(arbol, entrenamiento, type = "class")
tt_ent <- table(Prediccion = pred_ent, Real = entrenamiento$quality)
tt_ent## Real
## Prediccion 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 9 80 975 469 31 2 0
## 6 16 100 806 1894 868 159 4
## 7 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0#Entrenamiento
TA_ent <- sum(diag(tt_ent)) / sum(tt_ent)
paste0("Tasa de aciertos con los datos de entrenamiento: ", round(TA_ent, 4) * 100, "%")## [1] "Tasa de aciertos con los datos de entrenamiento: 53%"La tasa de aciertos del modelo para las observaciones de entrenamiento es de aproximadamente 53%, lo que indica que el árbol logra clasificar correctamente un poco más de la mitad de los casos en ese conjunto.
#Prueba
pred_prueba <- predict(arbol, prueba, type = "class")
tt_prueba <- table(Prediccion = pred_prueba, Real = prueba$quality)
tt_prueba## Real
## Prediccion 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 0 18 188 100 4 0 0
## 6 5 18 169 373 176 32 1
## 7 0 0 0 0 0 0 0
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0TA_prueba <- sum(diag(tt_prueba)) / sum(tt_prueba)
paste0("Tasa de aciertos con los datos de prueba: ", round(TA_prueba, 4) * 100, "%")## [1] "Tasa de aciertos con los datos de prueba: 51.75%"El modelo de conjunto de prueba logra predecir correctamente aproximadamente 51.75% de los datos, lo que sugiere que su rendimiento es similar en ambos conjuntos y que no presenta un sobreajuste fuerte, aunque su capacidad predictiva es moderada.