1 Introducción

Los árboles de decisión son modelos predictivos formados por reglas binarias (sí/no) con las que se consigue repartir las observaciones en función de sus atributos y predecir así el valor de la variable respuesta.

Muchos métodos predictivos generan modelos globales en los que una única ecuación se aplica a todo el espacio muestral. Cuando el caso de uso implica múltiples predictores, que interaccionan entre ellos de forma compleja y no lineal, es muy difícil encontrar un único modelo global que sea capaz de reflejar la relación entre las variables. Los métodos de machine learning basados en árboles engloban a un conjunto de técnicas supervisadas no paramétricas que consiguen segmentar el espacio de los predictores en regiones simples, dentro de las cuales es más sencillo manejar las interacciones. Es esta característica la que les proporciona gran parte de su potencial.

Ventajas

  • Los árboles son fáciles de interpretar aun cuando las relaciones entre predictores son complejas.

  • Los modelos basados en un solo árbol se pueden representar gráficamente aun cuando el número de predictores es mayor de 3.

  • Los árboles pueden, en teoría, manejar tanto predictores numéricos como categóricos sin tener que crear variables dummy.

  • Al tratarse de métodos no paramétricos, no es necesario que se cumpla ningún tipo de distribución específica.

  • Por lo general, requieren mucha menos limpieza y preprocesado de los datos en comparación con otros métodos de aprendizaje estadístico (por ejemplo, no requieren estandarización).

  • No se ven muy influenciados por outliers en comparación con las regresiones lineales.

  • Si para alguna observación, el valor de un predictor no está disponible, a pesar de no poder llegar a ningún nodo terminal, se puede conseguir una predicción empleando todas las observaciones que pertenecen al último nodo alcanzado. La precisión de la predicción se verá reducida pero al menos podrá obtenerse.

  • Son muy útiles en la exploración de datos, permiten identificar de forma rápida y eficiente las variables (predictores) más importantes.

  • Son capaces de seleccionar predictores de forma automática.

  • Pueden aplicarse a problemas de regresión y clasificación.

Desventajas

  • La capacidad predictiva de los modelos basados en un único árbol es bastante inferior a la conseguida con otros modelos. Esto es debido a su tendencia al overfitting y alta varianza. Sin embargo, existen técnicas más complejas que, haciendo uso de la combinación de múltiples árboles (bagging, random forest, boosting), consiguen mejorar en gran medida este problema.

  • Son sensibles a datos de entrenamiento desbalanceados (una de las clases domina sobre las demás).

  • Cuando tratan con predictores continuos, pierden parte de su información al categorizarlos en el momento de la división de los nodos.

  • La creación de las ramificaciones de los árboles se consigue mediante el algoritmo de recursive binary splitting. Este algoritmo identifica y evalúa las posibles divisiones de cada predictor acorde a una determinada medida (RSS, Gini, entropía…). Los predictores continuos tienen mayor probabilidad de contener, solo por azar, algún punto de corte óptimo, por lo que suelen verse favorecidos en la creación de los árboles.

  • No son capaces de extrapolar fuera del rango de los predictores observado en los datos de entrenamiento.

2 Tutorial práctico

En esta clase utilizaremos datos sobre hongos. Nuestro objetivo será predecir si un hongo es comestible. Para tal fin, aprenderemos a entrenar un modelo de árbol de decisión y evaluaremos su desempeño.

Note además que para esta clase los datos ya se encuentran partidos en Train y Test, con la particularidad de que para Test no observamos nuestra variable de interés sobre fraude. Se destinarán los últimos 30 minutos de la clase para que los estudiantes construyan su propio modelo y envien al correo de ambos complementarios un vector y_hat correspondiente a sus predicciones de y_test. Los mejores resultados recibirán una bonificación sobre el Problem Set 2.

# Cargamos las librerías necesarias
library(pacman)
p_load(tidyverse, ggplot2, doParallel, rattle, MLmetrics,
       janitor, fastDummies, tidymodels, caret)

