Introducción

En este ejercicio usamos el Adult Income Dataset (Census Income) para predecir si una persona gana más o menos de 50,000 USD anuales. Aplicamos dos modelos de clasificación supervisada:

Máquinas de Vectores de Soporte (SVM) con kernel lineal.
Árbol de Decisión con el paquete rpart.

Al final comparamos ambos modelos y discutimos sus implicaciones desde una perspectiva de política pública.

Parte 1: Exploración y Preprocesamiento (EDA)

Carga del dataset

library(tidyverse)
library(caret)
library(e1071)
library(rpart)
library(rpart.plot)
library(knitr)

# Carga del dataset
datos <- read.csv("ejercicio_final.csv", stringsAsFactors = TRUE)

# Quitar columna de índice
if (names(datos)[1] %in% c("X", "")) {
  datos <- datos[, -1]
}

cat("Dimensiones:", nrow(datos), "filas x", ncol(datos), "columnas\n\n")

## Dimensiones: 48598 filas x 15 columnas

str(datos)

## 'data.frame':    48598 obs. of  15 variables:
##  $ age           : int  25 38 28 44 18 34 29 63 24 55 ...
##  $ workclass     : Factor w/ 6 levels "?","Gov","Never-worked",..: 4 4 2 4 1 4 1 5 4 4 ...
##  $ demogweight   : int  226802 89814 336951 160323 103497 198693 227026 104626 369667 104996 ...
##  $ education     : Factor w/ 16 levels "10th","11th",..: 2 12 8 16 16 1 12 15 16 6 ...
##  $ education_num : int  7 9 12 10 10 6 9 15 10 4 ...
##  $ marital_status: Factor w/ 5 levels "Divorced","Married",..: 3 2 2 2 3 3 3 2 3 2 ...
##  $ occupation    : Factor w/ 15 levels "?","Adm-clerical",..: 8 6 12 8 1 9 1 11 9 4 ...
##  $ relationship  : Factor w/ 6 levels "Husband","Not-in-family",..: 4 1 1 1 4 2 5 1 5 1 ...
##  $ race          : Factor w/ 5 levels "Amer-Indian-Eskimo",..: 3 5 5 3 5 5 3 5 5 5 ...
##  $ gender        : Factor w/ 2 levels "Female","Male": 2 2 2 2 1 2 2 2 1 2 ...
##  $ capital_gain  : int  0 0 0 7688 0 0 0 3103 0 0 ...
##  $ capital_loss  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hours_per_week: int  40 50 40 40 30 30 40 32 40 10 ...
##  $ native_country: Factor w/ 41 levels "?","Cambodia",..: 39 39 39 39 39 39 39 39 39 39 ...
##  $ income        : Factor w/ 2 levels "<=50K",">50K": 1 1 2 2 1 1 1 2 1 1 ...

summary(datos)

##       age              workclass      demogweight             education    
##  Min.   :17.0   ?           : 2794   Min.   :  12285   HS-grad     :15750  
##  1st Qu.:28.0   Gov         : 6536   1st Qu.: 117551   Some-college:10860  
##  Median :37.0   Never-worked:   10   Median : 178215   Bachelors   : 7962  
##  Mean   :38.6   Private     :33780   Mean   : 189685   Masters     : 2627  
##  3rd Qu.:48.0   Self-emp    : 5457   3rd Qu.: 237713   Assoc-voc   : 2058  
##  Max.   :90.0   Without-pay :   21   Max.   :1490400   11th        : 1812  
##                                                        (Other)     : 7529  
##  education_num         marital_status            occupation   
##  Min.   : 1.00   Divorced     : 6613   Craft-repair   : 6096  
##  1st Qu.: 9.00   Married      :22847   Prof-specialty : 6071  
##  Median :10.00   Never-married:16096   Exec-managerial: 6019  
##  Mean   :10.06   Separated    : 1526   Adm-clerical   : 5603  
##  3rd Qu.:12.00   Widowed      : 1516   Sales          : 5470  
##  Max.   :16.00                         Other-service  : 4920  
##                                        (Other)        :14419  
##          relationship                   race          gender     
##  Husband       :19537   Amer-Indian-Eskimo:  470   Female:16156  
##  Not-in-family :12546   Asian-Pac-Islander: 1504   Male  :32442  
##  Other-relative: 1506   Black             : 4675                 
##  Own-child     : 7577   Other             :  403                 
##  Unmarried     : 5118   White             :41546                 
##  Wife          : 2314                                            
##                                                                  
##   capital_gain      capital_loss     hours_per_week        native_country 
##  Min.   :    0.0   Min.   :   0.00   Min.   : 1.00   United-States:43613  
##  1st Qu.:    0.0   1st Qu.:   0.00   1st Qu.:40.00   Mexico       :  949  
##  Median :    0.0   Median :   0.00   Median :40.00   ?            :  847  
##  Mean   :  582.4   Mean   :  87.94   Mean   :40.37   Philippines  :  292  
##  3rd Qu.:    0.0   3rd Qu.:   0.00   3rd Qu.:45.00   Germany      :  206  
##  Max.   :41310.0   Max.   :4356.00   Max.   :99.00   Puerto-Rico  :  184  
##                                                      (Other)      : 2507  
##    income     
##  <=50K:37155  
##  >50K :11443  
##               
##               
##               
##               
##

