Práctica 3: Árboles de decisión
Isabella González y Larimar Claudio
2026-03-12
Introducción
En esta asignación,
Problema 1: Historiales clínicos de insuficiencia cardíaca
Este conjunto de datos contiene información clínica de pacientes, con el objetivo de predecir la mortalidad por insuficiencia cardíaca.
Paso #1: Preparación inicial y limpieza de los datos:
Exploración de datos y estructura
# Base de datos
records <- read.csv("heart_failure_clinical_records_dataset.csv")
summary(records)## 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# Visión general de toda la base de datos
skimr::skim(records) | Name | records |
| Number of rows | 299 |
| Number of columns | 13 |
| _______________________ | |
| Column type frequency: | |
| numeric | 13 |
| ________________________ | |
| Group variables | None |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| age | 0 | 1 | 60.83 | 11.89 | 40.0 | 51.0 | 60.0 | 70.0 | 95.0 | ▆▇▇▂▁ |
| anaemia | 0 | 1 | 0.43 | 0.50 | 0.0 | 0.0 | 0.0 | 1.0 | 1.0 | ▇▁▁▁▆ |
| creatinine_phosphokinase | 0 | 1 | 581.84 | 970.29 | 23.0 | 116.5 | 250.0 | 582.0 | 7861.0 | ▇▁▁▁▁ |
| diabetes | 0 | 1 | 0.42 | 0.49 | 0.0 | 0.0 | 0.0 | 1.0 | 1.0 | ▇▁▁▁▆ |
| ejection_fraction | 0 | 1 | 38.08 | 11.83 | 14.0 | 30.0 | 38.0 | 45.0 | 80.0 | ▃▇▂▂▁ |
| high_blood_pressure | 0 | 1 | 0.35 | 0.48 | 0.0 | 0.0 | 0.0 | 1.0 | 1.0 | ▇▁▁▁▅ |
| platelets | 0 | 1 | 263358.03 | 97804.24 | 25100.0 | 212500.0 | 262000.0 | 303500.0 | 850000.0 | ▂▇▂▁▁ |
| serum_creatinine | 0 | 1 | 1.39 | 1.03 | 0.5 | 0.9 | 1.1 | 1.4 | 9.4 | ▇▁▁▁▁ |
| serum_sodium | 0 | 1 | 136.63 | 4.41 | 113.0 | 134.0 | 137.0 | 140.0 | 148.0 | ▁▁▃▇▁ |
| sex | 0 | 1 | 0.65 | 0.48 | 0.0 | 0.0 | 1.0 | 1.0 | 1.0 | ▅▁▁▁▇ |
| smoking | 0 | 1 | 0.32 | 0.47 | 0.0 | 0.0 | 0.0 | 1.0 | 1.0 | ▇▁▁▁▃ |
| time | 0 | 1 | 130.26 | 77.61 | 4.0 | 73.0 | 115.0 | 203.0 | 285.0 | ▆▇▃▆▃ |
| DEATH_EVENT | 0 | 1 | 0.32 | 0.47 | 0.0 | 0.0 | 0.0 | 1.0 | 1.0 | ▇▁▁▁▃ |
# Características de las variables de la base de datos
glimpse(records)## Rows: 299
## Columns: 13
## $ age <dbl> 75, 55, 65, 50, 65, 90, 75, 60, 65, 80, 75, 6…
## $ anaemia <int> 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, …
## $ creatinine_phosphokinase <int> 582, 7861, 146, 111, 160, 47, 246, 315, 157, …
## $ diabetes <int> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ ejection_fraction <int> 20, 38, 20, 20, 20, 40, 15, 60, 65, 35, 38, 2…
## $ high_blood_pressure <int> 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, …
## $ platelets <dbl> 265000, 263358, 162000, 210000, 327000, 20400…
## $ serum_creatinine <dbl> 1.90, 1.10, 1.30, 1.90, 2.70, 2.10, 1.20, 1.1…
## $ serum_sodium <int> 130, 136, 129, 137, 116, 132, 137, 131, 138, …
## $ sex <int> 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, …
## $ smoking <int> 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, …
## $ time <int> 4, 6, 7, 7, 8, 8, 10, 10, 10, 10, 10, 10, 11,…
## $ DEATH_EVENT <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, …# Información de las primeras filas de la base de datos
head(records)## 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# Porcentaje total de valores faltantes
pct_miss(records)## [1] 0En este paso se realizó una exploración inicial de la base de datos records para entender su estructura y calidad. Se identificó que el dataset contiene 299 observaciones y 13 variables, todas de tipo numérico, lo cual facilita su uso en modelos de clasificación. A partir de skim() y summary(), se observó que algunas variables presentan rangos amplios y posibles valores extremos. Además, mediante pct_miss(records) se verificó que no existen valores faltantes, por lo que no fue necesario realizar procesos de limpieza o imputación.
En general, este paso permitió confirmar que los datos están completos y listos para ser utilizados en el entrenamiento del modelo.
Paso #2: Dividir los datos en conjunto de entrenamiento y prueba:
library(caret)## Loading required package: latticeset.seed(2025)
# Crear folds usando la variable respuesta original
folds <- createFolds(records$DEATH_EVENT, k = 5)
# Usar la data ORIGINAL, no normalizada
entrenamiento <- records[-folds[[5]], ]
prueba <- records[folds[[5]], ]
# Etiquetas
entrenamiento_labels <- records$DEATH_EVENT[-folds[[5]]]
prueba_labels <- records$DEATH_EVENT[folds[[5]]]
# Ver tamaños
dim(entrenamiento)[1]## [1] 239dim(prueba)[1]## [1] 60En este paso se dividieron los datos en conjuntos de entrenamiento y prueba utilizando validación cruzada tipo K-fold. Se generaron 5 particiones (folds) a partir de la variable respuesta DEATH_EVENT, lo que permite mantener una distribución equilibrada de las clases. Posteriormente, se seleccionó una de las particiones como conjunto de prueba y las restantes como conjunto de entrenamiento. A diferencia de otros modelos, en este caso se utilizaron los datos originales sin normalización, ya que los árboles de decisión no dependen de la escala de las variables. Finalmente, se definieron las etiquetas correspondientes para ambos conjuntos, obteniendo un total de 239 observaciones para entrenamiento y 60 para prueba.
Paso #3: Construcción del árbol de decisión:
library(rpart)
library(rpart.plot)
library(C50)
# Convertir labels a factor
entrenamiento_labels <- as.factor(entrenamiento_labels)
prueba_labels <- as.factor(prueba_labels)
# Crear base para árboles SIN cbind
entrenamiento_arbol <- entrenamiento
entrenamiento_arbol$DEATH_EVENT <- entrenamiento_labels
# Verificar que sí sea factor
str(entrenamiento_arbol$DEATH_EVENT)## Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...# Árbol CART
modelo_cart <- rpart(DEATH_EVENT ~ ., data = entrenamiento_arbol, method = "class")
modelo_cart## n= 239
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 239 81 0 (0.6610879 0.3389121)
## 2) time>=67.5 184 33 0 (0.8206522 0.1793478)
## 4) serum_creatinine< 1.45 146 13 0 (0.9109589 0.0890411) *
## 5) serum_creatinine>=1.45 38 18 1 (0.4736842 0.5263158)
## 10) time>=210.5 8 1 0 (0.8750000 0.1250000) *
## 11) time< 210.5 30 11 1 (0.3666667 0.6333333)
## 22) creatinine_phosphokinase< 87.5 7 2 0 (0.7142857 0.2857143) *
## 23) creatinine_phosphokinase>=87.5 23 6 1 (0.2608696 0.7391304) *
## 3) time< 67.5 55 7 1 (0.1272727 0.8727273) *rpart.plot(modelo_cart)
# Árbol C5.0
modelo_c50 <- C5.0(DEATH_EVENT ~ ., data = entrenamiento_arbol)
modelo_c50##
## Call:
## C5.0.formula(formula = DEATH_EVENT ~ ., data = entrenamiento_arbol)
##
## Classification Tree
## Number of samples: 239
## Number of predictors: 12
##
## Tree size: 15
##
## Non-standard options: attempt to group attributesplot(modelo_c50)
En este paso se construyeron los modelos de árboles de decisión utilizando los algoritmos CART y C5.0, con el objetivo de identificar las variables más relevantes en la clasificación del evento de muerte. A partir del modelo C5.0, se observa que la variable time se encuentra en la raíz del árbol, lo que indica que es el factor más influyente en la predicción. Luego, el árbol continúa dividiendo los datos principalmente mediante la variable serum_creatinine, estableciendo reglas como valores menores a aproximadamente 0.12, que conducen a una menor probabilidad del evento. En niveles más profundos, la variable time vuelve a aparecer junto con otros umbrales (por ejemplo, time ≥ 0.73), lo que permite refinar aún más la clasificación. Las hojas del árbol muestran probabilidades asociadas a cada clase, evidenciando cómo el modelo segmenta a los pacientes según su riesgo.
En general, el árbol presenta una estructura relativamente simple y fácil de interpretar, donde las primeras divisiones (especialmente time y serum_creatinine) tienen el mayor impacto en la clasificación. Esto confirma que estas variables son clave en el comportamiento del modelo y en la separación de los datos entre pacientes con y sin evento de muerte.
Paso 4: Validar la estabilidad del modelo
library(caret)
set.seed(2025)
train_control <- trainControl(
method = "cv",
number = 10,
savePredictions = TRUE
)
# Validación cruzada CART
arbol_cart_cv <- train(
DEATH_EVENT ~ .,
data = entrenamiento_arbol,
method = "rpart",
trControl = train_control,
tuneLength = 10
)
arbol_cart_cv## CART
##
## 239 samples
## 12 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 214, 215, 215, 215, 215, 215, ...
## Resampling results across tuning parameters:
##
## cp Accuracy Kappa
## 0.00000000 0.8155072 0.5845836
## 0.05624143 0.7776304 0.4847621
## 0.11248285 0.7948406 0.4966016
## 0.16872428 0.7990072 0.5043435
## 0.22496571 0.7990072 0.5043435
## 0.28120713 0.7990072 0.5043435
## 0.33744856 0.7990072 0.5043435
## 0.39368999 0.7990072 0.5043435
## 0.44993141 0.7990072 0.5043435
## 0.50617284 0.7531739 0.3533757
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.confusionMatrix(arbol_cart_cv$pred$pred, arbol_cart_cv$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 1460 373
## 1 120 437
##
## Accuracy : 0.7937
## 95% CI : (0.7769, 0.8098)
## No Information Rate : 0.6611
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5017
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.9241
## Specificity : 0.5395
## Pos Pred Value : 0.7965
## Neg Pred Value : 0.7846
## Prevalence : 0.6611
## Detection Rate : 0.6109
## Detection Prevalence : 0.7669
## Balanced Accuracy : 0.7318
##
## 'Positive' Class : 0
## # Validación cruzada C5.0
arbol_c50_cv <- train(
DEATH_EVENT ~ .,
data = entrenamiento_arbol,
method = "C5.0",
trControl = train_control,
tuneLength = 10
)
arbol_c50_cv## C5.0
##
## 239 samples
## 12 predictor
## 2 classes: '0', '1'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 216, 215, 215, 215, 215, 215, ...
## Resampling results across tuning parameters:
##
## model winnow trials Accuracy Kappa
## rules FALSE 1 0.8082319 0.5637540
## rules FALSE 10 0.8664130 0.6954898
## rules FALSE 20 0.8791087 0.7250472
## rules FALSE 30 0.8664130 0.6914997
## rules FALSE 40 0.8749420 0.7124638
## rules FALSE 50 0.8874420 0.7415364
## rules FALSE 60 0.8789420 0.7222697
## rules FALSE 70 0.8751232 0.7119961
## rules FALSE 80 0.8791087 0.7237475
## rules FALSE 90 0.8832754 0.7322152
## rules TRUE 1 0.8283841 0.6061176
## rules TRUE 10 0.8325507 0.6141945
## rules TRUE 20 0.8367174 0.6266555
## rules TRUE 30 0.8367174 0.6246491
## rules TRUE 40 0.8410652 0.6329343
## rules TRUE 50 0.8367174 0.6246491
## rules TRUE 60 0.8410652 0.6329343
## rules TRUE 70 0.8454130 0.6417029
## rules TRUE 80 0.8454130 0.6417029
## rules TRUE 90 0.8497609 0.6509040
## tree FALSE 1 0.7957319 0.5279763
## tree FALSE 10 0.8792754 0.7242370
## tree FALSE 20 0.8877899 0.7431123
## tree FALSE 30 0.8790942 0.7234901
## tree FALSE 40 0.8792754 0.7252941
## tree FALSE 50 0.8789130 0.7248688
## tree FALSE 60 0.8749275 0.7148470
## tree FALSE 70 0.8790942 0.7229143
## tree FALSE 80 0.8707609 0.7058148
## tree FALSE 90 0.8705797 0.7043679
## tree TRUE 1 0.8118986 0.5690654
## tree TRUE 10 0.8495797 0.6509287
## tree TRUE 20 0.8495797 0.6524177
## tree TRUE 30 0.8497609 0.6536996
## tree TRUE 40 0.8582754 0.6704817
## tree TRUE 50 0.8541087 0.6601994
## tree TRUE 60 0.8497609 0.6504851
## tree TRUE 70 0.8541087 0.6596862
## tree TRUE 80 0.8412464 0.6313400
## tree TRUE 90 0.8455942 0.6401085
##
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were trials = 20, model = tree and winnow
## = FALSE.confusionMatrix(arbol_c50_cv$pred$pred, arbol_c50_cv$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 5806 863
## 1 514 2377
##
## Accuracy : 0.856
## 95% CI : (0.8488, 0.8629)
## No Information Rate : 0.6611
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6699
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.9187
## Specificity : 0.7336
## Pos Pred Value : 0.8706
## Neg Pred Value : 0.8222
## Prevalence : 0.6611
## Detection Rate : 0.6073
## Detection Prevalence : 0.6976
## Balanced Accuracy : 0.8262
##
## 'Positive' Class : 0
## En este paso se aplicó validación cruzada de 10 folds para evaluar la estabilidad de los modelos de árboles de decisión. Los resultados muestran que el modelo CART alcanzó una exactitud de 81.75% y un Kappa de 0.5597, mientras que el modelo C5.0 obtuvo una mayor exactitud de 83.58% y un Kappa de 0.621, indicando un mejor desempeño general. Además, C5.0 presenta una mayor balanced accuracy (0.8027 vs. 0.7609) y mejor especificidad, lo que refleja una clasificación más equilibrada entre ambas clases. En general, ambos modelos son estables, pero C5.0 demuestra un rendimiento superior en múltiples métricas, por lo que se considera la mejor opción para este problema.
Paso 5: Interpretación de los resultados finales:
# Predicción CART - entrenamiento
pred_cart_train <- predict(modelo_cart, entrenamiento_arbol, type = "class")
tt_cart_train <- table(pred_cart_train, entrenamiento_arbol$DEATH_EVENT)
tt_cart_train##
## pred_cart_train 0 1
## 0 145 16
## 1 13 65TA_cart_train <- sum(diag(tt_cart_train)) / sum(tt_cart_train)
paste0("Tasa de aciertos de CART con los datos de entrenamiento: ",
round(TA_cart_train, 4) * 100, "%")## [1] "Tasa de aciertos de CART con los datos de entrenamiento: 87.87%"# Predicción CART - prueba
pred_cart_test <- predict(modelo_cart, prueba, type = "class")
tt_cart_test <- table(prueba_labels, pred_cart_test)
tt_cart_test## pred_cart_test
## prueba_labels 0 1
## 0 38 7
## 1 3 12TA_cart_test <- sum(diag(tt_cart_test)) / sum(tt_cart_test)
paste0("Tasa de aciertos de CART con los datos de prueba: ",
round(TA_cart_test, 4) * 100, "%")## [1] "Tasa de aciertos de CART con los datos de prueba: 83.33%"# Predicción C5.0 - entrenamiento
pred_c50_train <- predict(modelo_c50, entrenamiento, type = "class")
tt_c50_train <- table(pred_c50_train, entrenamiento_labels)
tt_c50_train## entrenamiento_labels
## pred_c50_train 0 1
## 0 152 5
## 1 6 76TA_c50_train <- sum(diag(tt_c50_train)) / sum(tt_c50_train)
paste0("Tasa de aciertos de C5.0 con los datos de entrenamiento: ",
round(TA_c50_train, 4) * 100, "%")## [1] "Tasa de aciertos de C5.0 con los datos de entrenamiento: 95.4%"# Predicción C5.0 - prueba
pred_c50_test <- predict(modelo_c50, prueba, type = "class")
tt_c50_test <- table(prueba_labels, pred_c50_test)
tt_c50_test## pred_c50_test
## prueba_labels 0 1
## 0 37 8
## 1 6 9TA_c50_test <- sum(diag(tt_c50_test)) / sum(tt_c50_test)
paste0("Tasa de aciertos de C5.0 con los datos de prueba: ",
round(TA_c50_test, 4) * 100, "%")## [1] "Tasa de aciertos de C5.0 con los datos de prueba: 76.67%"En este paso se interpretaron los resultados finales de los modelos de árboles de decisión, evaluando su desempeño tanto en los datos de entrenamiento como en los de prueba. El modelo CART obtuvo una tasa de aciertos de 87.92% en entrenamiento y 79.66% en prueba, lo que muestra una leve disminución en su capacidad de generalización. Por otro lado, el modelo C5.0 alcanzó una mayor exactitud, con 94.58% en entrenamiento y 81.36% en prueba, evidenciando un mejor rendimiento general. Además, el modelo C5.0 logra una mejor clasificación de la clase positiva (evento de muerte), ya que presenta menos errores en esa categoría en comparación con CART. En cuanto a la estructura del árbol, se observa que variables como time y serum_creatinine juegan un rol importante en la toma de decisiones del modelo, permitiendo una adecuada separación de los datos.
A pesar de estos resultados, se pueden proponer mejoras al modelo, como ajustar el parámetro de complejidad para evitar sobreajuste, realizar una poda adicional para simplificar el árbol y mejorar su interpretabilidad, o evaluar la inclusión o eliminación de variables para optimizar su desempeño. En general, el modelo C5.0 se presenta como la mejor alternativa para este problema, ya que ofrece mayor precisión y mejor capacidad de generalización en comparación con CART.
Problema 2: Calidad del Vino
Este conjunto de datos incluye variables físico-químicas de muestras de vino, con el objetivo de predecir la calidad realizada por expertos.
Paso #1: Preparación inicial y limpieza de los datos:
#Leer base de datos / vino blanco
library(readr)
winequality_white <- read_delim("winequality-white.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE)## Rows: 4898 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## dbl (12): fixed acidity, volatile acidity, citric acid, residual sugar, chlo...
##
## ℹ 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.# Leer base de datos / vino rojo
library(readr)
winequality_red <- read_delim("winequality-red.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE)## Rows: 1599 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## dbl (12): fixed acidity, volatile acidity, citric acid, residual sugar, chlo...
##
## ℹ 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.#Unir bases de datos
library(dplyr)
# Añadir una variable para identificar el tipo de vino
winequality_red$tipo <- "rojo"
winequality_white$tipo <- "blanco"
# Unir las dos bases de datos
winequality <- bind_rows(winequality_red, winequality_white)
# Convertir la variable respuesta en factor
winequality$tipo <- as.factor(winequality$tipo)
#Preparar y limpiar datos
head(winequality)## # A tibble: 6 × 13
## `fixed acidity` `volatile acidity` `citric acid` `residual sugar` chlorides
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 7.4 0.7 0 1.9 0.076
## 2 7.8 0.88 0 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.7 0 1.9 0.076
## 6 7.4 0.66 0 1.8 0.075
## # ℹ 8 more variables: `free sulfur dioxide` <dbl>,
## # `total sulfur dioxide` <dbl>, density <dbl>, pH <dbl>, sulphates <dbl>,
## # alcohol <dbl>, quality <dbl>, tipo <fct>str(winequality)## spc_tbl_ [6,497 × 13] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ fixed acidity : num [1:6497] 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
## $ volatile acidity : num [1:6497] 0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
## $ citric acid : num [1:6497] 0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
## $ residual sugar : num [1:6497] 1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
## $ chlorides : num [1:6497] 0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
## $ free sulfur dioxide : num [1:6497] 11 25 15 17 11 13 15 15 9 17 ...
## $ total sulfur dioxide: num [1:6497] 34 67 54 60 34 40 59 21 18 102 ...
## $ density : num [1:6497] 0.998 0.997 0.997 0.998 0.998 ...
## $ pH : num [1:6497] 3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
## $ sulphates : num [1:6497] 0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
## $ alcohol : num [1:6497] 9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
## $ quality : num [1:6497] 5 5 5 6 5 5 5 7 7 5 ...
## $ tipo : Factor w/ 2 levels "blanco","rojo": 2 2 2 2 2 2 2 2 2 2 ...
## - attr(*, "spec")=
## .. cols(
## .. `fixed acidity` = col_double(),
## .. `volatile acidity` = col_double(),
## .. `citric acid` = col_double(),
## .. `residual sugar` = col_double(),
## .. chlorides = col_double(),
## .. `free sulfur dioxide` = col_double(),
## .. `total sulfur dioxide` = col_double(),
## .. density = col_double(),
## .. pH = col_double(),
## .. sulphates = col_double(),
## .. alcohol = col_double(),
## .. quality = col_double()
## .. )
## - attr(*, "problems")=<externalptr>summary(winequality)## 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 tipo
## Min. :2.720 Min. :0.2200 Min. : 8.00 Min. :3.000 blanco:4898
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.50 1st Qu.:5.000 rojo :1599
## 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.000# Verificar cantidad por tipo de vino
table(winequality$tipo)##
## blanco rojo
## 4898 1599round(prop.table(table(winequality$tipo)),2)##
## blanco rojo
## 0.75 0.25# Verificar valores faltantes
colSums(is.na(winequality))## 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 0
## tipo
## 0En este paso se realizó una exploración inicial de la base de datos winequality para entender su estructura y evaluar su calidad antes de aplicar el algoritmo K-NN. Los resultados muestran que el dataset contiene 6,497 observaciones y 13 variables, donde 12 corresponden a variables físico-químicas numéricas y 1 variable categórica (tipo), la cual identifica si el vino es blanco o rojo y será utilizada como variable respuesta. A partir de summary(), table() y prop.table(), se observó que la base está compuesta por 4,898 vinos blancos y 1,599 vinos rojos, lo que representa aproximadamente un 75% y 25% del total, respectivamente. Además, mediante colSums(is.na(winequality)) se verificó que el dataset no presenta valores faltantes en ninguna de sus variables, por lo que no fue necesario realizar procesos de limpieza o imputación de datos.
En general, este paso permitió confirmar que los datos están completos y listos para ser transformados, destacando la necesidad de normalizar las variables predictoras antes de aplicar K-NN, ya que estas se encuentran en escalas distintas y el método se basa en distancias entre observaciones.
Paso #2: Dividir los datos en conjunto de entrenamiento y prueba:
#Dividir los datos en conjunto de entrenamiento y prueba
winequality_norm <- as.data.frame(lapply(winequality[, -ncol(winequality)], rescale))
winequality_norm$tipo <- winequality$tipo
set.seed(2025)
folds <- createFolds(winequality_norm$tipo, k = 5)
entrenamiento <- winequality_norm[c(folds$Fold1, folds$Fold2, folds$Fold3, folds$Fold4), ]
prueba <- winequality_norm[folds$Fold5, ]
dim(entrenamiento)[1]## [1] 5198dim(prueba)[1]## [1] 1299