Predicción de la condición atlética a partir de la variabilidad de la frecuencia cardíaca, una aproximación desde la inteligencia artificial
Tony Estrella
2024-05-06
Abstract
Introducción: La variabilidad de la frecuencia cardíaca (HRV) se considera un indicador objetivo y no invasivo de salud y condición física (Heiss et al., 2021). Los atletas típicamente exhiben una mejor función autonómica cardíaca, caracterizada por una mayor variabilidad, en comparación con los no atletas (Souza et al., 2021).
Antecedentes y motivación del trabajo: Con el reciente crecimiento de la ciencia de datos y en concreto con los algoritmos de aprendizaje automático, es posible identificar características relacionadas con la condición física (Miah et al., 2023). El objetivo de este trabajo fue identificar y predecir la condición atlética a partir de registros de HRV utilizando algoritmos de aprendizaje automático.
Metodología: El conjunto de datos contiene 1350 registros de HRV de 5 minutos en reposo de 331 participantes. La muestra es de 141 deportistas de alto nivel y 190 estudiantes, con un rango de edad entre 18 y 30 años. Se aplicó el modelo de aprendizaje automático random forest, dividiéndose el conjunto de datos en 80% entrenamiento y 20% test. Se realizaron tres modelos. En el modelo 1 se identificó a los deportistas dentro de la totalidad de la muestra. En los modelos 2 y 3 se identificó a un caso único dentro de la muestra del estudio y dentro de la muestra de futbolistas respectivamente.
Resultados: El modelo 1 ha obtenido una precisión del 81% en la identificación de deportistas de alto nivel respecto a estudiantes, con un área bajo la curva ROC de 0.89. Los cinco principales parámetros de HRV predictores fueron mRR, HFnu, pNN50, VLFnu y HF. En el modelo 2 y 3 se ha obtenido una precisión del 93% y del 91% en la identificación de un caso, con áreas bajo la curva ROC de 0.84 y 0.96 respectivamente. Dentro de las variables más importantes en estos modelos se encuentran mRR, LFnu, HFnu, pNN50 y RMSSD.
Discusión/conclusiones: El modelo permite predecir el índice de condición atlética de una persona a partir de un test de HRV en reposo, rápido y no invasivo, realizado con tecnología mHealth. Con la identificación de un caso el modelo podría aplicarse para la detección de patrones atípicos como indicadores de fatiga y sobreesfuerzo. Por ejemplo, el índice desarrollado podría suponer una herramienta muy útil para monitorizar el proceso de esfuerzo/recuperación de los deportistas durante los entrenamientos.
Palabras clave: HRV, machine learning, random forest, sports characteristics prediction, fatigue, effort, mHealth.
Librerias
library(tidyverse)
library(readxl)
library(tidymodels)
library(skimr)
library(compareGroups)
library(themis)
library(DALEXtra)
theme_set(theme_bw())Datos
df<- read_excel("C:/Users/estre/Dropbox/Doctorat/DA HRV/ML Analysis/data/HRV v10_Total Param UPC_130seg.xls")
#df<- read_excel("C:/Users/1494617/Dropbox/Doctorat/DA HRV/ML Analysis/data/HRV v10_Total Param UPC_130seg.xls")
df$Sport<-as.factor(df$Sport)
levels(df$Sport)<- c("soccer", "hockey", "basket", "student")
df$Sport2<-as.factor(df$Sport2)
levels(df$Sport2)<- c("Student", "Athlete")
df <- df %>%
select(-c(Breathing, Team_Club, Gender, Age, Weight, Height, 'Duration(s)', Semafor_3))
df %>%
head()## # A tibble: 6 × 19
## Subject Sport Sport2 mRR_UPC SDNN_UPC RMSSD_UPC pNN50_UPC ti_UPC HF_UPC LF_UPC
## <dbl> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 socc… Athle… 1070. 88.2 68.7 36.4 312 1542. 718.
## 2 1 socc… Athle… 883. 63.4 40.8 19.7 298. 675. 2075.
## 3 1 socc… Athle… 977. 65.3 54.5 39.8 172. 1463. 1383.
## 4 2 socc… Athle… 1239. 70.8 60.3 47.1 243. 909. 4011.
## 5 3 socc… Athle… 1185. 123. 132. 75.2 307. 3492. 1330.
## 6 5 socc… Athle… 1021. 50.5 42.4 26.0 170. 496. 967.
## # ℹ 9 more variables: VLF_UPC <dbl>, `LF/HF_UPC` <dbl>, HFnu_UPC_2v <dbl>,
## # HFnu_UPC_3v <dbl>, VLFnu_UPC_3v <dbl>, LFnu_UPC_3v <dbl>, SD1_UPC <dbl>,
## # SD2_UPC <dbl>, LFnu_UPC_2v <dbl>Tenemos el DF con las variables de interes:
Variables de agrupación:
Subject = Sujeto
Sport = Tipo de deporte (futbol, basket, hockei, estudiante)
Sport2 = Atleta vs. estudiante
Variables de HRV calculadas y filtradas
Algoritmos
Configuramos los algoritmos dejandolos en abierto con tune() para que en cada conjunto de datos podamos elegir el mejor modelo.
Random Forest
rf_spec <-
rand_forest(
mtry = tune(),
trees = tune(),
min_n = tune()
) %>%
set_mode("classification") %>%
set_engine("ranger", importance = "impurity")XGBoost
xgb_spec <-
boost_tree(
mtry = tune(),
trees = tune(),
min_n = tune(),
learn_rate = tune()
) %>%
set_mode("classification") %>%
set_engine("xgboost", importance = "impurity")Support Vector Machine
svm_spec <-
svm_rbf(
cost = tune(),
rbf_sigma = tune()
) %>%
set_mode("classification") %>%
set_engine("kernlab")En este apartado estan los tres algoritmos de ML que vamos a utilizar en todos los modelos. Como vemos todos los hyperparametros estan abiertos para buscar la mejor configuracion en cada conjunto de datos.
Metricas
Dejamos configuradas las metricas de evaluacion que vamos a utilizar en todos los modelos.
metricas_modelo <- metric_set(accuracy, precision, sensitivity, specificity, roc_auc,recall)Modelo 1. Atleta vs Estudiante
Datos M1
at_df <- df %>%
select(-Sport)set.seed(1996)
at_split <- group_initial_split(at_df, Subject, prop= 0.8, strata = Sport2)
at_training <- training(at_split)
at_test <- testing(at_split)
at_split## <Training/Testing/Total>
## <1086/264/1350>Del dataframe original 1086 observaciones son para entrenamiento y 264 para test. Hay que tener en cuenta que esta divison se ha hecho por sujeto, las observaciones de un sujeto unico estan en la misma division para evitar overfitting.
Creamos muestras bootstrap de los datos de entrenamiento que sera donde vamos a ir a buscar los hiperparametros de los modelos.
set.seed(2024)
at_boot <- bootstraps(at_training, strata = Sport2)
at_boot## # Bootstrap sampling using stratification
## # A tibble: 25 × 2
## splits id
## <list> <chr>
## 1 <split [1086/395]> Bootstrap01
## 2 <split [1086/388]> Bootstrap02
## 3 <split [1086/401]> Bootstrap03
## 4 <split [1086/389]> Bootstrap04
## 5 <split [1086/405]> Bootstrap05
## 6 <split [1086/396]> Bootstrap06
## 7 <split [1086/399]> Bootstrap07
## 8 <split [1086/405]> Bootstrap08
## 9 <split [1086/364]> Bootstrap09
## 10 <split [1086/385]> Bootstrap10
## # ℹ 15 more rowsSe han creado 25 muestras de los datos de entrenamiento manteniendo la estratificación/estructura de la variable Sport2.
Receta M1
En esta receta prepramos los pasos de preprocesamiento para los modelos.
at_rec<-
recipe(formula = Sport2 ~ .,
data = at_training) %>% #datos de entrenamiento
step_rm(Subject) %>%
step_smote(Sport2, neighbors = 10)Hemos eliminado en esta receta la variable sujeto que nos servia para evitar que cayeran casos del mismo sujeto en los dos conjuntos de datos.
Con SMOTE corregimos que el dataset este desequilibrado.
Hemos escalado previamente las variables y los resultados de los modelos no han cambiado. Para facilitar la posterior interpretabilidad de los modelos las dejamos en sus valores originales.
Workflow M1
Random Forest
at_wf_rf <-
workflow() %>%
add_recipe(at_rec) %>%
add_model(rf_spec)XGBoost
at_wf_xgb <- workflow() %>%
add_recipe(at_rec) %>%
add_model(xgb_spec)Support Vector Machine
at_wf_svm <- workflow() %>%
add_recipe(at_rec) %>%
add_model(svm_spec)Hyperparametros M1
Ranfom Forest
doParallel::registerDoParallel()
set.seed(1234)
at_hyperparametros_rf <-
tune_grid(
object = at_wf_rf,
resamples = at_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
size = 10
),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE)
)Evaluacion hyperparametros M1
at_hyperparametros_metricas_rf <-
at_hyperparametros_rf %>%
collect_metrics()
at_hyperparametros_metricas_rf## # A tibble: 60 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 10 485 8 accuracy binary 0.849 25 0.00321 Preprocessor1_M…
## 2 10 485 8 precision binary 0.781 25 0.00669 Preprocessor1_M…
## 3 10 485 8 recall binary 0.808 25 0.00568 Preprocessor1_M…
## 4 10 485 8 roc_auc binary 0.911 25 0.00281 Preprocessor1_M…
## 5 10 485 8 sensitivity binary 0.808 25 0.00568 Preprocessor1_M…
## 6 10 485 8 specificity binary 0.872 25 0.00438 Preprocessor1_M…
## 7 9 206 16 accuracy binary 0.850 25 0.00334 Preprocessor1_M…
## 8 9 206 16 precision binary 0.781 25 0.00730 Preprocessor1_M…
## 9 9 206 16 recall binary 0.810 25 0.00592 Preprocessor1_M…
## 10 9 206 16 roc_auc binary 0.912 25 0.00288 Preprocessor1_M…
## # ℹ 50 more rowsautoplot(at_hyperparametros_rf)
at_hyperparametros_rf %>%
collect_metrics() %>%
pivot_longer(cols = c('mtry','trees','min_n'), names_to = 'hyperparametro', values_to = 'valor_hyperparametro') %>%
ggplot(aes(valor_hyperparametro, mean, color=mean)) +
geom_point() +
facet_grid(.metric~hyperparametro, scales = 'free') +
scale_color_viridis_b()
Vamos a ver ahora los mejores modelos en funcion de las metricas accuracy y auc roc:
at_hyperparametros_rf %>% show_best(metric = "accuracy")## # A tibble: 5 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 3 462 30 accuracy binary 0.858 25 0.00300 Preprocessor1_Model…
## 2 4 307 7 accuracy binary 0.857 25 0.00299 Preprocessor1_Model…
## 3 3 279 26 accuracy binary 0.857 25 0.00317 Preprocessor1_Model…
## 4 4 127 17 accuracy binary 0.855 25 0.00327 Preprocessor1_Model…
## 5 5 429 16 accuracy binary 0.855 25 0.00302 Preprocessor1_Model…at_hyperparametros_rf %>% show_best(metric = "roc_auc", n=1)## # A tibble: 1 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 5 429 16 roc_auc binary 0.915 25 0.00269 Preprocessor1_Model06Me quedo con el modelo con mejor auc_roc
at_mejor_auc_rf <- at_hyperparametros_rf %>% show_best(metric = "roc_auc", n=1)XGBoost
extract_parameter_set_dials(xgb_spec)## Collection of 4 parameters for tuning
##
## identifier type object
## mtry mtry nparam[?]
## trees trees nparam[+]
## min_n min_n nparam[+]
## learn_rate learn_rate nparam[+]
##
## Model parameters needing finalization:
## # Randomly Selected Predictors ('mtry')
##
## See `?dials::finalize` or `?dials::update.parameters` for more information.extract_parameter_set_dials(xgb_spec) %>% extract_parameter_dials("learn_rate")## Learning Rate (quantitative)
## Transformer: log-10 [1e-100, Inf]
## Range (transformed scale): [-3, -0.5]doParallel::registerDoParallel()
set.seed(1234)
at_hyperparametros_xgb <-
tune_grid(
object = at_wf_xgb,
resamples = at_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
learn_rate(),
size = 10
),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE)
)at_hyperparametros_metricas_xgb <-
at_hyperparametros_xgb %>%
collect_metrics()
at_hyperparametros_metricas_xgb## # A tibble: 60 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 3 491 5 0.0000000699 accura… binary 0.852 25 0.00312 Prepro…
## 2 3 491 5 0.0000000699 precis… binary 0.788 25 0.00659 Prepro…
## 3 3 491 5 0.0000000699 recall binary 0.807 25 0.00655 Prepro…
## 4 3 491 5 0.0000000699 roc_auc binary 0.910 25 0.00270 Prepro…
## 5 3 491 5 0.0000000699 sensit… binary 0.807 25 0.00655 Prepro…
## 6 3 491 5 0.0000000699 specif… binary 0.878 25 0.00456 Prepro…
## 7 3 143 20 0.000126 accura… binary 0.839 25 0.00350 Prepro…
## 8 3 143 20 0.000126 precis… binary 0.760 25 0.00636 Prepro…
## 9 3 143 20 0.000126 recall binary 0.809 25 0.00696 Prepro…
## 10 3 143 20 0.000126 roc_auc binary 0.903 25 0.00279 Prepro…
## # ℹ 50 more rowsat_hyperparametros_xgb %>%
collect_metrics() %>%
pivot_longer(cols = c('mtry','trees','min_n', 'learn_rate'), names_to = 'hyperparametro', values_to = 'valor_hyperparametro') %>%
ggplot(aes(valor_hyperparametro, mean, color=mean)) +
geom_point() +
facet_grid(.metric~hyperparametro, scales = 'free') +
scale_color_viridis_b()
at_hyperparametros_xgb %>% show_best(metric = "roc_auc", n=1)## # A tibble: 1 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 7 219 18 0.00719 roc_auc binary 0.915 25 0.00252 Preproces…at_mejor_auc_xgb <- at_hyperparametros_xgb %>% show_best(metric = "roc_auc", n=1)Support Vector Machine
extract_parameter_set_dials(svm_spec)## Collection of 2 parameters for tuning
##
## identifier type object
## cost cost nparam[+]
## rbf_sigma rbf_sigma nparam[+]extract_parameter_set_dials(svm_spec) %>% extract_parameter_dials("cost")## Cost (quantitative)
## Transformer: log-2 [1e-100, Inf]
## Range (transformed scale): [-10, 5]set.seed(1234)
at_hyperparametros_svm <-
tune_grid(
object = at_wf_svm,
resamples = at_boot,
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE)
)at_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)## # A tibble: 1 × 8
## cost rbf_sigma .metric .estimator mean n std_err .config
## <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 20.7 0.000129 roc_auc binary 0.920 25 0.00276 Preprocessor1_Model07at_mejor_auc_svm <- at_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)Modelo final M1
Random Forest
at_modelo_rf_final <-
at_wf_rf %>%
finalize_workflow(at_mejor_auc_rf) %>%
last_fit(at_split, metrics = metricas_modelo)## Warning: package 'ranger' was built under R version 4.2.3at_modelo_rf_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1086/264]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion RF M1
collect_predictions(at_modelo_rf_final)## # A tibble: 264 × 7
## id .pred_class .row .pred_Student .pred_Athlete Sport2 .config
## <chr> <fct> <int> <dbl> <dbl> <fct> <chr>
## 1 train/test split Athlete 1 0.293 0.707 Athle… Prepro…
## 2 train/test split Athlete 2 0.381 0.619 Athle… Prepro…
## 3 train/test split Athlete 3 0.168 0.832 Athle… Prepro…
## 4 train/test split Athlete 5 0.0332 0.967 Athle… Prepro…
## 5 train/test split Athlete 12 0.108 0.892 Athle… Prepro…
## 6 train/test split Athlete 65 0.0805 0.919 Athle… Prepro…
## 7 train/test split Athlete 67 0.102 0.898 Athle… Prepro…
## 8 train/test split Athlete 68 0.0829 0.917 Athle… Prepro…
## 9 train/test split Athlete 69 0.286 0.714 Athle… Prepro…
## 10 train/test split Athlete 70 0.476 0.524 Athle… Prepro…
## # ℹ 254 more rowsat_modelo_rf_final %>%
extract_workflow() %>%
predict(at_test)## # A tibble: 264 × 1
## .pred_class
## <fct>
## 1 Athlete
## 2 Athlete
## 3 Athlete
## 4 Athlete
## 5 Athlete
## 6 Athlete
## 7 Athlete
## 8 Athlete
## 9 Athlete
## 10 Athlete
## # ℹ 254 more rowsat_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.8181818 | 0.82 |
| precision | 0.7297297 | 0.73 |
| sensitivity | 0.8181818 | 0.82 |
| specificity | 0.8181818 | 0.82 |
| recall | 0.8181818 | 0.82 |
| roc_auc | 0.8961126 | 0.90 |
results_modelo_rf<-
at_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator, -.config)XGBoost
at_modelo_xgb_final <-
at_wf_xgb %>%
finalize_workflow(at_mejor_auc_xgb) %>%
last_fit(at_split, metrics = metricas_modelo)## Warning: package 'xgboost' was built under R version 4.2.3at_modelo_xgb_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1086/264]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion XGB M1
at_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.7954545 | 0.80 |
| precision | 0.6956522 | 0.70 |
| sensitivity | 0.8080808 | 0.81 |
| specificity | 0.7878788 | 0.79 |
| recall | 0.8080808 | 0.81 |
| roc_auc | 0.8925620 | 0.89 |
results_modelo_xgb <-
at_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator, -.config)Support Vector Machine
at_modelo_svm_final <-
at_wf_svm %>%
finalize_workflow(at_mejor_auc_svm) %>%
last_fit(at_split, metrics = metricas_modelo)
at_modelo_svm_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1086/264]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion SVM M1
at_modelo_svm_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.8409091 | 0.84 |
| precision | 0.7522124 | 0.75 |
| sensitivity | 0.8585859 | 0.86 |
| specificity | 0.8303030 | 0.83 |
| recall | 0.8585859 | 0.86 |
| roc_auc | 0.9131313 | 0.91 |
results_modelo_svm<-
at_modelo_svm_final %>%
collect_metrics() %>%
select(-.estimator, -.config) Grafico de los resultados por modelo M1
at_results<- data.frame(
metrica = results_modelo_rf$.metric,
RF = results_modelo_rf$.estimate,
XGB = results_modelo_xgb$.estimate,
SVM = results_modelo_svm$.estimate
)
at_results <-
at_results %>%
pivot_longer(cols = c("RF", "XGB", "SVM"),
names_to = "modelo") %>%
filter(metrica == "accuracy" |
metrica == "precision" |
metrica == "recall" |
metrica == "roc_auc") %>%
mutate(metrica = factor(metrica),
modelo = factor(modelo))
at_results## # A tibble: 12 × 3
## metrica modelo value
## <fct> <fct> <dbl>
## 1 accuracy RF 0.818
## 2 accuracy XGB 0.795
## 3 accuracy SVM 0.841
## 4 precision RF 0.730
## 5 precision XGB 0.696
## 6 precision SVM 0.752
## 7 recall RF 0.818
## 8 recall XGB 0.808
## 9 recall SVM 0.859
## 10 roc_auc RF 0.896
## 11 roc_auc XGB 0.893
## 12 roc_auc SVM 0.913levels(at_results$metrica) <- c("Accuracy", "Precision", "Recall", "AUC ROC")
at_results %>%
ggplot(aes(x = metrica, y = value, fill = modelo))+
geom_col(position = "dodge")+
scale_fill_brewer(palette= "Pastel2")+
scale_y_continuous(limits = c(0,1), expand = c(0,0))+
labs(y = "",
x = "Metric",
fill= NULL,
title= "")
Modelo 2. Caso respecto la muestra
Datos M2
df_caso <- df %>%
select(-c(Sport2, Sport)) %>%
mutate(cas_fut = as.factor(ifelse(Subject == 30, 1, 0)))
head(df_caso)## # A tibble: 6 × 18
## Subject mRR_UPC SDNN_UPC RMSSD_UPC pNN50_UPC ti_UPC HF_UPC LF_UPC VLF_UPC
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1070. 88.2 68.7 36.4 312 1542. 718. 4294.
## 2 1 883. 63.4 40.8 19.7 298. 675. 2075. 869.
## 3 1 977. 65.3 54.5 39.8 172. 1463. 1383. 2231.
## 4 2 1239. 70.8 60.3 47.1 243. 909. 4011. 1279.
## 5 3 1185. 123. 132. 75.2 307. 3492. 1330. 10519.
## 6 5 1021. 50.5 42.4 26.0 170. 496. 967. 546.
## # ℹ 9 more variables: `LF/HF_UPC` <dbl>, HFnu_UPC_2v <dbl>, HFnu_UPC_3v <dbl>,
## # VLFnu_UPC_3v <dbl>, LFnu_UPC_3v <dbl>, SD1_UPC <dbl>, SD2_UPC <dbl>,
## # LFnu_UPC_2v <dbl>, cas_fut <fct>La variable de interes es:
- cas_fut, el caso con más observaciones es el 30 con 105.
df_caso %>%
group_by(cas_fut) %>%
count()## # A tibble: 2 × 2
## # Groups: cas_fut [2]
## cas_fut n
## <fct> <int>
## 1 0 1245
## 2 1 105set.seed(1245)
caso_split <- initial_split(df_caso, prop= 0.8, strata = cas_fut)
caso_training <- training(caso_split)
caso_test <- testing(caso_split)
caso_split## <Training/Testing/Total>
## <1080/270/1350>Del dataframe original (1350 observaciones) 1080 observaciones son para entrenamiento y 270 para test. Como vamos a buscar un caso utilizo todos los sujetos simplemente diferenciandolos del que me interesa identificar.
set.seed(2023)
caso_boot <- bootstraps(caso_training)
caso_boot## # Bootstrap sampling
## # A tibble: 25 × 2
## splits id
## <list> <chr>
## 1 <split [1080/400]> Bootstrap01
## 2 <split [1080/406]> Bootstrap02
## 3 <split [1080/412]> Bootstrap03
## 4 <split [1080/382]> Bootstrap04
## 5 <split [1080/411]> Bootstrap05
## 6 <split [1080/394]> Bootstrap06
## 7 <split [1080/393]> Bootstrap07
## 8 <split [1080/394]> Bootstrap08
## 9 <split [1080/389]> Bootstrap09
## 10 <split [1080/390]> Bootstrap10
## # ℹ 15 more rowsReceta M2
caso_rec <-
recipe(formula = cas_fut ~ .,
data = caso_training) %>%
step_rm(Subject) %>%
step_smote(cas_fut, neighbors = 10)Workflow M2
Random Forest
caso_wf_rf <-
workflow() %>%
add_recipe(caso_rec) %>%
add_model(rf_spec)XGBoost
caso_wf_xgb <-
workflow() %>%
add_recipe(caso_rec) %>%
add_model(xgb_spec)Support Vector Machine
caso_wf_svm <-
workflow() %>%
add_recipe(caso_rec) %>%
add_model(svm_spec)Hyperparametros M2
Random Forest
doParallel::registerDoParallel()
set.seed(1234)
caso_hyperparametros_rf <-
tune_grid(
object = caso_wf_rf,
resamples = caso_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
size = 10),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE))Evaluacion hyperparametros RF M2
caso_hyperparametros_metricas_rf <-
caso_hyperparametros_rf %>%
collect_metrics()
caso_hyperparametros_metricas_rf## # A tibble: 60 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 10 485 8 accuracy binary 0.914 25 0.00233 Preprocessor1_M…
## 2 10 485 8 precision binary 0.962 25 0.00182 Preprocessor1_M…
## 3 10 485 8 recall binary 0.945 25 0.00291 Preprocessor1_M…
## 4 10 485 8 roc_auc binary 0.894 25 0.00580 Preprocessor1_M…
## 5 10 485 8 sensitivity binary 0.945 25 0.00291 Preprocessor1_M…
## 6 10 485 8 specificity binary 0.583 25 0.0140 Preprocessor1_M…
## 7 9 206 16 accuracy binary 0.916 25 0.00198 Preprocessor1_M…
## 8 9 206 16 precision binary 0.961 25 0.00189 Preprocessor1_M…
## 9 9 206 16 recall binary 0.946 25 0.00266 Preprocessor1_M…
## 10 9 206 16 roc_auc binary 0.895 25 0.00555 Preprocessor1_M…
## # ℹ 50 more rowscaso_hyperparametros_rf %>%
collect_metrics() %>%
pivot_longer(cols = c('mtry','trees','min_n'),
names_to = 'tipo_parametro',
values_to = 'valor_parametro') %>%
ggplot(aes(valor_parametro, mean, color=mean)) +
geom_point() +
facet_grid(.metric~tipo_parametro, scales = 'free' ) +
scale_color_viridis_b()
caso_hyperparametros_rf %>% show_best(metric= "roc_auc")## # A tibble: 5 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 4 307 7 roc_auc binary 0.906 25 0.00493 Preprocessor1_Model04
## 2 3 279 26 roc_auc binary 0.904 25 0.00530 Preprocessor1_Model03
## 3 3 462 30 roc_auc binary 0.904 25 0.00530 Preprocessor1_Model05
## 4 5 429 16 roc_auc binary 0.904 25 0.00529 Preprocessor1_Model06
## 5 4 127 17 roc_auc binary 0.903 25 0.00536 Preprocessor1_Model10caso_mejor_hyper_rf <- caso_hyperparametros_rf %>% show_best(metric = "roc_auc", n = 1)
caso_mejor_hyper_rf## # A tibble: 1 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 4 307 7 roc_auc binary 0.906 25 0.00493 Preprocessor1_Model04Mejor modelo RF:
mtry: 4
trees: 307
min_n: 7
XGBoost
doParallel::registerDoParallel()
set.seed(1234)
caso_hyperparametros_xgb <-
tune_grid(
object = caso_wf_xgb,
resamples = caso_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
learn_rate(),
size = 10
),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE))Evaluacion hyperparametros XGB M2
caso_hyperparametros_metricas_xgb <-
caso_hyperparametros_xgb %>%
collect_metrics()
caso_hyperparametros_metricas_xgb## # A tibble: 60 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 3 491 5 0.0000000699 accura… binary 0.872 25 0.00354 Prepro…
## 2 3 491 5 0.0000000699 precis… binary 0.972 25 0.00197 Prepro…
## 3 3 491 5 0.0000000699 recall binary 0.886 25 0.00449 Prepro…
## 4 3 491 5 0.0000000699 roc_auc binary 0.895 25 0.00544 Prepro…
## 5 3 491 5 0.0000000699 sensit… binary 0.886 25 0.00449 Prepro…
## 6 3 491 5 0.0000000699 specif… binary 0.719 25 0.0184 Prepro…
## 7 3 143 20 0.000126 accura… binary 0.865 25 0.00363 Prepro…
## 8 3 143 20 0.000126 precis… binary 0.971 25 0.00200 Prepro…
## 9 3 143 20 0.000126 recall binary 0.879 25 0.00474 Prepro…
## 10 3 143 20 0.000126 roc_auc binary 0.887 25 0.00580 Prepro…
## # ℹ 50 more rowscaso_hyperparametros_xgb %>%
collect_metrics() %>%
pivot_longer(cols = c('mtry','trees','min_n'),
names_to = 'tipo_parametro',
values_to = 'valor_parametro') %>%
ggplot(aes(valor_parametro, mean, color=mean)) +
geom_point() +
facet_grid(.metric~tipo_parametro, scales = 'free' ) +
scale_color_viridis_b()
caso_hyperparametros_xgb %>% show_best(metric= "roc_auc")## # A tibble: 5 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 3 491 5 0.0000000699 roc_auc binary 0.895 25 0.00544 Preproc…
## 2 7 219 18 0.00719 roc_auc binary 0.895 25 0.00516 Preproc…
## 3 5 275 6 0.0000792 roc_auc binary 0.892 25 0.00560 Preproc…
## 4 3 143 20 0.000126 roc_auc binary 0.887 25 0.00580 Preproc…
## 5 9 467 14 0.00115 roc_auc binary 0.886 25 0.00582 Preproc…caso_mejor_hyper_xgb <- caso_hyperparametros_xgb %>% show_best(metric = "roc_auc", n = 1)
caso_mejor_hyper_xgb## # A tibble: 1 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 3 491 5 0.0000000699 roc_auc binary 0.895 25 0.00544 Preproc…Mejor modelo XGB:
mtry: 3
trees: 491
min_n: 5
learning_rate: 0.0000000699 = 6.99e-8
Support Vector Machine
set.seed(1234)
caso_hyperparametros_svm <-
tune_grid(
object = caso_wf_svm,
resamples = caso_boot,
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE)
)caso_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)## # A tibble: 1 × 8
## cost rbf_sigma .metric .estimator mean n std_err .config
## <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 0.0118 0.0545 roc_auc binary 0.903 25 0.00454 Preprocessor1_Model03caso_mejor_hyper_svm <- caso_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)Modelo final M2
Random Forest
caso_modelo_hyperparametros_rf <-
caso_wf_rf %>%
finalize_workflow(caso_mejor_hyper_rf) %>%
fit(data = caso_training) set.seed(1256)
caso_modelo_rf_final <-
caso_wf_rf %>%
finalize_workflow(caso_mejor_hyper_rf) %>%
last_fit(caso_split,
metrics = metricas_modelo)
caso_modelo_rf_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1080/270]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion RF M2
collect_metrics(caso_modelo_rf_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.930 Preprocessor1_Model1
## 2 precision binary 0.965 Preprocessor1_Model1
## 3 sensitivity binary 0.961 Preprocessor1_Model1
## 4 specificity binary 0.357 Preprocessor1_Model1
## 5 recall binary 0.961 Preprocessor1_Model1
## 6 roc_auc binary 0.844 Preprocessor1_Model1caso_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.9296296 | 0.93 |
| precision | 0.9647059 | 0.96 |
| sensitivity | 0.9609375 | 0.96 |
| specificity | 0.3571429 | 0.36 |
| recall | 0.9609375 | 0.96 |
| roc_auc | 0.8437500 | 0.84 |
caso_results_modelo_rf <-
caso_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator, -.config)XGBoost
caso_modelo_hyperparametros_xgb <-
caso_wf_xgb %>%
finalize_workflow(caso_mejor_hyper_xgb) %>%
fit(data = caso_training) ## [17:43:21] WARNING: src/learner.cc:767:
## Parameters: { "importance" } are not used.set.seed(1256)
caso_modelo_xgb_final <-
caso_wf_xgb %>%
finalize_workflow(caso_mejor_hyper_xgb) %>%
last_fit(caso_split,
metrics = metricas_modelo)
caso_modelo_xgb_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1080/270]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluaciuon XGB M2
collect_metrics(caso_modelo_xgb_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.863 Preprocessor1_Model1
## 2 precision binary 0.978 Preprocessor1_Model1
## 3 sensitivity binary 0.875 Preprocessor1_Model1
## 4 specificity binary 0.643 Preprocessor1_Model1
## 5 recall binary 0.875 Preprocessor1_Model1
## 6 roc_auc binary 0.848 Preprocessor1_Model1caso_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.8629630 | 0.86 |
| precision | 0.9781659 | 0.98 |
| sensitivity | 0.8750000 | 0.88 |
| specificity | 0.6428571 | 0.64 |
| recall | 0.8750000 | 0.88 |
| roc_auc | 0.8475167 | 0.85 |
caso_results_modelo_xgb <-
caso_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator, -.config)Support Vector Machine
caso_modelo_hyperparametros_svm <-
caso_wf_svm %>%
finalize_workflow(caso_mejor_hyper_svm) %>%
fit(data = caso_training) set.seed(1256)
caso_modelo_svm_final <-
caso_wf_svm %>%
finalize_workflow(caso_mejor_hyper_svm) %>%
last_fit(caso_split,
metrics = metricas_modelo)
caso_modelo_svm_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [1080/270]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion SVM M2
collect_metrics(caso_modelo_svm_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.759 Preprocessor1_Model1
## 2 precision binary 0.985 Preprocessor1_Model1
## 3 sensitivity binary 0.758 Preprocessor1_Model1
## 4 specificity binary 0.786 Preprocessor1_Model1
## 5 recall binary 0.758 Preprocessor1_Model1
## 6 roc_auc binary 0.870 Preprocessor1_Model1caso_modelo_svm_final %>%
collect_metrics() %>%
select(-.estimator, -.config) %>%
mutate(metrica_redondeada = round(.estimate, 2)) %>%
knitr::kable()| .metric | .estimate | metrica_redondeada |
|---|---|---|
| accuracy | 0.7592593 | 0.76 |
| precision | 0.9847716 | 0.98 |
| sensitivity | 0.7578125 | 0.76 |
| specificity | 0.7857143 | 0.79 |
| recall | 0.7578125 | 0.76 |
| roc_auc | 0.8699777 | 0.87 |
caso_results_modelo_svm <-
caso_modelo_svm_final %>%
collect_metrics() %>%
select(-.estimator, -.config)Grafico de los modelos
###Cambiar a M2
caso_results<- data.frame(
metrica = caso_results_modelo_rf$.metric,
RF = caso_results_modelo_rf$.estimate,
XGB = caso_results_modelo_xgb$.estimate,
SVM = caso_results_modelo_svm$.estimate
)
caso_results <-
caso_results %>%
pivot_longer(cols = c("RF", "XGB", "SVM"),
names_to = "modelo") %>%
filter(metrica == "accuracy" |
metrica == "precision" |
metrica == "recall" |
metrica == "roc_auc") %>%
mutate(metrica = factor(metrica),
modelo = factor(modelo))
caso_results## # A tibble: 12 × 3
## metrica modelo value
## <fct> <fct> <dbl>
## 1 accuracy RF 0.930
## 2 accuracy XGB 0.863
## 3 accuracy SVM 0.759
## 4 precision RF 0.965
## 5 precision XGB 0.978
## 6 precision SVM 0.985
## 7 recall RF 0.961
## 8 recall XGB 0.875
## 9 recall SVM 0.758
## 10 roc_auc RF 0.844
## 11 roc_auc XGB 0.848
## 12 roc_auc SVM 0.870levels(caso_results$metrica) <- c("Accuracy", "Precision", "Recall", "AUC ROC")
caso_results %>%
ggplot(aes(x = metrica, y = value, fill = modelo))+
geom_col(position = "dodge")+
scale_fill_brewer(palette= "Pastel2")+
scale_y_continuous(limits = c(0,1), expand = c(0,0))+
labs(y = "",
x = "Metric",
fill= NULL,
title= "")
Modelo 3. Caso dentro de futbolistas
Datos M3
df_subfut <- df %>%
select(-Sport2) %>%
filter(Sport == "soccer") %>%
mutate(cas_fut = as.factor(ifelse(Subject == 30, 1, 0)))
head(df_subfut)## # A tibble: 6 × 19
## Subject Sport mRR_UPC SDNN_UPC RMSSD_UPC pNN50_UPC ti_UPC HF_UPC LF_UPC
## <dbl> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 soccer 1070. 88.2 68.7 36.4 312 1542. 718.
## 2 1 soccer 883. 63.4 40.8 19.7 298. 675. 2075.
## 3 1 soccer 977. 65.3 54.5 39.8 172. 1463. 1383.
## 4 2 soccer 1239. 70.8 60.3 47.1 243. 909. 4011.
## 5 3 soccer 1185. 123. 132. 75.2 307. 3492. 1330.
## 6 5 soccer 1021. 50.5 42.4 26.0 170. 496. 967.
## # ℹ 10 more variables: VLF_UPC <dbl>, `LF/HF_UPC` <dbl>, HFnu_UPC_2v <dbl>,
## # HFnu_UPC_3v <dbl>, VLFnu_UPC_3v <dbl>, LFnu_UPC_3v <dbl>, SD1_UPC <dbl>,
## # SD2_UPC <dbl>, LFnu_UPC_2v <dbl>, cas_fut <fct>df_subfut %>%
count(cas_fut)## # A tibble: 2 × 2
## cas_fut n
## <fct> <int>
## 1 0 514
## 2 1 105set.seed(1425)
casfut_split <- initial_split(df_subfut, prop= 0.8, strata = cas_fut)
casfut_training <- training(casfut_split)
casfut_test <- testing(casfut_split)
casfut_split## <Training/Testing/Total>
## <495/124/619>set.seed(2024)
casfut_boot <- bootstraps(casfut_training)
casfut_boot## # Bootstrap sampling
## # A tibble: 25 × 2
## splits id
## <list> <chr>
## 1 <split [495/182]> Bootstrap01
## 2 <split [495/178]> Bootstrap02
## 3 <split [495/189]> Bootstrap03
## 4 <split [495/179]> Bootstrap04
## 5 <split [495/186]> Bootstrap05
## 6 <split [495/181]> Bootstrap06
## 7 <split [495/182]> Bootstrap07
## 8 <split [495/179]> Bootstrap08
## 9 <split [495/192]> Bootstrap09
## 10 <split [495/196]> Bootstrap10
## # ℹ 15 more rowsReceta M3
casfut_rec <-
recipe(formula = cas_fut ~ .,
data = casfut_training) %>%
step_rm(Subject, Sport) %>%
step_smote(cas_fut, neighbors = 10)Workflow M3
Random Forest
casfut_wf_rf <-
workflow() %>%
add_recipe(casfut_rec) %>%
add_model(rf_spec)XGBoost
casfut_wf_xgb <-
workflow() %>%
add_recipe(casfut_rec) %>%
add_model(xgb_spec)Support Vector Machine
casfut_wf_svm <-
workflow() %>%
add_recipe(casfut_rec) %>%
add_model(svm_spec)Hyperparametros M3
Random Forest
set.seed(4564)
doParallel::registerDoParallel()
casfut_hyperparametros_rf <-
tune_grid(
object = casfut_wf_rf,
resamples = casfut_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
size = 10),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE))Evaluacion hyperparametros M3
casfut_hyperparametros_metricas_rf <-
casfut_hyperparametros_rf %>%
collect_metrics()
casfut_hyperparametros_metricas_rf## # A tibble: 60 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 4 497 25 accuracy binary 0.886 25 0.00330 Preprocessor1_M…
## 2 4 497 25 precision binary 0.933 25 0.00281 Preprocessor1_M…
## 3 4 497 25 recall binary 0.931 25 0.00492 Preprocessor1_M…
## 4 4 497 25 roc_auc binary 0.905 25 0.00505 Preprocessor1_M…
## 5 4 497 25 sensitivity binary 0.931 25 0.00492 Preprocessor1_M…
## 6 4 497 25 specificity binary 0.664 25 0.0168 Preprocessor1_M…
## 7 9 183 17 accuracy binary 0.885 25 0.00342 Preprocessor1_M…
## 8 9 183 17 precision binary 0.932 25 0.00335 Preprocessor1_M…
## 9 9 183 17 recall binary 0.930 25 0.00466 Preprocessor1_M…
## 10 9 183 17 roc_auc binary 0.895 25 0.00541 Preprocessor1_M…
## # ℹ 50 more rowscasfut_hyperparametros_rf %>% collect_metrics() %>% pivot_longer(cols = c('mtry','trees','min_n'), names_to = 'tipo_parametro', values_to = 'valor_parametro') %>% ggplot(aes(valor_parametro,mean, color=mean)) + geom_point() + facet_grid(.metric~tipo_parametro, scales = 'free' ) + scale_color_viridis_b()
casfut_mejor_hyper_rf <- casfut_hyperparametros_rf %>% show_best(metric = "roc_auc", n = 1)
casfut_mejor_hyper_rf## # A tibble: 1 × 9
## mtry trees min_n .metric .estimator mean n std_err .config
## <int> <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 2 214 10 roc_auc binary 0.910 25 0.00507 Preprocessor1_Model03Mejor hyperparametros RF:
mtry: 2
trees: 214
min_n: 10
XGBoost
doParallel::registerDoParallel()
set.seed(5698)
tictoc::tic()
casfut_hyperparametros_xgb <-
tune_grid(
object = casfut_wf_xgb,
resamples = casfut_boot,
grid = grid_max_entropy(
mtry(range = c(2, 10)),
min_n(range = c(5, 30)),
trees(range = c(100, 500)),
learn_rate(),
size = 10
),
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE))
tictoc::toc()## 35.84 sec elapsedEvaluacion hyperparametros XGB M2
casfut_hyperparametros_metricas_xgb <-
casfut_hyperparametros_xgb %>%
collect_metrics()
casfut_hyperparametros_metricas_xgb## # A tibble: 60 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 2 434 25 0.0000627 accura… binary 0.811 25 0.00527 Prepro…
## 2 2 434 25 0.0000627 precis… binary 0.945 25 0.00404 Prepro…
## 3 2 434 25 0.0000627 recall binary 0.822 25 0.00634 Prepro…
## 4 2 434 25 0.0000627 roc_auc binary 0.892 25 0.00646 Prepro…
## 5 2 434 25 0.0000627 sensit… binary 0.822 25 0.00634 Prepro…
## 6 2 434 25 0.0000627 specif… binary 0.762 25 0.0173 Prepro…
## 7 3 322 19 0.0000000546 accura… binary 0.842 25 0.00600 Prepro…
## 8 3 322 19 0.0000000546 precis… binary 0.946 25 0.00384 Prepro…
## 9 3 322 19 0.0000000546 recall binary 0.861 25 0.00682 Prepro…
## 10 3 322 19 0.0000000546 roc_auc binary 0.897 25 0.00574 Prepro…
## # ℹ 50 more rowscasfut_hyperparametros_xgb %>%
collect_metrics() %>%
pivot_longer(cols = c('mtry','trees','min_n'),
names_to = 'tipo_parametro',
values_to = 'valor_parametro') %>%
ggplot(aes(valor_parametro, mean, color=mean)) +
geom_point() +
facet_grid(.metric~tipo_parametro, scales = 'free' ) +
scale_color_viridis_b()
casfut_hyperparametros_xgb %>% show_best(metric= "roc_auc")## # A tibble: 5 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 5 469 17 0.00126 roc_auc binary 0.898 25 0.00538 Preproc…
## 2 8 390 6 0.00265 roc_auc binary 0.897 25 0.00556 Preproc…
## 3 3 322 19 0.0000000546 roc_auc binary 0.897 25 0.00574 Preproc…
## 4 6 160 8 0.000317 roc_auc binary 0.896 25 0.00530 Preproc…
## 5 2 434 25 0.0000627 roc_auc binary 0.892 25 0.00646 Preproc…casfut_mejor_hyper_xgb <- casfut_hyperparametros_xgb %>% show_best(metric = "roc_auc", n = 1)
casfut_mejor_hyper_xgb## # A tibble: 1 × 10
## mtry trees min_n learn_rate .metric .estimator mean n std_err .config
## <int> <int> <int> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 5 469 17 0.00126 roc_auc binary 0.898 25 0.00538 Preproces…Mejor modelo XGB:
mtry: 5
trees: 469
min_n: 17
learning_rate: 0.00126
Support Vector Machine
set.seed(1234)
casfut_hyperparametros_svm <-
tune_grid(
object = casfut_wf_svm,
resamples = casfut_boot,
metrics = metricas_modelo,
control = control_grid(save_pred = TRUE)
)casfut_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)## # A tibble: 1 × 8
## cost rbf_sigma .metric .estimator mean n std_err .config
## <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 0.0118 0.0545 roc_auc binary 0.914 25 0.00526 Preprocessor1_Model03casfut_mejor_hyper_svm <- casfut_hyperparametros_svm %>% show_best(metric = "roc_auc", n=1)Modelo final M3
Random Forest
casfut_modelo_rf_hyperparametros <-
casfut_wf_rf %>%
finalize_workflow(casfut_mejor_hyper_rf) %>%
fit(data = casfut_training)
set.seed(1256)
casfut_modelo_rf_final <-
casfut_wf_rf %>%
finalize_workflow(casfut_mejor_hyper_rf) %>%
last_fit(casfut_split,
metrics = metricas_modelo)
casfut_modelo_rf_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [495/124]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion RF M3
collect_metrics(casfut_modelo_rf_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.919 Preprocessor1_Model1
## 2 precision binary 0.935 Preprocessor1_Model1
## 3 sensitivity binary 0.971 Preprocessor1_Model1
## 4 specificity binary 0.667 Preprocessor1_Model1
## 5 recall binary 0.971 Preprocessor1_Model1
## 6 roc_auc binary 0.943 Preprocessor1_Model1casfut_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator,-.config) %>%
mutate(valor_redondeado = round(.estimate,2)) %>%
knitr::kable()| .metric | .estimate | valor_redondeado |
|---|---|---|
| accuracy | 0.9193548 | 0.92 |
| precision | 0.9345794 | 0.93 |
| sensitivity | 0.9708738 | 0.97 |
| specificity | 0.6666667 | 0.67 |
| recall | 0.9708738 | 0.97 |
| roc_auc | 0.9431345 | 0.94 |
XGBoost
casfut_modelo_xgb_hyperparametros <-
casfut_wf_xgb %>%
finalize_workflow(casfut_mejor_hyper_xgb) %>%
fit(data = casfut_training) ## [17:44:53] WARNING: src/learner.cc:767:
## Parameters: { "importance" } are not used.set.seed(1256)
casfut_modelo_xgb_final <-
casfut_wf_xgb %>%
finalize_workflow(casfut_mejor_hyper_xgb) %>%
last_fit(casfut_split,
metrics = metricas_modelo)
casfut_modelo_xgb_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [495/124]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion XGB M3
collect_metrics(casfut_modelo_xgb_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.871 Preprocessor1_Model1
## 2 precision binary 0.939 Preprocessor1_Model1
## 3 sensitivity binary 0.903 Preprocessor1_Model1
## 4 specificity binary 0.714 Preprocessor1_Model1
## 5 recall binary 0.903 Preprocessor1_Model1
## 6 roc_auc binary 0.946 Preprocessor1_Model1casfut_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator,-.config) %>%
mutate(valor_redondeado = round(.estimate,2)) %>%
knitr::kable()| .metric | .estimate | valor_redondeado |
|---|---|---|
| accuracy | 0.8709677 | 0.87 |
| precision | 0.9393939 | 0.94 |
| sensitivity | 0.9029126 | 0.90 |
| specificity | 0.7142857 | 0.71 |
| recall | 0.9029126 | 0.90 |
| roc_auc | 0.9459085 | 0.95 |
casfut_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator,-.config) %>%
mutate(valor_redondeado = round(.estimate,2)) %>%
knitr::kable()| .metric | .estimate | valor_redondeado |
|---|---|---|
| accuracy | 0.8709677 | 0.87 |
| precision | 0.9393939 | 0.94 |
| sensitivity | 0.9029126 | 0.90 |
| specificity | 0.7142857 | 0.71 |
| recall | 0.9029126 | 0.90 |
| roc_auc | 0.9459085 | 0.95 |
Support Vector Machine
casfut_modelo_svm_hyperparametros <-
casfut_wf_svm %>%
finalize_workflow(casfut_mejor_hyper_svm) %>%
fit(data = casfut_training)
set.seed(1256)
casfut_modelo_svm_final <-
casfut_wf_svm %>%
finalize_workflow(casfut_mejor_hyper_svm) %>%
last_fit(casfut_split,
metrics = metricas_modelo)
casfut_modelo_svm_final## # Resampling results
## # Manual resampling
## # A tibble: 1 × 6
## splits id .metrics .notes .predictions .workflow
## <list> <chr> <list> <list> <list> <list>
## 1 <split [495/124]> train/test split <tibble> <tibble> <tibble> <workflow>Evaluacion SVM M3
collect_metrics(casfut_modelo_svm_final)## # A tibble: 6 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 accuracy binary 0.806 Preprocessor1_Model1
## 2 precision binary 0.954 Preprocessor1_Model1
## 3 sensitivity binary 0.806 Preprocessor1_Model1
## 4 specificity binary 0.810 Preprocessor1_Model1
## 5 recall binary 0.806 Preprocessor1_Model1
## 6 roc_auc binary 0.921 Preprocessor1_Model1Grafico M3 comparacion modelos
results_modelo3_rf<-
casfut_modelo_rf_final %>%
collect_metrics() %>%
select(-.estimator, -.config)
results_modelo3_xgb<-
casfut_modelo_xgb_final %>%
collect_metrics() %>%
select(-.estimator, -.config)
results_modelo3_svm<-
casfut_modelo_svm_final %>%
collect_metrics() %>%
select(-.estimator, -.config) casm3_results<- data.frame(
metrica = results_modelo3_rf$.metric,
RF = results_modelo3_rf$.estimate,
XGB = results_modelo3_xgb$.estimate,
SVM = results_modelo3_svm$.estimate
)
casm3_results <-
casm3_results %>%
pivot_longer(cols = c("RF", "XGB", "SVM"),
names_to = "modelo") %>%
filter(metrica == "accuracy" |
metrica == "precision" |
metrica == "recall" |
metrica == "roc_auc") %>%
mutate(metrica = factor(metrica),
modelo = factor(modelo))
casm3_results## # A tibble: 12 × 3
## metrica modelo value
## <fct> <fct> <dbl>
## 1 accuracy RF 0.919
## 2 accuracy XGB 0.871
## 3 accuracy SVM 0.806
## 4 precision RF 0.935
## 5 precision XGB 0.939
## 6 precision SVM 0.954
## 7 recall RF 0.971
## 8 recall XGB 0.903
## 9 recall SVM 0.806
## 10 roc_auc RF 0.943
## 11 roc_auc XGB 0.946
## 12 roc_auc SVM 0.921levels(casm3_results$metrica) <- c("Accuracy", "Precision", "Recall", "AUC ROC")
casm3_results %>%
ggplot(aes(x = metrica, y = value, fill = modelo))+
geom_col(position = "dodge")+
scale_fill_brewer(palette= "Pastel2")+
scale_y_continuous(limits = c(0,1), expand = c(0,0))+
labs(y = "",
x = "Metric",
fill= NULL,
title= "")