Contents

1 Introducción

Ahora que se ha cubierto el entrenamiento y el preprocesamiento de datos, para continuar con la modelación predictiva a través de la clasificación, la atención se centrará en cómo dividir los datos, cómo evaluar la precisión de la predicción y cómo elegir los parámetros del modelo para maximizar el rendimiento.

Para comenzar, se cargan las librerías necesarias, se lee la base de datos y se hace una visualización del diagrama de dispersión de concavity_mean vs smoothness_mean coloreada por diagnosis.

# librerías
library(tidyverse)
library(tidymodels)
# datos
cancer <- read_csv("wdbc.csv") %>%
  mutate(diagnosis = as_factor(diagnosis)) # convertir variable character a factor
# paleta de color
cbPalette <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#999999")
# diagrama de dispersión concavity_mean vs smoothness_mean,
# diagnosis es la etiqueta de clase
perim_concav <- cancer %>%
  ggplot(aes(x = smoothness_mean, y = concavity_mean, color = diagnosis)) +
  geom_point(alpha = 0.5) +
  labs(color = "diagnosis") +
  scale_color_manual(labels = c("Malignant", "Benign"), values = cbPalette)
perim_concav

1.1 Crear la división entrenamiento / prueba

Una vez decidida la pregunta predictiva que se responderá y tras realizar una exploración preliminar, lo siguiente es dividir los datos en los conjuntos de entrenamiento y prueba. Normalmente, el conjunto de entrenamiento está entre el \(50\) y el \(100\) por ciento de los datos, mientras que el conjunto de prueba es el \(0-50\) por ciento restante

La intuición es que se desea intercambiar entre entrenar un modelo preciso (utilizando un conjunto de datos de entrenamiento más grande) y obtener una evaluación precisa de su rendimiento (utilizando un conjunto de datos de prueba más grande). Aquí, se usará el \(75\) por ciento de los datos para entrenamiento y el \(25\) por ciento para pruebas. Esto se lleva a cabo con la función initial_split, especificando que prop = 0.75 y la variable objetivo es diagnosis:

set.seed(1)
cancer_split <- initial_split(cancer, prop = 0.75, strata = diagnosis)
cancer_train <- training(cancer_split)
cancer_test <- testing(cancer_split)
glimpse(cancer_train[,1:12])
## Rows: 426
## Columns: 12
## $ id                     <dbl> 8510426, 8510653, 8510824, 857373, 857810, 8584…
## $ diagnosis              <fct> B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B,…
## $ radius_mean            <dbl> 13.540, 13.080, 9.504, 13.640, 13.050, 8.618, 1…
## $ texture_mean           <dbl> 14.36, 15.71, 12.44, 16.34, 19.31, 11.79, 14.88…
## $ perimeter_mean         <dbl> 87.46, 85.63, 60.34, 87.21, 82.61, 54.34, 64.55…
## $ area_mean              <dbl> 566.3, 520.0, 273.9, 571.8, 527.2, 224.5, 311.9…
## $ smoothness_mean        <dbl> 0.09779, 0.10750, 0.10240, 0.07685, 0.08060, 0.…
## $ compactness_mean       <dbl> 0.08129, 0.12700, 0.06492, 0.06059, 0.03789, 0.…
## $ concavity_mean         <dbl> 0.066640, 0.045680, 0.029560, 0.018570, 0.00069…
## $ `concave points_mean`  <dbl> 0.047810, 0.031100, 0.020760, 0.017230, 0.00416…
## $ symmetry_mean          <dbl> 0.1885, 0.1967, 0.1815, 0.1353, 0.1819, 0.1683,…
## $ fractal_dimension_mean <dbl> 0.05766, 0.06811, 0.06905, 0.05953, 0.05501, 0.…
glimpse(cancer_test[,1:12])
## Rows: 143
## Columns: 12
## $ id                     <dbl> 84501001, 846381, 84799002, 849014, 852763, 853…
## $ diagnosis              <fct> M, M, M, M, M, M, M, B, M, M, M, B, B, B, B, B,…
## $ radius_mean            <dbl> 12.460, 15.850, 14.540, 19.810, 14.580, 18.630,…
## $ texture_mean           <dbl> 24.04, 23.95, 27.54, 22.15, 21.53, 25.11, 21.59…
## $ perimeter_mean         <dbl> 83.97, 103.70, 96.73, 130.00, 97.41, 124.80, 11…
## $ area_mean              <dbl> 475.9, 782.7, 658.8, 1260.0, 644.8, 1088.0, 869…
## $ smoothness_mean        <dbl> 0.11860, 0.08401, 0.11390, 0.09831, 0.10540, 0.…
## $ compactness_mean       <dbl> 0.23960, 0.10020, 0.15950, 0.10270, 0.18680, 0.…
## $ concavity_mean         <dbl> 0.22730, 0.09938, 0.16390, 0.14790, 0.14250, 0.…
## $ `concave points_mean`  <dbl> 0.085430, 0.053640, 0.073640, 0.094980, 0.08783…
## $ symmetry_mean          <dbl> 0.2030, 0.1847, 0.2303, 0.1582, 0.2252, 0.2183,…
## $ fractal_dimension_mean <dbl> 0.08243, 0.05338, 0.07077, 0.05395, 0.06924, 0.…

