El ingreso de las personas es uno de los indicadores más utilizados para entender el bienestar económico de una sociedad. Saber qué características se asocian con ingresos más altos ayuda a comprender la desigualdad, a diseñar políticas de educación y empleo y a identificar grupos de la población que enfrentan mayores barreras económicas. En Estados Unidos, la Oficina del Censo recoge periódicamente esta información a través de la Encuesta de Población Actual (Current Population Survey), que registra datos como la edad, el nivel educativo, la ocupación, el estado civil y las horas de trabajo de cada persona.
A partir de esa encuesta, Barry Becker y Ronny Kohavi construyeron en 1996 la base de datos conocida como “Adult” o “Census Income”, que desde entonces es una de las bases más usadas en el mundo para enseñar y evaluar modelos de clasificación (Becker y Kohavi, 1996; Kohavi, 1996). La base contiene información de 32.561 personas encuestadas en 1994 y una variable que indica si la persona ganaba más de 50.000 dólares al año o no.
El presente estudio tiene como objetivo analizar y predecir si una persona supera los 50.000 dólares de ingreso anual a partir de seis características socioeconómicas: años de educación, edad, horas de trabajo semanales, estado civil, ocupación y sexo. Para abordar el problema se emplearon dos modelos de clasificación supervisada: el algoritmo K-Vecinos Más Cercanos (KNN) y la regresión logística (Logit). Estos modelos permiten estimar la probabilidad de que una persona tenga ingresos altos y comparar cuál ofrece un mejor equilibrio entre precisión y capacidad para detectar correctamente ambos grupos, teniendo en cuenta que las personas con ingresos altos son minoría en la base.
La información proviene de la base Adult del repositorio de aprendizaje automático de la Universidad de California en Irvine (UCI), construida a partir del censo de Estados Unidos de 1994. El conjunto de datos contiene 32.561 personas y 15 columnas, y fue importado desde un archivo de Excel. Inicialmente se realizó una inspección general de la estructura de los datos para verificar sus dimensiones, los tipos de variables y los primeros registros disponibles.
base <- read_excel("datos/adult.xlsx")
cat("Dimensiones de la base original:", nrow(base), "filas x", ncol(base), "columnas\n")## Dimensiones de la base original: 32561 filas x 15 columnasbase %>%
head(10) %>%
tabla(caption = "Primeros 10 registros de la base de datos", full_width = TRUE)| age | workclass | fnlwgt | education | education-num | marital-status | occupation | relationship | race | sex | capital-gain | capital-loss | hours-per-week | native-country | income |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 39 | State-gov | 77516 | Bachelors | 13 | Never-married | Adm-clerical | Not-in-family | White | Male | 2174 | 0 | 40 | United-States | <=50K |
| 50 | Self-emp-not-inc | 83311 | Bachelors | 13 | Married-civ-spouse | Exec-managerial | Husband | White | Male | 0 | 0 | 13 | United-States | <=50K |
| 38 | Private | 215646 | HS-grad | 9 | Divorced | Handlers-cleaners | Not-in-family | White | Male | 0 | 0 | 40 | United-States | <=50K |
| 53 | Private | 234721 | 11th | 7 | Married-civ-spouse | Handlers-cleaners | Husband | Black | Male | 0 | 0 | 40 | United-States | <=50K |
| 28 | Private | 338409 | Bachelors | 13 | Married-civ-spouse | Prof-specialty | Wife | Black | Female | 0 | 0 | 40 | Cuba | <=50K |
| 37 | Private | 284582 | Masters | 14 | Married-civ-spouse | Exec-managerial | Wife | White | Female | 0 | 0 | 40 | United-States | <=50K |
| 49 | Private | 160187 | 9th | 5 | Married-spouse-absent | Other-service | Not-in-family | Black | Female | 0 | 0 | 16 | Jamaica | <=50K |
| 52 | Self-emp-not-inc | 209642 | HS-grad | 9 | Married-civ-spouse | Exec-managerial | Husband | White | Male | 0 | 0 | 45 | United-States | >50K |
| 31 | Private | 45781 | Masters | 14 | Never-married | Prof-specialty | Not-in-family | White | Female | 14084 | 0 | 50 | United-States | >50K |
| 42 | Private | 159449 | Bachelors | 13 | Married-civ-spouse | Exec-managerial | Husband | White | Male | 5178 | 0 | 40 | United-States | >50K |
tribble(
~Variable, ~Descripción,
"age", "Edad en años",
"workclass", "Tipo de empleador (privado, gobierno, independiente, etc.)",
"fnlwgt", "Peso muestral del censo (cuántas personas representa el registro)",
"education", "Máximo nivel educativo alcanzado",
"education-num", "Nivel educativo expresado en años de estudio (1 a 16)",
"marital-status", "Estado civil",
"occupation", "Ocupación",
"relationship", "Relación con el jefe del hogar",
"race", "Raza declarada",
"sex", "Sexo",
"capital-gain", "Ganancias de capital en el año (dólares)",
"capital-loss", "Pérdidas de capital en el año (dólares)",
"hours-per-week", "Horas trabajadas por semana",
"native-country", "País de nacimiento",
"income", "Ingreso anual: <=50K o >50K (variable a predecir)"
) %>%
kable(caption = "Descripción de las 15 variables de la base Adult", align = c("l", "l")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(1, bold = TRUE)| Variable | Descripción |
|---|---|
| age | Edad en años |
| workclass | Tipo de empleador (privado, gobierno, independiente, etc.) |
| fnlwgt | Peso muestral del censo (cuántas personas representa el registro) |
| education | Máximo nivel educativo alcanzado |
| education-num | Nivel educativo expresado en años de estudio (1 a 16) |
| marital-status | Estado civil |
| occupation | Ocupación |
| relationship | Relación con el jefe del hogar |
| race | Raza declarada |
| sex | Sexo |
| capital-gain | Ganancias de capital en el año (dólares) |
| capital-loss | Pérdidas de capital en el año (dólares) |
| hours-per-week | Horas trabajadas por semana |
| native-country | País de nacimiento |
| income | Ingreso anual: <=50K o >50K (variable a predecir) |
La variable dependiente del estudio es el ingreso anual de la
persona, que en la base viene registrada en dos categorías:
<=50K (gana hasta 50.000 dólares al año) y
>50K (gana más de 50.000 dólares). Para el análisis se
construyó la variable ingreso_alto, codificada como
“Si” cuando la persona supera los 50.000 dólares y
“No” cuando no los supera, y se transformó a formato
factor para los modelos de clasificación.
Clasificar esta variable es interesante porque permite identificar qué características de las personas se relacionan con alcanzar un ingreso alto. Esa información es útil para entender la desigualdad de ingresos, orientar programas de formación y empleo y, en el ámbito privado, para segmentar clientes en servicios financieros o de mercadeo. En 1994, 50.000 dólares anuales era aproximadamente el ingreso de un hogar de clase media alta en Estados Unidos, por lo que el umbral separa a las personas con ingresos claramente por encima del promedio.
Para predecir el ingreso se seleccionaron seis variables independientes relacionadas con el capital humano, la situación laboral y las características demográficas de la persona. Se eligieron porque tienen una relación directa y fácil de interpretar con el nivel de ingresos, porque no repiten información entre sí y porque cubren distintos tipos de variable (cuantitativas y categóricas).
tribble(
~Variable, ~Nombre, ~Tipo, ~Justificación,
"X1", "Años de educación (education-num)", "Cuantitativa (1 a 16 años)", "A mayor educación, mayor acceso a empleos mejor remunerados.",
"X2", "Edad (age)", "Cuantitativa (17 a 90 años)", "Refleja la experiencia laboral acumulada; los ingresos suelen crecer con la edad hasta la jubilación.",
"X3", "Horas de trabajo por semana (hours-per-week)", "Cuantitativa (1 a 99 horas)", "Trabajar tiempo completo o jornadas largas se asocia con mayores ingresos.",
"X4", "Estado civil (marital-status)", "Categórica (3 grupos)", "Las personas casadas suelen tener mayor estabilidad económica y laboral.",
"X5", "Ocupación (occupation)", "Categórica (13 grupos)", "El tipo de trabajo determina directamente el nivel salarial.",
"X6", "Sexo (sex)", "Categórica binaria", "Permite observar la brecha salarial entre hombres y mujeres."
) %>%
kable(caption = "Variables independientes seleccionadas", align = c("c", "l", "l", "l")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(1, bold = TRUE)| Variable | Nombre | Tipo | Justificación |
|---|---|---|---|
| X1 | Años de educación (education-num) | Cuantitativa (1 a 16 años) | A mayor educación, mayor acceso a empleos mejor remunerados. |
| X2 | Edad (age) | Cuantitativa (17 a 90 años) | Refleja la experiencia laboral acumulada; los ingresos suelen crecer con la edad hasta la jubilación. |
| X3 | Horas de trabajo por semana (hours-per-week) | Cuantitativa (1 a 99 horas) | Trabajar tiempo completo o jornadas largas se asocia con mayores ingresos. |
| X4 | Estado civil (marital-status) | Categórica (3 grupos) | Las personas casadas suelen tener mayor estabilidad económica y laboral. |
| X5 | Ocupación (occupation) | Categórica (13 grupos) | El tipo de trabajo determina directamente el nivel salarial. |
| X6 | Sexo (sex) | Categórica binaria | Permite observar la brecha salarial entre hombres y mujeres. |
X1 — Años de educación: la base trae el nivel
educativo de dos formas: como texto (education, con 16
categorías desde preescolar hasta doctorado) y como número de años de
estudio (education-num, de 1 a 16). Ambas contienen
exactamente la misma información, así que se usó la versión numérica,
que es más sencilla para los modelos y permite interpretar el efecto de
“un año más de estudio”. Se espera que a mayor educación aumente la
probabilidad de ingresos altos.
X2 — Edad: se tomó como variable cuantitativa continua, entre 17 y 90 años. Se espera que las personas de mediana edad, que ya acumularon experiencia y están en plena etapa laboral, tengan mayor probabilidad de ingresos altos que los jóvenes que recién ingresan al mercado laboral o que las personas ya jubiladas.
X3 — Horas de trabajo por semana: es una variable cuantitativa entre 1 y 99 horas (99 es el valor máximo que registra el censo). Refleja la intensidad de la vida laboral: quien trabaja tiempo completo o más de 40 horas tiene más posibilidades de alcanzar ingresos altos que quien trabaja medio tiempo.
X4 — Estado civil: la base trae siete categorías. Para simplificar la interpretación se agruparon en tres: Casado(a) (casado con cónyuge civil o de las fuerzas armadas), Nunca casado(a) y Antes casado(a) (divorciado, separado, viudo o con cónyuge ausente). Se espera que las personas casadas tengan mayor probabilidad de ingresos altos, porque suelen ser mayores, tener empleos más estables y contar con el apoyo económico del hogar.
X5 — Ocupación: la base registra 14 ocupaciones. La categoría Armed-Forces (fuerzas armadas) tiene solo 9 personas, así que se unió con Protective-serv (servicios de protección) en un grupo llamado Protección y fuerzas armadas, quedando 13 grupos. Se espera que las ocupaciones directivas y profesionales concentren los ingresos altos, mientras que los servicios y las labores manuales presenten porcentajes bajos.
X6 — Sexo: variable binaria (hombre o mujer). Se incluye porque la brecha salarial de género es uno de los fenómenos más documentados en el mercado laboral y permite cuantificar la diferencia en la probabilidad de alcanzar ingresos altos entre hombres y mujeres, manteniendo constantes las demás variables.
Las demás variables de la base se dejaron por fuera:
fnlwgt es un peso muestral y no describe a la persona;
relationship repite la información del estado civil y del
sexo; education repite la de education-num;
native-country tiene 42 países pero el 90 % de las personas
son de Estados Unidos; race tiene una relación débil con el
ingreso en esta base; y las ganancias y pérdidas de capital son cero
para más del 90 % de las personas.
Una vez seleccionadas las variables, se revisó la calidad de la base.
La base no tiene celdas vacías, pero sí usa el símbolo
“?” para indicar información que la persona no reportó,
en tres columnas: tipo de empleador (workclass), ocupación
(occupation) y país de origen
(native-country). Como la ocupación es una de las variables
del modelo, las personas que no la reportaron no pueden usarse para
entrenarlo. También se encontraron 24 registros exactamente repetidos,
que se eliminaron para que una misma persona no quede a la vez en el
grupo de entrenamiento y en el de prueba.
# Personas con al menos un "?" en alguna columna
tiene_interrogante <- apply(base, 1, function(fila) any(fila == "?"))
resumen_limpieza <- data.frame(
Paso = c("Registros en el archivo original",
"Registros con '?' (información no reportada)",
"Registros duplicados (entre los que no tienen '?')",
"Registros finales para el análisis"),
Cantidad = c(nrow(base),
sum(tiene_interrogante),
sum(duplicated(base[!tiene_interrogante, ])),
nrow(distinct(base[!tiene_interrogante, ])))
)
resumen_limpieza %>%
tabla(caption = "Resumen del proceso de limpieza de la base", header_bg = "#b71c1c")| Paso | Cantidad |
|---|---|
| Registros en el archivo original | 32561 |
| Registros con ‘?’ (información no reportada) | 2399 |
| Registros duplicados (entre los que no tienen ‘?’) | 23 |
| Registros finales para el análisis | 30139 |
Se eliminaron 2399 personas con información no reportada (7.4 % de la base) y 23 registros duplicados, quedando 30139 personas para el análisis. Vale la pena anotar que entre las personas que no reportaron su información el porcentaje con ingresos altos es menor que en el resto (13.9 % frente a 24.9 %), de modo que al eliminarlas la base queda ligeramente inclinada hacia las personas con mejor información laboral; esto se retoma en las limitaciones.
Después se construyó la variable dependiente, se agruparon las categorías de estado civil y ocupación como se describió en la sección anterior, y se armó un subconjunto con las siete columnas necesarias para los modelos.
base_modelo <- base_limpia %>%
mutate(
ingreso_alto = factor(ifelse(income == ">50K", "Si", "No"), levels = c("Si", "No")),
educacion = as.numeric(`education-num`),
edad = as.numeric(age),
horas_semana = as.numeric(`hours-per-week`),
estado_civil = case_when(
`marital-status` %in% c("Married-civ-spouse", "Married-AF-spouse") ~ "Casado(a)",
`marital-status` == "Never-married" ~ "Nunca casado(a)",
TRUE ~ "Antes casado(a)"),
estado_civil = factor(estado_civil, levels = c("Nunca casado(a)", "Antes casado(a)", "Casado(a)")),
ocupacion = case_when(
occupation %in% c("Armed-Forces", "Protective-serv") ~ "Protección y fuerzas armadas",
occupation == "Exec-managerial" ~ "Directivos y gerentes",
occupation == "Prof-specialty" ~ "Profesionales especializados",
occupation == "Tech-support" ~ "Soporte técnico",
occupation == "Sales" ~ "Ventas",
occupation == "Craft-repair" ~ "Oficios y reparaciones",
occupation == "Transport-moving" ~ "Transporte",
occupation == "Adm-clerical" ~ "Administrativos y oficinistas",
occupation == "Machine-op-inspct" ~ "Operarios de máquinas",
occupation == "Farming-fishing" ~ "Agricultura y pesca",
occupation == "Handlers-cleaners" ~ "Carga y limpieza",
occupation == "Other-service" ~ "Otros servicios",
occupation == "Priv-house-serv" ~ "Servicio doméstico"),
ocupacion = relevel(factor(ocupacion), ref = "Otros servicios"),
sexo = factor(sex, levels = c("Female", "Male"), labels = c("Mujer", "Hombre"))
) %>%
select(ingreso_alto, educacion, edad, horas_semana, estado_civil, ocupacion, sexo)
na_check <- colSums(is.na(base_modelo))
data.frame(Variable = names(na_check), Faltantes = as.integer(na_check), row.names = NULL) %>%
tabla(caption = "Verificación de valores faltantes en la base final", header_bg = "#2e7d32")| Variable | Faltantes |
|---|---|
| ingreso_alto | 0 |
| educacion | 0 |
| edad | 0 |
| horas_semana | 0 |
| estado_civil | 0 |
| ocupacion | 0 |
| sexo | 0 |
base_modelo %>%
head(10) %>%
tabla(caption = "Primeros 10 registros de la base preparada para los modelos", header_bg = "#2e7d32")| ingreso_alto | educacion | edad | horas_semana | estado_civil | ocupacion | sexo |
|---|---|---|---|---|---|---|
| No | 13 | 39 | 40 | Nunca casado(a) | Administrativos y oficinistas | Hombre |
| No | 13 | 50 | 13 | Casado(a) | Directivos y gerentes | Hombre |
| No | 9 | 38 | 40 | Antes casado(a) | Carga y limpieza | Hombre |
| No | 7 | 53 | 40 | Casado(a) | Carga y limpieza | Hombre |
| No | 13 | 28 | 40 | Casado(a) | Profesionales especializados | Mujer |
| No | 14 | 37 | 40 | Casado(a) | Directivos y gerentes | Mujer |
| No | 5 | 49 | 16 | Antes casado(a) | Otros servicios | Mujer |
| Si | 9 | 52 | 45 | Casado(a) | Directivos y gerentes | Hombre |
| Si | 14 | 31 | 50 | Nunca casado(a) | Profesionales especializados | Mujer |
| Si | 13 | 42 | 40 | Casado(a) | Directivos y gerentes | Hombre |
El conjunto de datos, compuesto por 30.139 personas, se dividió en dos subconjuntos: el 75 % se destinó al entrenamiento de los modelos y el 25 % restante a la etapa de prueba. La división se hizo de forma estratificada, es decir, manteniendo en ambos grupos la misma proporción de personas con ingresos altos. El conjunto de entrenamiento permite que los algoritmos aprendan los patrones entre las variables y el ingreso, y el conjunto de prueba sirve para evaluar qué tan bien clasifican a personas que el modelo nunca vio.
set.seed(2026)
idx <- createDataPartition(y = base_modelo$ingreso_alto, p = 0.75, list = FALSE)
train <- base_modelo[idx, ]
test <- base_modelo[-idx, ]
data.frame(
Conjunto = c("Entrenamiento", "Prueba"),
Observaciones = c(nrow(train), nrow(test)),
Pct_No = c(round(mean(train$ingreso_alto == "No") * 100, 1), round(mean(test$ingreso_alto == "No") * 100, 1)),
Pct_Si = c(round(mean(train$ingreso_alto == "Si") * 100, 1), round(mean(test$ingreso_alto == "Si") * 100, 1))
) %>%
tabla(caption = "Distribución de la variable dependiente en cada conjunto",
col.names = c("Conjunto", "Observaciones", "% Hasta 50K", "% Más de 50K"))| Conjunto | Observaciones | % Hasta 50K | % Más de 50K |
|---|---|---|---|
| Entrenamiento | 22605 | 75.1 | 24.9 |
| Prueba | 7534 | 75.1 | 24.9 |
El modelo KNN es una técnica de aprendizaje supervisado no paramétrica, es decir, que no supone ninguna fórmula previa sobre la relación entre las variables. Su funcionamiento es intuitivo: para clasificar a una persona nueva, el algoritmo busca en el conjunto de entrenamiento las k personas más parecidas a ella (las “vecinas más cercanas”) y le asigna la categoría que predomine entre ellas (IBM, 2024). Si, por ejemplo, de los 15 vecinos más parecidos 10 tienen ingresos altos, el modelo predice que la persona también los tiene, con una probabilidad de 10/15.
Como el parecido entre personas se mide con una distancia, es necesario que todas las variables estén en una escala comparable: no es lo mismo una diferencia de 10 años de edad que una de 10 horas de trabajo. Por eso las variables numéricas se estandarizaron (media 0 y desviación estándar 1) y las variables categóricas se convirtieron en variables indicadoras de 0 y 1.
El número de vecinos k se eligió probando ocho valores (5, 7, 9, 11, 15, 21, 31 y 51) mediante validación cruzada de 5 pliegues: los datos se dividen en cinco partes, se entrena con cuatro y se valida con la quinta, rotando hasta usar todas. Se eligió el k con mayor área bajo la curva ROC (AUC), buscando un punto medio entre valores pequeños de k, que son muy sensibles a casos atípicos, y valores grandes, que suavizan demasiado las diferencias. Como KNN debe comparar cada persona con todas las demás, probar ocho valores de k sobre las más de 22.000 personas de entrenamiento tarda mucho; por eso la búsqueda de k se hizo sobre una muestra aleatoria de 6.000 personas del entrenamiento, y una vez elegido el mejor k, el modelo final se entrenó con el conjunto de entrenamiento completo.
La regresión logística es un modelo estadístico para problemas donde la variable a predecir tiene dos categorías. Estima la probabilidad de que ocurra el evento de interés (en este caso, tener ingresos altos) a partir de las variables independientes, usando una función en forma de “S” que garantiza que el resultado siempre esté entre 0 y 1 (IBM, 2024).
Su principal ventaja es que es fácil de interpretar: cada variable recibe un coeficiente y, al transformarlo, se obtiene un odds ratio (OR) que indica cuántas veces aumenta (si es mayor que 1) o disminuye (si es menor que 1) la razón de probabilidades de tener ingresos altos por cada unidad adicional de la variable, dejando las demás constantes. Para las variables categóricas el modelo compara cada categoría con una de referencia: Nunca casado(a) para el estado civil, Otros servicios para la ocupación y Mujer para el sexo.
Para convertir las probabilidades en una clasificación se usó primero el umbral habitual de 0,50 (si la probabilidad supera 0,5 se predice ingreso alto). Como las personas con ingresos altos son solo una de cada cuatro, ese umbral tiende a favorecer a la clase mayoritaria, así que también se calculó el umbral óptimo según el índice de Youden, que es el punto de corte que mejor equilibra la detección de ambos grupos. Ese umbral se calculó con los datos de entrenamiento y luego se aplicó a los de prueba.
Los dos modelos se evaluaron sobre el mismo conjunto de prueba. Como la clase de interés es tener ingresos altos (“Si”), las métricas se calcularon tomándola como clase positiva.
tribble(
~Métrica, ~Descripción,
"Accuracy (exactitud)", "Porcentaje total de personas clasificadas correctamente.",
"Kappa", "Qué tanto acierta el modelo por encima de lo que acertaría por puro azar.",
"Sensibilidad", "De las personas que realmente ganan más de 50K, cuántas detecta el modelo.",
"Especificidad", "De las personas que ganan hasta 50K, cuántas identifica correctamente.",
"PPV", "De las personas clasificadas como 'más de 50K', cuántas realmente lo ganan.",
"NPV", "De las personas clasificadas como 'hasta 50K', cuántas realmente están en ese grupo.",
"Balanced Accuracy", "Promedio de sensibilidad y especificidad; es más justa cuando una clase es minoritaria.",
"AUC", "Capacidad general del modelo para distinguir ambos grupos, sin depender del umbral (0,5 = azar, 1 = perfecto)."
) %>%
kable(caption = "Métricas de evaluación utilizadas", align = c("l", "l")) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(1, bold = TRUE)| Métrica | Descripción |
|---|---|
| Accuracy (exactitud) | Porcentaje total de personas clasificadas correctamente. |
| Kappa | Qué tanto acierta el modelo por encima de lo que acertaría por puro azar. |
| Sensibilidad | De las personas que realmente ganan más de 50K, cuántas detecta el modelo. |
| Especificidad | De las personas que ganan hasta 50K, cuántas identifica correctamente. |
| PPV | De las personas clasificadas como ‘más de 50K’, cuántas realmente lo ganan. |
| NPV | De las personas clasificadas como ‘hasta 50K’, cuántas realmente están en ese grupo. |
| Balanced Accuracy | Promedio de sensibilidad y especificidad; es más justa cuando una clase es minoritaria. |
| AUC | Capacidad general del modelo para distinguir ambos grupos, sin depender del umbral (0,5 = azar, 1 = perfecto). |
Esta seccion describe como se distribuye el ingreso anual de las 30.139 personas en la base y como se relaciona con las seis variables explicativas, antes de ajustar los modelos. Se compara cada variable entre quienes ganan hasta 50K dolares al años y quienes mas de 50K, con medias y medianas para las variables numericas y porcentajes por categoria para las categoricas.
tabla_y <- base_modelo %>%
count(ingreso_alto) %>%
mutate(Porcentaje = round(n / sum(n) * 100, 1),
Categoría = ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K")) %>%
select(Categoría, Frecuencia = n, Porcentaje)
tabla_y %>% tabla(caption = "Distribución de la variable dependiente (ingreso anual)")| Categoría | Frecuencia | Porcentaje |
|---|---|---|
| Más de 50K | 7506 | 24.9 |
| Hasta 50K | 22633 | 75.1 |
g_y <- ggplot(tabla_y, aes(x = Categoría, y = Porcentaje, fill = Categoría,
text = paste0(Categoría, ": ", format(Frecuencia, big.mark = "."), " personas (", Porcentaje, "%)"))) +
geom_col(width = 0.6, color = "white") +
geom_text(aes(label = paste0(Porcentaje, "%")), vjust = -0.4, size = 4) +
scale_fill_manual(values = c("Hasta 50K" = col_no, "Más de 50K" = col_si)) +
scale_y_continuous(limits = c(0, 90)) +
labs(title = "Distribución de personas según su ingreso anual",
x = "Ingreso anual", y = "Porcentaje (%)") +
tema + theme(legend.position = "none")
ggplotly(g_y, tooltip = "text")De las 30.139 personas de la base, el 75.1 % (22.633 personas) gana hasta 50.000 dólares al año y solo el 24.9 % (7.506 personas) supera esa cifra. Es decir, aproximadamente una de cada cuatro personas tiene ingresos altos.
Esta distribución desigual es importante para la modelación: un modelo que simplemente dijera que nadie gana más de 50K acertaría el 75 % de las veces sin aprender nada, así que la exactitud por sí sola puede engañar. Por eso se da especial importancia a la sensibilidad, a la exactitud balanceada y al AUC, y en la sección 4.4 se repite el análisis con una base balanceada, en la que ambos grupos tienen el mismo número de personas.
tabla_edu <- base_modelo %>%
group_by(ingreso_alto) %>%
summarise(Media = round(mean(educacion), 1), Mediana = median(educacion),
DE = round(sd(educacion), 1), Mín = min(educacion), Máx = max(educacion)) %>%
mutate(ingreso_alto = ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K"))
tabla_edu %>%
tabla(caption = "Años de educación según el ingreso anual",
col.names = c("Ingreso anual", "Media", "Mediana", "Desv. estándar", "Mínimo", "Máximo"))| Ingreso anual | Media | Mediana | Desv. estándar | Mínimo | Máximo |
|---|---|---|---|---|---|
| Más de 50K | 11.6 | 12 | 2.4 | 2 | 16 |
| Hasta 50K | 9.6 | 9 | 2.4 | 1 | 16 |
d_edu <- base_modelo %>%
count(educacion, ingreso_alto) %>%
group_by(educacion) %>%
mutate(pct = round(n / sum(n) * 100, 1)) %>%
ungroup()
g_edu <- ggplot(d_edu, aes(x = factor(educacion), y = pct, fill = ingreso_alto,
text = paste0(educacion, " años<br>", ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K"),
": ", n, " personas (", pct, "%)"))) +
geom_col(color = "white", width = 0.8) +
scale_fill_manual(values = pal_y, labels = c("No" = "Hasta 50K", "Si" = "Más de 50K")) +
labs(title = "Porcentaje de personas con ingresos altos según los años de educación",
x = "Años de educación", y = "Porcentaje (%)", fill = "Ingreso") +
tema
ggplotly(g_edu, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.2))La educación muestra una clara relación con el ingreso, en general a mayor educacion mas probabilidad de ganar mas de 50k dolares al año. Las personas con ingresos altos tienen en promedio 11.6 años de educación, dos años más que las personas con ingresos bajos (9.6 años). El gráfico lo muestra de forma escalonada: entre quienes solo terminaron el bachillerato (9 años) apenas el 16.4 % gana más de 50K; entre los profesionales universitarios (13 años) la proporción sube al 42.2 %; y entre quienes tienen maestría (14 años) o doctorado (16 años) alcanza el 56.5 % y el 74.7 %, respectivamente. Desde la perspectiva del modelo, la educación será una de las variables con mayor poder para predecir el ingreso.
tabla_edad <- base_modelo %>%
group_by(ingreso_alto) %>%
summarise(Media = round(mean(edad), 1), Mediana = median(edad),
DE = round(sd(edad), 1), Mín = min(edad), Máx = max(edad)) %>%
mutate(ingreso_alto = ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K"))
tabla_edad %>%
tabla(caption = "Edad según el ingreso anual",
col.names = c("Ingreso anual", "Media", "Mediana", "Desv. estándar", "Mínimo", "Máximo"))| Ingreso anual | Media | Mediana | Desv. estándar | Mínimo | Máximo |
|---|---|---|---|---|---|
| Más de 50K | 44.0 | 43 | 10.3 | 19 | 90 |
| Hasta 50K | 36.6 | 34 | 13.5 | 17 | 90 |
g_edad <- base_modelo %>%
mutate(Ingreso = ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K")) %>%
ggplot(aes(x = edad, fill = Ingreso, color = Ingreso)) +
geom_density(alpha = 0.35, linewidth = 0.8) +
scale_fill_manual(values = c("Hasta 50K" = col_no, "Más de 50K" = col_si)) +
scale_color_manual(values = c("Hasta 50K" = col_no, "Más de 50K" = col_si)) +
labs(title = "Distribución de la edad según el ingreso anual", x = "Edad (años)", y = "Densidad",
fill = "Ingreso", color = "Ingreso") +
tema
ggplotly(g_edad)d_edad <- base_modelo %>%
mutate(grupo_edad = cut(edad, breaks = c(16, 25, 35, 45, 55, 65, 90),
labels = c("17-25", "26-35", "36-45", "46-55", "56-65", "66-90"))) %>%
group_by(grupo_edad) %>%
summarise(n = n(), pct = round(100 * mean(ingreso_alto == "Si"), 1))
g_edad2 <- ggplot(d_edad, aes(x = grupo_edad, y = pct, group = 1,
text = paste0(grupo_edad, " años<br>", pct, "% con más de 50K<br>", format(n, big.mark = "."), " personas"))) +
geom_line(color = col_si, linewidth = 1) +
geom_point(color = col_si, size = 3) +
geom_text(aes(label = paste0(pct, "%")), vjust = -1, size = 3.5) +
scale_y_continuous(limits = c(0, 50)) +
labs(title = "Porcentaje de personas con ingresos altos por grupo de edad",
x = "Grupo de edad", y = "% con más de 50K") +
tema
ggplotly(g_edad2, tooltip = "text")Las personas con ingresos altos tienen en promedio 44 años, frente a 36.6 años en el grupo de ingresos bajos: una diferencia de más de siete años. Sin embargo, la relación no es una línea recta. Por grupos de edad, solo el 2 % de los jóvenes de 17 a 25 años gana más de 50K; la proporción sube con rapidez hasta alcanzar su punto máximo entre los 46 y 55 años (40.2 %), y luego desciende en las personas mayores de 65 años, muchas de ellas ya jubiladas. Esta forma de “montaña” indica que la edad aporta información, pero su efecto debe interpretarse junto con las otras variables.
tabla_horas <- base_modelo %>%
group_by(ingreso_alto) %>%
summarise(Media = round(mean(horas_semana), 1), Mediana = median(horas_semana),
DE = round(sd(horas_semana), 1), Mín = min(horas_semana), Máx = max(horas_semana)) %>%
mutate(ingreso_alto = ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K"))
tabla_horas %>%
tabla(caption = "Horas de trabajo semanales según el ingreso anual",
col.names = c("Ingreso anual", "Media", "Mediana", "Desv. estándar", "Mínimo", "Máximo"))| Ingreso anual | Media | Mediana | Desv. estándar | Mínimo | Máximo |
|---|---|---|---|---|---|
| Más de 50K | 45.7 | 40 | 10.7 | 1 | 99 |
| Hasta 50K | 39.4 | 40 | 11.9 | 1 | 99 |
d_horas <- base_modelo %>%
mutate(grupo_horas = cut(horas_semana, breaks = c(0, 30, 39, 40, 50, 99),
labels = c("1-30", "31-39", "40", "41-50", "Más de 50"))) %>%
count(grupo_horas, ingreso_alto) %>%
group_by(grupo_horas) %>%
mutate(pct = round(n / sum(n) * 100, 1)) %>%
ungroup()
g_horas <- ggplot(d_horas, aes(x = grupo_horas, y = pct, fill = ingreso_alto,
text = paste0(grupo_horas, " horas<br>", ifelse(ingreso_alto == "Si", "Más de 50K", "Hasta 50K"),
": ", format(n, big.mark = "."), " personas (", pct, "%)"))) +
geom_col(color = "white", width = 0.7) +
scale_fill_manual(values = pal_y, labels = c("No" = "Hasta 50K", "Si" = "Más de 50K")) +
labs(title = "Ingreso anual según las horas trabajadas por semana",
x = "Horas de trabajo por semana", y = "Porcentaje (%)", fill = "Ingreso") +
tema
ggplotly(g_horas, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.2))Las personas con ingresos altos trabajan en promedio 45.7 horas a la semana, unas seis horas más que las de ingresos bajos (39.4 horas). La jornada de 40 horas es la más común en ambos grupos, pero el porcentaje de personas con ingresos altos cambia mucho según la intensidad de trabajo: es de apenas 6.6 % entre quienes trabajan 30 horas o menos, de 21.8 % entre quienes trabajan exactamente 40 horas y alcanza el 41.8 % entre quienes trabajan más de 50 horas semanales. Trabajar jornadas largas casi duplica la probabilidad de ingresos altos respecto a la jornada estándar.
| Estado civil | Hasta 50K | Más de 50K | Total | % Más de 50K |
|---|---|---|---|---|
| Casado(a) | 7673 | 6407 | 14080 | 45.5% |
| Antes casado(a) | 5719 | 629 | 6348 | 9.9% |
| Nunca casado(a) | 9241 | 470 | 9711 | 4.8% |
El estado civil es una de las variables que más separa a los dos grupos, esto por la gran superioridad de personas que ganan mas de 50k al año en la categoria de casados en comparacion con las otras categorias. Entre las personas casadas, el 45.5 % gana más de 50K, mientras que entre las que nunca se han casado la proporción es de apenas 4.8 %, y entre las que estuvieron casadas antes (divorciadas, separadas o viudas) es de 9.9 %. La diferencia se cree que es en parte porque las personas casadas suelen asociarse a edades mayores y estar en una etapa laboral más consolidada, y en parte porque el matrimonio se asocia con hogares de mayor estabilidad económica. Para el modelo, esta variable aporta mucha información.
| Ocupación | Hasta 50K | Más de 50K | Total | % Más de 50K |
|---|---|---|---|---|
| Directivos y gerentes | 2054 | 1937 | 3991 | 48.5% |
| Profesionales especializados | 2224 | 1810 | 4034 | 44.9% |
| Protección y fuerzas armadas | 442 | 211 | 653 | 32.3% |
| Soporte técnico | 633 | 278 | 911 | 30.5% |
| Ventas | 2614 | 970 | 3584 | 27.1% |
| Oficios y reparaciones | 3117 | 908 | 4025 | 22.6% |
| Transporte | 1253 | 319 | 1572 | 20.3% |
| Administrativos y oficinistas | 3221 | 498 | 3719 | 13.4% |
| Operarios de máquinas | 1720 | 244 | 1964 | 12.4% |
| Agricultura y pesca | 872 | 115 | 987 | 11.7% |
| Carga y limpieza | 1266 | 83 | 1349 | 6.2% |
| Otros servicios | 3077 | 132 | 3209 | 4.1% |
| Servicio doméstico | 140 | 1 | 141 | 0.7% |
d_ocu <- base_modelo %>%
group_by(ocupacion) %>%
summarise(n = n(), pct = round(100 * mean(ingreso_alto == "Si"), 1)) %>%
mutate(ocupacion = reorder(ocupacion, pct))
g_ocu <- ggplot(d_ocu, aes(x = pct, y = ocupacion,
text = paste0(ocupacion, "<br>", pct, "% con más de 50K<br>", format(n, big.mark = "."), " personas"))) +
geom_col(fill = col_si, width = 0.7) +
geom_text(aes(label = paste0(pct, "%")), hjust = -0.15, size = 3.4) +
scale_x_continuous(limits = c(0, 60)) +
labs(title = "Porcentaje de personas con ingresos altos por ocupación",
x = "% con más de 50K", y = NULL) +
tema
ggplotly(g_ocu, tooltip = "text")La ocupación muestra diferencias enormes. En la parte alta están los directivos y gerentes (48.5 % con ingresos altos) y los profesionales especializados (44.9 %), seguidos por protección y fuerzas armadas, soporte técnico y ventas. En la parte baja están el servicio doméstico (0.7 %), otros servicios (4.1 %) y carga y limpieza (6.2 %). Es decir, una persona en un cargo directivo tiene más de diez veces la probabilidad de ganar más de 50K que una persona en servicios. Esta variable es clave porque refleja directamente el tipo de trabajo que remunera el mercado.
| Sexo | Hasta 50K | Más de 50K | Total | % Más de 50K |
|---|---|---|---|---|
| Hombre | 13972 | 6394 | 20366 | 31.4% |
| Mujer | 8661 | 1112 | 9773 | 11.4% |
Los resultados evidencian una brecha de género importante: el 31.4 % de los hombres gana más de 50K frente al 11.4 % de las mujeres, casi tres veces menos, parte de la diferencia puede deberse a que las mujeres de la base trabajan menos horas y están en ocupaciones distintas, por lo que el modelo Logit, que controla por esas variables, permitirá ver cuánta brecha queda después de tener en cuenta esos factores.
El ingreso alto es minoritario (24.9 %) y se concentra en personas con mas educacion, de mediana edad, con jornadas largas, casadas y en cargos directivos o profesionales, tambien se ve una brecha por sexo (del 31.4 % de los hombres frente a 11.4 % de las mujeres). Estas variables se solapan entre sí, por lo que las diferencias no pueden leerse por separado ni como efectos causales.
En esta seccion se ajustan dos modelos de clasificacion, K-vecinos mas cercanos (KNN) y regresion logistica, para predecir si una persona gana mas de 50.000 dólares al año. Ambos se entrenan con el 75 % de la base (22.605 personas) y se evaluan con el 25 % restante (7.534 personas), esta proporcion se mantiene igual en todos los escenarios para que las metricas sean comparables, primero se va a trabajar con la base completa y luego con una base balanceada, para ver cómo el desbalance de clases afecta la capacidad de detectar a las personas con altos ingresos, como solo una de cada cuatro personas pertenece a ese grupo, la exactitud global no es suficiente y se evalúa también con sensibilidad, especificidad, exactitud balanceada y AUC.
# 1) Búsqueda de k por validación cruzada sobre una muestra de 6.000 personas del entrenamiento
set.seed(2026)
muestra_k <- train[sample(nrow(train), 6000), ]
knn_busqueda <- train(
ingreso_alto ~ ., data = muestra_k, method = "knn",
tuneGrid = data.frame(k = c(5, 7, 9, 11, 15, 21, 31, 51)),
preProcess = c("center", "scale"),
trControl = trainControl(method = "cv", number = 5, classProbs = TRUE,
summaryFunction = twoClassSummary),
metric = "ROC"
)
k_opt <- knn_busqueda$bestTune$k
knn_resultados <- knn_busqueda$results %>% select(k, ROC, Sens, Spec)
# 2) Modelo final con el k elegido y todo el conjunto de entrenamiento
knn_entrenado <- train(
ingreso_alto ~ ., data = train, method = "knn",
tuneGrid = data.frame(k = k_opt),
preProcess = c("center", "scale"),
trControl = trainControl(method = "none", classProbs = TRUE)
)
knn_resultados %>%
mutate(across(c(ROC, Sens, Spec), ~ round(., 4))) %>%
kable(caption = "AUC, sensibilidad y especificidad por valor de k en validación cruzada",
col.names = c("k", "AUC", "Sensibilidad", "Especificidad"), align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = col_knn, color = "white") %>%
row_spec(which(knn_resultados$k == k_opt), bold = TRUE, background = "#e8f5e9",
extra_css = "border-left: 4px solid #2e7d32;")| k | AUC | Sensibilidad | Especificidad |
|---|---|---|---|
| 5 | 0.8552 | 0.6164 | 0.8900 |
| 7 | 0.8656 | 0.6092 | 0.8951 |
| 9 | 0.8725 | 0.6066 | 0.8982 |
| 11 | 0.8734 | 0.6178 | 0.8964 |
| 15 | 0.8771 | 0.6151 | 0.8991 |
| 21 | 0.8805 | 0.6178 | 0.9018 |
| 31 | 0.8808 | 0.5908 | 0.9045 |
| 51 | 0.8777 | 0.5651 | 0.9143 |
g_k <- ggplot(knn_resultados, aes(x = k, y = ROC, text = paste0("k = ", k, "<br>AUC = ", round(ROC, 4)))) +
geom_line(aes(group = 1), color = col_knn, linewidth = 1) +
geom_point(color = col_knn, size = 3) +
geom_vline(xintercept = k_opt, linetype = "dotted", color = col_si) +
annotate("text", x = k_opt, y = min(knn_resultados$ROC), label = paste0("k óptimo = ", k_opt),
color = col_si, hjust = -0.1, size = 3.8) +
labs(title = "Optimización del parámetro k — AUC en validación cruzada",
x = "Número de vecinos (k)", y = "AUC") +
tema
ggplotly(g_k, tooltip = "text")La busqueda por validacion cruzada de 5 pliegues hecha sobre una muestra de 6.000 personas del conjunto de entrenamiento, dio el mejor AUC (0.881) con k = 31, con pocos vecinos disminuyo el AUC a 0.855 con k = 5, probabliemente por que la decision depende de muy pocas personas y es inestable, desde k = 21 el AUC se estabiliza dejando un diferencia entre K = 21 y k = 31 de solo 0.0003, haciendo estos valores practicamente equivalentes, aun asi se eligio k = 31 por tener el AUC mas alto, con k= 51 el AUC baja levemente a 8.878, como posible explicacion a esto se palntea que con un numero muy grande de vecinos se comienza a incluir personas poco parecidas, con el k elegido se entreno el modelo final usando todo el conjunto de entrenamiento.
knn_pred <- predict(knn_entrenado, newdata = test)
knn_pred_prob <- predict(knn_entrenado, newdata = test, type = "prob")
cm_knn <- confusionMatrix(knn_pred, test$ingreso_alto, positive = "Si")
roc_knn <- roc(response = test$ingreso_alto, predictor = knn_pred_prob$Si,
levels = c("No", "Si"), direction = "<", quiet = TRUE)
auc_knn <- as.numeric(auc(roc_knn))
head(data.frame(Real = test$ingreso_alto, Predicho = knn_pred,
Prob_Si = round(knn_pred_prob$Si, 3), Prob_No = round(knn_pred_prob$No, 3)), 10) %>%
tabla(caption = paste0("Primeras 10 predicciones del modelo KNN (k = ", k_opt, ")"))| Real | Predicho | Prob_Si | Prob_No |
|---|---|---|---|
| No | No | 0.062 | 0.938 |
| No | No | 0.484 | 0.516 |
| No | Si | 0.613 | 0.387 |
| No | No | 0.000 | 1.000 |
| Si | Si | 0.649 | 0.351 |
| Si | No | 0.129 | 0.871 |
| No | No | 0.000 | 1.000 |
| No | No | 0.235 | 0.765 |
| Si | No | 0.364 | 0.636 |
| No | No | 0.000 | 1.000 |
as.data.frame(cm_knn$table) %>%
pivot_wider(names_from = Reference, values_from = Freq) %>%
rename(`Predicción / Real` = Prediction) %>%
tabla(caption = "Matriz de confusión del modelo KNN sobre el conjunto de prueba", header_bg = col_knn)| Predicción / Real | Si | No |
|---|---|---|
| Si | 1105 | 547 |
| No | 771 | 5111 |
roc_knn_df <- data.frame(FPR = 1 - roc_knn$specificities, TPR = roc_knn$sensitivities)
g_roc_knn <- ggplot(roc_knn_df, aes(x = FPR, y = TPR)) +
geom_area(fill = col_knn, alpha = 0.08) +
geom_line(color = col_knn, linewidth = 1.1) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "grey60") +
labs(title = sprintf("Curva ROC — KNN | AUC = %.3f", auc_knn),
x = "Tasa de falsos positivos", y = "Tasa de verdaderos positivos") +
tema
ggplotly(g_roc_knn)La tabla de predicciones muestra las primeras diez personas del
conjunto de prueba. Las columnas Prob_Si y
Prob_No indican qué fracción de los 31 vecinos más
parecidos tiene ingresos altos o bajos; cuando Prob_Si
supera 0,5 el modelo predice “Si”. Sobre las 7.534 personas de prueba,
el KNN alcanzó una exactitud de 82.5 %, superior al
75.1 % que se obtendría clasificando a todos como ingresos bajos.
Sin embargo, la matriz de confusión revela el efecto del desbalance: de las 1.876 personas que realmente ganan más de 50K, el modelo identificó 1.105 (sensibilidad de 58.9 %) y dejó pasar 771 como si tuvieran ingresos bajos. En cambio, de las 5.658 personas con ingresos bajos acertó 5.111 (especificidad de 90.3 %). El modelo es muy bueno reconociendo a la mayoría, pero se le escapa una parte importante de la minoría con ingresos altos. El Kappa de 0.513 indica un acuerdo moderado más allá del azar, y el AUC de 0.871 muestra que, pese a lo anterior, el modelo ordena bien a las personas según su probabilidad de ingresos altos.
train_logit <- train %>% mutate(ingreso_alto = as.numeric(ingreso_alto == "Si"))
fit_logit <- glm(ingreso_alto ~ ., data = train_logit, family = binomial())
coefs <- summary(fit_logit)$coefficients
ic <- confint.default(fit_logit)
or_tabla <- data.frame(
Variable = rownames(coefs),
OR = round(exp(coefs[, "Estimate"]), 3),
IC_2.5 = round(exp(ic[, 1]), 3),
IC_97.5 = round(exp(ic[, 2]), 3),
p_valor = coefs[, "Pr(>|z|)"],
row.names = NULL
) %>%
mutate(Significativo = ifelse(p_valor < 0.05, "Sí", "No"),
p_valor = ifelse(p_valor < 0.001, "< 0.001", sprintf("%.3f", p_valor)),
Variable = gsub("estado_civil", "Estado civil: ", Variable),
Variable = gsub("ocupacion", "Ocupación: ", Variable),
Variable = gsub("sexoHombre", "Sexo: Hombre", Variable),
Variable = gsub("educacion", "Años de educación", Variable),
Variable = gsub("edad", "Edad", Variable),
Variable = gsub("horas_semana", "Horas por semana", Variable))
or_tabla %>%
kable(caption = "Odds ratios e intervalos de confianza al 95 % — Modelo Logit",
col.names = c("Variable", "OR", "IC 2.5 %", "IC 97.5 %", "p-valor", "Significativo (p < 0.05)"),
align = c("l", "c", "c", "c", "c", "c")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(which(or_tabla$Significativo == "Sí" & or_tabla$OR > 1), background = "#fdf2f0") %>%
column_spec(2, bold = TRUE)| Variable | OR | IC 2.5 % | IC 97.5 % | p-valor | Significativo (p < 0.05) |
|---|---|---|---|---|---|
| (Intercept) | 0.000 | 0.000 | 0.000 | < 0.001 | Sí |
| Años de educación | 1.349 | 1.322 | 1.377 | < 0.001 | Sí |
| Edad | 1.028 | 1.025 | 1.032 | < 0.001 | Sí |
| Horas por semana | 1.031 | 1.028 | 1.035 | < 0.001 | Sí |
| Estado civil: Antes casado(a) | 1.700 | 1.445 | 1.999 | < 0.001 | Sí |
| Estado civil: Casado(a) | 13.409 | 11.705 | 15.362 | < 0.001 | Sí |
| Ocupación: Administrativos y oficinistas | 2.776 | 2.150 | 3.584 | < 0.001 | Sí |
| Ocupación: Agricultura y pesca | 0.755 | 0.539 | 1.056 | 0.101 | No |
| Ocupación: Carga y limpieza | 1.284 | 0.900 | 1.832 | 0.168 | No |
| Ocupación: Directivos y gerentes | 6.004 | 4.724 | 7.631 | < 0.001 | Sí |
| Ocupación: Oficios y reparaciones | 2.535 | 1.991 | 3.228 | < 0.001 | Sí |
| Ocupación: Operarios de máquinas | 2.146 | 1.630 | 2.825 | < 0.001 | Sí |
| Ocupación: Profesionales especializados | 4.780 | 3.734 | 6.119 | < 0.001 | Sí |
| Ocupación: Protección y fuerzas armadas | 4.382 | 3.196 | 6.007 | < 0.001 | Sí |
| Ocupación: Servicio doméstico | 0.189 | 0.018 | 2.011 | 0.167 | No |
| Ocupación: Soporte técnico | 4.860 | 3.613 | 6.536 | < 0.001 | Sí |
| Ocupación: Transporte | 2.039 | 1.550 | 2.681 | < 0.001 | Sí |
| Ocupación: Ventas | 3.582 | 2.801 | 4.581 | < 0.001 | Sí |
| Sexo: Hombre | 1.278 | 1.140 | 1.432 | < 0.001 | Sí |
or_plot <- or_tabla %>%
filter(Variable != "(Intercept)") %>%
mutate(Variable = reorder(Variable, OR))
g_or <- ggplot(or_plot, aes(x = OR, y = Variable, color = Significativo,
text = paste0(Variable, "<br>OR = ", OR, " [", IC_2.5, "; ", IC_97.5, "]"))) +
geom_vline(xintercept = 1, linetype = "dotted", color = "#2c2c2c") +
geom_errorbarh(aes(xmin = IC_2.5, xmax = IC_97.5), height = 0.25, color = "grey55") +
geom_point(size = 3) +
scale_x_log10() +
scale_color_manual(values = c("Sí" = col_si, "No" = "grey50")) +
labs(title = "Odds ratios con intervalos de confianza al 95 % (escala logarítmica)",
x = "Odds ratio", y = NULL, color = "Significativo") +
tema
ggplotly(g_or, tooltip = "text")La mayoría de los coeficientes son estadísticamente significativos con p < 0,05, las excepciones son tres categorias de ocupación (agricultura y pesca, carga y limpieza, y servicio doméstico), con más de 22.000 observaciones es fácil que las diferencias resulten significativas, por lo que la significancia indica que el efecto es distinguible de cero, no que sea grande, por lo que para valorar la importancia de cada variable es más informativo el tamaño del odds ratio y su intervalo de confianza. Los odds ratios comparan razones de probabilidades, no probabilidades un OR de 1.349 significa que las odds se multiplican por 1.349, no que la probabilidad aumente un 35 %, al exponenciar los coeficientes se obtienen los odds ratios, que se leen así:
p_hat_train <- predict(fit_logit, newdata = train, type = "response")
p_hat <- predict(fit_logit, newdata = test, type = "response")
# Umbral de Youden calculado en entrenamiento
roc_train <- roc(response = train$ingreso_alto, predictor = p_hat_train,
levels = c("No", "Si"), direction = "<", quiet = TRUE)
umbral <- as.numeric(coords(roc_train, x = "best", best.method = "youden", ret = "threshold"))
pred_05 <- factor(ifelse(p_hat >= 0.5, "Si", "No"), levels = c("Si", "No"))
pred_you <- factor(ifelse(p_hat >= umbral, "Si", "No"), levels = c("Si", "No"))
cm_logit05 <- confusionMatrix(pred_05, test$ingreso_alto, positive = "Si")
cm_logit <- confusionMatrix(pred_you, test$ingreso_alto, positive = "Si")
roc_logit <- roc(response = test$ingreso_alto, predictor = p_hat,
levels = c("No", "Si"), direction = "<", quiet = TRUE)
auc_logit <- as.numeric(auc(roc_logit))
head(data.frame(Real = test$ingreso_alto, Prob_Si = round(p_hat, 3),
`Pred (0.50)` = pred_05, `Pred (Youden)` = pred_you, check.names = FALSE), 10) %>%
tabla(caption = sprintf("Primeras 10 predicciones del modelo Logit (umbral de Youden = %.3f)", umbral))| Real | Prob_Si | Pred (0.50) | Pred (Youden) |
|---|---|---|---|
| No | 0.090 | No | No |
| No | 0.628 | Si | Si |
| No | 0.568 | Si | Si |
| No | 0.003 | No | No |
| Si | 0.592 | Si | Si |
| Si | 0.164 | No | No |
| No | 0.035 | No | No |
| No | 0.096 | No | No |
| Si | 0.334 | No | Si |
| No | 0.012 | No | No |
bind_rows(
as.data.frame(cm_logit05$table) %>% mutate(Umbral = "0.50"),
as.data.frame(cm_logit$table) %>% mutate(Umbral = sprintf("Youden (%.3f)", umbral))
) %>%
pivot_wider(names_from = Reference, values_from = Freq) %>%
select(Umbral, Prediction, Si, No) %>%
rename(`Predicción / Real` = Prediction) %>%
kable(caption = "Matrices de confusión del modelo Logit con los dos umbrales", align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
collapse_rows(columns = 1, valign = "top")| Umbral | Predicción / Real | Si | No |
|---|---|---|---|
| 0.50 | Si | 1018 | 477 |
| No | 858 | 5181 | |
| Youden (0.266) | Si | 1501 | 1265 |
| No | 375 | 4393 |
Métricas con el umbral clásico de 0,50:
Métricas con el umbral óptimo de Youden (0.266):
roc_df <- data.frame(FPR = 1 - roc_logit$specificities, TPR = roc_logit$sensitivities)
pt_you <- coords(roc_logit, x = umbral, input = "threshold", ret = c("specificity", "sensitivity"))
g_roc_logit <- ggplot(roc_df, aes(x = FPR, y = TPR)) +
geom_area(fill = col_si, alpha = 0.08) +
geom_line(color = col_si, linewidth = 1.1) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "grey60") +
annotate("point", x = 1 - pt_you$specificity, y = pt_you$sensitivity, size = 4, color = "#2c2c2c") +
annotate("text", x = 1 - pt_you$specificity, y = pt_you$sensitivity,
label = sprintf(" Umbral Youden = %.3f", umbral), hjust = 0, vjust = 1.5, size = 3.6) +
labs(title = sprintf("Curva ROC — Logit | AUC = %.3f", auc_logit),
x = "Tasa de falsos positivos", y = "Tasa de verdaderos positivos") +
tema
ggplotly(g_roc_logit)Con el umbral clásico de 0,50, el Logit obtuvo una exactitud de 82.3 %, pero una sensibilidad de solo 54.3 %: de las 1.876 personas con ingresos altos detectó 1.018 y dejó pasar 858. Como las personas con ingresos altos son minoría, el modelo necesita mucha evidencia antes de asignar una probabilidad mayor a 0,5, y termina favoreciendo a la clase mayoritaria.
El índice de Youden propone bajar el umbral a 0.266: basta con que la probabilidad estimada supere ese valor para clasificar a la persona como de ingresos altos. Con este cambio la sensibilidad sube a 80.0 % (1.501 personas detectadas) a costa de bajar la especificidad a 77.6 % y la exactitud a 78.2 %. La exactitud balanceada mejora de 0.729 a 0.788, lo que confirma que el nuevo umbral trata de forma más equilibrada a los dos grupos. El AUC de 0.870 no depende del umbral e indica que, si se toman al azar una persona con ingresos altos y otra con ingresos bajos, el modelo le asigna mayor probabilidad a la correcta en el 87 % de los casos.
La elección del umbral depende del objetivo: el de 0,50 conviene cuando se quiere evitar clasificar a alguien como de ingresos altos sin estar seguros; el de Youden conviene cuando lo importante es no dejar por fuera a las personas que sí tienen ingresos altos, por ejemplo al identificar potenciales clientes o contribuyentes.
comparacion <- data.frame(
Métrica = names(metricas(cm_knn, auc_knn)),
KNN = round(metricas(cm_knn, auc_knn), 4),
`Logit (0.50)` = round(metricas(cm_logit05, auc_logit), 4),
`Logit (Youden)` = round(metricas(cm_logit, auc_logit), 4),
check.names = FALSE, row.names = NULL
) %>%
rowwise() %>%
mutate(Mejor = {
v <- c(KNN = KNN, `Logit (0.50)` = `Logit (0.50)`, `Logit (Youden)` = `Logit (Youden)`)
g <- names(v)[v == max(v)]
if (length(g) == 3) "Empate" else paste(g, collapse = " / ")
}) %>%
ungroup()
comparacion %>%
kable(caption = "Tabla comparativa de métricas: KNN vs Logit (base completa)", align = c("l", "c", "c", "c", "c")) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
row_spec(which(grepl("Logit", comparacion$Mejor) & !grepl("KNN", comparacion$Mejor)), background = "#fdf2f0") %>%
row_spec(which(comparacion$Mejor == "KNN"), background = "#e3f2fd") %>%
column_spec(5, bold = TRUE)| Métrica | KNN | Logit (0.50) | Logit (Youden) | Mejor |
|---|---|---|---|---|
| Accuracy | 0.8251 | 0.8228 | 0.7823 | KNN |
| Kappa | 0.5128 | 0.4917 | 0.4976 | KNN |
| Sensibilidad | 0.5890 | 0.5426 | 0.8001 | Logit (Youden) |
| Especificidad | 0.9033 | 0.9157 | 0.7764 | Logit (0.50) |
| PPV | 0.6689 | 0.6809 | 0.5427 | Logit (0.50) |
| NPV | 0.8689 | 0.8579 | 0.9214 | Logit (Youden) |
| Balanced Accuracy | 0.7462 | 0.7292 | 0.7883 | Logit (Youden) |
| AUC | 0.8709 | 0.8698 | 0.8698 | KNN |
roc_comp <- bind_rows(
roc_knn_df %>% mutate(Modelo = sprintf("KNN (AUC = %.3f)", auc_knn)),
roc_df %>% mutate(Modelo = sprintf("Logit (AUC = %.3f)", auc_logit))
)
g_roc_comp <- ggplot(roc_comp, aes(x = FPR, y = TPR, color = Modelo)) +
geom_line(linewidth = 1.1) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "grey60") +
scale_color_manual(values = setNames(c(col_knn, col_si), unique(roc_comp$Modelo))) +
labs(title = "Comparación de curvas ROC: KNN vs Logit",
x = "Tasa de falsos positivos", y = "Tasa de verdaderos positivos", color = NULL) +
tema
ggplotly(g_roc_comp)g_bar <- comparacion %>%
filter(Métrica != "Kappa") %>%
pivot_longer(cols = c(KNN, `Logit (0.50)`, `Logit (Youden)`), names_to = "Modelo", values_to = "Valor") %>%
mutate(Métrica = factor(Métrica, levels = rev(comparacion$Métrica))) %>%
ggplot(aes(x = Valor, y = Métrica, fill = Modelo, text = paste0(Modelo, "<br>", Métrica, " = ", round(Valor, 3)))) +
geom_col(position = position_dodge(width = 0.8), width = 0.75, color = "white") +
scale_fill_manual(values = c("KNN" = col_knn, "Logit (0.50)" = "#7f8c8d", "Logit (Youden)" = col_si)) +
scale_x_continuous(limits = c(0, 1), breaks = seq(0, 1, 0.2)) +
labs(title = "Comparación de métricas: KNN vs Logit (base completa)", x = "Valor", y = NULL, fill = NULL) +
tema
ggplotly(g_bar, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.12))La comparación en la base completa permite responder las preguntas del taller:
En resumen, con la base completa los dos modelos tienen una capacidad de discriminación similar (AUC alrededor de 0.87), pero el umbral de decisión marca la diferencia: tanto el KNN como el Logit con 0,50 clasifican bien a la mayoría y dejan pasar a muchas personas con ingresos altos, mientras que el Logit con umbral de Youden detecta a la mayoría de ellas a cambio de más falsos positivos. Esto motiva el análisis con una base balanceada.
Como se vio en los resultados descriptivos, tres de cada cuatro personas ganan hasta 50K. Con esa proporción los algoritmos “aprenden” que lo más seguro es predecir ingresos bajos, y eso explica la baja sensibilidad obtenida. Una estrategia sencilla para corregirlo es el submuestreo de la clase mayoritaria: se toma una muestra aleatoria de personas con ingresos bajos del mismo tamaño que el grupo de ingresos altos, de modo que el modelo entrene con los dos grupos en igualdad de condiciones. El balanceo se aplica solo al conjunto de entrenamiento; el conjunto de prueba se deja igual que antes, con su distribución real, para que las métricas sean comparables con las de la base completa y reflejen lo que pasaría con personas nuevas.
set.seed(2026)
train_bal <- downSample(x = select(train, -ingreso_alto), y = train$ingreso_alto, yname = "ingreso_alto") %>%
mutate(ingreso_alto = factor(ingreso_alto, levels = c("Si", "No")))
data.frame(
Conjunto = c("Entrenamiento original", "Entrenamiento balanceado", "Prueba (sin cambios)"),
Observaciones = c(nrow(train), nrow(train_bal), nrow(test)),
Hasta_50K = c(sum(train$ingreso_alto == "No"), sum(train_bal$ingreso_alto == "No"), sum(test$ingreso_alto == "No")),
Mas_50K = c(sum(train$ingreso_alto == "Si"), sum(train_bal$ingreso_alto == "Si"), sum(test$ingreso_alto == "Si"))
) %>%
tabla(caption = "Composición de los conjuntos antes y después del balanceo",
col.names = c("Conjunto", "Observaciones", "Hasta 50K", "Más de 50K"))| Conjunto | Observaciones | Hasta 50K | Más de 50K |
|---|---|---|---|
| Entrenamiento original | 22605 | 16975 | 5630 |
| Entrenamiento balanceado | 11260 | 5630 | 5630 |
| Prueba (sin cambios) | 7534 | 5658 | 1876 |
# Se reutiliza el k elegido en la base completa; se reentrena con la base balanceada
k_opt_bal <- k_opt
knn_bal <- train(
ingreso_alto ~ ., data = train_bal, method = "knn",
tuneGrid = data.frame(k = k_opt_bal),
preProcess = c("center", "scale"),
trControl = trainControl(method = "none", classProbs = TRUE)
)
knn_bal_pred <- predict(knn_bal, newdata = test)
knn_bal_prob <- predict(knn_bal, newdata = test, type = "prob")
cm_knn_bal <- confusionMatrix(knn_bal_pred, test$ingreso_alto, positive = "Si")
roc_knn_bal <- roc(test$ingreso_alto, knn_bal_prob$Si, levels = c("No", "Si"), direction = "<", quiet = TRUE)
auc_knn_bal <- as.numeric(auc(roc_knn_bal))
as.data.frame(cm_knn_bal$table) %>%
pivot_wider(names_from = Reference, values_from = Freq) %>%
rename(`Predicción / Real` = Prediction) %>%
tabla(caption = paste0("Matriz de confusión del KNN entrenado con la base balanceada (k = ", k_opt_bal, ")"), header_bg = col_knn)| Predicción / Real | Si | No |
|---|---|---|
| Si | 1560 | 1444 |
| No | 316 | 4214 |
Con el entrenamiento balanceado, el KNN (mismo k = 31 de la base completa) cambia de comportamiento: la sensibilidad sube de 58.9 % a 83.2 %, es decir, ahora detecta a la gran mayoría de las personas con ingresos altos. El precio es una menor especificidad (74.5 % frente a 90.3 %) y una exactitud global de 76.6 %. La exactitud balanceada pasa de 0.746 a 0.788, lo que muestra que el modelo ahora trata de forma más justa a los dos grupos. El AUC (0.869) se mantiene casi igual, porque el balanceo cambia dónde se pone la frontera de decisión, no la capacidad del modelo para ordenar a las personas.
train_bal_logit <- train_bal %>% mutate(ingreso_alto = as.numeric(ingreso_alto == "Si"))
fit_logit_bal <- glm(ingreso_alto ~ ., data = train_bal_logit, family = binomial())
p_hat_bal <- predict(fit_logit_bal, newdata = test, type = "response")
pred_bal <- factor(ifelse(p_hat_bal >= 0.5, "Si", "No"), levels = c("Si", "No"))
cm_logit_bal <- confusionMatrix(pred_bal, test$ingreso_alto, positive = "Si")
roc_logit_bal <- roc(test$ingreso_alto, p_hat_bal, levels = c("No", "Si"), direction = "<", quiet = TRUE)
auc_logit_bal <- as.numeric(auc(roc_logit_bal))
as.data.frame(cm_logit_bal$table) %>%
pivot_wider(names_from = Reference, values_from = Freq) %>%
rename(`Predicción / Real` = Prediction) %>%
tabla(caption = "Matriz de confusión del Logit entrenado con la base balanceada (umbral 0,50)")| Predicción / Real | Si | No |
|---|---|---|
| Si | 1522 | 1320 |
| No | 354 | 4338 |
Al entrenar el Logit con la base balanceada ya no hace falta mover el umbral: con el 0,50 habitual la sensibilidad llega a 81.1 % y la especificidad a 76.7 %, resultados muy parecidos a los que se obtuvieron con la base completa y el umbral de Youden. Esto tiene sentido: balancear la base y bajar el umbral son dos caminos para lograr lo mismo, que el modelo le dé más peso a la clase minoritaria. El AUC se mantiene en 0.870.
comp_final <- data.frame(
Métrica = names(metricas(cm_knn, auc_knn)),
`KNN completa` = round(metricas(cm_knn, auc_knn), 4),
`Logit completa (0.50)` = round(metricas(cm_logit05, auc_logit), 4),
`Logit completa (Youden)` = round(metricas(cm_logit, auc_logit), 4),
`KNN balanceada` = round(metricas(cm_knn_bal, auc_knn_bal), 4),
`Logit balanceada` = round(metricas(cm_logit_bal, auc_logit_bal), 4),
check.names = FALSE, row.names = NULL
)
comp_final %>%
kable(caption = "Comparación final de todos los modelos sobre el mismo conjunto de prueba", align = c("l", rep("c", 5))) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = TRUE, font_size = 13) %>%
row_spec(0, bold = TRUE, background = "#2c2c2c", color = "white") %>%
column_spec(1, bold = TRUE)| Métrica | KNN completa | Logit completa (0.50) | Logit completa (Youden) | KNN balanceada | Logit balanceada |
|---|---|---|---|---|---|
| Accuracy | 0.8251 | 0.8228 | 0.7823 | 0.7664 | 0.7778 |
| Kappa | 0.5128 | 0.4917 | 0.4976 | 0.4799 | 0.4931 |
| Sensibilidad | 0.5890 | 0.5426 | 0.8001 | 0.8316 | 0.8113 |
| Especificidad | 0.9033 | 0.9157 | 0.7764 | 0.7448 | 0.7667 |
| PPV | 0.6689 | 0.6809 | 0.5427 | 0.5193 | 0.5355 |
| NPV | 0.8689 | 0.8579 | 0.9214 | 0.9302 | 0.9246 |
| Balanced Accuracy | 0.7462 | 0.7292 | 0.7883 | 0.7882 | 0.7890 |
| AUC | 0.8709 | 0.8698 | 0.8698 | 0.8690 | 0.8701 |
g_final <- comp_final %>%
filter(Métrica %in% c("Accuracy", "Sensibilidad", "Especificidad", "Balanced Accuracy", "AUC")) %>%
pivot_longer(-Métrica, names_to = "Modelo", values_to = "Valor") %>%
mutate(Métrica = factor(Métrica, levels = c("Accuracy", "Sensibilidad", "Especificidad", "Balanced Accuracy", "AUC")),
Modelo = factor(Modelo, levels = names(comp_final)[-1])) %>%
ggplot(aes(x = Métrica, y = Valor, fill = Modelo, text = paste0(Modelo, "<br>", Métrica, " = ", round(Valor, 3)))) +
geom_col(position = position_dodge(width = 0.85), width = 0.8, color = "white") +
scale_fill_manual(values = c("#90caf9", "#bdbdbd", "#ef9a9a", col_knn, col_si)) +
scale_y_continuous(limits = c(0, 1)) +
labs(title = "Comparación final de métricas: base completa vs base balanceada", x = NULL, y = "Valor", fill = NULL) +
tema
ggplotly(g_final, tooltip = "text") %>% layout(legend = list(orientation = "h", y = -0.15))cm_long <- bind_rows(
as.data.frame(cm_knn_bal$table) %>% mutate(Modelo = paste0("KNN balanceado (k = ", k_opt_bal, ")")),
as.data.frame(cm_logit_bal$table) %>% mutate(Modelo = "Logit balanceado")
) %>%
mutate(Tipo = case_when(Prediction == "Si" & Reference == "Si" ~ "Verdadero positivo",
Prediction == "No" & Reference == "No" ~ "Verdadero negativo",
Prediction == "Si" & Reference == "No" ~ "Falso positivo",
TRUE ~ "Falso negativo"))
g_cm <- ggplot(cm_long, aes(x = Reference, y = Prediction, fill = Freq, text = paste0(Tipo, ": ", format(Freq, big.mark = ".")))) +
geom_tile(color = "white", linewidth = 1.5) +
geom_text(aes(label = format(Freq, big.mark = ".")), size = 5.5, color = "white", fontface = "bold") +
facet_wrap(~ Modelo) +
scale_fill_gradient(low = "#9fb3c8", high = "#1b2a41") +
labs(title = "Matrices de confusión de los modelos balanceados", x = "Clase real", y = "Clase predicha") +
tema + theme(legend.position = "none")
ggplotly(g_cm, tooltip = "text")La tabla final deja ver dos conclusiones. La primera es que la base balanceada (o, en el Logit, el umbral de Youden) es la que permite cumplir el objetivo de detectar a las personas con ingresos altos: la sensibilidad pasa de 59 % (KNN) y 54 % (Logit con umbral 0,50) a valores de 83 % en KNN y 81 % en Logit, con exactitudes balanceadas alrededor de 0.79. La exactitud global baja unos puntos, pero se trata de un intercambio razonable cuando la clase minoritaria es la de interés.
La segunda conclusion es que, entre KNN y Logit, las diferencias son pequeñas en todas las métricas, con una leve ventaja del Logit en AUC (0.870 frente a 0.869) y del Logit en exactitud balanceada. Como el desempeño es tan parecido, la decisión se inclina por otros criterios: el Logit entrega odds ratios que explican por qué una persona tiene más probabilidad de ingresos altos, se calcula en segundos y no necesita guardar toda la base para predecir, mientras que el KNN debe comparar a cada persona nueva con las más de 22.000 del entrenamiento y no ofrece una explicación del resultado.
En resumen, ambos modelos ordenan a las personas con una capacidad muy similar, y lo que cambia el resultado es como se trata el desbalance de clases, con la base completa y el umbral de 0.5 los modelos edtectan solo entre el 54% y 59% de las 1876 personas con ingresos altos, al balancear la base o bajar el umbral en el Logit la sensibilidad sube a entre el 80% y el 83% a cambio de mas falsos positivos.
¿Qué modelo se recomienda? Para este problema se recomienda la regresión logística entrenada con la base balanceada (o, de forma equivalente, con la base completa y el umbral de Youden). Alcanza la mejor combinación de sensibilidad y exactitud balanceada, es la más fácil de explicar a un público no técnico y la más práctica de aplicar a nuevas personas.
El análisis permitió identificar los factores que más se relacionan con tener un ingreso anual superior a 50.000 dólares en la base del censo de Estados Unidos de 1994. Las seis variables elegidas (años de educación, edad, horas de trabajo semanales, estado civil, ocupación y sexo) mostraron relaciones claras y consistentes con el ingreso, tanto en el análisis descriptivo como en los modelos.
Los resultados descriptivos mostraron patrones muy marcados: el porcentaje de personas con ingresos altos crece de forma escalonada con los años de educación, alcanza su máximo entre los 46 y 55 años, aumenta con las horas trabajadas y se concentra en las ocupaciones directivas y profesionales. Las personas casadas tienen una proporción de ingresos altos cerca de diez veces mayor que las que nunca se han casado, y los hombres casi triplican a las mujeres. El modelo Logit confirmó que la brecha de género se mantiene incluso al comparar personas con la misma educación, edad, horas, estado civil y ocupación.
En cuanto a los modelos, KNN y regresión logística lograron una capacidad de discriminación similar y buena (AUC cercano a 0.87), pero con la base completa ambos tendieron a favorecer a la clase mayoritaria y dejaron pasar casi la mitad de las personas con ingresos altos. Dos estrategias corrigieron el problema con resultados equivalentes: bajar el umbral de decisión del Logit con el índice de Youden y entrenar los modelos con una base balanceada. Con ellas la sensibilidad subió por encima del 81 %, a cambio de algunos puntos de exactitud global.
¿Se cumplió el objetivo de la investigación? Sí. El objetivo era predecir si una persona supera los 50.000 dólares de ingreso anual a partir de características socioeconómicas, y los modelos lo logran con una exactitud de alrededor del 83 % y un AUC superior a 0,85, detectando además a la mayoría de las personas con ingresos altos cuando se corrige el desbalance. El modelo Logit, por su parte, no solo predice sino que explica: muestra que la ocupación y estado civil son las que más separan categorías, y educación y horas tienen efectos acumulativos, lo que da al resultado valor para entender la desigualdad de ingresos y no solo para clasificar. La principal reserva es que el modelo describe la economía estadounidense de 1994, por lo que sus conclusiones no deben trasladarse sin más a otros países ni a la actualidad.
Recomendaciones.
Una primera limitación es la antigüedad de los datos: la base corresponde al censo de 1994 y el umbral de 50.000 dólares no tiene hoy el mismo significado, por lo que los resultados describen la economía estadounidense de esa época.
En segundo lugar, al eliminar a las 2.399 personas que no reportaron su ocupación o empleador se introdujo un posible sesgo, pues ese grupo tiene una proporción menor de ingresos altos que el resto. Una alternativa sería tratar “no reportado” como una categoría más.
También existen variables omitidas que influyen en el ingreso y no están en la base, como la experiencia laboral específica, el sector económico, la región del país o el ingreso del cónyuge. Esto puede afectar la interpretación de los odds ratios, en especial el del sexo y el del estado civil.
El balanceo por submuestreo descarta más de 11.000 personas con ingresos bajos del entrenamiento, con la consiguiente pérdida de información; técnicas como SMOTE o la ponderación de observaciones podrían explorarse en el futuro.
Por último, la ocupación tiene 13 categorías y algunas, como el servicio doméstico, tienen pocas personas, lo que hace que sus odds ratios tengan intervalos de confianza amplios y deban interpretarse con cautela.
Becker, B. y Kohavi, R. (1996). Adult [Conjunto de datos]. UCI Machine Learning Repository. https://doi.org/10.24432/C5XW20
IBM. (2024). ¿Qué es el algoritmo de k vecinos más cercanos (KNN)? IBM Think. https://www.ibm.com/es-es/think/topics/knn
IBM. (2024). ¿Qué es la regresión logística? IBM Think. https://www.ibm.com/es-es/think/topics/logistic-regression