El dataset tiene 48598 observaciones y 15 variables. Las variables numéricas son age, demogweight, education_num, capital_gain, capital_loss y hours_per_week. Las categóricas incluyen workclass, education, marital_status, occupation, relationship, race, gender, native_country e income (variable objetivo).

Valores faltantes

# NAs reales
na_real <- colSums(is.na(datos))
cat("NAs reales por columna:\n")

## NAs reales por columna:

print(na_real[na_real > 0])

## named numeric(0)

# Missings codificados como " ?"
for (v in names(datos)) {
  if (is.factor(datos[[v]])) {
    n_q <- sum(datos[[v]] %in% c(" ?", "?"))
    if (n_q > 0) {
      cat(sprintf("  %s: %d observaciones con '?' (%.1f%%)\n",
                  v, n_q, 100 * n_q / nrow(datos)))
    }
  }
}

##   workclass: 2794 observaciones con '?' (5.7%)
##   occupation: 2804 observaciones con '?' (5.8%)
##   native_country: 847 observaciones con '?' (1.7%)

# Las categorías " ?" en workclass, occupation y native_country se recodifican
# como "Unknown". Representan menos del 6% y pueden ser informativas
# (empleo informal, no declarado), así que se conservan en lugar de eliminar.

datos <- datos %>%
  mutate(across(where(is.factor),
                ~ fct_recode(., "Unknown" = " ?", "Unknown" = "?")))

cat("Filas después de imputación:", nrow(datos), "\n")

## Filas después de imputación: 48598

Desbalance de clases

tabla_income <- table(datos$income)
prop_income  <- prop.table(tabla_income) * 100

cat("Distribución de income:\n")

## Distribución de income:

print(tabla_income)

## 
## <=50K  >50K 
## 37155 11443

cat("\nPorcentajes:\n")

## 
## Porcentajes:

print(round(prop_income, 2))

## 
## <=50K  >50K 
## 76.45 23.55

ggplot(datos, aes(x = income, fill = income)) +
  geom_bar(width = 0.5, show.legend = FALSE) +
  geom_text(stat = "count",
            aes(label = paste0(round(after_stat(count) / nrow(datos) * 100, 1), "%")),
            vjust = -0.5, size = 4.5) +
  scale_fill_manual(values = c("#2C7BB6", "#D7191C")) +
  labs(title = "Distribución de la variable objetivo: income",
       x = "Categoría de ingreso", y = "Frecuencia") +
  theme_minimal(base_size = 13)

Aproximadamente el 23.5% de las personas gana más de 50,000 USD. Este desbalance puede hacer que el modelo prediga casi siempre la clase mayoritaria (<=50K), lo que da una accuracy alta pero un recall bajo para el grupo de interés (>50K). Por eso es importante evaluar con Precision, Recall y F1, no solo con accuracy.

Visualizaciones exploratorias

Ingreso por nivel educativo

datos %>%
  group_by(education, income) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(education) %>%
  mutate(pct = n / sum(n) * 100) %>%
  filter(income == ">50K") %>%
  arrange(desc(pct)) %>%
  ggplot(aes(x = reorder(education, pct), y = pct, fill = pct)) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  scale_fill_gradient(low = "#fee8c8", high = "#b30000") +
  labs(title = "% con ingreso >50K por nivel educativo",
       x = "Nivel educativo", y = "% con ingreso >50K") +
  theme_minimal(base_size = 12)