Del código anterior se observa que el conjunto de entrenamiento contiene \(426\) observaciones, mientras que el conjunto de prueba contiene \(143\) observaciones. Esto corresponde a una división de entrenamiento / prueba del \(75\) / \(25\) por ciento.

1.2 Pre-procesamiento y entrenamiento

Como se mencionó anteriormente, la clasificación es sensible a la escala de los predictores, por lo que se debe realizar un pre-procesamiento para estandarizarlos. Una consideración adicional a tener en cuenta al hacer esto es que el pre-procesamiento de estandarización utiliza sólo los datos de entrenamiento. Esto asegura que los datos de prueba no influyan en ningún aspecto al entrenar modelos. Una vez que hayamos creada la estandarización, se aplica por separado a los datos de entrenamiento y de prueba.

Con el marco de referencia de recipe en tidymodels se maneja este paso correctamente. A continuación, se construye la recipe utilizando sólo los datos de entrenamiento.

cancer_recipe <- recipe(diagnosis ~ smoothness_mean + concavity_mean, data = cancer_train) %>%
  step_scale(all_predictors()) %>%
  step_center(all_predictors())

Con esta división se puede crear la clasificación de regresión logística con sólo el conjunto de entrenamiento empleando smoothness_mean y concavity_mean como predictores.

set.seed(1)
log_reg <- logistic_reg() %>%
  set_engine("glm") %>% 
  set_mode("classification")
log_fit3 <- workflow() %>%
  add_recipe(cancer_recipe) %>%
  add_model(log_reg) %>%
  fit(data = cancer_train)
log_fit3
## ══ Workflow [trained] ══════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 2 Recipe Steps
## 
## • step_scale()
## • step_center()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## 
## Call:  stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)
## 
## Coefficients:
##     (Intercept)  smoothness_mean   concavity_mean  
##          0.5089          -0.1150          -2.8031  
## 
## Degrees of Freedom: 425 Total (i.e. Null);  423 Residual
## Null Deviance:       562.9 
## Residual Deviance: 293   AIC: 299

1.3 Predicciones

Teniendo un objeto clasificador, se predicen las etiquetas de clase para el conjunto de prueba. Se usa bind_cols para agregar la columna de predicciones a los datos de prueba originales, creando el data frame cancer_test_predictions. La variable diagnosis contiene los diagnósticos verdaderos, mientras que .pred_class contiene los diagnósticos predichos por la clasificación.

cancer_test_predictions <- predict(log_fit3, cancer_test) %>%
  bind_cols(cancer_test)
