IA para Científicos Sociales

Sesión 2.3: Laboratorio 3 - Clasificación avanzada

Danilo Freire

danilofreire@gmail.com

Department of Data and Decision Sciences
Emory University

Laboratorio 3: Clasificación avanzada

Objetivos del laboratorio

Lo que vamos a hacer:

Predecir participación electoral
Baseline con regresión logística
Ajustar un Random Forest con CV
Interpretar con VIP y PDP
Comparar modelos en el conjunto de test

Lo que vamos a aprender:

Random Forest para clasificación
Tuning de hiperparámetros con grilla
Interpretación de modelos complejos
Cuándo vale la pena la complejidad extra

¡Trabajen en sus computadoras y pregunten si tienen dudas!

Parte 1: Preparación y baseline

Cargar los paquetes necesarios

# Si algún paquete falta:
# install.packages(c("tidyverse", "tidymodels", "ranger", "vip", "pdp", "xgboost", "patchwork"))
library(tidyverse)   # readr, dplyr, ggplot2, etc
library(tidymodels)  # rsample, parsnip, recipes, workflows, tune, yardstick
library(ranger)      # motor rápido para Random Forest
library(vip)         # Variable Importance Plots
library(pdp)         # Partial Dependence Plots
library(xgboost)     # Gradient Boosting (apéndice 4)
library(patchwork)   # combinar gráficos con +

set.seed(2026)

El dataset: Latinobarómetro (simulado)

Vamos a trabajar con datos simulados inspirados en el Latinobarómetro, una encuesta de opinión pública en América Latina:

~500 encuestados distribuidos en varios países de la región
Combina variables demográficas (edad, educación, ingreso, zona, género) con actitudes políticas (confianza en instituciones, satisfacción, interés)
Dos posibles variables objetivo en el mismo dataset:
- voto (sí/no): ¿el encuestado votó en la última elección? → Lab 3 (clasificación)
- satisfaccion_vida (1-10): satisfacción general con la vida → Lab 4 (regresión)

En este laboratorio, nuestro objetivo es predecir voto usando los demás predictores

Descripción de las variables

Variables numéricas

Variable	Descripción
`edad`	Edad del encuestado
`educacion_anios`	Años de educación formal
`ingreso_hogar`	Ingreso mensual del hogar (USD)
`confianza_gobierno`	Confianza en el gobierno (1-10)
`confianza_justicia`	Confianza en el poder judicial (1-10)
`satisfaccion_democracia`	Satisfacción con la democracia (1-5)
`percepcion_economia`	Percepción de la economía (1-5)
`interes_politica`	Interés en política (0-10)
`satisfaccion_vida`	Satisfacción con la vida (Lab 4)

Variables categóricas

Variable	Valores
`voto`	sí / no (outcome)
`uso_internet`	nunca / semanal / diario
`zona`	urbano / rural
`genero`	masculino / femenino
`pais`	varios países

Cargar y explorar los datos

# Cargar el dataset (generado con datos/crear-datos.R)
datos <- read_csv("datos/latinobarometro_sim.csv", show_col_types = FALSE)
# Lean el archivo directo desde la web:
# datos <- read_csv("https://raw.githubusercontent.com/danilofreire/introduccion-ia-ucu/main/clases/dia-02/datos/latinobarometro_sim.csv", show_col_types = FALSE)

# Convertir variables categóricas a factores
# El orden de niveles en uso_internet y voto es importante para interpretación
# voto usa c("no", "si"), la misma convención del Día 1: "si" es la clase
# positiva y por eso pasamos event_level = "second" a las métricas
datos <- datos |>
  mutate(
    pais = factor(pais),
    zona = factor(zona),
    genero = factor(genero),
    uso_internet = factor(uso_internet, levels = c("nunca", "semanal", "diario")),
    voto = factor(voto, levels = c("no", "si"))
  )

# Estructura y distribución del voto
glimpse(datos)

