Pedro Lorenzi

Paso 1

Librerías necesarias

library(class)
library(ggplot2)
library(caret)
library(kknn)
library(forcats)
library(dplyr)

Leer los datos de vino blanco

data1 <- read.csv("winequality-white.csv", sep = ";")
data2 <- read.csv("winequality-red.csv", sep = ";")
# Unir por más de una variable:
data1$tipo <- "blanco"
data2$tipo <- "tinto"
data <- rbind(data1, data2)

Ver los primeros registros

head(data)
##   fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1           7.0             0.27        0.36           20.7     0.045
## 2           6.3             0.30        0.34            1.6     0.049
## 3           8.1             0.28        0.40            6.9     0.050
## 4           7.2             0.23        0.32            8.5     0.058
## 5           7.2             0.23        0.32            8.5     0.058
## 6           8.1             0.28        0.40            6.9     0.050
##   free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
## 1                  45                  170  1.0010 3.00      0.45     8.8
## 2                  14                  132  0.9940 3.30      0.49     9.5
## 3                  30                   97  0.9951 3.26      0.44    10.1
## 4                  47                  186  0.9956 3.19      0.40     9.9
## 5                  47                  186  0.9956 3.19      0.40     9.9
## 6                  30                   97  0.9951 3.26      0.44    10.1
##   quality   tipo
## 1       6 blanco
## 2       6 blanco
## 3       6 blanco
## 4       6 blanco
## 5       6 blanco
## 6       6 blanco

Agrupamos calidades en Baja, Media y Alta

data <- mutate(data, quality = fct_recode(factor(data$quality),
                                          "Baja"   = "3",
                                          "Baja"   = "4",
                                          "Media"  = "5",
                                          "Media"  = "6",
                                          "Alta"   = "7",
                                          "Alta"   = "8",
                                          "Alta"   = "9"))

Exploramos la calidad de los vinos: Baja es 3 o 4, media es 5 o 5 y alta es 7-9

table(data$quality)
## 
##  Baja Media  Alta 
##   246  4974  1277
round(prop.table(table(data$quality)),2)
## 
##  Baja Media  Alta 
##  0.04  0.77  0.20

Al revisar la proporción de cada categoría de calidad, observamos que la mayoría de los vinos se encuentran en la categoría ‘Media’, mientras que las categorías ‘Baja’ y ‘Alta’ tienen menos representaciones. Este desbalance en las clases es importante para el modelo de clasificación, ya que podría sesgar las predicciones hacia la clase más frecuente. Además, notamos que las variables físico-químicas originales presentan escalas muy distintas, lo que puede afectar negativamente al algoritmo K-NN al darle mayor peso a las variables con magnitudes más grandes.

Normalización min-max

normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x)))
}

Normalizar solo predictores

data_norm <- as.data.frame(lapply(data[, -c(12, 13)], normalize))
data_norm$quality <- data$quality

Paso 2

División con createFolds()

set.seed(2025)
folds <- createFolds(data$quality, k = 6)
# Entrenamiento y prueba
entrenamiento <- data_norm[-folds[[6]], ]
prueba        <- data_norm[folds[[6]], ]

# Etiquetas
entrenamiento_labels <- data$quality[-folds[[6]]]
prueba_labels        <- data$quality[folds[[6]]]

Guardamos las etiquetas de la calidad de todas las observaciones en dos vectores por separado.

Paso 3

Ajuste automático de k (tuning con train.kknn)

modelo_k <- train.kknn(quality ~ ., data = entrenamiento, kmax = 50)
modelo_k
## 
## Call:
## train.kknn(formula = quality ~ ., data = entrenamiento, kmax = 50)
## 
## Type of response variable: nominal
## Minimal misclassification: 0.1834134
## Best kernel: optimal
## Best k: 12

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

K-NN con k=12 después de tuning

pred <- knn(entrenamiento[,-12], prueba[,-12], cl = entrenamiento$quality, k = 12)

Asegurar niveles correctos

prueba_labels <- factor(prueba$quality, levels = levels(pred))

Matriz de confusión

confusionMatrix(data = pred, reference = prueba_labels)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Baja Media Alta
##      Baja     0     0    0
##      Media   40   753  116
##      Alta     1    76   97
## 
## Overall Statistics
##                                          
##                Accuracy : 0.7849         
##                  95% CI : (0.7592, 0.809)
##     No Information Rate : 0.7655         
##     P-Value [Acc > NIR] : 0.06971        
##                                          
##                   Kappa : 0.3399         
##                                          
##  Mcnemar's Test P-Value : 1.108e-10      
## 
## Statistics by Class:
## 
##                      Class: Baja Class: Media Class: Alta
## Sensitivity              0.00000       0.9083     0.45540
## Specificity              1.00000       0.3858     0.91149
## Pos Pred Value               NaN       0.8284     0.55747
## Neg Pred Value           0.96214       0.5632     0.87239
## Prevalence               0.03786       0.7655     0.19668
## Detection Rate           0.00000       0.6953     0.08957
## Detection Prevalence     0.00000       0.8393     0.16066
## Balanced Accuracy        0.50000       0.6471     0.68345

Con este modelo hemos obtenido una exactitud del 78.49%

Estandarización Z-Score (scale)

data_z <- as.data.frame(scale(data[, -c(12, 13)]))
data_z$quality <- data$quality

set.seed(2025)
folds <- createFolds(data$quality, k = 6)

Dividir datos

entrenamiento_z <- data_z[-folds[[6]], -12]
prueba_z        <- data_z[folds[[6]], -12]

Crear etiquetas