cancer_test_predictions
## # A tibble: 143 x 33
##    .pred_class       id diagnosis radius_mean texture_mean perimeter_mean
##    <fct>          <dbl> <fct>           <dbl>        <dbl>          <dbl>
##  1 M           84501001 M                12.5         24.0           84.0
##  2 B             846381 M                15.8         24.0          104. 
##  3 M           84799002 M                14.5         27.5           96.7
##  4 M             849014 M                19.8         22.2          130  
##  5 M             852763 M                14.6         21.5           97.4
##  6 M             853401 M                18.6         25.1          125. 
##  7 M             854253 M                16.7         21.6          110. 
##  8 B             854941 B                13.0         18.4           82.6
##  9 M             855138 M                13.5         20.8           88.4
## 10 B             855167 M                13.4         21.6           86.2
## # … with 133 more rows, and 27 more variables: area_mean <dbl>,
## #   smoothness_mean <dbl>, compactness_mean <dbl>, concavity_mean <dbl>,
## #   concave points_mean <dbl>, symmetry_mean <dbl>,
## #   fractal_dimension_mean <dbl>, radius_se <dbl>, texture_se <dbl>,
## #   perimeter_se <dbl>, area_se <dbl>, smoothness_se <dbl>,
## #   compactness_se <dbl>, concavity_se <dbl>, concave points_se <dbl>,
## #   symmetry_se <dbl>, fractal_dimension_se <dbl>, radius_worst <dbl>,
## #   texture_worst <dbl>, perimeter_worst <dbl>, area_worst <dbl>,
## #   smoothness_worst <dbl>, compactness_worst <dbl>, concavity_worst <dbl>,
## #   concave points_worst <dbl>, symmetry_worst <dbl>,
## #   fractal_dimension_worst <dbl>

2 Evaluación en la modelación

2.1 Precisión

Para evaluar la precisión del clasificador se utiliza la función de metrics en tidymodels para obtener las estadísticas sobre la calidad de la modelación, especificando su veracidad en la estimación.

cancer_test_predictions %>%
  metrics(truth = diagnosis, estimate = .pred_class)
## # A tibble: 2 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.853
## 2 kap      binary         0.671

Esto muestra que la precisión del clasificador en los datos de prueba fue del \(85\) por ciento. También es de gran utilidad mirar la matriz de confusión para el clasificador, que muestra la tabla de etiquetas predichas y etiquetas correctas, usando la función conf_mat.

cancer_test_predictions %>%
  conf_mat(truth = diagnosis, estimate = .pred_class)
##           Truth
## Prediction  M  B
##          M 37  5
##          B 16 85

Esto dice que el clasificador etiquetó correctamente \(37 + 85 = 122\) observaciones, \(16\) observaciones como benignas cuando eran verdaderamente malignas y \(5\) observaciones como malignas cuando eran verdaderamente benignas.

La gran mayoría de la modelación predictiva en estadística y aprendizaje automático tienen parámetros que se deben elegir.

¿Es posible hacer esta selección, es decir, ajustar el modelo, de una manera basada en principios?

Idealmente, se busca maximizar de alguna manera el rendimiento de la clasificación en datos no observados. Entonces, se vuelve a aplicar la misma idea anterior al evaluar la clasificación: se dividie al conjunto de datos de entrenamiento en dos subconjuntos, el de entrenamiento y en un nuevo llamado conjunto de validación. Se vuelve a usar el conjunto de entrenamiento para construir el modelo y el conjunto de validación para evaluarlo. Luego, se prueban diferentes valores de los parámetros y se eligen los que arrojen la mayor precisión.

2.2 Validación cruzada

Hay un detalle importante que mencionar sobre el proceso de ajuste: se puede, si así se desea, dividir las bases de datos de entrenamiento de múltiples formas diferentes, entrenar y evaluar un clasificador para cada división y luego elegir el parámetro basado en todos los los diferentes resultados. Si sólo se dividen las bases de datos de entrenamiento generales una vez, la mejor elección de parámetros dependerá en gran medida de los datos que tuvieron la suerte de terminar en el conjunto de validación. Utilizando múltiples divisiones de entrenamiento / validación diferentes, se obtiene una mejor estimación de la precisión.

En particular, se utilizarán diferentes valores de inicialización en la función set.seed para generar cinco divisiones de entrenamiento / validación diferentes para la base de datos de entrenamiento general, entrenar cinco modelos de clasificación diferentes y evaluar su precisión.