Rows: 500
Columns: 14
$ pais                    <fct> Argentina, Costa Rica, Panamá, Perú, Nicaragua…
$ edad                    <dbl> 65, 19, 82, 54, 32, 21, 57, 21, 57, 80, 38, 69…
$ educacion_anios         <dbl> 15, 18, 11, 9, 14, 9, 7, 17, 3, 12, 12, 14, 9,…
$ ingreso_hogar           <dbl> 7, 10, 3, 8, 5, 5, 5, 9, 3, 7, 6, 6, 5, 8, 9, …
$ zona                    <fct> urbana, rural, urbana, urbana, urbana, urbana,…
$ genero                  <fct> hombre, hombre, mujer, mujer, hombre, hombre, …
$ confianza_gobierno      <dbl> 2, 3, 2, 4, 5, 5, 2, 4, 3, 1, 1, 2, 3, 3, 3, 3…
$ confianza_justicia      <dbl> 3, 3, 3, 2, 4, 2, 2, 4, 2, 3, 3, 2, 4, 3, 4, 3…
$ satisfaccion_democracia <dbl> 2, 1, 2, 2, 4, 3, 3, 4, 3, 3, 2, 4, 2, 2, 2, 3…
$ percepcion_economia     <dbl> 3, 5, 5, 5, 2, 5, 4, 2, 3, 3, 4, 4, 4, 1, 2, 4…
$ uso_internet            <fct> semanal, diario, diario, diario, nunca, semana…
$ interes_politica        <dbl> 3, 3, 3, 3, 3, 4, 4, 1, 1, 1, 1, 1, 2, 1, 3, 1…
$ satisfaccion_vida       <dbl> 8.6, 8.3, 5.3, 7.8, 6.3, 8.7, 5.9, 6.4, 4.5, 6…
$ voto                    <fct> no, si, si, no, si, si, no, si, no, si, si, no…

datos |> count(voto) |> mutate(proporcion = n / sum(n))

# A tibble: 2 × 3
  voto      n proporcion
  <fct> <int>      <dbl>
1 no      231      0.462
2 si      269      0.538

Dividir los datos

# initial_split(): divide los datos aleatoriamente en train y test
# prop = 0.75: 75% para entrenamiento, 25% para test
# strata = voto: estratificar para mantener la proporción de clases
datos_split <- initial_split(datos, prop = 0.75, strata = voto)

datos_train <- training(datos_split)
datos_test <- testing(datos_split)

# Verificar proporciones
cat("Proporción en train:\n")

Proporción en train:

prop.table(table(datos_train$voto))


       no        si 
0.4625668 0.5374332

cat("\nProporción en test:\n")


Proporción en test:

prop.table(table(datos_test$voto))


       no        si 
0.4603175 0.5396825

Preprocesamiento con recipes

# recipe(): define el preprocesamiento como una "receta de cocina"
# voto ~ ...: la fórmula indica variable objetivo ~ predictores
receta <- recipe(voto ~ ., data = datos_train) |>
  # step_rm(): excluir pais (alta cardinalidad) y satisfaccion_vida (outcome del Lab 4)
  step_rm(pais, satisfaccion_vida) |>
  # step_dummy(): convierte categóricas a variables indicadoras (0/1)
  step_dummy(all_nominal_predictors()) |>
  # step_normalize(): centra (media = 0) y escala (sd = 1) las numéricas
  step_normalize(all_numeric_predictors()) |>
  # step_zv(): elimina variables con varianza cero (constantes)
  step_zv(all_predictors())

# prep(): estima los parámetros de la receta (ej: medias para normalizar)
# juice(): aplica la receta y devuelve los datos transformados
receta |> prep() |> juice() |> glimpse()