Hay una relación clara y positiva entre nivel educativo e ingreso. Los posgrados (Doctorate, Prof-school, Masters) concentran las tasas más altas de ingreso >50K, lo cual es consistente con la teoría del capital humano.

Ingreso por ocupación

datos %>%
  group_by(occupation, income) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(occupation) %>%
  mutate(pct = n / sum(n) * 100) %>%
  filter(income == ">50K") %>%
  arrange(desc(pct)) %>%
  ggplot(aes(x = reorder(occupation, pct), y = pct, fill = pct)) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  scale_fill_gradient(low = "#deebf7", high = "#08519c") +
  labs(title = "% con ingreso >50K por ocupación",
       x = "Ocupación", y = "% con ingreso >50K") +
  theme_minimal(base_size = 12)

Las ocupaciones ejecutivas y de especialidad técnica (Exec-managerial, Prof-specialty) presentan las tasas más altas, mientras que las tareas agrícolas y de servicios tienen las más bajas.

Ingreso por sexo

datos %>%
  group_by(gender, income) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(gender) %>%
  mutate(pct = n / sum(n) * 100) %>%
  ggplot(aes(x = gender, y = pct, fill = income)) +
  geom_col(position = "fill", width = 0.5) +
  scale_y_continuous(labels = scales::percent) +
  scale_fill_manual(values = c("#2C7BB6", "#D7191C")) +
  labs(title = "Distribución de ingreso por sexo",
       x = "Sexo", y = "Proporción", fill = "Income") +
  theme_minimal(base_size = 13)

La brecha de género es significativa. Los hombres tienen una tasa de ingreso >50K aproximadamente tres veces mayor que las mujeres.

Preprocesamiento y estandarización

# Variables numéricas
vars_num <- c("age", "education_num", "capital_gain",
              "capital_loss", "hours_per_week", "demogweight")

# Variables categóricas (sin la variable objetivo)
vars_cat <- c("workclass", "marital_status", "occupation",
              "relationship", "race", "gender", "native_country")

# One-hot encoding para variables categóricas
dummy_formula <- as.formula(paste("~", paste(vars_cat, collapse = " + ")))
dummies <- model.matrix(dummy_formula, data = datos)[, -1]

# Estandarizar variables numéricas
datos_num_scaled <- scale(datos[, vars_num])

# Dataset final para los modelos
datos_modelo <- data.frame(
  datos_num_scaled,
  dummies,
  income = datos$income
)

cat("Dimensiones del dataset preprocesado:", dim(datos_modelo), "\n")

## Dimensiones del dataset preprocesado: 48598 80

cat("Niveles de income:", levels(datos_modelo$income), "\n")

## Niveles de income: <=50K >50K

División entrenamiento / prueba (70/30)

set.seed(2024)
idx_train <- createDataPartition(datos_modelo$income, p = 0.70, list = FALSE)

train_set <- datos_modelo[idx_train, ]
test_set  <- datos_modelo[-idx_train, ]

cat("Entrenamiento:", nrow(train_set), "observaciones\n")

## Entrenamiento: 34020 observaciones

cat("Prueba       :", nrow(test_set),  "observaciones\n")

## Prueba       : 14578 observaciones

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

## 
## Proporción en entrenamiento:

print(round(prop.table(table(train_set$income)) * 100, 2))

## 
## <=50K  >50K 
## 76.45 23.55

cat("Proporción en prueba:\n")

## Proporción en prueba:

print(round(prop.table(table(test_set$income)) * 100, 2))

## 
## <=50K  >50K 
## 76.46 23.54

La partición estratificada con createDataPartition conserva la proporción original de clases en ambos conjuntos.

Parte 2: Primer Modelo — SVM con Kernel Lineal

Se aplica una SVM con kernel lineal como primer modelo. Es un buen punto de partida porque es relativamente interpretable y eficiente computacionalmente.

Ajuste del modelo

# Pesos para compensar el desbalance de clases
n_neg <- sum(train_set$income == "<=50K")
n_pos <- sum(train_set$income == ">50K")
pesos <- c("<=50K" = 1, ">50K" = n_neg / n_pos)

set.seed(2024)
svm_lineal <- svm(
  income ~ .,
  data          = train_set,
  kernel        = "linear",
  cost          = 1,
  class.weights = pesos,
  scale         = FALSE  # ya estandarizamos
)

summary(svm_lineal)