accuracies <- c()
for (i in 1:5) {
  set.seed(i) # hace que la selección aleatoria de filas sea reproducible 
# crear la división 25/75 de los datos en entrenamiento y validación 
  cancer_split <- initial_split(cancer_train, prop = 0.75, strata = diagnosis)
  cancer_subtrain <- training(cancer_split)
  cancer_validation <- testing(cancer_split)
# recrear la recipe anterior (basada en los datos de entrenamiento)
  cancer_recipe <- recipe(diagnosis ~ smoothness_mean + concavity_mean, data = cancer_subtrain) %>%
    step_scale(all_predictors()) %>%
    step_center(all_predictors())
# ajustar el modelo log_fit3 anterior
  log_fit3 <- workflow() %>%
    add_recipe(cancer_recipe) %>%
    add_model(log_reg) %>%
    fit(data = cancer_subtrain)
# obtener predicciones sobre los datos de validación 
  validation_predicted <- predict(log_fit3, cancer_validation) %>%
    bind_cols(cancer_validation)
# calcular la precisión
  acc <- validation_predicted %>%
    metrics(truth = diagnosis, estimate = .pred_class) %>%
    filter(.metric == "accuracy") %>%
    select(.estimate) %>%
    pull()
  accuracies <- append(accuracies, acc)
}
accuracies
## [1] 0.8878505 0.8317757 0.8785047 0.8878505 0.8971963

Con cinco combinaciones diferentes de datos, se obtienen cinco valores diferentes de precisión. Ninguno de estos es necesariamente más correcto que cualquier otro; son solo cinco estimaciones de la verdadera precisión subyacente para la clasificación creada con la base de datos de entrenamiento general. Se pueden combinar las estimaciones tomando su promedio (aquí \(0.8878505\)) para intentar obtener una única evaluación de la precisión del modelo; esto tiene el efecto de reducir la influencia de cualquier conjunto de validación (des) afortunado en la estimación.

En la práctica, no se usan divisiones aleatorias, sino que se usa un procedimiento de división más estructurado para que cada observación en el conjunto de datos se use en un conjunto de validación sólo una vez. El nombre de esta estrategia se llama validación cruzada. En la validación cruzada, se dividen las bases de datos generales de entrenamiento en \(C\) fragmentos de tamaño uniforme, y luego se usa iterativamente \(1\) fragmento como el conjunto de validación y se combinan los \(C-1\) fragmentos restantes como el conjunto de entrenamiento.

Para hacer una validación cruzada de \(5\) pliegues en R con tidymodels, se usa otra función: vfold_cv. Esta función divide la base de datos de entrenamiento en v pliegues automáticamente:

cancer_vfold <- vfold_cv(cancer_train, v = 5, strata = diagnosis)
cancer_vfold
## #  5-fold cross-validation using stratification 
## # A tibble: 5 x 2
##   splits           id   
##   <list>           <chr>
## 1 <split [340/86]> Fold1
## 2 <split [340/86]> Fold2
## 3 <split [341/85]> Fold3
## 4 <split [341/85]> Fold4
## 5 <split [342/84]> Fold5

Luego, al crear un flujo de trabajo de análisis de datos, se usa la función fit_resamples en lugar de la función fit para el entrenamiento. Esto ejecuta una validación cruzada en cada división de entrenamiento / validación.

set.seed(1)

cancer_recipe <- recipe(diagnosis ~ smoothness_mean + concavity_mean, data = cancer_train) %>%
  step_scale(all_predictors()) %>%
  step_center(all_predictors())

log_fit3 <- workflow() %>%
  add_recipe(cancer_recipe) %>%
  add_model(log_reg) %>%
  fit_resamples(resamples = cancer_vfold)
log_fit3
## # Resampling results
## # 5-fold cross-validation using stratification 
## # A tibble: 5 x 4
##   splits           id    .metrics         .notes          
##   <list>           <chr> <list>           <list>          
## 1 <split [340/86]> Fold1 <tibble [2 × 4]> <tibble [0 × 1]>
## 2 <split [340/86]> Fold2 <tibble [2 × 4]> <tibble [0 × 1]>
## 3 <split [341/85]> Fold3 <tibble [2 × 4]> <tibble [0 × 1]>
## 4 <split [341/85]> Fold4 <tibble [2 × 4]> <tibble [0 × 1]>
## 5 <split [342/84]> Fold5 <tibble [2 × 4]> <tibble [0 × 1]>

La función collect_metrics se utiliza para agregar la media y el error estándar de la precisión de validación del clasificador en los pliegues. El error estándar es una medida de cuánta incertidumbre se tiene sobre el valor medio; aproximadamente, si su media estimada (que la da collect_metrics) es \(0.88\) y el error estándar es \(0.02\), se puede esperar que la precisión promedio real del clasificador esté aproximadamente entre \(0.86\) y \(0.90\) (aunque puede caer fuera de este rango).

