Ejercicio de clase:
Yeliany Colón Rodríguez
2025-03-18
Problema 2: Calidad del vino
I. Preparación inicial y limpieza de los datos:
- Cargar base de datos y librerías
library(tidyverse)
library(caret)
library(kknn)
library(scales)
library(class)
red_wine <- read.csv("winequality-red.csv", sep = ";", header = TRUE)
white_wine <- read.csv("winequality-white.csv", sep = ";", header = TRUE)
# Unir ambas bases
wine_data <- bind_rows(red_wine, white_wine)Unimos ambas bases de datos (vino tinto y vino blanco).
- Explorar los datos
# Ver estructura de la nueva base
str(wine_data)## 'data.frame': 6497 obs. of 12 variables:
## $ fixed.acidity : num 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
## $ volatile.acidity : num 0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
## $ citric.acid : num 0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
## $ residual.sugar : num 1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
## $ chlorides : num 0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
## $ free.sulfur.dioxide : num 11 25 15 17 11 13 15 15 9 17 ...
## $ total.sulfur.dioxide: num 34 67 54 60 34 40 59 21 18 102 ...
## $ density : num 0.998 0.997 0.997 0.998 0.998 ...
## $ pH : num 3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
## $ sulphates : num 0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
## $ alcohol : num 9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
## $ quality : int 5 5 5 6 5 5 5 7 7 5 ...# Distribución de la calidad del vino
table(wine_data$quality)##
## 3 4 5 6 7 8 9
## 30 216 2138 2836 1079 193 5# Visualización de la distribución de la calidad
ggplot(wine_data, aes(x = quality)) +
geom_bar(fill = "lightblue") +
labs(title = "Distribución de calidad - Vino")
# Resumen estadístico de los datos combinados
summary(wine_data)## 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.000En el gráfico de barra podemos observar que la mayoría de los vinos tienen una calidad de 5, 6 y 7, siendo 6 la más frecuente. Las calidades extremas (3, 4 y 8) son menos comunes, lo que indica un desequilibrio en la distribución.
Por otro lado, al observar las estadísticas descriptivas, notamos que las variables tienen escalas diferentes. Dado que K-NN se basa en distancias, es importante normalizar los datos para que ninguna variable tenga más peso que otra.
- Normalizar los datos
# Normalización Min-Max
wine_data_norm <- wine_data %>% select(-quality) %>%
mutate(across(everything(), rescale))Excluimos la variable quality porque es la variable objetivo y no queremos transformarla.
II. Dividir los datos en conjunto de entrenamiento y prueba
Dividimos la muestra en dos conjuntos, uno para entrenamiento y otro para prueba. Para ello, Utilizaremos createFolds() de caret para garantizar balance de clases en ambos conjuntos.
# Dividir en conjunto de entrenamiento y prueba con un k= 6
set.seed(2025)
# Crear folds
folds <- createFolds(wine_data$quality, k = 6)
entrenamiento <- wine_data_norm[-folds[[6]], ]
prueba <- wine_data_norm[folds[[6]], ]Elegimos k = 6 para garantizar un balance adecuado entre las clases en los conjuntos de entrenamiento y prueba, dado que la distribución de calidad del vino es desigual. Esta elección permite que cada fold mantenga representatividad sin perder datos valiosos para el entrenamiento.
Por otra parte, guardamos las etiquetas de la calidad de todas las observaciones en dos vectores por separado
# Extraer etiquetas de calidad para ambos conjuntos
entrenamiento_labels <- wine_data$quality[-folds[[6]]]
prueba_labels <- wine_data$quality[folds[[6]]]III. Aplicar el algoritmo K-NN
- Ajustar modelo KNN para encontrar el mejor K
train.kknn(entrenamiento_labels ~ ., data = entrenamiento, kmax = 50)##
## Call:
## train.kknn(formula = entrenamiento_labels ~ ., data = entrenamiento, kmax = 50)
##
## Type of response variable: continuous
## minimal mean absolute error: 0.4298116
## Minimal mean squared error: 0.4446715
## Best kernel: optimal
## Best k: 11Encontramos que el valor óptimo de k = 11. Entonces la predicción, sería:
- Aplicar KNN con el mejor K encontrado y evaluar la matriz de confusión
pred <- knn(train = entrenamiento, test = prueba, cl = entrenamiento_labels, k = 11)
prueba_labels <- factor(prueba_labels, levels = levels(pred))
# Evaluar el modelo con matriz de confusión
confusionMatrix(data = pred, reference = prueba_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 1 0 0 0 0 0 0
## 5 4 19 219 104 9 1 0
## 6 5 15 125 304 87 12 1
## 7 0 1 8 60 85 13 1
## 8 0 0 0 5 3 1 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5623
## 95% CI : (0.5322, 0.5921)
## No Information Rate : 0.4367
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.3216
##
## 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.0000000 0.6222 0.6427 0.46196 0.0370370
## Specificity 1.000000 0.9990458 0.8126 0.5984 0.90768 0.9924242
## Pos Pred Value NaN 0.0000000 0.6152 0.5537 0.50595 0.1111111
## Neg Pred Value 0.990766 0.9676525 0.8171 0.6835 0.89180 0.9757914
## Prevalence 0.009234 0.0323176 0.3250 0.4367 0.16990 0.0249307
## Detection Rate 0.000000 0.0000000 0.2022 0.2807 0.07849 0.0009234
## Detection Prevalence 0.000000 0.0009234 0.3287 0.5069 0.15512 0.0083102
## Balanced Accuracy 0.500000 0.4995229 0.7174 0.6205 0.68482 0.5147306
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998153
## Prevalence 0.001847
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000Con este modelo hemos obtenido una exactitud de 56% a la hora de acertar en una predicción.
Probemos ahora con reescalando los valores con la función scale().
# Normalizar los datos utilizando la función scale()
wine_data_z <- as.data.frame(scale(wine_data %>% select(-quality)))
# Dividir los datos normalizados en conjunto de entrenamiento y prueba
entrenamiento_z <- wine_data_z[-folds[[6]], ]
prueba_z <- wine_data_z[folds[[6]], ]
# Aplicar el modelo K-NN con k=11 sobre los datos estandarizados
pred_z <- knn(train = entrenamiento_z, test = prueba_z, cl = entrenamiento_labels, k = 11)
# Evaluar el modelo con la matriz de confusión
confusionMatrix(data = pred_z, reference = prueba_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 1 1 0 1 0 0 0
## 5 5 18 215 105 9 0 0
## 6 4 15 129 302 81 13 1
## 7 0 1 8 62 89 12 1
## 8 0 0 0 3 5 2 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5623
## 95% CI : (0.5322, 0.5921)
## No Information Rate : 0.4367
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.3237
##
## 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.0285714 0.6108 0.6385 0.48370 0.074074
## Specificity 1.000000 0.9980916 0.8126 0.6016 0.90656 0.992424
## Pos Pred Value NaN 0.3333333 0.6108 0.5541 0.51445 0.200000
## Neg Pred Value 0.990766 0.9685185 0.8126 0.6822 0.89560 0.976701
## Prevalence 0.009234 0.0323176 0.3250 0.4367 0.16990 0.024931
## Detection Rate 0.000000 0.0009234 0.1985 0.2789 0.08218 0.001847
## Detection Prevalence 0.000000 0.0027701 0.3250 0.5032 0.15974 0.009234
## Balanced Accuracy 0.500000 0.5133315 0.7117 0.6201 0.69513 0.533249
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998153
## Prevalence 0.001847
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000En este caso, podemos ver que nuestra exactitud se quedó practicamente en 56%, por lo que no hemos conseguido mejorarla con respecto a la normalización min-max.
IV. Validar la estabilidad del modelo
Aplicaremos la validación cruzada para validar la estabilidad del modelo.
# Guardar la exactitud de cada fold
exactitud <- numeric(length = 6)
# Validación cruzada
for(i in 1:6) {
# Definir conjuntos de entrenamiento y prueba según el fold actual
prueba <- wine_data_z[folds[[i]], ]
entrenamiento <- wine_data_z[-folds[[i]], ]
# Etiquetas
entrenamiento_labels <- wine_data$quality[-folds[[i]]]
prueba_labels <- wine_data$quality[folds[[i]]]
# Aplicar KNN con k = 11
pred_knn <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 11)
# Asegurar que las etiquetas tengan los mismos niveles
prueba_labels <- factor(prueba_labels, levels = levels(pred_knn))
# Evaluar exactitud con matriz de confusión
cm <- confusionMatrix(pred_knn, prueba_labels)
exactitud[i] <- cm$overall["Accuracy"]
# Mostrar resultado de cada fold
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.5406654
## Fold 2 - Exactitud: 0.5571956
## Fold 3 - Exactitud: 0.5281625
## Fold 4 - Exactitud: 0.5207756
## Fold 5 - Exactitud: 0.5702403
## Fold 6 - Exactitud: 0.5660203# Exactitud promedio de validación cruzada
Exactitud_promedio <- round(mean(exactitud),4)*100
paste("Exactitud_promedio: ",Exactitud_promedio,"%",sep="")## [1] "Exactitud_promedio: 54.72%"A partir de los resultados de validación cruzada, podemos concluir que el modelo K-NN tiene una precisión promedio de 54%, lo que indica que su capacidad de clasificación es limitada. Este nivel de exactitud sugiere que el modelo no está realizando una buena diferenciación entre las clases.
V. Interpretación de los resultados finales
A continuación haremos la validación cruzada de forma más automatica y tomando más folds.
set.seed(2025)
# Definir validación cruzada con 10 folds
train_control <- trainControl(method = "cv", number = 10, savePredictions = TRUE)
# Entrenar modelo KNN con validación cruzada
knn_cv <- train(quality ~ .,
data = cbind(prueba, quality = prueba_labels),
method = "knn",
trControl = train_control,
tuneGrid = data.frame(k = 11))
# Mostrar resultados de validación cruzada
knn_cv## k-Nearest Neighbors
##
## 1083 samples
## 11 predictor
## 7 classes: '3', '4', '5', '6', '7', '8', '9'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 976, 974, 976, 975, 975, 975, ...
## Resampling results:
##
## Accuracy Kappa
## 0.5033738 0.2210625
##
## Tuning parameter 'k' was held constant at a value of 11# Matriz de confusión usando predicciones guardadas por caret
confusionMatrix(knn_cv$pred$pred, knn_cv$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 2 0 0 0 0
## 5 5 25 216 122 12 1 0
## 6 5 10 126 282 124 13 1
## 7 0 0 8 69 47 13 1
## 8 0 0 0 0 1 0 0
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.5032
## 95% CI : (0.473, 0.5334)
## No Information Rate : 0.4367
## P-Value [Acc > NIR] : 6.406e-06
##
## Kappa : 0.221
##
## 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.000000 0.6136 0.5962 0.2554 0.0000000
## Specificity 1.000000 0.998092 0.7743 0.5426 0.8988 0.9990530
## Pos Pred Value NaN 0.000000 0.5669 0.5027 0.3406 0.0000000
## Neg Pred Value 0.990766 0.967623 0.8063 0.6341 0.8550 0.9750462
## Prevalence 0.009234 0.032318 0.3250 0.4367 0.1699 0.0249307
## Detection Rate 0.000000 0.000000 0.1994 0.2604 0.0434 0.0000000
## Detection Prevalence 0.000000 0.001847 0.3518 0.5180 0.1274 0.0009234
## Balanced Accuracy 0.500000 0.499046 0.6940 0.5694 0.5771 0.4995265
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.998153
## Prevalence 0.001847
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000El modelo K-NN con k = 11 y validación cruzada de 10 folds obtuvo una precisión promedio del 50.34% lo que indica un desempeño bajo en la clasificación de la calidad del vino.