## 
## Call:
## svm(formula = income ~ ., data = train_set, kernel = "linear", cost = 1, 
##     class.weights = pesos, scale = FALSE)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  linear 
##        cost:  1 
## 
## Number of Support Vectors:  14349
## 
##  ( 10962 3387 )
## 
## 
## Number of Classes:  2 
## 
## Levels: 
##  <=50K >50K

Evaluación en prueba

pred_svm <- predict(svm_lineal, newdata = test_set)
cm_svm   <- confusionMatrix(pred_svm, test_set$income, positive = ">50K")
print(cm_svm)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction <=50K >50K
##      <=50K  8602  494
##      >50K   2544 2938
##                                           
##                Accuracy : 0.7916          
##                  95% CI : (0.7849, 0.7982)
##     No Information Rate : 0.7646          
##     P-Value [Acc > NIR] : 3.407e-15       
##                                           
##                   Kappa : 0.5203          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.8561          
##             Specificity : 0.7718          
##          Pos Pred Value : 0.5359          
##          Neg Pred Value : 0.9457          
##              Prevalence : 0.2354          
##          Detection Rate : 0.2015          
##    Detection Prevalence : 0.3760          
##       Balanced Accuracy : 0.8139          
##                                           
##        'Positive' Class : >50K            
##

acc_svm  <- cm_svm$overall["Accuracy"]
prec_svm <- cm_svm$byClass["Precision"]
rec_svm  <- cm_svm$byClass["Recall"]
f1_svm   <- cm_svm$byClass["F1"]

cat(sprintf("SVM Lineal — Accuracy: %.3f | Precision: %.3f | Recall: %.3f | F1: %.3f\n",
            acc_svm, prec_svm, rec_svm, f1_svm))

## SVM Lineal — Accuracy: 0.792 | Precision: 0.536 | Recall: 0.856 | F1: 0.659

Ajuste del hiperparámetro cost (validación cruzada)

# Submuestra estratificada para hacer tune más rápido
set.seed(2024)
idx_tune <- createDataPartition(train_set$income, p = 0.25, list = FALSE)
tune_data <- train_set[idx_tune, ]

tune_svm <- tune(
  svm,
  income ~ .,
  data   = tune_data,
  kernel = "linear",
  ranges = list(cost = c(0.01, 0.1, 1, 5, 10)),
  tunecontrol = tune.control(cross = 5)
)

summary(tune_svm)

## 
## Parameter tuning of 'svm':
## 
## - sampling method: 5-fold cross validation 
## 
## - best parameters:
##  cost
##   0.1
## 
## - best performance: 0.1487181 
## 
## - Detailed performance results:
##    cost     error  dispersion
## 1  0.01 0.1523626 0.008391663
## 2  0.10 0.1487181 0.006652460
## 3  1.00 0.1503642 0.006622148
## 4  5.00 0.1503642 0.007641685
## 5 10.00 0.1500114 0.007432514

cat("\nMejor cost:", tune_svm$best.parameters$cost, "\n")

## 
## Mejor cost: 0.1

best_cost <- tune_svm$best.parameters$cost

svm_opt <- svm(
  income ~ .,
  data          = train_set,
  kernel        = "linear",
  cost          = best_cost,
  class.weights = pesos,
  scale         = FALSE
)

pred_svm_opt <- predict(svm_opt, newdata = test_set)
cm_svm_opt   <- confusionMatrix(pred_svm_opt, test_set$income, positive = ">50K")
print(cm_svm_opt)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction <=50K >50K
##      <=50K  8584  489
##      >50K   2562 2943
##                                          
##                Accuracy : 0.7907         
##                  95% CI : (0.784, 0.7973)
##     No Information Rate : 0.7646         
##     P-Value [Acc > NIR] : 2.598e-14      
##                                          
##                   Kappa : 0.5191         
##                                          
##  Mcnemar's Test P-Value : < 2.2e-16      
##                                          
##             Sensitivity : 0.8575         
##             Specificity : 0.7701         
##          Pos Pred Value : 0.5346         
##          Neg Pred Value : 0.9461         
##              Prevalence : 0.2354         
##          Detection Rate : 0.2019         
##    Detection Prevalence : 0.3776         
##       Balanced Accuracy : 0.8138         
##                                          
##        'Positive' Class : >50K           
##

acc_svm_opt  <- cm_svm_opt$overall["Accuracy"]
prec_svm_opt <- cm_svm_opt$byClass["Precision"]
rec_svm_opt  <- cm_svm_opt$byClass["Recall"]
f1_svm_opt   <- cm_svm_opt$byClass["F1"]