Rows: 374
Columns: 13
$ edad                    <dbl> 0.6856092, 0.1155615, 0.2710290, 0.2710290, 0.…
$ educacion_anios         <dbl> 0.9505020, -0.5084081, -0.9947114, -1.9673182,…
$ ingreso_hogar           <dbl> 0.7168678, 1.1614923, -0.1723812, -1.0616302, …
$ confianza_gobierno      <dbl> -0.3526125, 1.9409016, -0.3526125, 0.7941446, …
$ confianza_justicia      <dbl> 0.3920426, -0.6191569, -0.6191569, -0.6191569,…
$ satisfaccion_democracia <dbl> -0.5870209, -0.5870209, 0.5331108, 0.5331108, …
$ percepcion_economia     <dbl> -0.04903852, 1.61827102, 0.78461625, -0.049038…
$ interes_politica        <dbl> 0.5552766, 0.5552766, 1.5833629, -1.5008960, -…
$ voto                    <fct> no, no, no, no, no, no, no, no, no, no, no, no…
$ zona_urbana             <dbl> 0.5416006, 0.5416006, 0.5416006, 0.5416006, -1…
$ genero_mujer            <dbl> -1.0094008, 0.9880378, 0.9880378, -1.0094008, …
$ uso_internet_semanal    <dbl> 1.6418718, -0.6074324, 1.6418718, -0.6074324, …
$ uso_internet_diario     <dbl> -1.1805505, 0.8447976, -1.1805505, 0.8447976, …

Modelo baseline: Regresión logística

# logistic_reg(): modelo de regresión logística
# set_engine("glm"): usar el motor glm de R base
# set_mode("classification"): tarea de clasificación (no regresión)
modelo_logit <- logistic_reg() |>
  set_engine("glm") |>
  set_mode("classification")

# workflow(): combina preprocesamiento (receta) + modelo + ajuste en una pipeline
ajuste_logit <- workflow() |>
  add_recipe(receta) |>       # agregar la receta de preprocesamiento
  add_model(modelo_logit) |>  # agregar el modelo
  fit(data = datos_train)     # ajustar a los datos de entrenamiento

# augment(): genera predicciones y métricas para cada observación
pred_logit <- augment(ajuste_logit, datos_test)

# metric_set(): las cuatro métricas que usaremos en todo el lab
mis_metricas <- metric_set(accuracy, precision, recall, roc_auc)

# truth: variable real, estimate: predicción de clase, .pred_si: probabilidades
# event_level = "second": "si" es la clase positiva (igual que en el Día 1)
metricas_logit <- pred_logit |>
  mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
               event_level = "second")

metricas_logit

# A tibble: 4 × 3
  .metric   .estimator .estimate
  <chr>     <chr>          <dbl>
1 accuracy  binary         0.611
2 precision binary         0.634
3 recall    binary         0.662
4 roc_auc   binary         0.626

En la sesión 2.2 vimos last_fit(), que hace fit() + predicciones + métricas en una sola llamada. Acá guardamos las predicciones aparte porque las vamos a reusar en la matriz de confusión, la curva ROC y la comparación final

Matriz de confusión del baseline

# conf_mat(): construye la tabla de predicho vs. real
# autoplot(type = "heatmap"): visualización como mapa de calor
conf_mat(pred_logit, truth = voto, estimate = .pred_class) |>
  autoplot(type = "heatmap") +
  labs(title = "Matriz de confusión - Regresión logística")

Ejercicio 1: Umbral óptimo

Por defecto, clasificamos como “sí” si P(sí) > 0.5. Pero este umbral (threshold) puede no ser óptimo

Tarea: ejecuten el código abajo (compara F1 con tres umbrales) y respondan:

¿Qué umbral da el F1 más alto?
¿Cómo cambia el F1 cuando subimos el umbral? ¿Por qué?

# F1 para tres umbrales distintos
umbrales <- c(0.3, 0.5, 0.7)

for (umbral in umbrales) {
  # 1. Clasificar como "si" si la probabilidad supera el umbral
  pred_umbral <- pred_logit |>
    mutate(
      clase = ifelse(.pred_si > umbral, "si", "no"),
      clase = factor(clase, levels = c("no", "si"))
    )

  # 2. Calcular el F1 de esas predicciones ("si" es la clase positiva)
  f1 <- f_meas(pred_umbral, truth = voto, estimate = clase,
               event_level = "second")

  # 3. Mostrar el umbral y su F1
  cat("Umbral", umbral, "→ F1 =", round(f1$.estimate, 3), "\n")
}

