library(tidymodels)
library(tidyverse)
library(ranger)
library(vip)
library(pdp)
library(xgboost)
set.seed(2026)
datos <- read_csv("datos/latinobarometro_sim.csv", show_col_types = FALSE)
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"))
)
# Las métricas del laboratorio + F1 (la pide la Pregunta 12)
# event_level = "second": "si" es la clase positiva
mis_metricas <- metric_set(accuracy, roc_auc, precision, recall, f_meas)
# División train/test (reutilizada en varias preguntas)
datos_split <- initial_split(datos, prop = 0.75, strata = voto)
datos_train <- training(datos_split)
datos_test <- testing(datos_split)
# Receta estándar (reutilizada en varias preguntas)
receta <- recipe(voto ~ edad + educacion_anios + ingreso_hogar + zona +
genero + confianza_gobierno + confianza_justicia +
satisfaccion_democracia + percepcion_economia +
uso_internet + interes_politica,
data = datos_train) |>
step_dummy(all_nominal_predictors()) |>
step_normalize(all_numeric_predictors()) |>
step_zv(all_predictors())Tarea 3: Clasificación avanzada con tidymodels – Respuestas
IA para Científicos Sociales - UCU
1 Instrucciones
Esta es la clave de respuestas de la Tarea 3. Cada pregunta incluye el código R completo y una respuesta escrita.
1.1 Configuración
2 Exploración
2.1 Pregunta 1: Participación electoral por grupos
Calculen la proporción de votantes (voto == "si") por zona (urbana/rural) y por género. Muestren los resultados en una tabla. ¿Hay diferencias entre los grupos?
# Proporción de votantes por zona
cat("Proporción de votantes por zona:\n")Proporción de votantes por zona:datos |>
group_by(zona) |>
summarise(
n = n(),
n_voto_si = sum(voto == "si"),
prop_si = round(mean(voto == "si"), 3)
)# A tibble: 2 × 4
zona n n_voto_si prop_si
<fct> <int> <int> <dbl>
1 rural 114 66 0.579
2 urbana 386 203 0.526# Proporción de votantes por género
cat("\nProporción de votantes por género:\n")
Proporción de votantes por género:datos |>
group_by(genero) |>
summarise(
n = n(),
n_voto_si = sum(voto == "si"),
prop_si = round(mean(voto == "si"), 3)
)# A tibble: 2 × 4
genero n n_voto_si prop_si
<fct> <int> <int> <dbl>
1 hombre 252 136 0.54
2 mujer 248 133 0.536# Cruce zona x género
cat("\nProporción de votantes por zona y género:\n")
Proporción de votantes por zona y género:datos |>
group_by(zona, genero) |>
summarise(
n = n(),
prop_si = round(mean(voto == "si"), 3),
.groups = "drop"
)# A tibble: 4 × 4
zona genero n prop_si
<fct> <fct> <int> <dbl>
1 rural hombre 66 0.561
2 rural mujer 48 0.604
3 urbana hombre 186 0.532
4 urbana mujer 200 0.52 Respuesta: Las diferencias entre zona urbana y rural son pequeñas, al igual que las diferencias entre hombres y mujeres. Esto es consistente con el diseño del dataset simulado, donde zona y género tienen efectos débiles sobre la probabilidad de votar. En datos reales del Latinobarómetro, estas diferencias suelen ser más marcadas.
2.2 Pregunta 2: Correlaciones entre predictores
Calculen la matriz de correlaciones entre las variables numéricas. ¿Cuáles dos variables tienen la mayor correlación? ¿Tiene sentido teórico?
vars_num <- datos |>
select(edad, educacion_anios, ingreso_hogar,
confianza_gobierno, confianza_justicia,
satisfaccion_democracia, percepcion_economia,
interes_politica, satisfaccion_vida)
mat_cor <- cor(vars_num)
round(mat_cor, 2) edad educacion_anios ingreso_hogar confianza_gobierno
edad 1.00 -0.04 -0.06 -0.03
educacion_anios -0.04 1.00 0.54 0.05
ingreso_hogar -0.06 0.54 1.00 -0.03
confianza_gobierno -0.03 0.05 -0.03 1.00
confianza_justicia 0.05 -0.03 -0.04 0.18
satisfaccion_democracia 0.00 -0.01 -0.02 0.17
percepcion_economia 0.08 -0.01 -0.08 0.02
interes_politica -0.06 0.04 0.02 0.38
satisfaccion_vida 0.08 0.36 0.33 0.24
confianza_justicia satisfaccion_democracia
edad 0.05 0.00
educacion_anios -0.03 -0.01
ingreso_hogar -0.04 -0.02
confianza_gobierno 0.18 0.17
confianza_justicia 1.00 0.09
satisfaccion_democracia 0.09 1.00
percepcion_economia -0.04 -0.03
interes_politica 0.01 0.16
satisfaccion_vida 0.01 0.21
percepcion_economia interes_politica satisfaccion_vida
edad 0.08 -0.06 0.08
educacion_anios -0.01 0.04 0.36
ingreso_hogar -0.08 0.02 0.33
confianza_gobierno 0.02 0.38 0.24
confianza_justicia -0.04 0.01 0.01
satisfaccion_democracia -0.03 0.16 0.21
percepcion_economia 1.00 -0.02 0.14
interes_politica -0.02 1.00 0.17
satisfaccion_vida 0.14 0.17 1.00# Par con mayor correlación
mat_cor_abs <- abs(mat_cor)
diag(mat_cor_abs) <- 0
max_idx <- which(mat_cor_abs == max(mat_cor_abs), arr.ind = TRUE)[1, ]
cat("\nPar con mayor correlación:",
names(vars_num)[max_idx[1]], "y",
names(vars_num)[max_idx[2]], "\n")
Par con mayor correlación: ingreso_hogar y educacion_anios cat("Correlación:", round(mat_cor[max_idx[1], max_idx[2]], 3), "\n")Correlación: 0.539 Respuesta: Las variables con mayor correlación son ingreso_hogar y educacion_anios (r ≈ 0.54), lo cual tiene sentido: personas con más educación tienden a tener mayores ingresos. También hay correlación entre interes_politica y confianza_gobierno, ya que personas más interesadas en política pueden tener opiniones más formadas sobre el gobierno. Las correlaciones entre actitudes políticas (confianza en gobierno, en justicia, satisfacción democrática) son moderadas, reflejando que estas actitudes están relacionadas entre sí.
2.3 Pregunta 3: Distribución de edad por voto
Creen un boxplot que muestre la distribución de edad separada por voto. ¿Los votantes tienden a ser mayores o menores que los no votantes?
ggplot(datos, aes(x = voto, y = edad, fill = voto)) +
geom_boxplot() +
scale_fill_manual(values = c("si" = "#27AE60", "no" = "#E74C3C")) +
labs(title = "Distribución de edad por participación electoral",
x = "¿Votó en la última elección?",
y = "Edad") +
theme_minimal() +
theme(legend.position = "none")
Respuesta: Los votantes tienden a ser mayores que los no votantes. La mediana de edad del grupo “si” es superior a la del grupo “no”. Esto tiene sentido tanto teórico como empírico: la participación electoral tiende a aumentar con la edad en la mayoría de los países, ya que las personas mayores tienen mayor arraigo cívico y hábito de voto.
3 Modelos base
3.1 Pregunta 4: Modelo reducido
Dividan los datos y ajusten una regresión logística con solo tres predictores. ¿Cómo se compara con el modelo completo?
# Receta reducida (solo 3 predictores)
receta_reducida <- recipe(voto ~ edad + educacion_anios + interes_politica,
data = datos_train) |>
step_normalize(all_numeric_predictors())
modelo_logit <- logistic_reg() |>
set_engine("glm") |>
set_mode("classification")
# Modelo reducido
ajuste_reducido <- workflow() |>
add_recipe(receta_reducida) |>
add_model(modelo_logit) |>
fit(data = datos_train)
pred_reducido <- augment(ajuste_reducido, datos_test)
metricas_reducido <- pred_reducido |>
mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second")
cat("Modelo reducido (3 predictores):\n")Modelo reducido (3 predictores):metricas_reducido# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.635
2 precision binary 0.645
3 recall binary 0.721
4 f_meas binary 0.681
5 roc_auc binary 0.637# Modelo completo para comparar
ajuste_completo <- workflow() |>
add_recipe(receta) |>
add_model(modelo_logit) |>
fit(data = datos_train)
pred_completo <- augment(ajuste_completo, datos_test)
metricas_completo <- pred_completo |>
mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second")
cat("\nModelo completo (11 predictores):\n")
Modelo completo (11 predictores):metricas_completo# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.611
2 precision binary 0.634
3 recall binary 0.662
4 f_meas binary 0.647
5 roc_auc binary 0.626Respuesta: En esta muestra el modelo reducido con tres predictores (edad, educación e interés político) rinde apenas mejor que el completo en el conjunto de prueba: AUC ≈ 0.64 y accuracy ≈ 0.64, frente a AUC ≈ 0.63 y accuracy ≈ 0.61 del modelo con once predictores. No es un error: esos tres predictores son justamente los más fuertes (lo confirmamos en la pregunta 5), y agregar ocho variables débiles aporta poca señal pero sí ruido de estimación, lo que puede empeorar ligeramente el desempeño fuera de muestra. Es un recordatorio de que más predictores no implican mejor predicción: la parsimonia suele pagar, sobre todo con muestras moderadas.
3.2 Pregunta 5: Coeficientes e interpretación
Usando el modelo reducido de la pregunta 4, extraigan los coeficientes con tidy() y calculen los odds ratios. ¿Cuál de los tres predictores tiene el efecto más fuerte? ¿Los signos van en la dirección esperada?
coefs <- tidy(ajuste_reducido) |>
mutate(odds_ratio = exp(estimate)) |>
arrange(desc(abs(statistic)))
coefs |>
select(term, estimate, std.error, statistic, p.value, odds_ratio)# A tibble: 4 × 6
term estimate std.error statistic p.value odds_ratio
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 educacion_anios 0.389 0.112 3.49 0.000482 1.48
2 interes_politica 0.333 0.111 3.00 0.00269 1.39
3 edad 0.291 0.110 2.66 0.00792 1.34
4 (Intercept) 0.163 0.108 1.51 0.130 1.18Respuesta: Con los niveles c("no", "si"), glm() modela la probabilidad del segundo nivel, P(votar), así que los coeficientes se leen de forma directa: un coeficiente positivo (odds ratio mayor que 1) aumenta la probabilidad de votar.
Los coeficientes están en escala normalizada (aplicamos step_normalize() en la receta), así que cada uno mide el efecto de una desviación estándar del predictor y son directamente comparables. El efecto más fuerte es el de educacion_anios (z ≈ 3.5; odds ratio ≈ 1.48: una desviación estándar más de educación aumenta los odds de votar en ~48%), seguido por interes_politica (z ≈ 3.0; OR ≈ 1.39) y edad (z ≈ 2.7; OR ≈ 1.34). Los tres coeficientes son positivos, es decir, los tres aumentan la probabilidad de votar: exactamente la dirección que predice la literatura clásica de participación electoral (más recursos cognitivos, más motivación y más arraigo, más voto). Ojo: si el factor se hubiera definido al revés (c("si", "no")), glm() modelaría P(no votar) y todos los signos aparecerían invertidos; por eso siempre conviene verificar los niveles antes de interpretar.
4 Random Forest y tuning
4.1 Pregunta 6: Efecto del número de árboles
Entrenen RF con 100, 500 y 1000 árboles. ¿Cuánto mejora el AUC?
resultados_arboles <- data.frame(trees = numeric(), auc = numeric())
for (n_trees in c(100, 500, 1000)) {
modelo_temp <- rand_forest(trees = n_trees, mtry = 4, min_n = 10) |>
set_engine("ranger") |>
set_mode("classification")
ajuste_temp <- workflow() |>
add_recipe(receta) |>
add_model(modelo_temp) |>
fit(data = datos_train)
auc_val <- ajuste_temp |>
augment(datos_test) |>
roc_auc(truth = voto, .pred_si, event_level = "second") |>
pull(.estimate)
resultados_arboles <- rbind(resultados_arboles,
data.frame(trees = n_trees, auc = round(auc_val, 4)))
}
resultados_arboles trees auc
1 100 0.5477
2 500 0.5718
3 1000 0.5682Respuesta: La diferencia entre 100 y 500 árboles suele ser pequeña (1-2 puntos de AUC), y entre 500 y 1000 es aún menor. En general, 500 árboles es suficiente para la mayoría de los problemas. El rendimiento de Random Forest se estabiliza rápidamente con más árboles, pero el tiempo de cómputo sigue creciendo de forma lineal. Para datasets pequeños como este (500 observaciones), 500 árboles es un buen punto de equilibrio.
4.2 Pregunta 7: Grilla aleatoria vs. regular
Usen grid_random() con size = 20 y comparen con grid_regular().
modelo_rf_tune <- rand_forest(
mtry = tune(),
trees = 500,
min_n = tune()
) |>
set_engine("ranger") |>
set_mode("classification")
wf_rf_tune <- workflow() |>
add_recipe(receta) |>
add_model(modelo_rf_tune)
folds <- vfold_cv(datos_train, v = 5, strata = voto)
# Grilla regular (4x4 = 16 combinaciones)
grilla_reg <- grid_regular(
mtry(range = c(2, 8)),
min_n(range = c(5, 30)),
levels = c(4, 4)
)
res_regular <- tune_grid(
wf_rf_tune, resamples = folds, grid = grilla_reg,
metrics = metric_set(roc_auc),
control = control_grid(verbose = FALSE)
)
mejor_regular <- show_best(res_regular, metric = "roc_auc", n = 1)
cat("Mejor AUC con grilla regular:\n")Mejor AUC con grilla regular:mejor_regular |> select(mtry, min_n, mean, std_err)# A tibble: 1 × 4
mtry min_n mean std_err
<int> <int> <dbl> <dbl>
1 2 21 0.624 0.0252# Grilla aleatoria (20 combinaciones)
set.seed(2026)
grilla_rand <- grid_random(
mtry(range = c(2, 8)),
min_n(range = c(5, 30)),
size = 20
)
res_random <- tune_grid(
wf_rf_tune, resamples = folds, grid = grilla_rand,
metrics = metric_set(roc_auc),
control = control_grid(verbose = FALSE)
)
mejor_random <- show_best(res_random, metric = "roc_auc", n = 1)
cat("\nMejor AUC con grilla aleatoria:\n")
Mejor AUC con grilla aleatoria:mejor_random |> select(mtry, min_n, mean, std_err)# A tibble: 1 × 4
mtry min_n mean std_err
<int> <int> <dbl> <dbl>
1 2 17 0.615 0.0200Respuesta: Ambas grillas dan resultados similares. La grilla regular explora el espacio de forma uniforme, lo cual es bueno cuando hay pocos hiperparámetros (2 en este caso). La grilla aleatoria explora combinaciones que la regular podría no probar, lo que es más eficiente cuando hay 3 o más hiperparámetros. Para este caso con solo 2 hiperparámetros, la diferencia es mínima.
4.3 Pregunta 8: ¿La validación cruzada predice el desempeño real?
Finalicen el workflow con la mejor combinación de la grilla regular, ajusten sobre entrenamiento y comparen el AUC de prueba con la estimación de la validación cruzada.
# Mejor combinación según la CV de la pregunta 7 (grilla regular)
mejor_regular |> select(mtry, min_n, mean, std_err)# A tibble: 1 × 4
mtry min_n mean std_err
<int> <int> <dbl> <dbl>
1 2 21 0.624 0.0252# Finalizar, ajustar sobre TODO el entrenamiento y evaluar en prueba
ajuste_rf_final <- finalize_workflow(wf_rf_tune,
mejor_regular |> select(mtry, min_n)) |>
fit(data = datos_train)
pred_rf_final <- augment(ajuste_rf_final, datos_test)
auc_test <- pred_rf_final |>
roc_auc(truth = voto, .pred_si, event_level = "second")
cat("AUC estimado por CV:", round(mejor_regular$mean, 3),
"± 2 SE = [", round(mejor_regular$mean - 2 * mejor_regular$std_err, 3),
",", round(mejor_regular$mean + 2 * mejor_regular$std_err, 3), "]\n")AUC estimado por CV: 0.624 ± 2 SE = [ 0.574 , 0.674 ]cat("AUC en el conjunto de prueba:", round(auc_test$.estimate, 3), "\n")AUC en el conjunto de prueba: 0.589 Respuesta: En nuestra corrida la validación cruzada estima un AUC de ~0,62 y el conjunto de prueba da ~0,59: la CV fue levemente optimista, pero el valor de prueba cae dentro del rango de ± 2 errores estándar, así que la estimación es honesta dentro de su incertidumbre. Ese pequeño optimismo es esperable: elegimos justamente la combinación de hiperparámetros que mejor rindió en la CV, y “el ganador del torneo” siempre tiene algo de suerte incluida. Por eso es tan importante que el conjunto de prueba no participe del tuning: es el único dato que el proceso de selección nunca vio, y por lo tanto la única medida no contaminada del desempeño real. Si tuneáramos contra la prueba, el AUC reportado sería sistemáticamente inflado y no sabríamos cuánto.
5 Interpretación
5.1 Pregunta 9: PDPs adicionales
Creen PDPs para confianza_gobierno y educacion_anios.
# Random Forest principal con importancia (lo reusamos en VIP y comparación)
modelo_rf_final <- rand_forest(trees = 500, mtry = 4, min_n = 10) |>
set_engine("ranger", importance = "impurity") |>
set_mode("classification")
ajuste_rf <- workflow() |>
add_recipe(receta) |>
add_model(modelo_rf_final) |>
fit(data = datos_train)
rf_engine <- extract_fit_engine(ajuste_rf)
datos_prep <- bake(prep(receta), new_data = datos_train)
# PDP para confianza_gobierno
pdp_gobierno <- partial(
rf_engine,
pred.var = "confianza_gobierno",
train = datos_prep,
prob = TRUE,
which.class = "si"
)
p1 <- autoplot(pdp_gobierno) +
labs(title = "PDP: Confianza en el gobierno",
x = "Confianza en el gobierno (normalizada)",
y = "P(voto = sí)") +
theme_minimal()
# PDP para educacion_anios
pdp_educacion <- partial(
rf_engine,
pred.var = "educacion_anios",
train = datos_prep,
prob = TRUE,
which.class = "si"
)
p2 <- autoplot(pdp_educacion) +
labs(title = "PDP: Años de educación",
x = "Educación (normalizada)",
y = "P(voto = sí)") +
theme_minimal()
# Mostrar ambos gráficos
library(patchwork)
p1 + p2
Respuesta: El PDP de confianza en el gobierno muestra una relación positiva: a mayor confianza, mayor probabilidad de votar. La relación puede tener una forma de escalón o ser aproximadamente lineal. El PDP de educación también muestra una relación positiva, lo cual tiene sentido: personas más educadas tienden a participar más en elecciones. Si alguna relación muestra curvas o mesetas, esto indica que Random Forest está capturando no-linealidades que la regresión logística no puede modelar.
5.2 Pregunta 10: VIP vs. coeficientes logísticos
Comparen el ranking del VIP con el ranking de los coeficientes logísticos.
# VIP del Random Forest (Gini)
cat("Ranking VIP (Random Forest, Gini):\n")Ranking VIP (Random Forest, Gini):rf_parsnip <- extract_fit_parsnip(ajuste_rf)
importancia_rf <- vip::vi(rf_parsnip)
importancia_rf |> arrange(desc(Importance))# A tibble: 12 × 2
Variable Importance
<chr> <dbl>
1 edad 26.3
2 educacion_anios 23.2
3 ingreso_hogar 15.3
4 interes_politica 10.8
5 confianza_justicia 9.77
6 percepcion_economia 9.23
7 confianza_gobierno 9.15
8 satisfaccion_democracia 7.70
9 genero_mujer 3.59
10 uso_internet_diario 3.58
11 uso_internet_semanal 3.54
12 zona_urbana 3.38# Ranking de coeficientes logísticos (por |z|)
cat("\nRanking de coeficientes (regresión logística, |z|):\n")
Ranking de coeficientes (regresión logística, |z|):coefs_logit <- tidy(ajuste_completo) |>
filter(term != "(Intercept)") |>
mutate(abs_z = abs(statistic)) |>
arrange(desc(abs_z)) |>
select(term, estimate, statistic, abs_z)
coefs_logit# A tibble: 12 × 4
term estimate statistic abs_z
<chr> <dbl> <dbl> <dbl>
1 educacion_anios 0.433 3.25 3.25
2 interes_politica 0.335 2.75 2.75
3 edad 0.302 2.69 2.69
4 confianza_justicia 0.247 2.16 2.16
5 uso_internet_semanal 0.343 2.12 2.12
6 uso_internet_diario 0.310 1.93 1.93
7 zona_urbana -0.117 -1.04 1.04
8 satisfaccion_democracia 0.0943 0.829 0.829
9 percepcion_economia -0.0645 -0.576 0.576
10 confianza_gobierno 0.0457 0.377 0.377
11 ingreso_hogar -0.0319 -0.246 0.246
12 genero_mujer -0.00273 -0.0246 0.0246Respuesta: Los dos rankings coinciden en la cima en educacion_anios y edad, pero divergen en puntos reveladores. El caso más claro es ingreso_hogar: aparece tercero en el VIP (importancia Gini) y casi último en el ranking logístico (|z| ≈ 0.25). Esto ilustra un sesgo conocido de la importancia por impureza (Gini): tiende a inflar la importancia de variables continuas con muchos valores distintos, como el ingreso, porque ofrecen más puntos de corte posibles, aunque su efecto lineal sea débil. A la inversa, interes_politica tiene un efecto lineal fuerte (segundo por |z|) pero queda más abajo en el VIP. Las diferencias surgen porque: (1) la importancia Gini mide cuánto reduce cada variable la impureza en los árboles, mientras que el estadístico z mide la significancia del efecto lineal; (2) Random Forest reparte la importancia entre variables correlacionadas; (3) cada método responde a una estructura distinta. Una nota: en el laboratorio usamos importancia por permutación, menos sensible a este sesgo; aquí usamos Gini a propósito para mostrar que la métrica de importancia elegida cambia el ranking.
6 Comparación de modelos
6.1 Pregunta 11: Agregar un árbol de decisión
Entrenen un decision_tree() y compárenlo con los otros modelos.
# Árbol de decisión
modelo_arbol <- decision_tree(
cost_complexity = 0.01,
tree_depth = 10,
min_n = 10
) |>
set_engine("rpart") |>
set_mode("classification")
ajuste_arbol <- workflow() |>
add_recipe(receta) |>
add_model(modelo_arbol) |>
fit(data = datos_train)
pred_arbol <- augment(ajuste_arbol, datos_test)
metricas_arbol <- pred_arbol |>
mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second")
cat("Árbol de decisión:\n")Árbol de decisión:metricas_arbol# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.571
2 precision binary 0.597
3 recall binary 0.632
4 f_meas binary 0.614
5 roc_auc binary 0.604# Random Forest: reusamos ajuste_rf de la pregunta 9
pred_rf <- augment(ajuste_rf, datos_test)
metricas_rf <- pred_rf |>
mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second")
cat("\nRandom Forest:\n")
Random Forest:metricas_rf# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.548
2 precision binary 0.575
3 recall binary 0.618
4 f_meas binary 0.596
5 roc_auc binary 0.570cat("\nRegresión logística:\n")
Regresión logística:metricas_completo# A tibble: 5 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 accuracy binary 0.611
2 precision binary 0.634
3 recall binary 0.662
4 f_meas binary 0.647
5 roc_auc binary 0.626Respuesta: El resultado va contra la intuición habitual: en esta muestra el árbol de decisión (AUC ≈ 0.60) rinde mejor que el Random Forest sin tunear (AUC ≈ 0.57), y la regresión logística los supera a ambos (AUC ≈ 0.63). La regla de que “un solo árbol es más débil que un ensemble de 500” no se cumple aquí porque el problema es lineal, ruidoso y con pocas observaciones: el ensemble no encuentra estructura no lineal que aprovechar y la logística, bien especificada, gana. La ventaja del árbol sigue siendo su interpretabilidad: se visualiza como un diagrama de flujo que muestra exactamente cómo se decide. La lección es que un modelo más complejo no garantiza mejor desempeño; conviene compararlo siempre con un baseline lineal.
6.2 Pregunta 12: Tabla comparativa completa
Creen una tabla que compare los cuatro modelos.
# XGBoost (del laboratorio)
modelo_xgb <- boost_tree(
trees = 500, tree_depth = 4, learn_rate = 0.01, min_n = 10
) |>
set_engine("xgboost") |>
set_mode("classification")
ajuste_xgb <- workflow() |>
add_recipe(receta) |>
add_model(modelo_xgb) |>
fit(data = datos_train)
pred_xgb <- augment(ajuste_xgb, datos_test)
# Calcular las cinco métricas para cada modelo con mis_metricas
tabla <- bind_rows(
pred_completo |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second") |>
mutate(modelo = "Reg. 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"),
pred_arbol |> mis_metricas(truth = voto, estimate = .pred_class, .pred_si,
event_level = "second") |>
mutate(modelo = "Árbol decisión")
)
# Tabla resumen
tabla |>
select(modelo, .metric, .estimate) |>
pivot_wider(names_from = .metric, values_from = .estimate) |>
mutate(across(where(is.numeric), \(x) round(x, 3))) |>
arrange(desc(roc_auc))# A tibble: 4 × 6
modelo accuracy precision recall f_meas roc_auc
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Reg. logística 0.611 0.634 0.662 0.647 0.626
2 XGBoost 0.587 0.618 0.618 0.618 0.61
3 Árbol decisión 0.571 0.597 0.632 0.614 0.604
4 Random Forest 0.548 0.575 0.618 0.596 0.57 Respuesta: Ordenada por AUC, la tabla sorprende: la regresión logística queda primera (AUC ≈ 0.63), seguida de XGBoost (≈ 0.61) y el árbol (≈ 0.60), y el Random Forest sin tunear queda último (≈ 0.57). La explicación es clara: el proceso que genera el voto es esencialmente lineal en los predictores (lo diseñamos así), de modo que la regresión logística está bien especificada y es difícil de superar. Los modelos de árboles no tienen no-linealidades que explotar, y el Random Forest con hiperparámetros fijos (mtry = 4, min_n = 10) ni siquiera está tuneado: cuando lo ajustamos por validación cruzada en las preguntas 7 y 8, su AUC sube a ≈ 0.62 y prácticamente empata con la logística. La moraleja es doble: el modelo más sofisticado no siempre gana, y conviene ajustar los hiperparámetros y elegir la familia de modelos según la estructura de los datos. Las diferencias en accuracy, precisión y recall son pequeñas y refuerzan la misma conclusión.
7 Reflexión
7.1 Pregunta 13: Recomendación para un tomador de decisiones
¿Qué modelo recomendarían para un organismo electoral? Consideren rendimiento, interpretabilidad y utilidad.
Respuesta: Para un organismo electoral que busca entender qué factores influyen en la participación, recomendaría una combinación de regresión logística y Random Forest:
Regresión logística como modelo principal de comunicación: sus coeficientes (odds ratios) permiten decir cosas concretas como “por cada año adicional de edad, las chances de votar aumentan X%”. Esto es directamente útil para diseñar campañas de movilización dirigidas a grupos específicos.
Random Forest con VIP y PDP como herramienta de exploración: el VIP confirma qué variables son más predictivas (sin asumir linealidad), y los PDPs revelan relaciones no lineales que la regresión logística no captura (por ejemplo, si el efecto de la edad se estabiliza a partir de cierta edad).
No recomendaría XGBoost para este caso. En esta muestra su AUC es incluso menor que el de la regresión logística, así que perderíamos toda la interpretabilidad sin ganar precisión. Un funcionario público necesita poder explicar y justificar las decisiones, algo difícil con un modelo de caja negra.
En ciencias sociales aplicadas, la interpretabilidad suele ser tan importante como el rendimiento predictivo. En este caso ni siquiera hay que elegir: la regresión logística fue a la vez el modelo más interpretable y el de mejor AUC, así que la decisión es fácil. Y aun cuando exista un pequeño costo en precisión, un modelo que permite explicar y justificar las decisiones suele ser más útil para un organismo público que uno opaco con una ventaja marginal.