log_fit3 %>% collect_metrics()
## # A tibble: 2 x 6
##   .metric  .estimator  mean     n std_err .config             
##   <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
## 1 accuracy binary     0.876     5  0.0246 Preprocessor1_Model1
## 2 roc_auc  binary     0.939     5  0.0208 Preprocessor1_Model1

Se pueden elegir cualquier número de pliegues y, por lo general, cuantos más se usen, mejor será la estimación de precisión. La limitación viene dada por la potencia computacional: cuantos más pliegues se elijan, más cálculos se necesitan.

Entonces, cuando se realiza una validación cruzada, se debe considerar el tamaño de los datos, la velocidad del algoritmo y la velocidad de cada computadora. En la práctica, este es un proceso de prueba y error, pero normalmente \(C\) se elige para que sea \(5\) o \(10\).

Como ilustración, se muestra cómo el error estándar disminuye cuando se usa una validación cruzada de \(10\) pliegues en lugar de \(5\):

cancer_vfold <- vfold_cv(cancer_train, v = 10, strata = diagnosis)

workflow() %>%
  add_recipe(cancer_recipe) %>%
  add_model(log_reg) %>%
  fit_resamples(resamples = cancer_vfold) %>%
  collect_metrics()
## # A tibble: 2 x 6
##   .metric  .estimator  mean     n std_err .config             
##   <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
## 1 accuracy binary     0.880    10  0.0178 Preprocessor1_Model1
## 2 roc_auc  binary     0.941    10  0.0119 Preprocessor1_Model1

2.3 Penalización

Para ilustrar el proceso de validación, en lugar de usar múltiples iteraciones de remuestreo, se crerá un solo remuestreo para el conjunto de validación. En tidymodels, un conjunto de validación se trata como una única iteración de remuestreo. Esta será una división de la muestras diagnosticadas que no se usaron para las pruebas, con cancer_train. Esta división crea dos nuevos conjuntos de datos:

  • El conjunto presentado con el fin de medir el rendimiento, denominado conjunto de validación, y

  • Los datos restantes utilizados para ajustar el modelo, denominados conjunto de entrenamiento.

Se usará la función validation_split() para asignar el \(20\) por ciento de los diagnósticos en cancer_train al conjunto de validación y el resto al conjunto de entrenamiento. Esto significa que las métricas de rendimiento se calcularán en un solo conjunto de \(86\) diagnósticos.

set.seed(234)
val_set <- validation_split(cancer_train, 
                            strata = diagnosis, 
                            prop = 0.80)
val_set
## # Validation Set Split (0.8/0.2)  using stratification 
## # A tibble: 1 x 2
##   splits           id        
##   <list>           <chr>     
## 1 <split [340/86]> validation

Esta función, como initial_split(), tiene el mismo argumento de estratos, que usa muestreo estratificado para crear el remuestreo. Esto significa que se tendrán aproximadamente las mismas proporciones de muestras con diagnóstico de benignidad y malignidad en los nuevos conjuntos de validación y entrenamiento, en comparación con las proporciones originales de cancer_train.

Dado que la variable objetiva es categórica, se ha empleado la regresión logística como una buena primer modelación. Ahora, se toma un modelo que pueda realizar la selección de funciones durante el entrenamiento. La librería glmnet de R se ajusta a un modelo lineal generalizado a través de la máxima verosimilitud penalizada. Este método de estimación de los parámetros de pendiente de regresión logística utiliza una penalización en el proceso para que los predictores menos relevantes se dirijan hacia un valor de cero. Uno de los métodos de penalización de glmnet, llamado método de lasso, puede realmente establecer las pendientes del predictor en cero si se usa una penalización lo suficientemente grande.

Para especificar un modelo de regresión logística penalizado que usa una penalización de selección de características, se usa la librería parsnip con el motor glmnet:

lr_mod <- 
  logistic_reg(penalty = tune(), mixture = 1) %>% 
  set_engine("glmnet")

Se establece el argumento de penalty = tune() como marcador de posición por ahora. Este es un hiperparámetro de modelo que ajustaremos para encontrar el mejor valor para hacer predicciones con la base de datos. Establecer la mezcla en un valor de uno significa que el modelo glmnet eliminará potencialmente predictores irrelevantes y elegirá un modelo más simple.

