A continuación estaremos trabajando con dos conjuntos de bases de datos reales obtenidos de el Repositorio de Machine Learning de la UCI. En estas bases de datos estaremos aplicando el método KNN. Más adelante indagaremos en lo que contiene cada uno de estas bases de datos, por ahora descargamos todas las librerías para comenzar con la primera.
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ purrr 1.2.1
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:kknn':
##
## contr.dummy
##
## The following object is masked from 'package:purrr':
##
## lift##
## Attaching package: 'scales'
##
## The following object is masked from 'package:purrr':
##
## discard
##
## The following object is masked from 'package:readr':
##
## col_factorEste primer conjunto de datos contiene información clínica de pacientes, el objetivo en este estudio es predecir la mortalidad por insuficiencia cardíaca.
Comenzamos descargando, explorando y normalizando los datos para evitar posibles problemas y sesgos:
## Rows: 299 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (13): age, anaemia, creatinine_phosphokinase, diabetes, ejection_fractio...
##
## ℹ 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.heart <- heart %>%
mutate(
across(c(anaemia, diabetes, high_blood_pressure, sex, smoking, DEATH_EVENT), as.factor)
) %>%
mutate(
DEATH_EVENT = recode(DEATH_EVENT,
"0" = "muerto",
"1" = "vivo")
)
heart_log <- heart %>% mutate(platelets = log(platelets))
heart_norm <- heart_log %>% select(
age, creatinine_phosphokinase, ejection_fraction, platelets, serum_creatinine, serum_sodium, time
)%>% mutate(across(everything(), rescale))Divide el conjunto total en dos de forma aleatoria. Uno conjunto de entrenamiento para ajustar el modelo y otro conjunto de prueba que no lo usaremos en la construcción del modelo pero nos va a servir para evaluar su desempeño.
set.seed(2004)
folds <- createFolds(heart$DEATH_EVENT, k = 5)
entrenamiento <- heart_norm[-folds$Fold5,]
prueba <- heart_norm[folds$Fold5,]
dim(entrenamiento)[1]## [1] 240## [1] 59entrenamiento_log <- heart_log$DEATH_EVENT[-folds[[5]]]
prueba_log <- heart_log$DEATH_EVENT[folds[[5]]]Observación: Al dividir el conjunto total en dos subconjuntos utilizando “createFolds”. El conjunto de entrenamiento quedó compuesto por 240 observaciones, y se utilizará para ajustar el modelo. Por otro lado, el conjunto de prueba quedó compuesto por 59 observaciones, y servirá para evaluar el desempeño del modelo con datos no utilizados en el entrenamiento.
Se encontró que el valor óptimo de vecinos es k= 18
##
## Call:
## train.kknn(formula = entrenamiento_log ~ ., data = entrenamiento, kmax = 75)
##
## Type of response variable: nominal
## Minimal misclassification: 0.2166667
## Best kernel: optimal
## Best k: 18prediccion <- knn(entrenamiento, prueba, cl = entrenamiento_log, k = 18)
confusionMatrix(data = prediccion, reference = prueba_log)## Confusion Matrix and Statistics
##
## Reference
## Prediction muerto vivo
## muerto 40 10
## vivo 0 9
##
## Accuracy : 0.8305
## 95% CI : (0.7103, 0.9156)
## No Information Rate : 0.678
## P-Value [Acc > NIR] : 0.006651
##
## Kappa : 0.5496
##
## Mcnemar's Test P-Value : 0.004427
##
## Sensitivity : 1.0000
## Specificity : 0.4737
## Pos Pred Value : 0.8000
## Neg Pred Value : 1.0000
## Prevalence : 0.6780
## Detection Rate : 0.6780
## Detection Prevalence : 0.8475
## Balanced Accuracy : 0.7368
##
## 'Positive' Class : muerto
## Observación: El modelo está más inclinado a identificar correctamente los casos de muerto que los de vivo. Esto se observa en la sensibilidad perfecta (1.00) y en una especificidad más baja (0.4737).
exactitud <- numeric(length = 5)
for(i in 1:5){
# Definir conjuntos entrenamiento y prueba según el fold actual
prueba <- heart_norm[folds[[i]],]
entrenamiento <- heart_norm[-folds[[i]],]
# Labels
e_labels <- heart_log$DEATH_EVENT[-folds[[i]]]
p_labels <- heart_log$DEATH_EVENT[folds[[i]]]
e_labels <- as.factor(e_labels)
p_labels <- as.factor(p_labels)
pred_knn <- knn(entrenamiento, prueba, cl= e_labels, k = 19)
# Evaluar exactitud del modelo en cada fold
cm <- confusionMatrix(pred_knn, p_labels)
exactitud[i] <- cm$overall["Accuracy"]
# Mostrar resultado del fold
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.8474576
## Fold 2 - Exactitud: 0.7166667
## Fold 3 - Exactitud: 0.8196721
## Fold 4 - Exactitud: 0.8166667
## Fold 5 - Exactitud: 0.8474576## [1] 0.8095841Observación: En la validación cruzada, el modelo obtuvo exactitudes entre 0.7167 y 0.8475, con un promedio de 0.8096. Esto indica que el modelo tiene un desempeño bueno y una estabilidad razonable entre particiones.
set.seed(2004)
train_control <- trainControl(method="cv",number=10,savePredictions = TRUE)
knn_cv <- train(DEATH_EVENT ~ ., data=cbind(prueba, DEATH_EVENT=p_labels),
method = "knn", trControl = train_control, tuneGrid = data.frame(k=19))
knn_cv## k-Nearest Neighbors
##
## 59 samples
## 7 predictor
## 2 classes: 'muerto', 'vivo'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 53, 54, 53, 53, 53, 53, ...
## Resampling results:
##
## Accuracy Kappa
## 0.7633333 0.2857143
##
## Tuning parameter 'k' was held constant at a value of 19En conclusión, el modelo K-NN alcanzó una exactitud de 76.33%, lo que indica un desempeño aceptable en la clasificación. No obstante, el valor de Kappa = 0.2857 muestra que la concordancia del modelo es moderada-baja, por lo que sus resultados deben interpretarse con cuidad. Pero en general, el modelo funciona de manera razonable.
Este conjunto de datos incluye variables físico-químicas de muestras de vino, el objetivo es predecir la calidad realizada por expertos.
## 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.## 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.Al descargar las dos bases de datos hemos identificado que ambas tienen unas variables de “Id” para identificar el tipo de vino, así que vamos a estar nombrando cada vino por su tipo para poder organizar la base de datos:
## [1] 6497 13## 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 : chr [1:6497] "rojo" "rojo" "rojo" "rojo" ...
## - 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>winequality$quality <- as.factor(winequality$quality)
winequality$tipo <- as.factor(winequality$tipo)Solo para corroborar vamos a estar viendo la distribución de ambas varibles:
Quality:
##
## 3 4 5 6 7 8 9
## 30 216 2138 2836 1079 193 5##
## 3 4 5 6 7 8 9
## 0.00 0.03 0.33 0.44 0.17 0.03 0.00Tipo:
##
## blanco rojo
## 4898 1599##
## blanco rojo
## 0.75 0.25Decidimos utilizar el metodo de Normalización en las variables predictoras porque hay muchas porque al ver los datos se ve que hay diferencias de escalas entre las variables y con el KNN la distancia entre las observaciones así que para evitar sesgos.
winequality_norm <- winequality[,1:11]
winequality_norm <- as.data.frame(lapply(winequality_norm, rescale))
head(winequality_norm)Se utilizó “createFolds” para dividir la base de datos en conjuntos de entrenamiento y prueba, manteniendo el balance de la variable quality. Esta partición permite ajustar el modelo para evaluar su desempeño con observaciones no utilizadas en el entrenamiento.
folds <- createFolds(winequality$quality, k = 5)
entrenamiento <- winequality_norm[-folds[[5]], ]
prueba <- winequality_norm[folds[[5]], ]
entrenamiento_labels <- winequality$quality[-folds[[5]]]
prueba_labels <- winequality$quality[folds[[5]]]
dim(entrenamiento)[1]## [1] 5198## [1] 1299Aquí estaremos ajustando el modelo K-NN usando el conjunto de entrenamiento, vamos a utilizar la función train.kknnya que esta permite evaluar distintos valores de y seleccionar automáticamente el número de vecinos que minimiza el error de clasificación:
library(kknn)
modelo <- train.kknn(entrenamiento_labels ~ .,
data = cbind(entrenamiento, entrenamiento_labels),
kmax = 20)
modelo##
## Call:
## train.kknn(formula = entrenamiento_labels ~ ., data = cbind(entrenamiento, entrenamiento_labels), kmax = 20)
##
## Type of response variable: nominal
## Minimal misclassification: 0.3778376
## Best kernel: optimal
## Best k: 1Se encontró que el valor óptimo de vecinos es k=1
library(class)
pred <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 1)
library(caret)
confusionMatrix(data = pred, reference = prueba_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 0 0 1 0 0 0 0
## 4 1 9 10 6 0 0 0
## 5 2 17 293 93 10 1 0
## 6 3 17 105 394 58 11 1
## 7 0 0 18 66 138 11 0
## 8 0 0 0 7 10 16 0
## 9 0 0 0 1 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.6543
## 95% CI : (0.6278, 0.6802)
## No Information Rate : 0.4365
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4807
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 0.0000000 0.209302 0.6862 0.6949 0.6389 0.41026
## Specificity 0.9992266 0.986465 0.8589 0.7336 0.9123 0.98651
## Pos Pred Value 0.0000000 0.346154 0.7043 0.6689 0.5923 0.48485
## Neg Pred Value 0.9953775 0.973291 0.8482 0.7563 0.9268 0.98183
## Prevalence 0.0046189 0.033102 0.3287 0.4365 0.1663 0.03002
## Detection Rate 0.0000000 0.006928 0.2256 0.3033 0.1062 0.01232
## Detection Prevalence 0.0007698 0.020015 0.3202 0.4534 0.1794 0.02540
## Balanced Accuracy 0.4996133 0.597884 0.7726 0.7142 0.7756 0.69838
## Class: 9
## Sensitivity 0.0000000
## Specificity 0.9992296
## Pos Pred Value 0.0000000
## Neg Pred Value 0.9992296
## Prevalence 0.0007698
## Detection Rate 0.0000000
## Detection Prevalence 0.0007698
## Balanced Accuracy 0.4996148El modelo obtuvo una exactitud de 65.43% y un Kappa de 0.4807, lo que indica un desempeño moderado. La matriz de confusión muestra que las clases 5, 6 y 7 fueron las mejor clasificadas, mientras que las clases extremas 3 y 9 no fueron identificadas correctamente, probablemente debido a su baja frecuencia en la base de datos.
Para Validar la estabilidad del modelo se aplicó una validación cruzada de 5 folds. Este procedimiento permite verificar si el desempeño del modelo se mantiene relativamente constante al cambiar la partición de los datos, evitando que los resultados dependan de una sola división entrenamiento-prueba.
exactitud <- numeric(length = 5)
for(i in 1:5){
prueba <- winequality_norm[folds[[i]], ]
entrenamiento <- winequality_norm[-folds[[i]], ]
entrenamiento_labels <- winequality$quality[-folds[[i]]]
prueba_labels <- winequality$quality[folds[[i]]]
pred <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 1)
cm <- confusionMatrix(pred, prueba_labels)
exactitud[i] <- cm$overall["Accuracy"]
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.6315385
## Fold 2 - Exactitud: 0.6386749
## Fold 3 - Exactitud: 0.6096998
## Fold 4 - Exactitud: 0.6456572
## Fold 5 - Exactitud: 0.6543495Las exactitudes obtenidas en los 5 folds fueron 0.6315, 0.6387, 0.6097, 0.6457 y 0.6543. Se observa que los valores son relativamente cercanos entre sí, lo que indica que el desempeño del modelo no cambia drásticamente de una partición a otra.
Exactitud Promedio
Exactitud_promedio <- round(mean(exactitud), 4) * 100
paste("Exactitud promedio:", Exactitud_promedio, "%", sep = "")## [1] "Exactitud promedio:63.6%"Mediante validación cruzada de 5 folds se obtuvo una exactitud promedio de 63.6%. Las exactitudes de cada fold fueron similares, lo que sugiere que el modelo K-NN es relativamente estable, aunque su capacidad predictiva sigue siendo moderada.
## Accuracy
## 65.43## [1] 63.6El modelo K-NN obtuvo una exactitud de 65.43% en el conjunto de prueba. Además, la validación cruzada de 5 folds produjo una exactitud promedio de 63.6%, lo que puede indicar que el modelo presenta un desempeño medio y relativamente estable. La matriz de confusión muestra que las categorías intermedias de calidad, especialmente 5, 6 y 7, son clasificadas mejor que las categorías extremas 3 y 9, las cuales tienen muy pocas observaciones.