Nota

¿Por qué F1 y no precisión o recall? F1 combina ambas y obliga al modelo a encontrar un equilibrio. Si fuera un test de cáncer (falso negativo = paciente sin diagnosticar) usaríamos recall. Si fuera un sistema de recomendación (falso positivo = recomendar algo malo) usaríamos precisión. Aquí ambos errores son igual de problemáticos, así que F1 nos da el equilibrio.

¡Tómense 3-5 minutos!

Apéndice 1: Solución

Parte 2: Random Forest con tuning

Definir Random Forest con hiperparámetros a ajustar

# rand_forest(): modelo de Random Forest
# tune(): marcador especial que indica "optimizar este valor automáticamente"
modelo_rf_tune <- rand_forest(
  mtry = tune(),       # Número de variables a considerar en cada split
  trees = 500,         # Número de árboles (fijo, no se optimiza)
  min_n = tune()       # Mínimo de observaciones en nodo terminal
) |>
  # importance = "permutation": importancia por permutación (la usaremos en el VIP)
  set_engine("ranger", importance = "permutation") |> # ranger es un motor rápido para Random Forest
  set_mode("classification")

# workflow(): combina receta + modelo
wf_rf_tune <- workflow() |>
  add_recipe(receta) |>
  add_model(modelo_rf_tune)

Crear la grilla de búsqueda

# grid_regular(): crea una grilla con valores uniformemente espaciados
# Cada parámetro tiene un rango definido; levels indica cuántos valores probar
grilla_rf <- grid_regular(
  mtry(range = c(2, 8)),    # De 2 a 8 variables por split
  min_n(range = c(5, 30)),  # De 5 a 30 obs mínimas por nodo
  levels = c(4, 4)          # 4 valores de cada uno = 4 x 4 = 16 combinaciones
)

# Ver la grilla
grilla_rf

# A tibble: 16 × 2
    mtry min_n
   <int> <int>
 1     2     5
 2     4     5
 3     6     5
 4     8     5
 5     2    13
 6     4    13
 7     6    13
 8     8    13
 9     2    21
10     4    21
11     6    21
12     8    21
13     2    30
14     4    30
15     6    30
16     8    30

# Alternativa: grilla aleatoria (más eficiente para muchos hiperparámetros)
# grilla_rf <- grid_random(
#   mtry(range = c(2, 8)),
#   min_n(range = c(5, 30)),
#   size = 20  # 20 combinaciones aleatorias
# )

Configurar validación cruzada

# vfold_cv(): divide los datos en v grupos (folds) para validación cruzada
# strata = voto: estratificar para que cada fold mantenga la proporción de clases
folds <- vfold_cv(datos_train, v = 10, strata = voto)

# Ver los folds
folds

#  10-fold cross-validation using stratification 
# A tibble: 10 × 2
   splits           id    
   <list>           <chr> 
 1 <split [335/39]> Fold01
 2 <split [336/38]> Fold02
 3 <split [336/38]> Fold03
 4 <split [337/37]> Fold04
 5 <split [337/37]> Fold05
 6 <split [337/37]> Fold06
 7 <split [337/37]> Fold07
 8 <split [337/37]> Fold08
 9 <split [337/37]> Fold09
10 <split [337/37]> Fold10

# Cada fold tiene 9/10 de los datos en training y 1/10 en assessment

Nota

Con 10 folds las estimaciones son más estables que con 5, y para este tamaño de dataset corre en pocos segundos. Para datasets mucho más grandes (>10K observaciones), 5 folds es un compromiso razonable entre estabilidad y tiempo de cómputo.

Ejecutar el tuning

# tune_grid(): evalúa cada combinación de hiperparámetros con CV
# Para cada combinación de la grilla, entrena el modelo en cada fold
# y calcula las métricas especificadas
resultados_tune <- tune_grid(
  wf_rf_tune,                # el workflow con tune() pendientes
  resamples = folds,         # los folds de validación cruzada
  grid = grilla_rf,          # la grilla de combinaciones a probar
  # metric_set(): para elegir hiperparámetros alcanza con roc_auc
  metrics = metric_set(roc_auc),
  control = control_grid(verbose = FALSE)  # no imprimir progreso
)