Cuando se especifica la modelación, se puede especificar la penalización a utilizar: lasso, ridge o una red elástica. La ecuación general a minimizar es:

\[RSS +{\lambda}\Bigg((1-{\alpha})\sum_{i=1}^p {\beta}_j^2 + {\alpha}¸\sum_{i=1}^p |{\beta}_j|\Bigg).\]

\({\lambda}\) es el término de penalización, y al contar con \({\lambda}\) y \({\alpha}\) positivas, se va a llevar a cabo un promedio ponderado entre la regresión lasso y la regresión ridge (red elástica). Al contar con \({\alpha}=1\) se lleva a cabo la regresión lasso y si \({\alpha}=0\) se lleva a cabo la regresión ridge. Dentro de glmnet, el hiperparámetro penalty es \({\lambda}\) y el hiperparámetro mixture es \({\alpha}\) (que es un valor entre \(0\) y \(1\)). La validación permite ajustar estos hiperparámetros.

2.4 Workflow

Se agrupa lr_mod y cancer_recipe en un solo objeto del tipo workflow():

lr_workflow <- 
  workflow() %>% 
  add_model(lr_mod) %>% 
  add_recipe(cancer_recipe)

Antes de ajustar este modelo, se configura una cuadrícula de valores de penalización para ajustar. La función dials::grid_regular() permite crear una cuadrícula expandida basada en una combinación de dos hiperparámetros. Como solo tenemos un hiperparámetro para ajustar en lasso, se puede configurar la cuadrícula manualmente usando una tibble de una columna con \(30\) valores candidatos:

lr_reg_grid <- tibble(penalty = 10^seq(-4, -1, length.out = 30))
lr_reg_grid %>% top_n(-5) # valor de penalziación más bajo
## # A tibble: 5 x 1
##    penalty
##      <dbl>
## 1 0.0001  
## 2 0.000127
## 3 0.000161
## 4 0.000204
## 5 0.000259
lr_reg_grid %>% top_n(5)  # valor de penalziación más alto
## # A tibble: 5 x 1
##   penalty
##     <dbl>
## 1  0.0386
## 2  0.0489
## 3  0.0621
## 4  0.0788
## 5  0.1

Se emplea tune::tune_grid() para entrenar estos \(30\) modelos de regresión logística penalizados. También se guardarán las predicciones del conjunto de validación (a través de la llamada a control_grid()) para que la información de diagnóstico pueda estar disponible después del ajuste del modelo. El área bajo la curva ROC se utilizará para cuantificar qué tan bien se desempeña el modelo en un continuo de umbrales de eventos.

lr_res <- 
  lr_workflow %>% 
  tune_grid(val_set,
            grid = lr_reg_grid,
            control = control_grid(save_pred = TRUE),
            metrics = metric_set(roc_auc))

Podría ser más fácil visualizar las métricas del conjunto de validación trazando el área bajo la curva ROC contra el rango de valores de penalización:

lr_plot <- 
  lr_res %>% 
  collect_metrics() %>% 
  ggplot(aes(x = penalty, y = mean)) + 
  geom_point() + 
  geom_line() + 
  ylab("Área bajo la curva ROC") +
  scale_x_log10(labels = scales::label_number())
lr_res 
## # Tuning results
## # Validation Set Split (0.8/0.2)  using stratification 
## # A tibble: 1 x 5
##   splits          id         .metrics         .notes         .predictions       
##   <list>          <chr>      <list>           <list>         <list>             
## 1 <split [340/86… validation <tibble [30 × 5… <tibble [0 × … <tibble [2,580 × 6…
lr_plot

Estas gráficas muestran que el rendimiento del modelo es generalmente mejor con el valor de penalización cercano a \(0.01\). Esto sugiere que la mayoría de los predictores son importantes para el modelo. También se ve una ligera caída en el área bajo la curva ROC hacia los valores de penalización mayores a \(0.01\). Esto sucede porque una penalización lo suficientemente grande eliminará todos los predictores del modelo y, como era de esperar, la precisión predictiva se desploma sin predictores en el modelo (un valor de ROC-AUC de \(0.50\) significa que el modelo no hace mejor que la posibilidad de predecir la clase correcta).