cat(sprintf("SVM Lineal (opt) — Accuracy: %.3f | Precision: %.3f | Recall: %.3f | F1: %.3f\n",
            acc_svm_opt, prec_svm_opt, rec_svm_opt, f1_svm_opt))

## SVM Lineal (opt) — Accuracy: 0.791 | Precision: 0.535 | Recall: 0.858 | F1: 0.659

Variables más importantes — SVM Lineal

# Pesos del hiperplano separador (solo disponible para kernel lineal)
w_lineal <- t(svm_opt$coefs) %*% svm_opt$SV
importancia_svm <- sort(abs(w_lineal[1, ]), decreasing = TRUE)[1:15]

df_imp_svm <- data.frame(
  Variable    = names(importancia_svm),
  Importancia = as.numeric(importancia_svm)
)

ggplot(df_imp_svm, aes(x = reorder(Variable, Importancia), y = Importancia)) +
  geom_col(fill = "#2C7BB6") +
  coord_flip() +
  labs(title = "Top 15 variables — SVM Lineal",
       subtitle = "Magnitud de pesos del hiperplano separador",
       x = "Variable", y = "|w|") +
  theme_minimal(base_size = 11)

Las variables relationshipHusband, marital_statusMarried-civ-spouse, capital_gain y education_num aparecen entre las más importantes. Esto es coherente con la literatura económica: el capital humano (educación) y la acumulación de riqueza (capital gain) son predictores clave del ingreso.

Parte 3: Segundo Modelo — Árbol de Decisión

Como segundo modelo se aplica un árbol de decisión con el paquete rpart. Este modelo tiene una ventaja importante sobre la SVM: es completamente interpretable visualmente, lo que facilita la comunicación de resultados a tomadores de decisiones.

Para el árbol no es necesario el one-hot encoding ni la estandarización, así que se trabaja directamente con el dataset original (imputado).

Preparación de datos para el árbol

# Para el árbol se usa el dataset original (imputado), sin escalar ni dummies
set.seed(2024)
idx_arbol <- createDataPartition(datos$income, p = 0.70, list = FALSE)

train_arbol <- datos[idx_arbol, ]
test_arbol  <- datos[-idx_arbol, ]

cat("Entrenamiento:", nrow(train_arbol), "\n")

## Entrenamiento: 34020

cat("Prueba       :", nrow(test_arbol), "\n")

## Prueba       : 14578

Ajuste del árbol

# Se usa class.weights a través de los pesos en rpart con parms
# El parámetro prior ajusta las probabilidades a priori para compensar el desbalance
prop_pos <- mean(train_arbol$income == ">50K")
prop_neg <- 1 - prop_pos

set.seed(2024)
arbol <- rpart(
  income ~ .,
  data   = train_arbol,
  method = "class",
  parms  = list(prior = c(prop_neg, prop_pos)),
  control = rpart.control(
    minsplit = 20,
    minbucket = 7,
    cp = 0.001,
    maxdepth = 8
  )
)

printcp(arbol)

## 
## Classification tree:
## rpart(formula = income ~ ., data = train_arbol, method = "class", 
##     parms = list(prior = c(prop_neg, prop_pos)), control = rpart.control(minsplit = 20, 
##         minbucket = 7, cp = 0.001, maxdepth = 8))
## 
## Variables actually used in tree construction:
## [1] age            capital_gain   capital_loss   education      hours_per_week
## [6] native_country occupation     relationship  
## 
## Root node error: 8011/34020 = 0.23548
## 
## n= 34020 
## 
##          CP nsplit rel error  xerror      xstd
## 1 0.1217701      0   1.00000 1.00000 0.0097690
## 2 0.0582948      2   0.75646 0.75646 0.0088095
## 3 0.0345775      3   0.69817 0.69817 0.0085336
## 4 0.0080514      4   0.66359 0.66359 0.0083601
## 5 0.0073649      6   0.64748 0.65410 0.0083111
## 6 0.0034952      8   0.63275 0.63737 0.0082232
## 7 0.0017476     11   0.62040 0.62339 0.0081482
## 8 0.0016727     12   0.61865 0.61840 0.0081211
## 9 0.0010000     19   0.60479 0.61740 0.0081157

Poda del árbol (selección de cp óptimo)