# Cargamos los datos
X_train <- read_csv("Data/X_train.csv")
y_train <- read_csv("Data/y_train.csv")
X_test  <- read_csv("Data/X_test.csv")

# Limpiamos el nombre de las variables
X_train <- clean_names(X_train)
X_test <- clean_names(X_test)

Ahora procederemos a estudiar un poco la estructura de los datos.

# Estudiamos la estructura de los datos de train
glimpse(X_train)
## Rows: 27,513
## Columns: 11
## $ cap_diameter         <dbl> 6.58, 4.77, 6.17, 13.12, 15.24, 4.43, 9.36, 2.52,…
## $ cap_shape            <chr> "x", "x", "x", "x", "f", "c", "x", "f", "c", "x",…
## $ cap_color            <chr> "w", "y", "y", "n", "n", "n", "n", "y", "n", "n",…
## $ does_bruise_or_bleed <lgl> FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FAL…
## $ gill_color           <chr> "w", "y", "y", "y", "n", "w", "w", "y", "w", "w",…
## $ stem_height          <dbl> 3.22, 4.23, 7.96, 9.67, 4.73, 11.85, 6.85, 8.15, …
## $ stem_width           <dbl> 8.07, 10.73, 13.72, 24.21, 26.30, 11.80, 9.15, 3.…
## $ stem_color           <chr> "w", "w", "w", "n", "n", "w", "w", "y", "n", "n",…
## $ has_ring             <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, …
## $ habitat              <chr> "d", "d", "d", "d", "g", "d", "d", "g", "d", "h",…
## $ season               <chr> "a", "u", "u", "u", "u", "u", "a", "u", "u", "u",…
# Distribución de la marca
prop.table(table(y_train))
## class
##         e         p 
## 0.8903427 0.1096573
# Dimensión de X_test
dim(X_test)
## [1] 3057   11
# Cantidad de NAs en la base de prueba y testeo
sum(is.na(X_train))
## [1] 0
sum(is.na(X_test))
## [1] 0
# Estadísticas descriptivas de Train
summary(X_train)
##   cap_diameter     cap_shape          cap_color         does_bruise_or_bleed
##  Min.   : 0.500   Length:27513       Length:27513       Mode :logical       
##  1st Qu.: 4.110   Class :character   Class :character   FALSE:22486         
##  Median : 6.570   Mode  :character   Mode  :character   TRUE :5027          
##  Mean   : 7.592                                                             
##  3rd Qu.: 9.270                                                             
##  Max.   :62.340                                                             
##   gill_color         stem_height       stem_width      stem_color       
##  Length:27513       Min.   : 0.000   Min.   :  0.00   Length:27513      
##  Class :character   1st Qu.: 5.000   1st Qu.:  6.69   Class :character  
##  Mode  :character   Median : 6.190   Median : 12.31   Mode  :character  
##                     Mean   : 6.943   Mean   : 13.95                     
##                     3rd Qu.: 7.750   3rd Qu.: 18.07                     
##                     Max.   :33.920   Max.   :103.91                     
##   has_ring         habitat             season         
##  Mode :logical   Length:27513       Length:27513      
##  FALSE:21288     Class :character   Class :character  
##  TRUE :6225      Mode  :character   Mode  :character  
##                                                       
##                                                       
## 

Nuestra base de entrenamiento tiene más de 30 mil observaciones y 11 variables predictoras. Note además que nos enfrentamos a un problema de clasificación desbalanceado dondo solo solo el 27% de los hongos son venenosos. Finalmente, la base para la evaluación tiene casi 4 mil observaciones.

Adicionalmente, nos podemos percatar que nuestra base no tiene ningún valor faltante. Sin embargo, tenemos variables continuas y categóricas.

Comenzaremos realizando nuestro ejercicio sin preocuparnos por el desbalance y vamos a aplicar un modelo de árboles.