# collect_metrics(): extrae los resultados promediados de todos los folds
resultados_tune |>
  collect_metrics() |>
  filter(.metric == "roc_auc") |>
  arrange(desc(mean))

# A tibble: 16 × 8
    mtry min_n .metric .estimator  mean     n std_err .config         
   <int> <int> <chr>   <chr>      <dbl> <int>   <dbl> <chr>           
 1     2    30 roc_auc binary     0.623    10  0.0300 pre0_mod04_post0
 2     6     5 roc_auc binary     0.623    10  0.0217 pre0_mod09_post0
 3     6    30 roc_auc binary     0.621    10  0.0251 pre0_mod12_post0
 4     4    30 roc_auc binary     0.619    10  0.0266 pre0_mod08_post0
 5     8    13 roc_auc binary     0.619    10  0.0253 pre0_mod14_post0
 6     2    13 roc_auc binary     0.618    10  0.0301 pre0_mod02_post0
 7     8     5 roc_auc binary     0.618    10  0.0271 pre0_mod13_post0
 8     6    21 roc_auc binary     0.618    10  0.0229 pre0_mod11_post0
 9     2     5 roc_auc binary     0.617    10  0.0281 pre0_mod01_post0
10     4    13 roc_auc binary     0.617    10  0.0279 pre0_mod06_post0
11     2    21 roc_auc binary     0.614    10  0.0255 pre0_mod03_post0
12     4    21 roc_auc binary     0.614    10  0.0256 pre0_mod07_post0
13     8    21 roc_auc binary     0.614    10  0.0241 pre0_mod15_post0
14     4     5 roc_auc binary     0.613    10  0.0262 pre0_mod05_post0
15     6    13 roc_auc binary     0.613    10  0.0261 pre0_mod10_post0
16     8    30 roc_auc binary     0.612    10  0.0254 pre0_mod16_post0

Seleccionar y ajustar el modelo final

# select_best(): elige la combinación con el mejor valor de la métrica
mejor_rf <- select_best(resultados_tune, metric = "roc_auc")
mejor_rf

# A tibble: 1 × 3
   mtry min_n .config         
  <int> <int> <chr>           
1     2    21 pre0_mod03_post0

# finalize_workflow(): reemplaza los tune() por los valores óptimos;
# luego fit() ajusta con todos los datos de entrenamiento, en una pipeline
ajuste_rf <- wf_rf_tune |>
  finalize_workflow(mejor_rf) |>
  fit(data = datos_train)

# Predicciones y métricas en test
pred_rf <- augment(ajuste_rf, datos_test)

metricas_rf <- pred_rf |>
  mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
               event_level = "second")

cat("Regresión logística:\n"); print(metricas_logit)

Regresión logística:

# A tibble: 4 × 3
  .metric   .estimator .estimate
  <chr>     <chr>          <dbl>
1 accuracy  binary         0.611
2 precision binary         0.634
3 recall    binary         0.662
4 roc_auc   binary         0.626

cat("\nRandom Forest:\n");     print(metricas_rf)


Random Forest:

# A tibble: 4 × 3
  .metric   .estimator .estimate
  <chr>     <chr>          <dbl>
1 accuracy  binary         0.563
2 precision binary         0.589
3 recall    binary         0.632
4 roc_auc   binary         0.588

Curva ROC comparativa

# roc_curve(): calcula sensibilidad y especificidad para cada umbral
# truth: la variable real, .pred_si: probabilidades predichas
roc_logit <- pred_logit |>
  roc_curve(truth = voto, .pred_si, event_level = "second") |>
  mutate(modelo = "Regresión logística")

roc_rf <- pred_rf |>
  roc_curve(truth = voto, .pred_si, event_level = "second") |>
  mutate(modelo = "Random Forest")

