KNN_Exercise
Isabela Puga, Anna Gonzalez
2026-03-15
Problema 1: Historiales clínicos de insuficiencia cardíaca.
glimpse(datos)## Rows: 299
## Columns: 13
## $ age <dbl> 75, 55, 65, 50, 65, 90, 75, 60, 65, 80, 75, 6…
## $ anaemia <dbl> 0, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, …
## $ creatinine_phosphokinase <dbl> 582, 7861, 146, 111, 160, 47, 246, 315, 157, …
## $ diabetes <dbl> 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ ejection_fraction <dbl> 20, 38, 20, 20, 20, 40, 15, 60, 65, 35, 38, 2…
## $ high_blood_pressure <dbl> 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, …
## $ platelets <dbl> 265000, 263358, 162000, 210000, 327000, 20400…
## $ serum_creatinine <dbl> 1.90, 1.10, 1.30, 1.90, 2.70, 2.10, 1.20, 1.1…
## $ serum_sodium <dbl> 130, 136, 129, 137, 116, 132, 137, 131, 138, …
## $ sex <dbl> 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, …
## $ smoking <dbl> 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, …
## $ time <dbl> 4, 6, 7, 7, 8, 8, 10, 10, 10, 10, 10, 10, 11,…
## $ DEATH_EVENT <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, …boxplot(datos)
datos <- datos %>% mutate(across(c(anaemia, diabetes, high_blood_pressure, sex, smoking, DEATH_EVENT), as.factor)) %>% mutate(across(c(age, ejection_fraction, time), as.numeric))
datos <- datos %>% mutate(DEATH_EVENT = recode(DEATH_EVENT, "1" = "death", "0" = "alive"))
datos_lg <- datos %>% mutate(platelets = log(platelets))
boxplot(datos_lg)
table(datos_lg$DEATH_EVENT)##
## alive death
## 203 96datos_mm <- datos_lg %>% select(age, creatinine_phosphokinase, ejection_fraction, platelets, serum_creatinine, serum_sodium, time ) %>% mutate(across(everything(), rescale))Los datos fueron primero fueron transformados a variables númericas y variables categóricas y luego se procedió a sacar el el logaritmo de la varibale “platelets”, puesto que, presentaba una cantidad significante de “outliers”.
Para este conjunto de datos, la mejor forma de reescalar los datos son estandarizando con min-max
Entrenamiento y predicción del modelo utilizando Knn
set.seed(2499)
folds <- createFolds(datos_lg$DEATH_EVENT, k = 5)
entrenamiento <- datos_mm[-folds[[5]],]
prueba <- datos_mm[folds[[5]],]
entrenamiento_mk <- datos_lg$DEATH_EVENT[-folds[[5]]]
prueba_mk <- datos_lg$DEATH_EVENT[folds[[5]]]
train.kknn(entrenamiento_mk ~ ., data = entrenamiento, kmax = 30)##
## Call:
## train.kknn(formula = entrenamiento_mk ~ ., data = entrenamiento, kmax = 30)
##
## Type of response variable: nominal
## Minimal misclassification: 0.2291667
## Best kernel: optimal
## Best k: 7pred <- knn(entrenamiento,prueba, cl = entrenamiento_mk, k = 7)
confusionMatrix(data = pred, reference = prueba_mk)## Confusion Matrix and Statistics
##
## Reference
## Prediction alive death
## alive 39 6
## death 1 13
##
## Accuracy : 0.8814
## 95% CI : (0.7707, 0.9509)
## No Information Rate : 0.678
## P-Value [Acc > NIR] : 0.0002779
##
## Kappa : 0.7081
##
## Mcnemar's Test P-Value : 0.1305700
##
## Sensitivity : 0.9750
## Specificity : 0.6842
## Pos Pred Value : 0.8667
## Neg Pred Value : 0.9286
## Prevalence : 0.6780
## Detection Rate : 0.6610
## Detection Prevalence : 0.7627
## Balanced Accuracy : 0.8296
##
## 'Positive' Class : alive
## datos_esta <- as.data.frame(scale(datos_lg[,c("age", "creatinine_phosphokinase", "ejection_fraction", "platelets", "serum_creatinine", "serum_sodium", "time")]))
entrenamiento_esta <- datos_esta[-folds[[5]],]
prueba_esta <- datos_esta[folds[[5]],]
pred_esta <- knn(entrenamiento_esta, prueba_esta, cl = entrenamiento_mk, k = 7)
confusionMatrix(data = pred_esta, reference = prueba_mk)## Confusion Matrix and Statistics
##
## Reference
## Prediction alive death
## alive 38 5
## death 2 14
##
## Accuracy : 0.8814
## 95% CI : (0.7707, 0.9509)
## No Information Rate : 0.678
## P-Value [Acc > NIR] : 0.0002779
##
## Kappa : 0.7165
##
## Mcnemar's Test P-Value : 0.4496918
##
## Sensitivity : 0.9500
## Specificity : 0.7368
## Pos Pred Value : 0.8837
## Neg Pred Value : 0.8750
## Prevalence : 0.6780
## Detection Rate : 0.6441
## Detection Prevalence : 0.7288
## Balanced Accuracy : 0.8434
##
## 'Positive' Class : alive
## *Con min-max, se obtuvo una tasa de exactitud de 84.75%, mientras que con la estandarización normal se obtuvo una tasa de exactitud de 77.97%. Esto prueba que la estandarización normal empeoró significativamente la predicción del modelo.
Cálculos de tasas de exactitud con validación cruzada
exactitud <- numeric(length = 5)
for(i in 1:5){
prueba <- datos_mm[folds[[i]],]
entrenamiento <- datos_mm[-folds[[i]],]
entrenamiento_mk <- datos_lg$DEATH_EVENT[-folds[[i]]]
prueba_mk <- datos_lg$DEATH_EVENT[folds[[i]]]
pred_knn <- knn(entrenamiento,prueba, cl= entrenamiento_mk, k = 7)
cm <- confusionMatrix(pred_knn, prueba_mk)
exactitud[i] <- cm$overall["Accuracy"]
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.7833333
## Fold 2 - Exactitud: 0.6885246
## Fold 3 - Exactitud: 0.8644068
## Fold 4 - Exactitud: 0.7666667
## Fold 5 - Exactitud: 0.8813559Exactitud_promedio <- round(mean(exactitud),4)*100
paste("Exactitud_promedio: ",Exactitud_promedio,"%",sep="")## [1] "Exactitud_promedio: 79.69%"- En promedio, el modelo tuvo una tasa de exactitud de 80.95%
Validación cruzada realizada múltiples veces
set.seed(13)
train_control <- trainControl(method="cv",number=17,savePredictions = TRUE)
knn_cv13 <- train(DEATH_EVENT ~ ., data=cbind(prueba, DEATH_EVENT=prueba_mk),
method = "knn", trControl = train_control, tuneGrid = data.frame(k=7))
knn_cv13## k-Nearest Neighbors
##
## 59 samples
## 7 predictor
## 2 classes: 'alive', 'death'
##
## No pre-processing
## Resampling: Cross-Validated (17 fold)
## Summary of sample sizes: 56, 56, 56, 55, 55, 56, ...
## Resampling results:
##
## Accuracy Kappa
## 0.8558824 0.5850267
##
## Tuning parameter 'k' was held constant at a value of 7confusionMatrix(knn_cv13$pred$pred, knn_cv13$pred$obs)## Confusion Matrix and Statistics
##
## Reference
## Prediction alive death
## alive 39 7
## death 1 12
##
## Accuracy : 0.8644
## 95% CI : (0.7502, 0.9396)
## No Information Rate : 0.678
## P-Value [Acc > NIR] : 0.0009098
##
## Kappa : 0.6614
##
## Mcnemar's Test P-Value : 0.0770999
##
## Sensitivity : 0.9750
## Specificity : 0.6316
## Pos Pred Value : 0.8478
## Neg Pred Value : 0.9231
## Prevalence : 0.6780
## Detection Rate : 0.6610
## Detection Prevalence : 0.7797
## Balanced Accuracy : 0.8033
##
## 'Positive' Class : alive
## La tasa promedio realizando 13 validaciones cruzadas se fue de 81.36%. Esta tasa aparenta mantenerse estable, sin consideración del número de veces que se realice la validación cruzada.
Concluimos que la tasa de exactitud es de 81.36%, tasa que ha no ha variado significativamente a través de los distintos procesos realizados
Problema 2: Calidad del Vino.
Paso 1: Distribución y Valores Atípicos
skimr::skim(df_completo)| Name | df_completo |
| Number of rows | 6495 |
| Number of columns | 12 |
| _______________________ | |
| Column type frequency: | |
| numeric | 12 |
| ________________________ | |
| Group variables | None |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| fixed acidity | 0 | 1 | 7.22 | 1.30 | 3.80 | 6.40 | 7.00 | 7.70 | 15.90 | ▂▇▁▁▁ |
| volatile acidity | 0 | 1 | 0.34 | 0.16 | 0.08 | 0.23 | 0.29 | 0.40 | 1.58 | ▇▂▁▁▁ |
| citric acid | 0 | 1 | 0.32 | 0.15 | 0.00 | 0.25 | 0.31 | 0.39 | 1.66 | ▇▅▁▁▁ |
| residual sugar | 0 | 1 | 5.44 | 4.76 | 0.60 | 1.80 | 3.00 | 8.10 | 65.80 | ▇▁▁▁▁ |
| chlorides | 0 | 1 | 0.06 | 0.04 | 0.01 | 0.04 | 0.05 | 0.06 | 0.61 | ▇▁▁▁▁ |
| free sulfur dioxide | 0 | 1 | 30.52 | 17.75 | 1.00 | 17.00 | 29.00 | 41.00 | 289.00 | ▇▁▁▁▁ |
| total sulfur dioxide | 0 | 1 | 115.74 | 56.53 | 6.00 | 77.00 | 118.00 | 156.00 | 440.00 | ▅▇▂▁▁ |
| density | 0 | 1 | 0.99 | 0.00 | 0.99 | 0.99 | 0.99 | 1.00 | 1.04 | ▇▂▁▁▁ |
| pH | 0 | 1 | 3.22 | 0.16 | 2.72 | 3.11 | 3.21 | 3.32 | 4.01 | ▁▇▆▁▁ |
| sulphates | 0 | 1 | 0.53 | 0.15 | 0.22 | 0.43 | 0.51 | 0.60 | 2.00 | ▇▃▁▁▁ |
| alcohol | 0 | 1 | 10.49 | 1.19 | 8.00 | 9.50 | 10.30 | 11.30 | 14.90 | ▃▇▅▂▁ |
| quality | 0 | 1 | 5.82 | 0.87 | 3.00 | 5.00 | 6.00 | 6.00 | 9.00 | ▁▆▇▃▁ |
table(df_completo$quality)##
## 3 4 5 6 7 8 9
## 30 216 2137 2836 1078 193 5prueba_long <- pivot_longer(df_completo, cols = everything(), names_to = "variable", values_to = "value")
ggplot(prueba_long, aes(x = variable, y = value)) +
geom_boxplot(outlier.colour = "red", outlier.shape = 16) +
facet_wrap(~variable, scales = "free") +
theme_minimal() +
labs(title = "Outlier Detection per Variable")
La exploración inicial revela que las variables predictoras presentan escalas considerablemente distintas. Esta disparidad distorsionaría los cálculos de distancia euclidiana en KNN, por lo que se aplican dos métodos de escalamiento: normalización Min-Max y estandarización Z-score, para comparar su efecto en el desempeño del modelo.
Adicionalmente, los diagramas de caja evidencian valores atípicos en la mayoría de las variables predictoras. Dado que Min-Max es sensible a valores extremos, esta comparación permite evaluar la robustez de cada método ante outliers. Finalmente, la variable quality muestra una distribución desbalanceada, concentrándose en los niveles 5 y 6, lo que podría influir en la capacidad del modelo para clasificar correctamente los niveles extremo.
Paso 2: Preparación de Data
#Para Min-Max
Min_max <- df_completo %>%
mutate(across(-quality, rescale))
set.seed(2025)
folds = createFolds(df_completo$quality, k=5)
entrenamiento_min= Min_max[-folds[[5]],]
prueba_min = Min_max[folds[[5]],]
#labels
train_labels = df_completo$quality[-folds[[5]]] %>% as.factor()
test_labels = df_completo$quality[folds[[5]]] %>% as.factor()
# Split para estandar
entrenamiento_est = df_completo[-folds[[5]],]
prueba_est = df_completo[folds[[5]],]
entrenamiento_est <- entrenamiento_est %>%
mutate(across(-quality, rescale))
prueba_est = prueba_est %>%
mutate(across(-quality,rescale))Paso 3 : Creación de Modelo
train.kknn(train_labels ~ ., data = entrenamiento_min, kmax = 50)##
## Call:
## train.kknn(formula = train_labels ~ ., data = entrenamiento_min, kmax = 50)
##
## Type of response variable: nominal
## Minimal misclassification: 0.05735181
## Best kernel: optimal
## Best k: 5pred <- knn(entrenamiento_min,prueba_min, cl = train_labels, k = 5)
confusionMatrix(data = pred, reference = test_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 7 0 0 0 0 0 0
## 4 0 50 0 0 0 0 0
## 5 0 0 419 0 0 0 0
## 6 0 0 0 568 0 0 0
## 7 0 0 0 0 203 0 0
## 8 0 0 0 0 0 49 3
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.9977
## 95% CI : (0.9933, 0.9995)
## No Information Rate : 0.4373
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9966
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 1.000000 1.00000 1.0000 1.0000 1.0000 1.00000
## Specificity 1.000000 1.00000 1.0000 1.0000 1.0000 0.99760
## Pos Pred Value 1.000000 1.00000 1.0000 1.0000 1.0000 0.94231
## Neg Pred Value 1.000000 1.00000 1.0000 1.0000 1.0000 1.00000
## Prevalence 0.005389 0.03849 0.3226 0.4373 0.1563 0.03772
## Detection Rate 0.005389 0.03849 0.3226 0.4373 0.1563 0.03772
## Detection Prevalence 0.005389 0.03849 0.3226 0.4373 0.1563 0.04003
## Balanced Accuracy 1.000000 1.00000 1.0000 1.0000 1.0000 0.99880
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.997691
## Prevalence 0.002309
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000train.kknn(train_labels~. , data = entrenamiento_est , kmax=50)##
## Call:
## train.kknn(formula = train_labels ~ ., data = entrenamiento_est, kmax = 50)
##
## Type of response variable: nominal
## Minimal misclassification: 0.05735181
## Best kernel: optimal
## Best k: 5pred_est = knn(entrenamiento_est, prueba_est, cl = train_labels, k =5)
confusionMatrix(data = pred_est, reference = test_labels)## Confusion Matrix and Statistics
##
## Reference
## Prediction 3 4 5 6 7 8 9
## 3 7 0 0 0 0 0 0
## 4 0 50 0 0 0 0 0
## 5 0 0 419 0 0 0 0
## 6 0 0 0 568 0 0 0
## 7 0 0 0 0 203 0 0
## 8 0 0 0 0 0 49 3
## 9 0 0 0 0 0 0 0
##
## Overall Statistics
##
## Accuracy : 0.9977
## 95% CI : (0.9933, 0.9995)
## No Information Rate : 0.4373
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9966
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 3 Class: 4 Class: 5 Class: 6 Class: 7 Class: 8
## Sensitivity 1.000000 1.00000 1.0000 1.0000 1.0000 1.00000
## Specificity 1.000000 1.00000 1.0000 1.0000 1.0000 0.99760
## Pos Pred Value 1.000000 1.00000 1.0000 1.0000 1.0000 0.94231
## Neg Pred Value 1.000000 1.00000 1.0000 1.0000 1.0000 1.00000
## Prevalence 0.005389 0.03849 0.3226 0.4373 0.1563 0.03772
## Detection Rate 0.005389 0.03849 0.3226 0.4373 0.1563 0.03772
## Detection Prevalence 0.005389 0.03849 0.3226 0.4373 0.1563 0.04003
## Balanced Accuracy 1.000000 1.00000 1.0000 1.0000 1.0000 0.99880
## Class: 9
## Sensitivity 0.000000
## Specificity 1.000000
## Pos Pred Value NaN
## Neg Pred Value 0.997691
## Prevalence 0.002309
## Detection Rate 0.000000
## Detection Prevalence 0.000000
## Balanced Accuracy 0.500000*Tanto la normalización como la estandarización tuvieron un rendimiento efectivo en el modelo, alcanzando una tasa de acierto de 99.77% (95% CI: (0.9933, 0.9995)), demostrando una clasificación adecuada a pesar del desbalance en las variables de calidad. El índice de Kappa resultó igual para ambas con 0.9966, demostrando una concordancia fuerte aun tomando en consideración los valores atípicos de las variables predictivas.
Paso 5: Estabilidad
all_levels <- as.character(sort(unique(df_completo$quality)))
set.seed(2025)
exactitud <- numeric(5)
folds <- createFolds(df_completo$quality, k=5)
for(i in 1:5){
prueba <- Min_max[folds[[i]],]
entrenamiento <- Min_max[-folds[[i]],]
entrenamiento_labels <- factor(df_completo$quality[-folds[[i]]], levels = all_levels)
prueba_labels <- factor(df_completo$quality[folds[[i]]], levels = all_levels)
pred_knn <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 5)
pred_knn <- factor(pred_knn, levels = all_levels)
cm <- confusionMatrix(pred_knn, prueba_labels)
exactitud[i] <- cm$overall["Accuracy"]
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 1
## Fold 2 - Exactitud: 1
## Fold 3 - Exactitud: 1
## Fold 4 - Exactitud: 1
## Fold 5 - Exactitud: 0.9976905Exactitud_promedio <- round(mean(exactitud),4)*100
paste("Exactitud_promedio: ",Exactitud_promedio,"%",sep="")## [1] "Exactitud_promedio: 99.95%"- La tasa de acierto promedio del modelo KNN con normalización fue de 99.94%, lo cual representa un rendimiento muy alto. La consistencia de la exactitud entre folds sugiere que el modelo es estable y poco sensible a la distribución de los datos en cada partición.
exactitud <- numeric(5)
set.seed(2025)
folds <- createFolds(df_completo$quality, k=5)
all_levels <- as.character(sort(unique(df_completo$quality)))
for(i in 1:5){
prueba <- df_completo[folds[[i]],]%>%
mutate(across(everything(), rescale))
entrenamiento <- df_completo[-folds[[i]],]%>%
mutate(across(everything(), rescale))
# Force same levels on both
entrenamiento_labels <- factor(df_completo$quality[-folds[[i]]], levels = all_levels)
prueba_labels <- factor(df_completo$quality[ folds[[i]]], levels = all_levels)
pred_knn <- knn(entrenamiento, prueba, cl = entrenamiento_labels, k = 5)
pred_knn <- factor(pred_knn, levels = all_levels)
cm <- confusionMatrix(pred_knn, prueba_labels)
exactitud[i] <- cm$overall["Accuracy"]
cat("Fold", i, "- Exactitud:", exactitud[i], "\n")
}## Fold 1 - Exactitud: 0.7621247
## Fold 2 - Exactitud: 0.8421863
## Fold 3 - Exactitud: 0.8598922
## Fold 4 - Exactitud: 0.7159353
## Fold 5 - Exactitud: 0.9091609Exactitud_promedio_0 <- round(mean(exactitud),4)*100
paste("Exactitud_promedio_0: ",Exactitud_promedio_0,"%",sep="")## [1] "Exactitud_promedio_0: 81.79%"- Por su parte, el método de estandarización (Z-score) obtuvo una tasa de acierto promedio de 81.79%, reflejando igualmente una alta estabilidad entre folds.El método de normalización resultó en una estabilidad en promedio mayor de 99.94%. Dado que la diferencia entre ambos métodos es mínima, se puede concluir que los dos son adecuados para este conjunto de datos. Cabe destacar que, aunque la mayoría de las variables predictivas presentan valores atípicos, condición que teóricamente perjudica a la normalización esto no afectó negativamente su desempeño, lo que sugiere que los outliers no tienen un impacto determinante en este caso particular.