Dado que tenemos algunas variables categóricas, las vamos a dummyficar. Para hacer esto vamos a combinar X_train y X_test solo para este paso pensando en que queremos que el modelo se entrene con todas las categorías posibles aún si para algunos casos estas no están disponibles en X_train.

# Primero vamos a construir las variables dicótomas
X_train$base <- "Train"
X_test$base <- "Test"
X <- rbind(X_train, X_test)

# Veamos la cantidad de valores únicos para cada variable categórica y su distribución
filtro <- !sapply(X, is.numeric)
categoricas <- names(X)[filtro]
categoricas <- categoricas[categoricas != "base"]

for (var in categoricas) {
  frecuencia <- prop.table(table(X[, var]))
  len <- nrow(frecuencia)
  print(paste("Cantidad de valores únicos para la variable", var, "son:", len))
  frecuencia <- round(100*frecuencia, 1)
  print(frecuencia)
}
## [1] "Cantidad de valores únicos para la variable cap_shape son: 7"
## cap_shape
##    b    c    f    o    p    s    x 
##  5.6  2.9 23.5  3.5  5.5 12.1 46.9 
## [1] "Cantidad de valores únicos para la variable cap_color son: 12"
## cap_color
##    b    e    g    k    l    n    o    p    r    u    w    y 
##  3.3  3.9  8.1  1.9  1.6 44.4  4.4  1.9  1.1  2.4 13.6 13.5 
## [1] "Cantidad de valores únicos para la variable does_bruise_or_bleed son: 2"
## does_bruise_or_bleed
## FALSE  TRUE 
##  81.9  18.1 
## [1] "Cantidad de valores únicos para la variable gill_color son: 12"
## gill_color
##    b    e    f    g    k    n    o    p    r    u    w    y 
##  2.4  1.2  5.3  7.7  3.5 11.9  4.6  9.2  2.1  1.6 35.7 14.8 
## [1] "Cantidad de valores únicos para la variable stem_color son: 13"
## stem_color
##    b    e    f    g    k    l    n    o    p    r    u    w    y 
##  0.6  2.3  0.3  5.5  0.9  0.4 27.4  3.2  0.7  0.5  2.1 46.1 10.0 
## [1] "Cantidad de valores únicos para la variable has_ring son: 2"
## has_ring
## FALSE  TRUE 
##  77.4  22.6 
## [1] "Cantidad de valores únicos para la variable habitat son: 8"
## habitat
##    d    g    h    l    m    p    u    w 
## 73.9  9.8  2.7  6.8  5.2  0.1  0.4  1.2 
## [1] "Cantidad de valores únicos para la variable season son: 4"
## season
##    a    s    u    w 
## 47.5  5.5 35.9 11.1
# Creamos las dummies
X <- dummy_cols(X, select_columns = categoricas, 
                remove_selected_columns = T)
X_train <- X %>%
  filter(base == "Train") %>%
  select(-base)
X_test <- X %>%
  filter(base == "Test") %>%
  select(-base)

Ahora vamos a dividir nuestra base de X_train en dos para poder escoger los mejores hiperparámetros y la mejor especificación antes de realizar las predicciones finales.

# Creamos una copia de seguridad de nuestra base
df <- cbind(y_train, X_train)

# Partimos nuestra base aleatoriamente. Así garantizamos que se conserve la distribución en las marcas.
set.seed(666)
n <- 0.8*nrow(df)
n <- round(n, 0)
index <- sample(1:nrow(df), n)
train_set <- df[index,]
test_set <- df[-index,]

# Verificamos que la partición sea adecuada
prop.table(table(train_set$class))
## 
##         e         p 
## 0.8911404 0.1088596
prop.table(table(test_set$class))
## 
##         e         p 
## 0.8871525 0.1128475

2.1 Árbol de decisión básico

