library(class)
library(ggplot2)
library(caret)
library(kknn)
library(forcats)
library(dplyr)
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)
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
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.
normalize <- function(x) {
return ((x - min(x)) / (max(x) - min(x)))
}
data_norm <- as.data.frame(lapply(data[, -c(12, 13)], normalize))
data_norm$quality <- data$quality
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.
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:
pred <- knn(entrenamiento[,-12], prueba[,-12], cl = entrenamiento$quality, k = 12)
prueba_labels <- factor(prueba$quality, levels = levels(pred))
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%
data_z <- as.data.frame(scale(data[, -c(12, 13)]))
data_z$quality <- data$quality
set.seed(2025)
folds <- createFolds(data$quality, k = 6)
entrenamiento_z <- data_z[-folds[[6]], -12]
prueba_z <- data_z[folds[[6]], -12]
entrenamiento_labelsZ <- data_z[-folds[[6]], 12]
prueba_labelsZ <- factor(data_z[folds[[6]], 12])
pred_z <- knn(entrenamiento_z, prueba_z, cl = entrenamiento_labelsZ, k = 12)
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.
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()
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
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
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.