# Combinar y graficar
bind_rows(roc_logit, roc_rf) |>
  ggplot(aes(x = 1 - specificity, y = sensitivity, color = modelo)) +
  geom_path(linewidth = 1.2) +
  geom_abline(linetype = "dashed", color = "gray50") +
  coord_equal() +
  labs(title = "Comparación de curvas ROC",
       x = "1 - Especificidad (Tasa de falsos positivos)",
       y = "Sensibilidad (Tasa de verdaderos positivos)",
       color = "Modelo") +
  theme_minimal()

Parte 3: Interpretación

Importancia de variables

rf_parsnip <- extract_fit_parsnip(ajuste_rf)

vip(rf_parsnip, num_features = 15) +
  labs(title = "Importancia de variables") +
  theme_minimal()

Lo que vemos

Edad es el predictor más fuerte, seguida por educación e ingreso
Interés en política es la actitud más predictiva
Confianza en justicia supera a confianza en el gobierno
Género, zona, internet: baja importancia

Advertencia

Importancia mide predictibilidad, no efecto causal: que la edad importe no significa que “envejecer causa votar”

Partial Dependence Plots

rf_engine <- extract_fit_engine(ajuste_rf)
datos_prep <- bake(prep(receta), new_data = datos_train)

# partial() calcula el efecto marginal sobre P(voto = "si")
pdp_edad    <- partial(rf_engine, pred.var = "edad",
                       train = datos_prep, prob = TRUE, which.class = "si")
pdp_interes <- partial(rf_engine, pred.var = "interes_politica",
                       train = datos_prep, prob = TRUE, which.class = "si")

autoplot(pdp_edad)    + labs(title = "Edad", y = "P(voto = sí)") +
autoplot(pdp_interes) + labs(title = "Interés en política", y = NULL) &
  theme_minimal()

Interpretación

Edad: la probabilidad de votar aumenta con la edad; el efecto se acelera entre los más viejos
Interés en política: relación monotónica y aproximadamente lineal

Tip

PDPs vs. coeficientes: si el PDP es aproximadamente lineal → la regresión logística podría bastar. Si tiene curvas o mesetas → Random Forest captura patrones que otros modelos pierden

Ejercicio 2: Análisis por país

Instrucciones:

Filtrar los datos para Uruguay solamente
Entrenar el mismo modelo de Random Forest (sin tuning, con hiperparámetros fijos)
¿Cambia la importancia de las variables?
¿La edad sigue siendo el predictor más importante?

# Tu código aquí
datos_uruguay <- datos |>
  filter(pais == "Uruguay")

# Crear receta y workflow, ajustar el modelo...
# Comparar el VIP con el modelo general

Pista: con pocos datos, usen hiperparámetros fijos en vez de tuning

Apéndice 2: Solución

Parte 4: Discusión y cierre

¿Cuál modelo elegir?

Si el objetivo es predicción pura:

Elegir el modelo con mejor AUC
Random Forest suele superar a la regresión logística
La interpretabilidad es secundaria

Si el objetivo es entender los factores:

Regresión logística da coeficientes interpretables
Random Forest con VIP + PDP es un compromiso

Consideraciones prácticas:

Tiempo: RF es más lento que la regresión logística
Explicabilidad: ¿Podemos justificar las predicciones?
Mejora marginal: ¿Vale la pena 2% más de AUC?

En ciencias sociales, la interpretabilidad suele ser tan importante como el rendimiento

Apéndice 3: árbol de decisión · Apéndice 4: XGBoost opcional

Resumen del laboratorio

Lo que practicamos:

Flujo completo de clasificación
Tuning de hiperparámetros con CV
Interpretación con VIP y PDP
Comparación de modelos en test

Conceptos clave:

tune() marca hiperparámetros a ajustar
grid_regular() crea combinaciones
tune_grid() evalúa con CV
select_best() elige la mejor combinación
finalize_workflow() aplica los valores

En el próximo laboratorio aplicaremos estos conceptos a regresión

Continuar con el laboratorio de regresión

Apéndice: Soluciones

Apéndice 1: Umbral óptimo

Respuestas:

