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.
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
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 |
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 |
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 |