library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.library(e1071)
library(rpart)
library(caret)## Loading required package: ggplot2##
## Attaching package: 'ggplot2'## The following object is masked from 'package:randomForest':
##
## margin## Loading required package: latticelibrary(class)
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:randomForest':
##
## combine## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondata_obesidad = read.csv("/Users/macbookair/Desktop/R (MASTER)/ObesityDataSet_raw_and_data_sinthetic.csv", header = T)columnas_a_truncar = c('Age','NCP', 'FCVC','CH2O','FAF', 'TUE') # Lista de columnas a truncar
# Crear un nuevo dataframe con valores truncados
tabla_truncada = data_obesidad
tabla_truncada[, columnas_a_truncar] = lapply(tabla_truncada[, columnas_a_truncar], trunc)variables_a_factor = c('FCVC', "NCP", "CH2O", 'FAF','TUE','SMOKE' )
# Utilizamos lapply para convertir las variables a factor
tabla_truncada[, variables_a_factor] = lapply(tabla_truncada[, variables_a_factor], as.factor)columnas_a_eliminar = c('Height','Weight','family_history_with_overweight','NCP','CH2O')
t_buena = tabla_truncada %>%
select(-one_of(columnas_a_eliminar))Intentaremos con un SVM
# Convertimos la variable SMOKE a factor
t_buena$SMOKE = as.factor(t_buena$SMOKE)
# Convertimos la variable SCC a factor para el análisis posterior
t_buena$SCC = as.factor(t_buena$SCC)
# Establecemos semilla para reproducibilidad
set.seed(123)
# Creamos un índice de partición (80% entrenamiento, 20% prueba)
index = createDataPartition(t_buena$SMOKE, p = 0.8, list = FALSE)
# Creamos conjuntos de entrenamiento y prueba
train_data = t_buena[index, ]
test_data = t_buena[-index, ]
# Entrenamos el modelo SVM
model = svm(SMOKE ~ ., data = train_data, kernel = "radial")
# Realizamos predicciones en el conjunto de prueba
predictions = predict(model, newdata = test_data)
# Evaluamos el rendimiento del modelo
conf_matrix = table(predictions, test_data$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predictions no yes
## no 413 8
## yes 0 0print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.980997624703088"El modelo tiene un accuracy del 98%, aunque parece un buen resultado esto puede ser engañoso, ya que como mencionamos anteriormente existe un desbalance entre las clases de fumadores y no fumadores. Este desbalance se ve reflejado en la matriz de confución, donde vemos que las predicciones que hizo fueron todas para no fumadores, acertando en 413 y teniendo 8 errados.
El modelo tiene muy buena sensibilidad pues identifica bastante bien los los negativos verdaderos, aunque su especificidad es muy mala, osea muy malo para identificar verdaderos positivos.
Intentaremos con un Kernel lineal para ver si mejora.
# Entrenamos el modelo SVM
model = svm(SMOKE ~ ., data = train_data, kernel = "linear")
# Realizamos predicciones en el conjunto de prueba
predictions = predict(model, newdata = test_data)
# Evaluamos el rendimiento del modelo
conf_matrix = table(predictions, test_data$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predictions no yes
## no 413 8
## yes 0 0print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.980997624703088"El resultado fue el mismo
Una forma en la que podemos contrarrestar el problema del desbalance de clases es reducir la cantidad de registros de no fumadores para que sea más cercana a la de fumadores sin embargo la diferencia es demasiada y probablemente estaríamos perdiendo información valiosa. Intentaremos hacer el mismo modelo de SVM con el mismo dataset pero asignándole mayor peso a la clase “yes”
# Entrenamos al modelo SVM
model = svm(SMOKE ~ ., data = train_data, class.weights = table(train_data$SMOKE), kernel = "linear")
# Realizamos predicciones en el conjunto de prueba
predictions = predict(model, newdata = test_data)
# Evaluamos el rendimiento del modelo
conf_matrix = table(predictions, test_data$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predictions no yes
## no 413 8
## yes 0 0print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.980997624703088"El peso no parece tener impacto en el modelo, intentaremos con un submuestreo.
library(ROSE)## Loaded ROSE 0.0-4# la columna MTRANS está resultando problemática, vamos a eliminarle
t_submuestreo = t_buena %>%
select(-one_of("MTRANS"))
# Nuevos sets de entrenamiento y testeo pues la clase Bike de MTRANS está dando problemas y son solo 7 registros, vamos a eliminarlos
set.seed(123) # Establecer una semilla para reproducibilidad
index_train = createDataPartition(t_submuestreo$SMOKE, p = 0.8, list = FALSE)
# Obtenemos índices para el conjunto de prueba (complemento del conjunto de entrenamiento)
index_test = setdiff(1:nrow(t_submuestreo), index_train)
# Creamos conjuntos de entrenamiento y prueba
train_data2 = t_submuestreo[index_train, ]
test_data2 = t_submuestreo[index_test, ]
# Realizamos submuestreo para equilibrar las clases
train_data_balanced = ovun.sample(SMOKE ~ ., data = train_data2, method = "under", N = 2 * sum(train_data2$SMOKE == "yes"), seed = 123)$data
# Entrenamos el modelo SVM en el conjunto de datos balanceado
model = svm(SMOKE ~ ., data = train_data_balanced, kernel = "linear")
# Realizamos predicciones en el conjunto de prueba
predictions = predict(model, newdata = test_data2)
# Evaluamos el rendimiento del modelo
conf_matrix = table(predictions, test_data2$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predictions no yes
## no 315 4
## yes 98 4print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.757719714964371"La técnica de submuestreo pareció no dar muy buenos resultados, tuvo muchos falsos positivos y el accuracy bajó hasta 75%, que en el caso de una clasificación binaria no se considera muy bueno.
Intentaremos con Random Forest
# Establecemos una semilla para reproducibilidad
set.seed(123)
# Dividimos del conjunto de datos en entrenamiento (80%) y prueba (20%)
indice_entrenamiento = sample(1:nrow(t_buena), 0.8 * nrow(t_buena))
datos_entrenamiento = t_buena[indice_entrenamiento, ]
datos_prueba = t_buena[-indice_entrenamiento, ]
# Ajustamos el modelo de Random Forest
modelo_rf = randomForest(SMOKE ~ ., data = datos_entrenamiento)
# Realizamos predicciones en el conjunto de prueba
predicciones = predict(modelo_rf, datos_prueba)
# Evaluamos la precisión del modelo
conf_matrix = table(predicciones, datos_prueba$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
print(conf_matrix)##
## predicciones no yes
## no 410 12
## yes 1 0print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.969267139479905"# Calculamos la matriz de confusión
conf_matrix = table(predicciones, datos_prueba$SMOKE)
# Calculamos Precision, Recall y F1 score
precision = conf_matrix[1, 1] / sum(conf_matrix[, 1])
recall = conf_matrix[1, 1] / sum(conf_matrix[1, ])
F1_score = 2 * precision * recall / (precision + recall)
# Imprimimos los resultados
sprintf("Precision: %f", precision)## [1] "Precision: 0.997567"sprintf("Recall: %f", recall)## [1] "Recall: 0.971564"sprintf("F1 score: %f", F1_score)## [1] "F1 score: 0.984394"Aunque está muy lejos de ser algo ideal, vamos a reducir el tamaño del dataset de tal modo que el número de registros en la clase “yes” y “no” de la variable SMOKE queden balanceadas y entonces hacer un nuevo modelo de clasificación con este data set reducido para ver qué pasa.
set.seed(123) # Semilla
# Obtenemos los índices de registros a conservar para ambas clases
indices_a_conservar_yes = which(t_submuestreo$SMOKE == "yes")
indices_a_conservar_no = sample(which(t_submuestreo$SMOKE == "no"), min(50, sum(t_submuestreo$SMOKE == "no")))
# Creamos un nuevo dataframe conservando los registros deseados
t_reducida = t_submuestreo[c(indices_a_conservar_yes, indices_a_conservar_no), ]
# Verificamos el nuevo balance
table(t_reducida$SMOKE)##
## no yes
## 50 44# Semilla
set.seed(123)
# Creamos un índice de partición (80% entrenamiento, 20% prueba)
index = createDataPartition(t_reducida$SMOKE, p = 0.8, list = FALSE)
# Creamos conjuntos de entrenamiento y prueba
train_dataredux = t_reducida[index, ]
test_dataredux = t_reducida[-index, ]
# Entrenarmos el modelo SVM
model = svm(SMOKE ~ ., data = train_dataredux, kernel = "linear")
# Realizamos predicciones en el conjunto de prueba
predictions = predict(model, newdata = test_dataredux)
# Evaluamos el rendimiento del modelo
conf_matrix = table(predictions, test_dataredux$SMOKE)
accuracy = sum(diag(conf_matrix)) / sum(conf_matrix)
precision = conf_matrix[2, 2] / sum(conf_matrix[, 2])
recall = conf_matrix[2, 2] / sum(conf_matrix[2, ])
f1_score = 2 * precision * recall / (precision + recall)
# Imprimimos métricas
print("Matriz de Confusión:")## [1] "Matriz de Confusión:"print(conf_matrix)##
## predictions no yes
## no 7 1
## yes 3 7print(paste("Accuracy:", accuracy))## [1] "Accuracy: 0.777777777777778"print(paste("Precision:", precision))## [1] "Precision: 0.875"print(paste("Recall:", recall))## [1] "Recall: 0.7"print(paste("F1 Score:", f1_score))## [1] "F1 Score: 0.777777777777778"Aunque el recall o sensibilidad mejora considerablemente aquí en comparación a los otros modelos el desempeño general sigue sin ser muy bueno. Además de que al realizar la reducción de los registros se eliminaron muchísimos que tenían la clase “no” y esto nos hace perder demasiada información. Realmente se hizo este modelo con un data set reducido a modo de experimento.
En resumen, consideramos que es muy dificil hacer un modelo de clasificación binaria que presente buenas métricas, que sea confiable y que no sobreajuste cuando existe un desbalance tan significativo entre sus clases. A priori, habiendo explorado también la variable de Control de ingesta calórica, creemos que el caso será muy similar a este.
Intentaremos primero con un Árbol de decisión
# Ajustamos el modelo de árbol de decisión
modelo_arbol = rpart(SCC ~ ., data = train_data, method = "class")
# Realizamos predicciones en el conjunto de prueba
predicciones = predict(modelo_arbol, newdata = test_data, type = "class")
# Evaluamos el rendimiento del modelo
matriz_confusion = confusionMatrix(predicciones, test_data$SCC)
# Imprimimos la matriz de confusión y otras métricas
print(matriz_confusion)## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 396 14
## yes 5 6
##
## Accuracy : 0.9549
## 95% CI : (0.9304, 0.9726)
## No Information Rate : 0.9525
## P-Value [Acc > NIR] : 0.46809
##
## Kappa : 0.3657
##
## Mcnemar's Test P-Value : 0.06646
##
## Sensitivity : 0.9875
## Specificity : 0.3000
## Pos Pred Value : 0.9659
## Neg Pred Value : 0.5455
## Prevalence : 0.9525
## Detection Rate : 0.9406
## Detection Prevalence : 0.9739
## Balanced Accuracy : 0.6438
##
## 'Positive' Class : no
## Como se esperaba, el modelo presenta un problema similar al de la variable SMOKE (aunque menos pronunciado) de desbalance de clases, en el que podemos ver una sensibilidad o recall del 98% (muy bueno para identificar positivos reales) pero una especificidad más bien mala del 30% (baja capacidad del modelo para identificar negativos reales). El modelo tiene un Balance Accuracy del 64% que se refiere al rendimiento que tiene considerando tanto el recall como la especificidad.
Intentaremos ahora crear un modelo de KNN (Vecinos más cercanos) para comparar y evaluar su rendimiento frente al árbol de decisión. Haremos uno con 3 vecinos y otro con 5.
# Especificamos el número de vecinos y otros ajustes
k = 3
trControl = trainControl(method = "cv", number = 5) # Validación cruzada
# Ajustamos el modelo KNN con la función train de caret
modelo_knn = train(SCC ~ ., data = train_data, method = "knn", trControl = trControl, tuneGrid = data.frame(k = k), weights = ifelse(train_data$SCC == "yes", 2, 1))
# Realizamos predicciones en el conjunto de prueba
predicciones_knn = predict(modelo_knn, newdata = test_data)
# Evaluamos el rendimiento del modelo KNN
matriz_confusion_knn = confusionMatrix(predicciones_knn, test_data$SCC)
# Imprimimos la matriz de confusión y otras métricas
print(matriz_confusion_knn)## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 399 14
## yes 2 6
##
## Accuracy : 0.962
## 95% CI : (0.939, 0.9781)
## No Information Rate : 0.9525
## P-Value [Acc > NIR] : 0.21479
##
## Kappa : 0.4126
##
## Mcnemar's Test P-Value : 0.00596
##
## Sensitivity : 0.9950
## Specificity : 0.3000
## Pos Pred Value : 0.9661
## Neg Pred Value : 0.7500
## Prevalence : 0.9525
## Detection Rate : 0.9477
## Detection Prevalence : 0.9810
## Balanced Accuracy : 0.6475
##
## 'Positive' Class : no
## # Vecinos k en 5
k = 5
trControl = trainControl(method = "cv", number = 5) # Validación cruzada
# Ajustamos el modelo KNN con la función train de caret
modelo_knn = train(SCC ~ ., data = train_data, method = "knn", trControl = trControl, tuneGrid = data.frame(k = k), weights = ifelse(train_data$SCC == "yes", 2, 1))
# Realizamos predicciones en el conjunto de prueba
predicciones_knn = predict(modelo_knn, newdata = test_data)
# Evaluamos el rendimiento del modelo KNN
matriz_confusion_knn = confusionMatrix(predicciones_knn, test_data$SCC)
# Imprime la matriz de confusión y otras métricas
print(matriz_confusion_knn)## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 400 17
## yes 1 3
##
## Accuracy : 0.9572
## 95% CI : (0.9333, 0.9745)
## No Information Rate : 0.9525
## P-Value [Acc > NIR] : 0.377291
##
## Kappa : 0.2379
##
## Mcnemar's Test P-Value : 0.000407
##
## Sensitivity : 0.9975
## Specificity : 0.1500
## Pos Pred Value : 0.9592
## Neg Pred Value : 0.7500
## Prevalence : 0.9525
## Detection Rate : 0.9501
## Detection Prevalence : 0.9905
## Balanced Accuracy : 0.5738
##
## 'Positive' Class : no
## El modelo con k = 3 o tres vecinos en lugar de 5, tiene una especificidad mayor, aunque sigue siendo bastante mala, incluso después de asignarle mayor peso a “yes”. Nuevamente nos topamos con el problema de las clases desbalanceadas. Hace sentido cuando consideramos que hay 2015 registros de la clase “no” en la variable SCC y solamente 96 de la clase “yes”