El umbral cercano a 0.4-0.5 suele dar el F1 más alto (varía según la muestra)
Al subir el umbral el modelo predice “sí” con más cautela: la precisión sube (menos falsos positivos) pero el recall baja (perdemos casos reales). El F1 balancea ambos, así que crece hasta cierto punto y después baja

Versión extendida — barrer umbrales finos (cada 0.05) y graficar la curva:

umbrales <- seq(0.3, 0.7, by = 0.05)
resultados <- data.frame(umbral = numeric(), f1 = numeric())

for (t in umbrales) {
  pred_nuevo <- pred_logit |>
    mutate(.pred_class_nuevo = factor(
      ifelse(.pred_si > t, "si", "no"), levels = c("no", "si")))
  f1 <- f_meas(pred_nuevo, truth = voto, estimate = .pred_class_nuevo,
               event_level = "second")
  resultados <- rbind(resultados,
                      data.frame(umbral = t, f1 = f1$.estimate))
}

resultados |> arrange(desc(f1))

  umbral        f1
1   0.30 0.6994536
2   0.35 0.6971429
3   0.40 0.6625767
4   0.45 0.6578947
5   0.50 0.6474820
6   0.55 0.5901639
7   0.60 0.5309735
8   0.65 0.4081633
9   0.70 0.3146067

ggplot(resultados, aes(x = umbral, y = f1)) +
  geom_line(linewidth = 1.2, color = "#2d4563") +
  geom_point(size = 3, color = "#2d4563") +
  labs(title = "F1 según el umbral",
       x = "Umbral", y = "F1") +
  theme_minimal()

El umbral óptimo depende del costo relativo de cada tipo de error: si los falsos positivos son caros, subir; si los falsos negativos son caros, bajar

Volver al ejercicio

Apéndice 2: Análisis por país

# Filtrar datos de Uruguay
datos_uruguay <- datos |> filter(pais == "Uruguay")
cat("Observaciones en Uruguay:", nrow(datos_uruguay), "\n")

Observaciones en Uruguay: 31

# Con pocos datos (~31 obs), no dividimos en train/test
# Entrenamos con todo el subconjunto solo para comparar VIP
receta_uy <- recipe(voto ~ ., data = datos_uruguay) |>
  step_rm(pais, satisfaccion_vida) |>
  step_dummy(all_nominal_predictors()) |>
  step_normalize(all_numeric_predictors()) |>
  step_zv(all_predictors())

modelo_rf_uy <- rand_forest(trees = 500, mtry = 4, min_n = 3) |>
  set_engine("ranger", importance = "permutation") |>
  set_mode("classification")

ajuste_rf_uy <- workflow() |>
  add_recipe(receta_uy) |>
  add_model(modelo_rf_uy) |>
  fit(data = datos_uruguay)

# Comparar importancia de variables
vip(extract_fit_parsnip(ajuste_rf_uy), num_features = 10) +
  labs(title = "Importancia de variables - solo Uruguay",
       subtitle = paste0("n = ", nrow(datos_uruguay), " observaciones")) +
  theme_minimal()

Con tan pocos datos (~31 obs), los resultados son inestables: cambian con la semilla
El ranking de importancia puede diferir del modelo general
Para conclusiones confiables a nivel país, necesitaríamos muestras más grandes

Volver al ejercicio

Apéndice 3: Árbol de decisión

# Modelo de árbol con costo de complejidad a ajustar
modelo_arbol <- decision_tree(
  cost_complexity = tune(),
  tree_depth = 10,
  min_n = 10
) |>
  set_engine("rpart") |>
  set_mode("classification")

# Workflow con la misma receta
wf_arbol <- workflow() |>
  add_recipe(receta) |>
  add_model(modelo_arbol)

# Grilla de búsqueda para cost_complexity
# range en escala log10: 10^-4 = 0.0001 a 10^-1 = 0.1
grilla_arbol <- grid_regular(
  cost_complexity(range = c(-4, -1)),
  levels = 10
)