# Seleccionar el cp que minimiza el error de validación cruzada
cp_opt <- arbol$cptable[which.min(arbol$cptable[, "xerror"]), "CP"]
cat("cp óptimo:", cp_opt, "\n")

## cp óptimo: 0.001

arbol_podado <- prune(arbol, cp = cp_opt)

cat("\nNúmero de hojas árbol original:", sum(arbol$cptable[, "nsplit"]) + 1, "\n")

## 
## Número de hojas árbol original: 66

cat("Número de nodos terminales árbol podado:", 
    sum(arbol_podado$frame$var == "<leaf>"), "\n")

## Número de nodos terminales árbol podado: 20

Visualización del árbol

rpart.plot(
  arbol_podado,
  type   = 4,
  extra  = 104,
  box.palette = c("#2C7BB6", "#D7191C"),
  branch = 0.5,
  shadow.col = "gray",
  main   = "Árbol de decisión podado — Adult Income"
)

El árbol muestra las divisiones más importantes en orden jerárquico. Las primeras ramas corresponden a las variables con mayor poder discriminante.

Evaluación en prueba

pred_arbol <- predict(arbol_podado, newdata = test_arbol, type = "class")
cm_arbol   <- confusionMatrix(pred_arbol, test_arbol$income, positive = ">50K")
print(cm_arbol)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction <=50K  >50K
##      <=50K 10786  1752
##      >50K    360  1680
##                                           
##                Accuracy : 0.8551          
##                  95% CI : (0.8493, 0.8608)
##     No Information Rate : 0.7646          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.5319          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.4895          
##             Specificity : 0.9677          
##          Pos Pred Value : 0.8235          
##          Neg Pred Value : 0.8603          
##              Prevalence : 0.2354          
##          Detection Rate : 0.1152          
##    Detection Prevalence : 0.1399          
##       Balanced Accuracy : 0.7286          
##                                           
##        'Positive' Class : >50K            
##

acc_arbol  <- cm_arbol$overall["Accuracy"]
prec_arbol <- cm_arbol$byClass["Precision"]
rec_arbol  <- cm_arbol$byClass["Recall"]
f1_arbol   <- cm_arbol$byClass["F1"]

cat(sprintf("Árbol — Accuracy: %.3f | Precision: %.3f | Recall: %.3f | F1: %.3f\n",
            acc_arbol, prec_arbol, rec_arbol, f1_arbol))

## Árbol — Accuracy: 0.855 | Precision: 0.824 | Recall: 0.490 | F1: 0.614

Variables más importantes — Árbol de Decisión

imp_arbol <- arbol_podado$variable.importance
imp_arbol <- sort(imp_arbol, decreasing = TRUE)[1:12]

df_imp_arbol <- data.frame(
  Variable    = names(imp_arbol),
  Importancia = as.numeric(imp_arbol)
)

ggplot(df_imp_arbol, aes(x = reorder(Variable, Importancia), y = Importancia)) +
  geom_col(fill = "#D7191C") +
  coord_flip() +
  labs(title = "Top 12 variables — Árbol de Decisión",
       subtitle = "Basado en reducción de impureza (Gini)",
       x = "Variable", y = "Importancia") +
  theme_minimal(base_size = 11)

Parte 4: Contraste y Discusión Económica

Tabla comparativa de métricas

metricas <- data.frame(
  Modelo      = c("SVM Lineal (cost óptimo)", "Árbol de Decisión (podado)"),
  Accuracy    = round(c(acc_svm_opt,  acc_arbol),  4),
  Precision   = round(c(prec_svm_opt, prec_arbol), 4),
  Recall      = round(c(rec_svm_opt,  rec_arbol),  4),
  F1          = round(c(f1_svm_opt,   f1_arbol),   4),
  Specificity = round(c(cm_svm_opt$byClass["Specificity"],
                        cm_arbol$byClass["Specificity"]), 4)
)

kable(metricas,
      caption = "Comparación de métricas: SVM Lineal vs. Árbol de Decisión",
      align = "c")

Comparación de métricas: SVM Lineal vs. Árbol de Decisión
Modelo	Accuracy	Precision	Recall	F1	Specificity
SVM Lineal (cost óptimo)	0.7907	0.5346	0.8575	0.6586	0.7701
Árbol de Decisión (podado)	0.8551	0.8235	0.4895	0.6140	0.9677

Ambos modelos muestran desempeño similar en accuracy, pero difieren en el equilibrio entre Precision y Recall para la clase >50K. El modelo con mayor F1 tiene mejor balance entre detectar correctamente los casos positivos sin generar demasiados falsos positivos.

