Aprendizaje Supervisado. Árboles de decisión
Implementación en tidymodels
Germán Rosati
05 mayo, 2025
El problema
El eje de estas clases va a ser predecir si la participación de las
personas en el trabajo doméstico del hogar, en base a los resultados de
la Encuesta de Uso del Tiempo (2021). Vamos a tomar como insumo la
variable TCS_GRUPO_DOMESTICO para construir una variable
dicotómica que clasisifica a las personas según si realizan o no trabajo
doméstico en el hogar. Vamos a considerar que la persona realizó trabajo
doméstico si lo hizo durante al menos 2 horas en el día.
TCS_GRUPO_DOMESTICO son los minutos totales dedicados a
las actividades de trabajo doméstico en un día, independientemente de si
se realizó otra actividad en simultáneo.
¿Qué variables podríamos utilizar?
Vamos a tratar de predecir si las personas realizan o no trabajo doméstico en base al sexo, edad, la condición de actividad, la región, el nivel educativo, la relación con el/la jefe/a de hogar, la cantidad de demandantes de cuidado en el hogar, la cantidad de no demandantes de cuidado y si ese miembro del hogar es demandante o no de cuidado.
Importación y preprocesamiento de los datos
Primero, vamos vamos a leer la base, recodificar algunas variables y generar nuestra variable dicotómica Y.
library(tidyverse)
data <- read_delim("./data/enut2021_base.txt", delim = "|")
data <- data %>% select(ID, SEXO_SEL, EDAD_SEL, TCS_GRUPO_DOMESTICO, CONDICION_ACTIVIDAD_AGRUPADA,
NIVEL_EDUCATIVO_AGRUPADO, CANT_DEMANDANTES_TOTAL, CANT_NODEMANDANTES_TOTAL,
BHCH04_SEL, BHDC_SEL) %>%
mutate(realiza_domest = as.factor(case_when(
TCS_GRUPO_DOMESTICO > 120 ~ "Realiza",
TRUE ~ "No realiza")))
data <- data %>% mutate_at(
vars(SEXO_SEL),
~as.factor(case_when(
. == 1 ~ "Mujer",
. == 2 ~ "Varón"
)))
data <- data %>% mutate_at(vars(CONDICION_ACTIVIDAD_AGRUPADA),
~as.factor(case_when(
. == 1 ~ "Ocupado",
. == 2 ~ "No ocupado"
)))
data <- data %>% mutate_at(vars(BHCH04_SEL),
~as.factor(case_when(
. == 1 ~ "Jefe/a",
. == 2 ~ "Cónyuge/pareja",
. == 3 ~ "Hijo/a",
. == 4 ~ "Hijastro/a",
. == 5 ~ "Yerno/nuera",
. == 6 ~ "Nieto/a",
. == 7 ~ "Padre o madre",
. == 8 ~ "Suegro/a",
. == 9 ~ "Hermano/a",
. == 10 ~ "Cuñado/a",
. == 11 ~ "Sobrino/a",
. == 12 ~ "Abuelo/a",
. == 13 ~ "Otro familiar",
. == 14 ~ "Otro no familiar")))
data <- data %>% mutate_at(vars(BHDC_SEL),
~as.factor(case_when(
. == 0 ~ "No es demandante de cuidado",
. == 1 ~ "Es demandante de cuidado"
)))
data <- data %>% select(-TCS_GRUPO_DOMESTICO)Luego, vamos a importar tidymodels, que es el paquete que vamos a estar usando para trabajar con modelos:
library(tidymodels)¿Cuántos valores tenemos de cada caso?
summary(data$realiza_domest)## No realiza Realiza
## 6745 7605Modelado
Partición train/test
Lo próximo a hacer para empezar el modelo es crear una partición de datos en train y test. Recuerden que esto es muy importante, ya que queremos entrenar el modelo con nuestro conjunto de datos pero también queremos ver cómo funcionaría con datos nuevos.
set.seed(123)
split <- initial_split(data)
train <- training(split)
test <- testing(split)
table(train$realiza_domest)##
## No realiza Realiza
## 5094 5668Feature engineering
Nuestra muestra está bastante desbalanceada, pero nos vamos a encargar de ello ahora en el workflow.
A continuación, procesamos las variable haciendo la “receta” del
modelo. Con recipe() especificamos un set de
transformaciones que queremos hacer sobre el modelo. Su principal
argumento es la fórmula del modelo, que en nuestro caso es
realiza_domest ~ .. También vamos a usar
step_other() para agrupar las categorías de relación con
jefe de hogar minoritarias.
library(themis)
recipe <- recipe(realiza_domest ~ ., data = train)%>%
update_role(ID, new_role = "id") %>%
step_other(BHCH04_SEL, threshold = 0.2)A continuación, vamos a construir el workflow()de
trabajo. Recordemos que en un workflow podemos agrupar las etapas de
preprocesamiento, modelado e incluso, funciones de post-modelado.
Agregamos la receta que hicimos con add_recipe.
wf <- workflow() %>%
add_recipe(recipe)Tuneando los hiperparámetros
Ahora, vamos a armar nuestro modelo para el workflow. En este punto es importante tener en cuenta que no hay una única manera de hacer un árbol de decisión. Existen distintos hiperparámetros que podemos modificar que van a cambiar la complejidad y performance del árbol. Desde tidymodels puedo modificar tres: el umbral de la métrica de pureza para definir la complejidad del árbol, la profundidad del árbol y el mínimo de variables que tiene que tener cada partición del nodo.
Como a priori no tenemos forma de saber qué combinación de
hiperparámetros es mejor para cada caso, tenemos que hacer una prueba
con varios a través de cross-validation y ver cuál funciona mejor. Por
eso, en este workflow primero vamos a crear un árbol de decisión con
parámetros “vacíos”. Únicamente vamos a pasar la función
tune(), con la cual le damos a entender a
tidymodels que vamos a pasar y probar una serie de
distintos parámetros para el árbol de decisión. Es decir,
tune() nos sirve para identificar cuáles son los
hiperparámetros que vamos a tunear.
tree_spec <- decision_tree(
cost_complexity = tune(),
tree_depth = tune(),
min_n = tune()
) %>%
set_engine("rpart") %>%
set_mode("classification")
tree_spec %>% translate()## Decision Tree Model Specification (classification)
##
## Main Arguments:
## cost_complexity = tune()
## tree_depth = tune()
## min_n = tune()
##
## Computational engine: rpart
##
## Model fit template:
## rpart::rpart(formula = missing_arg(), data = missing_arg(), weights = missing_arg(),
## cp = tune(), maxdepth = tune(), minsplit = min_rows(tune(),
## data))Una vez instanciado el modelo, lo metemos en el workflow.
tree_wf <- wf %>%
add_model(tree_spec)Con la función grid_regular() armamos una serie de
combinaciones aleatorias posibles para los parámetros del modelo. Le
decimos que nos de 4 niveles de valores posibles para cada uno de los
parámetros, y que los combine. Acá es donde introducimos hiperparámetros
para la prepoda y post-poda del árbol:
cost_complexity():es un número que recorta los nodos del árbol, empezando por aquellos que tengan la mayor pureza. Postpoda.tree_depth():es un número que define la máxima cantidad de particiones que puede llegar a tener el modelo. Prepoda.min_n():mínimo número de puntos que debe haber en un nodo para que el árbol se siga partiendo hacia abajo. Prepoda.
set.seed(1912)
tree_grid <- grid_regular(cost_complexity(), tree_depth(), min_n(), levels = 4)
tree_grid## # A tibble: 64 × 3
## cost_complexity tree_depth min_n
## <dbl> <int> <int>
## 1 0.0000000001 1 2
## 2 0.0000001 1 2
## 3 0.0001 1 2
## 4 0.1 1 2
## 5 0.0000000001 5 2
## 6 0.0000001 5 2
## 7 0.0001 5 2
## 8 0.1 5 2
## 9 0.0000000001 10 2
## 10 0.0000001 10 2
## # ℹ 54 more rowsTambién podríamos definir de forma manual una grilla de
hiperparámetros. Por ejemplo, con la función
crossing():
crossing(
cost_complexity =seq(0,1,0.1),
tree_depth = seq(1,15,5),
min_n = seq(2,40,5)
)## # A tibble: 264 × 3
## cost_complexity tree_depth min_n
## <dbl> <dbl> <dbl>
## 1 0 1 2
## 2 0 1 7
## 3 0 1 12
## 4 0 1 17
## 5 0 1 22
## 6 0 1 27
## 7 0 1 32
## 8 0 1 37
## 9 0 6 2
## 10 0 6 7
## # ℹ 254 more rowsO con expand_grid():
expand.grid(
cost_complexity =seq(0.1,1,0.05),
tree_depth = seq(1,15,10),
min_n = seq(2,40,10)
) %>% head()## cost_complexity tree_depth min_n
## 1 0.10 1 2
## 2 0.15 1 2
## 3 0.20 1 2
## 4 0.25 1 2
## 5 0.30 1 2
## 6 0.35 1 2Vamos a hacer un paréntesis para explicar un poquito mejor en qué
consiste el parámetro de cost_complexity().
Cost-complexity prunning
Como charlamos en la parte teórica, la estrategia de controlar el tamaño del árbol mediante reglas de pre-poda tiene un inconveniente: el árbol se crece seleccionando la mejor división en cada momento. Al evaluar las divisiones sin tener en cuenta las que vendrán después, nunca se elige la opción que resulta en el mejor árbol final, a no ser que también sea la que genera en ese momento la mejor división. A este tipo de estrategias se les conoce como greedy.
Un ejemplo que ilustra el problema de este tipo de estrategia es el siguiente: supóngase que un coche circula por el carril izquierdo de una carretera de dos carriles en la misma dirección. En el carril que se encuentra hay muchos coches circulando a 100 km/h, mientras que el otro carril se encuentra vacío. A cierta distancia se observa que hay un vehículo circulando por el carril derecho a 20 km/h. Si el objetivo del conductor es llegar a su destino lo antes posible tiene dos opciones: cambiarse de carril o mantenerse en el que está. Una aproximación de tipo greedy evaluaría la situación en ese instante y determinaría que la mejor opción es cambiarse de carril y acelerar a más de 100 km/h, sin embargo, a largo plazo, esta no es la mejor solución, ya que una vez alcance al vehículo lento, tendrá que reducir mucho su velocidad.
Una alternativa no greedy que consigue evitar el overfitting consiste en generar árboles grandes, sin condiciones de parada más allá de las necesarias por las limitaciones computacionales, para después podarlos (post-pruning), manteniendo únicamente la estructura robusta que consigue un test error bajo. La selección del sub-árbol óptimo puede hacerse mediante cross-validation, sin embargo, dado que los árboles se crecen lo máximo posible (tienen muchos nodos terminales) no suele ser viable estimar el test error de todas las posibles sub-estructuras que se pueden generar. En su lugar, se recurre al cost complexity pruning o weakest link pruning.
Cost complexity pruning es un método de penalización de tipo Loss + Penalty, similar al empleado en ridge regression o lasso. Así, si nos encontráramos ante un problema de regresión, se busca el sub-árbol T que minimiza la ecuación:
\[\sum_{j=1}^{|T|}\sum_{i \in R_j}(y_{i}-y_{R_{j}})^2 + \alpha|T|\] donde \(|T|\) es el número de nodos terminales del árbol.
El primer término de la ecuación se corresponde con la suma total de los residuos cuadrados Por definición, cuantos más nodos terminales tenga el modelo menor será esta parte de la ecuación. El segundo término es la restricción, que penaliza al modelo en función del número de nodos terminales (a mayor número, mayor penalización). El grado de penalización se determina mediante el tuning parameter \(\alpha\).
Así, cuando \(\alpha=0\) la penalización es nula y el árbol resultante es equivalente al árbol original. A medida que se incrementa \(\alpha\), la penalización es mayor y, como consecuencia, los árboles resultantes son de menor tamaño. El valor óptimo de \(\alpha\) puede identificarse mediante validación cruzada.
Algoritmo para crear un árbol de regresión con pruning 1. Se emplea recursive binary splitting para crear un árbol grande y complejo (\(T_{0}\)) empleando los datos de training y reduciendo al máximo posible las condiciones de parada. Normalmente se emplea como única condición de parada el número mínimo de observaciones por nodo terminal.
Se aplica el cost complexity pruning al árbol \(T_{0}\) para obtener el mejor sub-árbol en función de \(\alpha\). Es decir, se obtiene el mejor sub-árbol para un rango de valores de \(\alpha\).
Identificación del valor óptimo de \(\alpha\) mediante k-cross-validation. Se divide el training data set en \(K\) grupos. Para \(k=1, …, k=K\):
- Repetir pasos 1 y 2 empleando todas las observaciones excepto las del grupo \(k_{i}\).
- Evaluar el mean squared error para el rango de valores de \(\alpha\) empleando el grupo \(k_{i}\).
- Obtener el promedio de los \(K\) mean squared error calculados para cada valor \(\alpha\).
Seleccionar el sub-árbol del paso 2 que se corresponde con el valor \(\alpha\) que ha conseguido el menor cross-validation mean squared error en el paso 3.
En el caso de los árboles de clasificación, en lugar de emplear la suma de residuos cuadrados como criterio de selección, se emplea alguna de las métricas de error como accuracy, precision, recall, f1, AUC, etc.
Seguimos tuneando…
Hacemos las muestras de cross-validation.
set.seed(111)
folds <- vfold_cv(train, v = 10)
tidy(folds)## # A tibble: 107,620 × 3
## Row Data Fold
## <int> <chr> <chr>
## 1 1 Analysis Fold01
## 2 1 Analysis Fold02
## 3 1 Analysis Fold03
## 4 1 Analysis Fold05
## 5 1 Analysis Fold06
## 6 1 Analysis Fold07
## 7 1 Analysis Fold08
## 8 1 Analysis Fold09
## 9 1 Analysis Fold10
## 10 2 Analysis Fold01
## # ℹ 107,610 more rowsAhora vamos a probar los posibles valores que puede adoptar el modelo con los distintos parámetros en las muestras con cross-validation.
library(future)
plan(multisession, workers = 8)
set.seed(345)
tree_rs <- tree_wf %>%
tune_grid(
resamples = folds,
grid = tree_grid,
metrics = metric_set(roc_auc, precision,
recall, f_meas)
)
#write_rds(tree_rs, './data/cart_rs.rds')Podemos ver los resultados de este objeto con
collect_metrics().
collect_metrics(tree_rs)## # A tibble: 256 × 9
## cost_complexity tree_depth min_n .metric .estimator mean n std_err
## <dbl> <int> <int> <chr> <chr> <dbl> <int> <dbl>
## 1 0.0000000001 1 2 f_meas binary 0.619 10 0.00494
## 2 0.0000000001 1 2 precision binary 0.641 10 0.00626
## 3 0.0000000001 1 2 recall binary 0.600 10 0.00659
## 4 0.0000000001 1 2 roc_auc binary 0.649 10 0.00451
## 5 0.0000001 1 2 f_meas binary 0.619 10 0.00494
## 6 0.0000001 1 2 precision binary 0.641 10 0.00626
## 7 0.0000001 1 2 recall binary 0.600 10 0.00659
## 8 0.0000001 1 2 roc_auc binary 0.649 10 0.00451
## 9 0.0001 1 2 f_meas binary 0.619 10 0.00494
## 10 0.0001 1 2 precision binary 0.641 10 0.00626
## # ℹ 246 more rows
## # ℹ 1 more variable: .config <chr>Evaluación del training set
Con la función autoplot() podemos hacer de manera
sencilla un gráfico que nos visualice las métricas de cada una de las
variantes del modelo.
autoplot(tree_rs) 
Parecería que este dataset funciona mejor con un árbol no tan complejo. Podemos seguir examinando el mejor set de parámetros según la métrica que queramos.
show_best(tree_rs, metric="roc_auc")## # A tibble: 5 × 9
## cost_complexity tree_depth min_n .metric .estimator mean n std_err
## <dbl> <int> <int> <chr> <chr> <dbl> <int> <dbl>
## 1 0.0001 10 40 roc_auc binary 0.751 10 0.00419
## 2 0.0000000001 10 40 roc_auc binary 0.751 10 0.00403
## 3 0.0000001 10 40 roc_auc binary 0.751 10 0.00403
## 4 0.0001 15 40 roc_auc binary 0.748 10 0.00388
## 5 0.0000000001 15 40 roc_auc binary 0.747 10 0.00369
## # ℹ 1 more variable: .config <chr>E incluso podemos elegir el mejor modelo de esas pruebas cross-validation para implementar en el modelo final.
best_model <- select_best(tree_rs, metric="roc_auc")
final_tree <- finalize_model(tree_spec, best_model)
final_tree## Decision Tree Model Specification (classification)
##
## Main Arguments:
## cost_complexity = 1e-04
## tree_depth = 10
## min_n = 40
##
## Computational engine: rpartHasta acá, el modelo está actualizado y finalizado (no lo podemos
seguir tuneando con distintos parámetros). Pero nos resta
fitearlo al dataset de entrenamiento, lo que vamos a hacer con
la función fit().
final_fit <- tree_wf %>% update_model(final_tree) %>% fit(train)
write_rds(final_fit, './data/cart_final_train.rds') # Lo persistimos
final_fit## ══ Workflow [trained] ══════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: decision_tree()
##
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 1 Recipe Step
##
## • step_other()
##
## ── Model ───────────────────────────────────────────────────────────────────────
## n= 10762
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 10762 5094 Realiza (0.47333209 0.52666791)
## 2) SEXO_SEL=Varón 4772 1716 No realiza (0.64040235 0.35959765)
## 4) EDAD_SEL< 50.5 3110 874 No realiza (0.71897106 0.28102894)
## 8) EDAD_SEL< 19.5 375 45 No realiza (0.88000000 0.12000000) *
## 9) EDAD_SEL>=19.5 2735 829 No realiza (0.69689214 0.30310786)
## 18) EDAD_SEL< 34.5 1353 356 No realiza (0.73688101 0.26311899)
## 36) CONDICION_ACTIVIDAD_AGRUPADA=Ocupado 1112 274 No realiza (0.75359712 0.24640288) *
## 37) CONDICION_ACTIVIDAD_AGRUPADA=No ocupado 241 82 No realiza (0.65975104 0.34024896)
## 74) BHCH04_SEL=other 175 45 No realiza (0.74285714 0.25714286) *
## 75) BHCH04_SEL=Cónyuge/pareja,Jefe/a 66 29 Realiza (0.43939394 0.56060606)
## 150) EDAD_SEL< 28.5 46 23 No realiza (0.50000000 0.50000000)
## 300) EDAD_SEL< 22.5 18 8 No realiza (0.55555556 0.44444444) *
## 301) EDAD_SEL>=22.5 28 13 Realiza (0.46428571 0.53571429) *
## 151) EDAD_SEL>=28.5 20 6 Realiza (0.30000000 0.70000000) *
## 19) EDAD_SEL>=34.5 1382 473 No realiza (0.65774240 0.34225760)
## 38) CONDICION_ACTIVIDAD_AGRUPADA=Ocupado 1285 417 No realiza (0.67548638 0.32451362)
## 76) CANT_NODEMANDANTES_TOTAL>=1.5 981 300 No realiza (0.69418960 0.30581040)
## 152) EDAD_SEL>=35.5 901 269 No realiza (0.70144284 0.29855716) *
## 153) EDAD_SEL< 35.5 80 31 No realiza (0.61250000 0.38750000)
## 306) CANT_DEMANDANTES_TOTAL< 1.5 61 20 No realiza (0.67213115 0.32786885) *
## 307) CANT_DEMANDANTES_TOTAL>=1.5 19 8 Realiza (0.42105263 0.57894737) *
## 77) CANT_NODEMANDANTES_TOTAL< 1.5 304 117 No realiza (0.61513158 0.38486842)
## 154) CANT_DEMANDANTES_TOTAL< 0.5 272 99 No realiza (0.63602941 0.36397059)
## 308) EDAD_SEL< 48.5 232 79 No realiza (0.65948276 0.34051724)
## 616) NIVEL_EDUCATIVO_AGRUPADO>=2.5 168 52 No realiza (0.69047619 0.30952381) *
## 617) NIVEL_EDUCATIVO_AGRUPADO< 2.5 64 27 No realiza (0.57812500 0.42187500)
## 1234) EDAD_SEL>=39.5 48 17 No realiza (0.64583333 0.35416667) *
## 1235) EDAD_SEL< 39.5 16 6 Realiza (0.37500000 0.62500000) *
## 309) EDAD_SEL>=48.5 40 20 No realiza (0.50000000 0.50000000)
## 618) NIVEL_EDUCATIVO_AGRUPADO< 3.5 20 9 No realiza (0.55000000 0.45000000) *
## 619) NIVEL_EDUCATIVO_AGRUPADO>=3.5 20 9 Realiza (0.45000000 0.55000000) *
## 155) CANT_DEMANDANTES_TOTAL>=0.5 32 14 Realiza (0.43750000 0.56250000) *
## 39) CONDICION_ACTIVIDAD_AGRUPADA=No ocupado 97 41 Realiza (0.42268041 0.57731959)
## 78) EDAD_SEL>=47.5 18 7 No realiza (0.61111111 0.38888889) *
## 79) EDAD_SEL< 47.5 79 30 Realiza (0.37974684 0.62025316) *
## 5) EDAD_SEL>=50.5 1662 820 Realiza (0.49338147 0.50661853)
## 10) CONDICION_ACTIVIDAD_AGRUPADA=Ocupado 901 364 No realiza (0.59600444 0.40399556)
## 20) EDAD_SEL< 59.5 484 178 No realiza (0.63223140 0.36776860)
## 40) EDAD_SEL>=58.5 51 8 No realiza (0.84313725 0.15686275) *
## 41) EDAD_SEL< 58.5 433 170 No realiza (0.60739030 0.39260970)
## 82) NIVEL_EDUCATIVO_AGRUPADO>=2.5 274 100 No realiza (0.63503650 0.36496350)
## 164) BHCH04_SEL=Cónyuge/pareja,other 51 13 No realiza (0.74509804 0.25490196) *
## 165) BHCH04_SEL=Jefe/a 223 87 No realiza (0.60986547 0.39013453)
## 330) EDAD_SEL< 52.5 62 20 No realiza (0.67741935 0.32258065) *
## 331) EDAD_SEL>=52.5 161 67 No realiza (0.58385093 0.41614907)
##
## ...
## and 154 more lines.Este print nos muestra un bloque de texto con los nodos y distintas
ramas. Sin embargo, también podemos visualizar las variables más
importantes del modelo con el paquete vip. Con su función
podemos mostrar de forma sencilla la importancia de las variables del
modelo en un gráfico de columnas, puntos, boxplot o violin plot. Sin
embargo, hay que tener en cuenta una cosa: este paquete funciona con
modelos, no con workflows. Por eso vamos a usar la
función extract_fit_parsnip para extraer nuestro modelo del
workflow y aplicar vip sobre él.
library(vip)##
## Attaching package: 'vip'## The following object is masked from 'package:utils':
##
## viextract_fit_parsnip(final_fit) %>%
vip(geom = "col") + theme_minimal()
Podemos ver que las variables más importantes para explicar si se
realiza trabajo doméstico o no son SEXO_SEL,
EDAD_SEL BHCH04_SEL, la relación con el jefe
de hogar.
También podemos graficarlo con la librería rpart.plot.
El código acá se hace un poco más choclo, porque tenemos que llamar la
misma función para extraer el modelo pero además llamar al objeto
fit dentro de eso.
library(rpart.plot)
rpart.plot(extract_fit_parsnip(final_fit)$fit)
Evaluación
Ahora bien, el último paso sería probar esto en el set de validación
o test set. Usamos predict() para predecir con el modelo
los valores de el dataset de testeo, y con bind_cols() lo
agregamos como una columna.
test <- final_fit %>%
predict(test) %>%
bind_cols(test, .)¿Cómo vemos las metricas de evaluación? Usamos la funcion
metric_set(), donde podemos pasar las métricas que queremos
ver y lo creamos en un objeto. Luego, a ese objeto le pasamos el
dataset, los valores reales y los valores predichos.
class_metrics <- metric_set(precision, accuracy,
recall, f_meas)
class_metrics(test, truth = realiza_domest, estimate = .pred_class)## # A tibble: 4 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 precision binary 0.663
## 2 accuracy binary 0.703
## 3 recall binary 0.720
## 4 f_meas binary 0.690En base a lo visto durante el contenido teórico, ¿qué nos dice cada una de estas métricas sobre el modelo? ¿Cómo se interpretan?
matriz_confusion <- conf_mat(test,truth = realiza_domest, estimate = .pred_class)
matriz_confusion## Truth
## Prediction No realiza Realiza
## No realiza 1189 604
## Realiza 462 1333También podemos graficar la curva ROC. Primero hay que obtener las probabilidades de predicción para cada clase:
test <- final_fit %>%
predict(test, type = "prob") %>%
bind_cols(test, .)
test %>% select(realiza_domest:.pred_Realiza)## # A tibble: 3,588 × 4
## realiza_domest .pred_class `.pred_No realiza` .pred_Realiza
## <fct> <fct> <dbl> <dbl>
## 1 Realiza No realiza 0.557 0.443
## 2 No realiza No realiza 0.690 0.310
## 3 Realiza Realiza 0.313 0.688
## 4 No realiza No realiza 0.677 0.323
## 5 No realiza No realiza 0.658 0.342
## 6 No realiza No realiza 0.690 0.310
## 7 Realiza Realiza 0.246 0.754
## 8 Realiza Realiza 0.163 0.837
## 9 No realiza No realiza 0.658 0.342
## 10 Realiza Realiza 0.317 0.683
## # ℹ 3,578 more rowsGraficamos la curva ROC pasando el valor real y la probabilidad de predicción.
test %>%
roc_curve(truth = realiza_domest, ".pred_No realiza") %>%
autoplot()
O si lo queremos hacer a mano…
test %>%
roc_curve(truth = realiza_domest, ".pred_No realiza") %>%
ggplot() +
geom_line(aes(x=1-specificity, y=sensitivity)) +
geom_abline(slope=1, intercept=0, linetype='dashed') +
theme_minimal()
Para obtener una métrica normalizada, usamos roc_auc para obtener el valor del área debajo de la curva.
test %>%
roc_auc(truth = realiza_domest, ".pred_No realiza")## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 roc_auc binary 0.766