entrenamiento_labelsZ <- data_z[-folds[[6]], 12]
prueba_labelsZ        <- factor(data_z[folds[[6]], 12])

K-NN con k=12 para el caso estandarizado

pred_z <- knn(entrenamiento_z, prueba_z, cl = entrenamiento_labelsZ, k = 12)

Matriz de confusión

confusionMatrix(data = pred_z, reference = prueba_labelsZ)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Baja Media Alta
##      Baja     0     0    0
##      Media   41   774  118
##      Alta     0    55   95
## 
## Overall Statistics
##                                           
##                Accuracy : 0.8024          
##                  95% CI : (0.7774, 0.8257)
##     No Information Rate : 0.7655          
##     P-Value [Acc > NIR] : 0.001979        
##                                           
##                   Kappa : 0.3693          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: Baja Class: Media Class: Alta
## Sensitivity              0.00000       0.9337     0.44601
## Specificity              1.00000       0.3740     0.93678
## Pos Pred Value               NaN       0.8296     0.63333
## Neg Pred Value           0.96214       0.6333     0.87353
## Prevalence               0.03786       0.7655     0.19668
## Detection Rate           0.00000       0.7147     0.08772
## Detection Prevalence     0.00000       0.8615     0.13850
## Balanced Accuracy        0.50000       0.6538     0.69140

En este caso podemos ver que nuestra exactitud aumento a aproximadamente 80.24%, por lo que conseguimos mejorarla con respecto a la normalización min-max.

Gráfico de barras agrupadas por tipo y calidad

ggplot(data, aes(x = quality, fill = tipo)) +
  geom_bar(position = "dodge") +
  labs(
    title = "Distribución de la Calidad según Tipo de Vino",
    x = "Categoría de Calidad (Baja, Media, Alta)",
    y = "Frecuencia",
    fill = "Tipo de Vino"
  ) +
  theme_minimal()

Paso 4

Guardar la exactitud de cada fold

exactitud <- numeric(length = 6)

for(i in 1:6){
# Dividir datos según el fold actual
  prueba        <- data_norm[folds[[i]], ]
  entrenamiento <- data_norm[-folds[[i]], ]
  
# Etiquetas (recuerda que ya recodificamos 'quality' como Baja, Media, Alta)
  entrenamiento_labels <- data$quality[-folds[[i]]]
  prueba_labels        <- data$quality[folds[[i]]]
  
#Ajuste automático de k dentro del fold con train.kknn()
  modelo_fold <- train.kknn(quality ~ ., data = entrenamiento, kmax = 50)
  modelo_fold
  
# K-NN con k=12 
pred_knn <- knn(entrenamiento[,-12], prueba[,-12], cl = entrenamiento_labels, k = 12)
  
# Evaluar exactitud del modelo en cada fold
cm <- confusionMatrix(pred_knn, factor(prueba_labels, levels = levels(pred_knn)))
exactitud[i] <- cm$overall["Accuracy"]
  
# Mostrar resultado del fold
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}
## Fold 1 - Exactitud: 0.7867036 
## Fold 2 - Exactitud: 0.7793167 
## Fold 3 - Exactitud: 0.8068392 
## Fold 4 - Exactitud: 0.800554 
## Fold 5 - Exactitud: 0.7857802 
## Fold 6 - Exactitud: 0.7894737

Resultado final: promedio de exactitud

cat("Exactitud promedio:", mean(exactitud), "\n")
## Exactitud promedio: 0.7914446
set.seed(2025)

# Definimos control para validación cruzada 10-fold
train_control <- trainControl(method = "cv", number = 10, savePredictions = TRUE)

# Aplicamos train() con K-NN y k=12
knn_cv <- train(quality ~ ., 
                data = data_norm, 
                method = "knn", 
                trControl = train_control, 
                tuneGrid = data.frame(k = 12))

# Resultados de la validación cruzada
knn_cv
## k-Nearest Neighbors 
## 
## 6497 samples
##   11 predictor
##    3 classes: 'Baja', 'Media', 'Alta' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 5847, 5849, 5846, 5846, 5848, 5846, ... 
## Resampling results:
## 
##   Accuracy   Kappa    
##   0.7923743  0.3632386
## 
## Tuning parameter 'k' was held constant at a value of 12

Matriz de confusión con las predicciones guardadas por caret

confusionMatrix(knn_cv$pred$pred, factor(knn_cv$pred$obs, levels = levels(knn_cv$pred$pred)))
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Baja Media Alta
##      Baja     6     2    0
##      Media  233  4540  675
##      Alta     7   432  602
## 
## Overall Statistics
##                                           
##                Accuracy : 0.7924          
##                  95% CI : (0.7823, 0.8022)
##     No Information Rate : 0.7656          
##     P-Value [Acc > NIR] : 1.306e-07       
##                                           
##                   Kappa : 0.364           
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
## 
## Statistics by Class:
## 
##                      Class: Baja Class: Media Class: Alta
## Sensitivity            0.0243902       0.9127     0.47142
## Specificity            0.9996801       0.4038     0.91590
## Pos Pred Value         0.7500000       0.8333     0.57829
## Neg Pred Value         0.9630143       0.5863     0.87628
## Prevalence             0.0378636       0.7656     0.19655
## Detection Rate         0.0009235       0.6988     0.09266
## Detection Prevalence   0.0012313       0.8385     0.16023
## Balanced Accuracy      0.5120351       0.6583     0.69366

Podemos concluir que la tasa de aciertos es aproximadamente 79.62% y es bastante consistente. Es decir, aunque se muevan un poco los parámetros la tasa se mantienes constante.