Nuestro primer modelo no se preocupará por el inbalance en los datos y tampoco se escogerá ningún hiperparámetro. Este modelo servirá de benchmark. Note que no vamos a escalar las variables pues en los modelos de árboles no es necesario.

# Convertimos la marca a factor
train_set$class <- factor(train_set$class)
test_set$class <- factor(test_set$class)

# Creamos el primer modelo
modelo1 <- decision_tree() %>%
  set_engine("rpart") %>%
  set_mode("classification")

# Dado que estos modelos son computacionalmente demandantes, vamos a distribuir los cálculos en diferentes nucleos de nuestro procesador para acelerar el proceso.

# Identificamos cuántos cores tiene nuestra máquina
n_cores <- detectCores()
print(paste("Mi PC tiene", n_cores, "nucleos"))
## [1] "Mi PC tiene 16 nucleos"
# Vamos a usar n_cores - 2 procesadores para esto
cl <- makePSOCKcluster(n_cores - 6) 
registerDoParallel(cl)

# Entrenamos el modelo utilizando procesamiento en paralelo
modelo1_fit <- fit(modelo1, class ~ ., data = train_set)

# Liberamos nuestros procesadores
stopCluster(cl)

A continuación se representa el modelo ajustado y las variables más importantes.

# Cortes del modelo
modelo1_fit
## parsnip model object
## 
## n= 22010 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 22010 2396 e (0.89114039 0.10885961)  
##     2) stem_height>=2.145 21871 2260 e (0.89666682 0.10333318)  
##       4) stem_width>=8.125 15029 1094 e (0.92720740 0.07279260)  
##         8) cap_color_r< 0.5 14877 1023 e (0.93123614 0.06876386) *
##         9) cap_color_r>=0.5 152   71 e (0.53289474 0.46710526)  
##          18) stem_width>=18.055 74    8 e (0.89189189 0.10810811) *
##          19) stem_width< 18.055 78   15 p (0.19230769 0.80769231) *
##       5) stem_width< 8.125 6842 1166 e (0.82958199 0.17041801)  
##        10) stem_height< 8.045 6684 1055 e (0.84216038 0.15783962)  
##          20) stem_height>=4.095 5447  672 e (0.87662934 0.12337066)  
##            40) stem_color_u< 0.5 5418  643 e (0.88132152 0.11867848)  
##              80) cap_shape_p< 0.5 5390  615 e (0.88589981 0.11410019) *
##              81) cap_shape_p>=0.5 28    0 p (0.00000000 1.00000000) *
##            41) stem_color_u>=0.5 29    0 p (0.00000000 1.00000000) *
##          21) stem_height< 4.095 1237  383 e (0.69037995 0.30962005)  
##            42) stem_color_w>=0.5 747  102 e (0.86345382 0.13654618) *
##            43) stem_color_w< 0.5 490  209 p (0.42653061 0.57346939)  
##              86) cap_diameter>=2.465 305  108 e (0.64590164 0.35409836)  
##               172) stem_height>=3.775 163   22 e (0.86503067 0.13496933) *
##               173) stem_height< 3.775 142   56 p (0.39436620 0.60563380) *
##              87) cap_diameter< 2.465 185   12 p (0.06486486 0.93513514) *
##        11) stem_height>=8.045 158   47 p (0.29746835 0.70253165) *
##     3) stem_height< 2.145 139    3 p (0.02158273 0.97841727) *
# Gráfica del modelo
fancyRpartPlot(modelo1_fit$fit, main = "Árbol sin fine tuning", 
               sub = "")

# Importancia de las variables
importancia <- varImp(modelo1_fit$fit)
importancia <- importancia %>%
  data.frame() %>%
  rownames_to_column(var = "Variable") %>%
  mutate(Porcentaje = Overall/sum(Overall)) %>%
  filter(Porcentaje > 0) %>%
  arrange(desc(Porcentaje))