Ambos modelos coinciden en señalar variables relacionadas con estado civil/relación familiar (relationship, marital_status), educación (education_num) y ganancias de capital (capital_gain) como los predictores más importantes del ingreso. Que los dos lleguen a conclusiones similares nos da más confianza en que estos resultados no son casualidad.

La relación entre estado civil e ingreso alto tiene sentido si pensamos que personas con mayor educación o ingresos tienden a estar en relaciones estables, y también porque en muchos hogares hay dos ingresos que se complementan.

Implicaciones de política pública

1. Retornos a la educación

education_num sale como uno de los predictores más fuertes en los dos modelos. Básicamente, entre más años de escolaridad tiene una persona, más probable es que gane más de 50K. Esto apoya la idea de que invertir en educación superior y formación técnica podría ayudar a reducir la desigualdad de ingresos entre grupos.

2. Brecha de género

Las gráficas muestran una diferencia muy marcada entre hombres y mujeres: los hombres tienen una probabilidad mucho mayor de estar en el grupo de ingresos altos. Esto puede deberse a varias cosas — las ocupaciones no están distribuidas igual entre géneros, hay interrupciones en la carrera laboral, y posiblemente también diferencias salariales directas. Políticas de igualdad salarial y programas de reincorporación laboral para mujeres serían relevantes aquí.

3. Concentración del capital

capital_gain aparece como predictor importante en ambos modelos. Tiene sentido: quien ya tiene activos o inversiones genera más ingresos de capital, lo que refuerza la desigualdad. Esto sugiere que ampliar el acceso a instrumentos financieros para personas de bajos ingresos (crédito, ahorro formal) podría tener un efecto redistributivo.

4. Ocupación

Las diferencias entre ocupaciones son bastante grandes. Ocupaciones ejecutivas y técnicas tienen tasas de ingreso alto mucho más altas que las de servicios o agricultura. En ese sentido, programas de reconversión laboral hacia sectores mejor remunerados podrían tener impacto, sobre todo considerando que muchas ocupaciones de bajos ingresos están en riesgo por la automatización.

Conclusiones

En general, los dos modelos funcionan de forma bastante similar en las métricas principales. La diferencia más importante no es tanto el desempeño sino lo que cada uno ofrece: el árbol de decisión da reglas claras y visuales que son fáciles de explicar, mientras que la SVM puede manejar mejor datasets con muchas variables (como este, después del one-hot encoding) sin sobreajustarse a patrones muy específicos.

Lo que nos parece más relevante es que ambos modelos coinciden en las mismas variables clave — educación, relación familiar y capital — lo que sugiere que estos patrones son reales y no dependen del método que se use para analizarlos.

Referencias

Becker, G. S. (1964). Human Capital. Columbia University Press.
James, G., Witten, D., Hastie, T., & Tibshirani, R. (2021). An Introduction to Statistical Learning (2nd ed.). Springer.
Vapnik, V. (1995). The Nature of Statistical Learning Theory. Springer.
Dua, D. & Graff, C. (2019). UCI Machine Learning Repository. Adult Data Set. University of California, Irvine.

Documento generado con R Markdown. Resultados reproducibles con set.seed(2024).

Actividad M5: Modelos de pronóstico y clasificación

Paula Garza, Josue Briones

2026-06-12

Introducción

Parte 1: Exploración y Preprocesamiento (EDA)

Carga del dataset

Valores faltantes

Desbalance de clases

Visualizaciones exploratorias

Ingreso por nivel educativo

Ingreso por ocupación

Ingreso por sexo

Preprocesamiento y estandarización

División entrenamiento / prueba (70/30)

Parte 2: Primer Modelo — SVM con Kernel Lineal

Ajuste del modelo

Evaluación en prueba

Ajuste del hiperparámetro cost (validación cruzada)

Variables más importantes — SVM Lineal

Parte 3: Segundo Modelo — Árbol de Decisión

Preparación de datos para el árbol

Ajuste del árbol

Poda del árbol (selección de cp óptimo)

Visualización del árbol

Evaluación en prueba

Variables más importantes — Árbol de Decisión

Parte 4: Contraste y Discusión Económica

Tabla comparativa de métricas

Implicaciones de política pública

1. Retornos a la educación

2. Brecha de género

3. Concentración del capital

4. Ocupación

Conclusiones

Referencias