Problema 2: Calidad del vino

I. Preparación inicial y limpieza de los datos:

  1. 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).

  1. 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.000

En 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.

  1. 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

  1. 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: 11

Encontramos que el valor óptimo de k = 11. Entonces la predicción, sería:

  1. 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.500000

Con 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.500000

En 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.500000

El 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.