El rendimiento de la clasificación parece estabilizarse en un único valor, por lo que seguir la métrica roc_auc por sí sola podría llevarnos a una opción para el mejor valor para este hiperparámetro.

top_models <-
  lr_res %>% 
  show_best("roc_auc") %>% 
  arrange(penalty) 
top_models
## # A tibble: 5 x 7
##   penalty .metric .estimator  mean     n std_err .config              
##     <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
## 1  0.0149 roc_auc binary     0.936     1      NA Preprocessor1_Model22
## 2  0.0189 roc_auc binary     0.936     1      NA Preprocessor1_Model23
## 3  0.0240 roc_auc binary     0.936     1      NA Preprocessor1_Model24
## 4  0.0304 roc_auc binary     0.936     1      NA Preprocessor1_Model25
## 5  0.0386 roc_auc binary     0.936     1      NA Preprocessor1_Model26

Cada modelo candidato en este tibble probablemente incluye más variables predictoras que el modelo en la fila debajo de él. El modelo candidato \(1\) con un valor de penalización de \(0.0149\), ofrece mayor interpretabilidad al considerar más peso en los predictores.

top_models <-
  lr_res %>% 
  show_best("roc_auc") %>% 
  arrange(penalty) 
top_models
## # A tibble: 5 x 7
##   penalty .metric .estimator  mean     n std_err .config              
##     <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
## 1  0.0149 roc_auc binary     0.936     1      NA Preprocessor1_Model22
## 2  0.0189 roc_auc binary     0.936     1      NA Preprocessor1_Model23
## 3  0.0240 roc_auc binary     0.936     1      NA Preprocessor1_Model24
## 4  0.0304 roc_auc binary     0.936     1      NA Preprocessor1_Model25
## 5  0.0386 roc_auc binary     0.936     1      NA Preprocessor1_Model26

Sin embargo, es posible que la elección de un valor de penalización más a lo largo del eje \(x\), más cerca de donde se comienza a ver la disminución en el rendimiento del modelo. Por ejemplo, el modelo candidato \(2\) con un valor de penalización de \(0.0189\) tiene efectivamente el mismo rendimiento que el mejor modelo numérico, pero podría eliminar más predictores. En general, es mejor tener menos predictores irrelevantes. Si el rendimiento es aproximadamente el mismo, preferimos elegir un valor de penalización más alto.

Se puede seleccionar este valor y visualizar la curva ROC del conjunto de validación:

lr_best <- 
  lr_res %>% 
  collect_metrics() %>% 
  arrange(penalty) %>% 
  slice(2)
lr_best
## # A tibble: 1 x 7
##    penalty .metric .estimator  mean     n std_err .config              
##      <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
## 1 0.000127 roc_auc binary     0.935     1      NA Preprocessor1_Model02
lr_auc <- 
  lr_res %>% 
  collect_predictions(parameters = lr_best)

2.5 Puntajes

lr_auc
## # A tibble: 86 x 7
##    id         .pred_M   .pred_B  .row  penalty diagnosis .config              
##    <chr>        <dbl>     <dbl> <int>    <dbl> <fct>     <chr>                
##  1 validation  0.0368 0.963         7 0.000127 B         Preprocessor1_Model02
##  2 validation  1.00   0.000430     11 0.000127 B         Preprocessor1_Model02
##  3 validation  0.0260 0.974        24 0.000127 B         Preprocessor1_Model02
##  4 validation  0.257  0.743        28 0.000127 B         Preprocessor1_Model02
##  5 validation  0.0478 0.952        29 0.000127 B         Preprocessor1_Model02
##  6 validation  0.0688 0.931        34 0.000127 B         Preprocessor1_Model02
##  7 validation  0.0321 0.968        38 0.000127 B         Preprocessor1_Model02
##  8 validation  0.337  0.663        45 0.000127 B         Preprocessor1_Model02
##  9 validation  0.728  0.272        46 0.000127 B         Preprocessor1_Model02
## 10 validation  1.00   0.0000118    47 0.000127 B         Preprocessor1_Model02
## # … with 76 more rows
lr_auc <- 
  lr_res %>% 
  collect_predictions(parameters = lr_best) %>% 
  roc_curve(diagnosis, .pred_M) %>% 
  mutate(model = "Regresión Logistica")
autoplot(lr_auc)

3 Referencias