# Tuning con validación cruzada (reutilizamos folds)
resultados_arbol <- tune_grid(
  wf_arbol,
  resamples = folds,
  grid = grilla_arbol,
  metrics = metric_set(roc_auc),
  control = control_grid(verbose = FALSE)
)

# Mejor modelo
mejor_arbol <- select_best(resultados_arbol, metric = "roc_auc")
cat("Mejor cost_complexity:", mejor_arbol$cost_complexity, "\n")

Mejor cost_complexity: 0.004641589

# Ajustar y evaluar (finalize_workflow + fit en una pipeline)
ajuste_arbol <- wf_arbol |>
  finalize_workflow(mejor_arbol) |>
  fit(data = datos_train)

pred_arbol <- augment(ajuste_arbol, datos_test)

# Comparar métricas
cat("Árbol de decisión:\n")

Árbol de decisión:

print(pred_arbol |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
                                 event_level = "second"))

# A tibble: 4 × 3
  .metric   .estimator .estimate
  <chr>     <chr>          <dbl>
1 accuracy  binary         0.563
2 precision binary         0.584
3 recall    binary         0.662
4 roc_auc   binary         0.592

cat("\nRandom Forest:\n")


Random Forest:

print(metricas_rf)

# A tibble: 4 × 3
  .metric   .estimator .estimate
  <chr>     <chr>          <dbl>
1 accuracy  binary         0.563
2 precision binary         0.589
3 recall    binary         0.632
4 roc_auc   binary         0.588

# Visualizar el tuning
autoplot(resultados_arbol) +
  theme_minimal() +
  labs(title = "Tuning del árbol de decisión")

El árbol de decisión suele tener menor AUC que Random Forest
A cambio, es mucho más interpretable: se puede visualizar como un diagrama de flujo
cost_complexity controla la poda: valores más altos producen árboles más simples

Apéndice 4: XGBoost opcional

# boost_tree(): Gradient Boosting (árboles secuenciales)
# tree_depth y learn_rate a optimizar; min_n fijo
modelo_xgb <- boost_tree(
  trees = 500,
  tree_depth = tune(),
  learn_rate = tune(),
  min_n = 10
) |>
  set_engine("xgboost") |>
  set_mode("classification")

wf_xgb <- workflow() |>
  add_recipe(receta) |>
  add_model(modelo_xgb)

# learn_rate en escala log10: 10^-3 a 10^-1
grilla_xgb <- grid_regular(
  tree_depth(range = c(3, 8)),
  learn_rate(range = c(-3, -1)),
  levels = c(3, 3)
)

resultados_xgb <- tune_grid(
  wf_xgb, resamples = folds, grid = grilla_xgb,
  metrics = metric_set(roc_auc),
  control = control_grid(verbose = FALSE)
)

mejor_xgb <- select_best(resultados_xgb, metric = "roc_auc")
ajuste_xgb <- wf_xgb |>
  finalize_workflow(mejor_xgb) |>
  fit(data = datos_train)

# Predicciones y comparación final
pred_xgb <- augment(ajuste_xgb, datos_test)

bind_rows(
  pred_logit |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
                             event_level = "second") |>
    mutate(modelo = "Regresión logística"),
  pred_rf |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
                          event_level = "second") |>
    mutate(modelo = "Random Forest"),
  pred_xgb |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
                           event_level = "second") |>
    mutate(modelo = "XGBoost")
) |>
  select(modelo, .metric, .estimate) |>
  pivot_wider(names_from = .metric, values_from = .estimate) |>
  arrange(desc(roc_auc))

# A tibble: 3 × 5
  modelo              accuracy precision recall roc_auc
  <chr>                  <dbl>     <dbl>  <dbl>   <dbl>
1 Regresión logística    0.611     0.634  0.662   0.626
2 Random Forest          0.563     0.589  0.632   0.588
3 XGBoost                0.524     0.543  0.75    0.578

XGBoost suele igualar o superar a Random Forest en datasets tabulares
Requiere más tuning (tree_depth, learn_rate, trees) y más tiempo de cómputo
En ciencias sociales, la mejora marginal rara vez justifica la pérdida de interpretabilidad