ggplot(importancia, aes(x = Porcentaje, 
                        y = reorder(Variable, Porcentaje))) +
  geom_bar(stat = "identity", fill = "darkblue", alpha = 0.8) +
  labs(y = "Variable") +
  scale_x_continuous(labels = scales::percent) +
  theme_classic()

Note que nuestro árbol no utiliza todas las variables disponibles. Por lo pronto vamos a evaluar el desempeño del modelo en la base de entrenamiento y en la base de testeo.

y_hat_insample <- predict(modelo1_fit, train_set)$.pred_class
y_hat_outsample <- predict(modelo1_fit, test_set)$.pred_class

cm_insample <- confusionMatrix(train_set$class, y_hat_insample,
                               positive = "p")$table
cm_outsample <- confusionMatrix(test_set$class, y_hat_outsample,
                               positive = "p")$table

# Confusion Matrix insample
cm_insample
##           Reference
## Prediction     e     p
##          e 19481   133
##          p  1770   626
# Confusion Matrix outsample
cm_outsample
##           Reference
## Prediction    e    p
##          e 4837   45
##          p  485  136
acc_in <- Accuracy(y_true = train_set$class, y_pred = y_hat_insample)
acc_in <- round(100*acc_in, 2)
pre_in <- Precision(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
pre_in <- round(100*pre_in, 2)
recall_in <- Recall(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
recall_in <- round(100*recall_in, 2)
f1_in <- F1_Score(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
f1_in <- round(100*f1_in, 2)

acc_out <- Accuracy(y_true = test_set$class, y_pred = y_hat_outsample)
acc_out <- round(100*acc_out, 2)
pre_out <- Precision(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
pre_out <- round(100*pre_out, 2)
recall_out <- Recall(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
recall_out <- round(100*recall_out, 2)
f1_out <- F1_Score(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
f1_out <- round(100*f1_out, 2)

resultados <- data.frame(Modelo = "Modelo 1", Base = c("Train", "Test"), 
                         Accuracy = c(acc_in, acc_out), 
                         Precision = c(pre_in, pre_out),
                         Recall = c(recall_in, recall_out),
                         F1 = c(f1_in, f1_out))
Modelo Base Accuracy Precision Recall F1
Modelo 1 Train 91.35 82.48 26.13 39.68
Modelo 1 Test 90.37 75.14 21.90 33.92

2.2 Encontrar los mejores hiperparámetros

Dado el desbalance, es claro que la métrica de Accuracy no es la mejor pues es engañosamente alta. Nuestro modelo en la base de entrenamiento es ligeramente superior a la base de validación, por ende es probable contar con algo de overfitting.

Para solucionar esto, vamos a tunear algunos hiperparámetros:

  • cost_complexity = Un número positivo para el parámetro de costo/complejidad (también conocido como Cp) utilizado por los modelos CART.
  • tree_depth = Un número entero para la profundidad máxima del árbol.
  • min_n = Un número entero para la cantidad mínima de puntos de datos en un nodo que se requieren para que el nodo se divida más.
# Creamos modelo
modelo2 <- decision_tree(
  cost_complexity = tune(),
  tree_depth = tune(),
  min_n = tune()
) %>%
  set_engine("rpart") %>%
  set_mode("classification")

# Creamos grilla
# tree_grid <- grid_regular(
#   cost_complexity(), 
#   min_n(),
#   tree_depth(), 
#   levels = 4)

tree_grid <- crossing(
  cost_complexity = c(0.0001),
  min_n = c(2, 14, 27),
  tree_depth = c(4, 8, 16)
)

# Definimos CV
set.seed(666)
folds <- vfold_cv(train_set, strata = class, v = 5)

# Entrenamos el modelo utilizando procesamiento en paralelo
cl <- makePSOCKcluster(n_cores - 6) 
registerDoParallel(cl)

set.seed(666)
modelo2_cv <- tune_grid(
  modelo2,
  class ~ .,
  resamples = folds,
  grid = tree_grid,
  metrics = metric_set(f_meas),
  control = control_grid(event_level = 'second')
)

# Liberamos nuestros procesadores
stopCluster(cl)
Analicemos los resultados
cost_complexity tree_depth min_n .metric .estimator mean n std_err .config
1e-04 4 2 f_meas binary 0.2134339 5 0.0174394 Preprocessor1_Model1
1e-04 8 2 f_meas binary 0.5098538 5 0.0114834 Preprocessor1_Model2
1e-04 16 2 f_meas binary 0.7941753 5 0.0095137 Preprocessor1_Model3
1e-04 4 14 f_meas binary 0.2131813 5 0.0173543 Preprocessor1_Model4
1e-04 8 14 f_meas binary 0.5021649 5 0.0116089 Preprocessor1_Model5
1e-04 16 14 f_meas binary 0.7858460 5 0.0138635 Preprocessor1_Model6
1e-04 4 27 f_meas binary 0.2130135 5 0.0173006 Preprocessor1_Model7
1e-04 8 27 f_meas binary 0.4880311 5 0.0137821 Preprocessor1_Model8
1e-04 16 27 f_meas binary 0.7623006 5 0.0192191 Preprocessor1_Model9
collect_metrics(modelo2_cv)
autoplot(modelo2_cv) + 
  theme_light() +
  labs(y = "F1 Score")

# Escogemos el mejor modelo
modelo2 <- finalize_model(modelo2, select_best(modelo2_cv))
# Entrenamos el mejor modelo
modelo2_fit <- fit(modelo2, class ~ ., train_set)
# Cortes del modelo
# modelo2_fit
# Gráfica del modelo
fancyRpartPlot(modelo2_fit$fit, main = "Árbol con fine tuning", 
               sub = "")

# Importancia de las variables
importancia <- varImp(modelo2_fit$fit)
importancia <- importancia %>%
  data.frame() %>%
  rownames_to_column(var = "Variable") %>%
  mutate(Porcentaje = Overall/sum(Overall)) %>%
  filter(Porcentaje > 0) %>%
  arrange(desc(Porcentaje))

ggplot(importancia, aes(x = Porcentaje, 
                        y = reorder(Variable, Porcentaje))) +
  geom_bar(stat = "identity", fill = "darkblue", alpha = 0.8) +
  labs(y = "Variable") +
  scale_x_continuous(labels = scales::percent) +
  theme_classic()

# Evaluamos
y_hat_insample <- predict(modelo2_fit, train_set)$.pred_class
y_hat_outsample <- predict(modelo2_fit, test_set)$.pred_class

cm_insample <- confusionMatrix(train_set$class, y_hat_insample,
                               positive = "p")$table
cm_outsample <- confusionMatrix(test_set$class, y_hat_outsample,
                               positive = "p")$table

# Confusion Matrix insample
cm_insample
##           Reference
## Prediction     e     p
##          e 19594    20
##          p   582  1814
# Confusion Matrix outsample
cm_outsample
##           Reference
## Prediction    e    p
##          e 4856   26
##          p  204  417
acc_in <- Accuracy(y_true = train_set$class, y_pred = y_hat_insample)
acc_in <- round(100*acc_in, 2)
pre_in <- Precision(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
pre_in <- round(100*pre_in, 2)
recall_in <- Recall(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
recall_in <- round(100*recall_in, 2)
f1_in <- F1_Score(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
f1_in <- round(100*f1_in, 2)

acc_out <- Accuracy(y_true = test_set$class, y_pred = y_hat_outsample)
acc_out <- round(100*acc_out, 2)
pre_out <- Precision(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
pre_out <- round(100*pre_out, 2)
recall_out <- Recall(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
recall_out <- round(100*recall_out, 2)
f1_out <- F1_Score(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
f1_out <- round(100*f1_out, 2)

resultados2 <- data.frame(Modelo = "Modelo 2: Grid search", Base = c("Train", "Test"), 
                          Accuracy = c(acc_in, acc_out), 
                          Precision = c(pre_in, pre_out),
                          Recall = c(recall_in, recall_out),
                          F1 = c(f1_in, f1_out))

resultados <- rbind(resultados, resultados2)
Modelo Base Accuracy Precision Recall F1
Modelo 1 Train 91.35 82.48 26.13 39.68
Modelo 1 Test 90.37 75.14 21.90 33.92
Modelo 2: Grid search Train 97.26 98.91 75.71 85.77
Modelo 2: Grid search Test 95.82 94.13 67.15 78.38

2.3 Corregir inbalance

Dado que nuestra base está desbalanceada, recomendamos tener en cuenta los siguientes aspectos:

  • En caso de que haga un undersampling o un oversampling, nunca realice una evaluación del modelo sobre los datos después de este proceso. La evaluación de los modelos debe ser sobre los datos sin balancear.

  • Si queremos implementar la validación cruzada, recuerde sobremuestrear o submuestrear sus datos de entrenamiento durante la validación cruzada, no antes

  • No utilice la métrica de accuracy en conjuntos de datos desbalanceados (por lo general, será alta y engañosa); en su lugar, utilice las métricas de f1, precision o recall.

# Implementamos oversampling
receta <- recipe(class ~ ., data = train_set) %>%
  themis::step_smote(class)

# Creamos modelo
modelo3 <- decision_tree(
  cost_complexity = tune(),
  tree_depth = tune()
) %>%
  set_engine("rpart") %>%
  set_mode("classification")

# Creamos un workflow
wflow <- workflow() %>%
  add_recipe(receta) %>%
  add_model(modelo3)

tree_grid <- crossing(
  cost_complexity = c(0.01, 0.001, 0.0001),
  tree_depth = c(10, 15, 20, 25, 30)
)

# Definimos CV
set.seed(666)
folds <- vfold_cv(train_set, strata = class, v = 5)

# Entrenamos el modelo utilizando procesamiento en paralelo
cl <- makePSOCKcluster(n_cores - 6) 
registerDoParallel(cl)

set.seed(666)
modelo3_cv <- tune_grid(
  wflow,
  resamples = folds,
  grid = tree_grid,
  metrics = metric_set(f_meas),
  control = control_grid(event_level = 'second')
)

# Liberamos nuestros procesadores
stopCluster(cl)
Analicemos los resultados
cost_complexity tree_depth .metric .estimator mean n std_err .config
1e-04 10 f_meas binary 0.5824719 5 0.0192289 Preprocessor1_Model01
1e-04 15 f_meas binary 0.7841591 5 0.0135390 Preprocessor1_Model02
1e-04 20 f_meas binary 0.8379721 5 0.0058445 Preprocessor1_Model03
1e-04 25 f_meas binary 0.8573159 5 0.0031838 Preprocessor1_Model04
1e-04 30 f_meas binary 0.8584941 5 0.0025974 Preprocessor1_Model05
1e-03 10 f_meas binary 0.5578347 5 0.0184063 Preprocessor1_Model06
1e-03 15 f_meas binary 0.7096877 5 0.0111508 Preprocessor1_Model07
1e-03 20 f_meas binary 0.7292978 5 0.0066587 Preprocessor1_Model08
1e-03 25 f_meas binary 0.7317327 5 0.0069872 Preprocessor1_Model09
1e-03 30 f_meas binary 0.7317327 5 0.0069872 Preprocessor1_Model10
1e-02 10 f_meas binary 0.3618010 5 0.0098295 Preprocessor1_Model11
1e-02 15 f_meas binary 0.3618010 5 0.0098295 Preprocessor1_Model12
1e-02 20 f_meas binary 0.3618010 5 0.0098295 Preprocessor1_Model13
1e-02 25 f_meas binary 0.3618010 5 0.0098295 Preprocessor1_Model14
1e-02 30 f_meas binary 0.3618010 5 0.0098295 Preprocessor1_Model15
collect_metrics(modelo3_cv)
autoplot(modelo3_cv) + 
  theme_light() +
  labs(y = "F1 Score")

# Escogemos el mejor modelo
modelo3 <- finalize_model(modelo3, select_best(modelo3_cv))
# Entrenamos el mejor modelo
modelo3_fit <- fit(modelo3, class ~ ., train_set)
# Cortes del modelo
# modelo3_fit
# Gráfica del modelo
fancyRpartPlot(modelo3_fit$fit, main = "Árbol con fine tuning + oversampling", 
               sub = "")

# Importancia de las variables
importancia <- varImp(modelo3_fit$fit)
importancia <- importancia %>%
  data.frame() %>%
  rownames_to_column(var = "Variable") %>%
  mutate(Porcentaje = Overall/sum(Overall)) %>%
  filter(Porcentaje > 0) %>%
  arrange(desc(Porcentaje))

ggplot(importancia, aes(x = Porcentaje, 
                        y = reorder(Variable, Porcentaje))) +
  geom_bar(stat = "identity", fill = "darkblue", alpha = 0.8) +
  labs(y = "Variable") +
  scale_x_continuous(labels = scales::percent) +
  theme_classic()

# Evaluamos
y_hat_insample <- predict(modelo3_fit, train_set)$.pred_class
y_hat_outsample <- predict(modelo3_fit, test_set)$.pred_class

cm_insample <- confusionMatrix(train_set$class, y_hat_insample,
                               positive = "p")$table
cm_outsample <- confusionMatrix(test_set$class, y_hat_outsample,
                               positive = "p")$table

# Confusion Matrix insample
cm_insample
##           Reference
## Prediction     e     p
##          e 19469   145
##          p   237  2159
# Confusion Matrix outsample
cm_outsample
##           Reference
## Prediction    e    p
##          e 4826   56
##          p   95  526
acc_in <- Accuracy(y_true = train_set$class, y_pred = y_hat_insample)
acc_in <- round(100*acc_in, 2)
pre_in <- Precision(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
pre_in <- round(100*pre_in, 2)
recall_in <- Recall(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
recall_in <- round(100*recall_in, 2)
f1_in <- F1_Score(y_true = train_set$class, y_pred = y_hat_insample,
                               positive = "p")
f1_in <- round(100*f1_in, 2)

acc_out <- Accuracy(y_true = test_set$class, y_pred = y_hat_outsample)
acc_out <- round(100*acc_out, 2)
pre_out <- Precision(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
pre_out <- round(100*pre_out, 2)
recall_out <- Recall(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
recall_out <- round(100*recall_out, 2)
f1_out <- F1_Score(y_true = test_set$class, y_pred = y_hat_outsample,
                               positive = "p")
f1_out <- round(100*f1_out, 2)

resultados3 <- data.frame(Modelo = "Modelo 3: Grid search + Oversampling", Base = c("Train", "Test"), 
                          Accuracy = c(acc_in, acc_out), 
                          Precision = c(pre_in, pre_out),
                          Recall = c(recall_in, recall_out),
                          F1 = c(f1_in, f1_out))

resultados <- rbind(resultados, resultados3)
Modelo Base Accuracy Precision Recall F1
Modelo 1 Train 91.35 82.48 26.13 39.68
Modelo 1 Test 90.37 75.14 21.90 33.92
Modelo 2: Grid search Train 97.26 98.91 75.71 85.77
Modelo 2: Grid search Test 95.82 94.13 67.15 78.38
Modelo 3: Grid search + Oversampling Train 98.26 93.71 90.11 91.87
Modelo 3: Grid search + Oversampling Test 97.26 90.38 84.70 87.45