Aplicación de Algoritmos de Machine Learning para la Clasificación del Nivel de Ingresos en la Base Adult Census
- Indira Vivas (2437700) - David Elizalde (2438289) - Josué Sebastián Pérez Rodríguez 2522025 - Sebastian Dario Luna Noguera (2438085)
1.INTRODUCCIÓN
La base de datos seleccionada proviene del Census de Estados Unidos de 1994 y contiene información demográfica, educativa y laboral de diferentes personas, permitiendo analizar cómo estas características se relacionan con el nivel de ingresos.
Entender los factores asociados a mayores ingresos es relevante en
ámbitos económicos y sociales, ya que variables como la educación, la
ocupación o la cantidad de horas trabajadas suelen influir en las
oportunidades laborales y en la calidad de vida de las personas. La
variable de interés es binaria: indica si una persona tiene ingresos
iguales o inferiores a 50K dólares anuales (<=50K) o
superiores (>50K).
A partir de esta información, se planteó la siguiente pregunta de investigación:
¿Cómo influyen la edad, nivel educativo, horas trabajadas, ocupación, estado civil y sexo sobre la probabilidad de que una persona tenga ingresos superiores a 50K anuales?
Para responderla, se construyeron y compararon dos modelos de clasificación supervisada: regresión logística (Logit) y K-Nearest Neighbors (KNN), evaluando su capacidad predictiva sobre este problema binario.
2.METODOLOGÍA
El presente estudio adoptó un enfoque de aprendizaje supervisado orientado a la clasificación binaria del nivel de ingresos.implementado mediante dos familias de algoritmos: K-Vecinos Más Cercanos (KNN) y regresión logística (Logit).
Se utilizó la base de datos pública Adult Census Income Dataset en Kaggle , basada en información demográfica y laboral proveniente del censo de adultos de Estados Unidos. El conjunto de datos fue sometido a un proceso de limpieza y preparación que incluyó la selección de variables relevantes como edad (age), nivel educativo (education.num), horas trabajadas por semana (hours.per.week), ocupación (occupation), estado civil (marital.status), sexo (sex) e ingreso (income). Posteriormente, se eliminaron registros con ocupaciones desconocidas representadas por el valor “?”, se transformaron las variables categóricas en factores para facilitar su análisis y modelado, y se realizó un proceso de balanceo de clases mediante undersampling para reducir el desbalance existente entre las categorías de ingreso mayores y menores a 50K anuales.
2.1 Descripción de variables
Las variables seleccionadas fueron elegidas porque representan características personales y laborales que pueden tener relación directa con el nivel de ingresos de una persona. Diversos estudios en economía laboral y análisis sociodemográficos han demostrado que factores como la educación, la experiencia, el tipo de empleo y las condiciones sociales influyen significativamente en la capacidad de generar ingresos:
age: La edad puede reflejar la experiencia laboral acumulada, el tiempo de permanencia en el mercado laboral y el desarrollo de habilidades profesionales. Según la teoría del capital humano propuesta por Gary Becker en 1993, la experiencia y la inversión en capacidades personales incrementan la productividad y, en consecuencia, los ingresos salariales. Además, estudios laborales indican que los ingresos suelen aumentar con la edad hasta cierto punto, debido a la acumulación de experiencia y conocimientos.
education.num: Esta variable representa el nivel educativo expresado numéricamente y permite medir de manera cuantitativa la formación académica de una persona. La educación es uno de los factores más importantes para explicar diferencias salariales, ya que niveles educativos más altos suelen asociarse con mejores oportunidades de empleo, mayor productividad y acceso a ocupaciones de mayor remuneración.
hours.per.week:Las horas trabajadas por semana permiten analizar la intensidad de participación en el mercado laboral. Una mayor cantidad de horas trabajadas puede relacionarse con mayores ingresos, especialmente en empleos remunerados por tiempo trabajado. Sin embargo, también puede reflejar condiciones laborales exigentes o necesidad económica.
occupation: La ocupación aporta información sobre el tipo de trabajo desempeñado y el sector laboral al que pertenece la persona. Diferentes ocupaciones requieren distintos niveles de formación, experiencia y habilidades, lo que genera variaciones salariales importantes. Trabajos especializados o profesionales suelen tener mayores niveles de ingreso que ocupaciones operativas o de baja cualificación. Esta variable es fundamental en estudios de desigualdad salarial y segmentación del mercado laboral.
marital.status: El estado civil puede estar asociado con diferencias en los ingresos debido a factores económicos y sociales. Algunos estudios sugieren que las personas casadas tienden a presentar mayores ingresos promedio, posiblemente por estabilidad económica, distribución de responsabilidades o incentivos laborales. También puede influir en la disponibilidad de tiempo para trabajar y en las decisiones financieras del hogar.
sex: Esta variable permite identificar posibles diferencias de ingresos entre hombres y mujeres y analizar fenómenos relacionados con la brecha salarial de género..
En conjunto, estas variables permiten construir modelos de clasificación con información tanto cuantitativa como cualitativa.
2.2 Selección y preparación de variables
En la siguiente tabla se muestra la tabla con las variables seleccionadas a partir de la base de datos.
datos_tabla <- c(datos2)
datos_tabla <- as.data.frame(datos_tabla)
datos_tabla[] <- lapply(
datos2,
function(x){
if(is.character(x)){
iconv(x, to = "UTF-8", sub = "")
} else {
x
}
}
)
reactable(
datos_tabla,
# cantidad de filas por página
defaultPageSize = 15,
# opciones de filas
showPageSizeOptions = TRUE,
pageSizeOptions = c(10, 15, 25, 50),
# diseño
striped = TRUE,
highlight = TRUE,
bordered = TRUE,
# filtros y ordenamiento
filterable = TRUE,
sortable = TRUE,
# ajustes visuales
wrap = FALSE,
resizable = TRUE,
# estilo general columnas
defaultColDef = colDef(
align = "center",
minWidth = 140,
headerStyle = list(
background = "#B22222", # rojo oscuro
color = "white",
fontWeight = "bold"
)
),
# estilo tabla
style = list(
fontFamily = "Arial",
fontSize = "14px",
border = "2px solid #B22222"
),
# tema
theme = reactableTheme(
stripedColor = "#FFE5E5", # rojo claro filas alternas
highlightColor = "#FFCCCC", # resaltado rojo suave
cellPadding = "8px 12px",
borderColor = "#B22222",
style = list(
borderColor = "#B22222"
)
)
)2.3 Balanceo de clases
La variable dependiente presentaba un desbalance importante:
aproximadamente el 76% de los registros correspondían a ingresos menores
o iguales a 50K. Para evitar que los modelos favorezcan sistemáticamente
la clase mayoritaria, se realizó un submuestreo aleatorio de la clase
<=50K, dejando 10,000 observaciones de esa categoría y
manteniendo todos los registros de >50K.
tabla_income <- datos_balance %>%
count(income)
# Crear tabla
tabla_income %>%
kable(
col.names = c("Nivel de ingreso", "Cantidad"),
align = "c",
caption = "Distribución de ingresos"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center"
) %>%
row_spec(
0,
bold = TRUE,
color = "white",
background = "#8B0000"
) %>%
row_spec(
1,
background = "#FFE5E5",
color = "#8B0000",
bold = TRUE
) %>%
row_spec(
2,
background = "#FFD1D1",
color = "#B22222",
bold = TRUE
) %>%
column_spec(2,
bold = TRUE,
color = "#8B0000")| Nivel de ingreso | Cantidad |
|---|---|
| <=50K | 10000 |
| >50K | 7650 |
2.4 División entrenamiento y prueba
El conjunto de datos balanceado se dividió en 70% para entrenamiento (12,355 observaciones) y 30% para prueba (5,295 observaciones), manteniendo la proporción de clases en ambos subconjuntos mediante muestreo estratificado.
set.seed(123)
trainIndex <- createDataPartition(datos_balance$income,
p = 0.7,
list = FALSE)
train <- datos_balance[trainIndex, ]
test <- datos_balance[-trainIndex, ]
dim(train)## [1] 12355 7## [1] 5295 73.RESULTADOS DESCRIPTIVOS
3.1 Estadísticas descriptivas
## age education.num hours.per.week occupation
## Min. :17.00 Min. : 1.00 Min. : 1.00 Exec-managerial:2873
## 1st Qu.:30.00 1st Qu.: 9.00 1st Qu.:40.00 Prof-specialty :2821
## Median :39.00 Median :10.00 Median :40.00 Craft-repair :2291
## Mean :39.84 Mean :10.49 Mean :42.07 Sales :2143
## 3rd Qu.:49.00 3rd Qu.:13.00 3rd Qu.:48.00 Adm-clerical :1930
## Max. :90.00 Max. :16.00 Max. :99.00 Other-service :1525
## (Other) :4067
## marital.status sex income
## Divorced :2125 Female: 5028 <=50K:10000
## Married-AF-spouse : 15 Male :12622 >50K : 7650
## Married-civ-spouse :9888
## Married-spouse-absent: 180
## Never-married :4604
## Separated : 432
## Widowed : 406datos_balance %>%
select(age, education.num, hours.per.week) %>%
summarise(
across(everything(),
list(
media = mean,
mediana = median,
sd = sd,
min = min,
max = max
))
) %>%
pivot_longer(everything(),
names_to = c("variable", "estadistico"),
names_sep = "_",
values_to = "valor") %>%
pivot_wider(names_from = "estadistico",
values_from = "valor")library(ggplot2)
library(gridExtra)
# BOXPLOT EDAD
g1 <- ggplot(datos2, aes(x = "", y = age)) +
geom_boxplot(
fill = "darkred",
color = "black"
) +
stat_summary(
fun = mean,
geom = "point",
shape = 20,
size = 4,
color = "yellow"
) +
labs(
title = "Boxplot de Edad",
y = "Edad",
x = ""
) +
theme_minimal()
# BOXPLOT EDUCACION
g2 <- ggplot(datos2, aes(x = "", y = education.num)) +
geom_boxplot(
fill = "firebrick",
color = "black"
) +
stat_summary(
fun = mean,
geom = "point",
shape = 20,
size = 4,
color = "yellow"
) +
labs(
title = "Boxplot Nivel Educativo",
y = "Education Num",
x = ""
) +
theme_minimal()
# BOXPLOT HORAS
g3 <- ggplot(datos2, aes(x = "", y = hours.per.week)) +
geom_boxplot(
fill = "brown",
color = "black"
) +
stat_summary(
fun = mean,
geom = "point",
shape = 20,
size = 4,
color = "yellow"
) +
labs(
title = "Boxplot Horas Trabajadas",
y = "Horas por Semana",
x = ""
) +
theme_minimal()
# MOSTRAR GRAFICOS
grid.arrange(
g1, g2, g3,
ncol = 3
)
En promedio, los individuos tienen 39.8 años, un nivel educativo de 10.5 (equivalente aproximadamente a algunos créditos universitarios) y trabajan 42.1 horas semanales.
# distribucion de ingreso por sexo
prop.table(table(datos_balance$sex,
datos_balance$income), margin = 1) %>% round(3)##
## <=50K >50K
## Female 0.776 0.224
## Male 0.483 0.517# distribucion de ingreso por estado civil
prop.table(table(datos_balance$marital.status,
datos_balance$income), margin = 1) %>% round(3)##
## <=50K >50K
## Divorced 0.785 0.215
## Married-AF-spouse 0.333 0.667
## Married-civ-spouse 0.341 0.659
## Married-spouse-absent 0.817 0.183
## Never-married 0.895 0.105
## Separated 0.847 0.153
## Widowed 0.800 0.200# distribucion de ingreso por ocupacion
prop.table(table(datos_balance$occupation,
datos_balance$income), margin = 1) %>% round(3)##
## <=50K >50K
## Adm-clerical 0.737 0.263
## Armed-Forces 0.800 0.200
## Craft-repair 0.595 0.405
## Exec-managerial 0.315 0.685
## Farming-fishing 0.780 0.220
## Handlers-cleaners 0.861 0.139
## Machine-op-inspct 0.751 0.249
## Other-service 0.910 0.090
## Priv-house-serv 0.986 0.014
## Prof-specialty 0.341 0.659
## Protective-serv 0.484 0.516
## Sales 0.541 0.459
## Tech-support 0.504 0.496
## Transport-moving 0.631 0.3693.2 Gráficos descriptivos
ggplot(datos_balance, aes(x = income)) +
geom_bar(fill = "#8B0000") +
labs(title = "Distribución del ingreso",
x = "Nivel de ingreso",
y = "Frecuencia")
Distribución del ingreso en la muestra balanceada
ggplot(datos_balance,
aes(x = income,
y = age,
fill = income)) +
geom_boxplot() +
labs(title = "Edad según nivel de ingreso",
x = "Ingreso",
y = "Edad")
Distribución de edad según nivel de ingreso
Las personas con ingresos superiores a 50K tienden a ser mayores, lo que es consistente con una mayor acumulación de experiencia laboral.
ggplot(datos_balance,
aes(x = income,
y = hours.per.week,
fill = income)) +
geom_boxplot() +
labs(title = "Horas trabajadas según ingreso",
x = "Ingreso",
y = "Horas por semana")
Horas trabajadas según nivel de ingreso
Quienes ganan más de 50K trabajan en promedio más horas semanales, aunque con mayor dispersión.
ggplot(datos_balance,
aes(x = sex,
fill = income)) +
geom_bar(position = "fill") +
labs(title = "Distribución del ingreso según sexo",
x = "Sexo",
y = "Proporción")
Distribución del ingreso según sexo
Se observa una diferencia marcada entre hombres y mujeres: una proporción considerablemente mayor de hombres tiene ingresos superiores a 50K.
ggplot(datos_balance,
aes(x = factor(education.num),
fill = income)) +
geom_bar(position = "fill") +
labs(title = "Nivel educativo según ingreso",
x = "Nivel educativo",
y = "Proporción")
Nivel educativo según ingreso
A mayor nivel educativo, mayor es la proporción de personas con ingresos superiores a 50K, confirmando la relevancia de esta variable.
ggplot(datos_balance,
aes(x = reorder(occupation, occupation,
function(x) -length(x)),
fill = income)) +
geom_bar(position = "fill") +
coord_flip() +
labs(title = "Distribución del ingreso según ocupación",
x = "Ocupación",
y = "Proporción")
Distribución del ingreso según ocupación
Las ocupaciones ejecutivas y de especialización profesional concentran la mayor proporción de ingresos superiores a 50K, mientras que servicios domésticos y agricultura presentan los valores más bajos.
4.MODELOS DE CLASIFICACION
La clasificación es un enfoque fundamental dentro del aprendizaje supervisado cuyo objetivo es asignar observaciones a categorías predefinidas basándose en un conjunto conocido de características. Este tipo de modelos aprenden a partir de datos etiquetados, donde cada instancia cuenta con una clase o categoría asociada, para después predecir la clase de nuevas observaciones. La clasificación se aplica en diversos campos y problemas donde es necesario discriminar entre dos o más opciones. A continuación, se detalla la división de los datos y la implementación de cada modelo utilizado para evaluar su desempeño en la clasificación.
4.1 Modelo de Regresión Logística (Logit)
La regresión logística (modelo Logit) es un método de clasificación paramétrico que estima la probabilidad de que una observación pertenezca a una de dos categorías, en función de variables explicativas. A diferencia del KNN, el Logit construye un modelo matemático explícito: el logaritmo del odds (razón de probabilidades) se modela linealmente respecto a los predictores.
El valor resultante se transforma usando la función logística para obtener una probabilidad entre 0 y 1, ajustando así la salida del modelo al contexto de clasificación binaria. Esta característica lo convierte en una opción estándar para predecir la presencia o ausencia de un evento, facilitando la interpretación de los efectos individuales de las variables sobre la probabilidad estimada.
Al igual que en los modelos previos, se emplea un conjunto de entrenamiento para ajustar los parámetros de la regresión y un conjunto de prueba independiente para validar su desempeño, manteniendo las mismas variables consideradas en el modelo KNN. Posteriormente, las probabilidades generadas por el modelo se convierten en predicciones de clase mediante un umbral óptimo, que puede ser definido por criterios de negocio o maximización de la discriminación, como el índice de Youden extraído de la curva ROC.
El modelo de regresión logística se entrenó utilizando la función glm() en R con familia binomial para modelar la probabilidad de ingresos superiores a 50k en función de las variables predictoras seleccionadas.
modelo_logit <- glm(income ~ age +
education.num +
hours.per.week +
occupation +
marital.status +
sex,
data = train,
family = "binomial")
summary(modelo_logit)##
## Call:
## glm(formula = income ~ age + education.num + hours.per.week +
## occupation + marital.status + sex, family = "binomial", data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.669006 0.226080 -33.922 < 2e-16 ***
## age 0.031065 0.002292 13.553 < 2e-16 ***
## education.num 0.283825 0.012535 22.643 < 2e-16 ***
## hours.per.week 0.035108 0.002374 14.787 < 2e-16 ***
## occupationArmed-Forces -0.595429 1.549143 -0.384 0.700711
## occupationCraft-repair -0.015145 0.102367 -0.148 0.882386
## occupationExec-managerial 0.803492 0.098524 8.155 3.48e-16 ***
## occupationFarming-fishing -1.461462 0.173843 -8.407 < 2e-16 ***
## occupationHandlers-cleaners -0.885897 0.185225 -4.783 1.73e-06 ***
## occupationMachine-op-inspct -0.316489 0.130593 -2.423 0.015373 *
## occupationOther-service -0.879839 0.143643 -6.125 9.06e-10 ***
## occupationPriv-house-serv -1.927148 1.062270 -1.814 0.069650 .
## occupationProf-specialty 0.677742 0.102400 6.619 3.63e-11 ***
## occupationProtective-serv 0.507301 0.168546 3.010 0.002614 **
## occupationSales 0.218900 0.104257 2.100 0.035762 *
## occupationTech-support 0.487664 0.147730 3.301 0.000963 ***
## occupationTransport-moving -0.293387 0.129770 -2.261 0.023771 *
## marital.statusMarried-AF-spouse 3.318704 0.728543 4.555 5.23e-06 ***
## marital.statusMarried-civ-spouse 2.041460 0.083003 24.595 < 2e-16 ***
## marital.statusMarried-spouse-absent 0.119321 0.283023 0.422 0.673319
## marital.statusNever-married -0.489365 0.100322 -4.878 1.07e-06 ***
## marital.statusSeparated 0.028280 0.194309 0.146 0.884282
## marital.statusWidowed 0.069954 0.188681 0.371 0.710822
## sexMale 0.369832 0.068169 5.425 5.79e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 16908 on 12354 degrees of freedom
## Residual deviance: 10457 on 12331 degrees of freedom
## AIC: 10505
##
## Number of Fisher Scoring iterations: 6# odds ratios con intervalos de confianza
exp(cbind(OR = coef(modelo_logit),
confint(modelo_logit)))## OR 2.5 % 97.5 %
## (Intercept) 4.670818e-04 0.0002988837 7.251356e-04
## age 1.031552e+00 1.0269383692 1.036208e+00
## education.num 1.328201e+00 1.2961440438 1.361428e+00
## hours.per.week 1.035732e+00 1.0309470443 1.040588e+00
## occupationArmed-Forces 5.513257e-01 0.0179258428 1.082706e+01
## occupationCraft-repair 9.849693e-01 0.8060761181 1.204122e+00
## occupationExec-managerial 2.233327e+00 1.8419664525 2.710400e+00
## occupationFarming-fishing 2.318970e-01 0.1643100097 3.249573e-01
## occupationHandlers-cleaners 4.123442e-01 0.2849798284 5.895517e-01
## occupationMachine-op-inspct 7.287030e-01 0.5636547016 9.405803e-01
## occupationOther-service 4.148496e-01 0.3120319945 5.481314e-01
## occupationPriv-house-serv 1.455627e-01 0.0078026329 7.719356e-01
## occupationProf-specialty 1.969425e+00 1.6119728202 2.408278e+00
## occupationProtective-serv 1.660802e+00 1.1953270979 2.314983e+00
## occupationSales 1.244707e+00 1.0148589326 1.527281e+00
## occupationTech-support 1.628507e+00 1.2194807498 2.176348e+00
## occupationTransport-moving 7.457333e-01 0.5780417184 9.614576e-01
## marital.statusMarried-AF-spouse 2.762453e+01 6.7627308593 1.247124e+02
## marital.statusMarried-civ-spouse 7.701846e+00 6.5533141668 9.073892e+00
## marital.statusMarried-spouse-absent 1.126732e+00 0.6346278821 1.930784e+00
## marital.statusNever-married 6.130158e-01 0.5036032580 7.463067e-01
## marital.statusSeparated 1.028684e+00 0.6969610560 1.494444e+00
## marital.statusWidowed 1.072459e+00 0.7363863093 1.544161e+00
## sexMale 1.447491e+00 1.2663932121 1.654380e+00Las variables con mayor efecto positivo sobre la probabilidad de
ingresos superiores a 50K son el estado civil casado
(Married-civ-spouse, OR = 7.70), la ocupación ejecutiva
(Exec-managerial, OR = 2.23) y la especialización
profesional (Prof-specialty, OR = 1.97). Por su parte,
ocupaciones como agricultura (Farming-fishing, OR = 0.23) y
servicios domésticos (Priv-house-serv, OR = 0.15) reducen
considerablemente esa probabilidad. El nivel educativo (OR = 1.33) y las
horas trabajadas (OR = 1.04) también muestran efectos positivos y
significativos.
prob_logit <- predict(modelo_logit,
newdata = test,
type = "response")
pred_logit <- ifelse(prob_logit > 0.5,
">50K",
"<=50K")
pred_logit <- as.factor(pred_logit)
confusionMatrix(pred_logit, test$income)## Confusion Matrix and Statistics
##
## Reference
## Prediction <=50K >50K
## <=50K 2424 544
## >50K 576 1751
##
## Accuracy : 0.7885
## 95% CI : (0.7772, 0.7994)
## No Information Rate : 0.5666
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.57
##
## Mcnemar's Test P-Value : 0.3543
##
## Sensitivity : 0.8080
## Specificity : 0.7630
## Pos Pred Value : 0.8167
## Neg Pred Value : 0.7525
## Prevalence : 0.5666
## Detection Rate : 0.4578
## Detection Prevalence : 0.5605
## Balanced Accuracy : 0.7855
##
## 'Positive' Class : <=50K
## roc_logit <- roc(response = test$income,
predictor = prob_logit,
levels = c("<=50K", ">50K"))
auc_logit <- auc(roc_logit)
auc_logit## Area under the curve: 0.8757
cm_logit <- confusionMatrix(pred_logit, test$income)
acc_logit <- cm_logit$overall["Accuracy"]
sens_logit <- cm_logit$byClass["Sensitivity"]
spec_logit <- cm_logit$byClass["Specificity"]
auc_logit <- auc(roc_logit)library(caret)
library(dplyr)
library(kableExtra)
#=================================================
# PREDICCIONES MODELO LOGIT
#=================================================
# probabilidades
prob_logit <- predict(
modelo_logit,
newdata = test,
type = "response"
)
# convertir probabilidades en clases
pred_logit <- ifelse(
prob_logit > 0.5,
">50K",
"<=50K"
)
pred_logit <- as.factor(pred_logit)
# asegurar mismo orden de niveles
pred_logit <- factor(
pred_logit,
levels = levels(test$income)
)
#=================================================
# MATRIZ DE CONFUSION
#=================================================
cm_logit <- confusionMatrix(
pred_logit,
test$income,
positive = ">50K"
)
#=================================================
# EXTRAER METRICAS
#=================================================
acc <- round(
cm_logit$overall["Accuracy"],
4
)
acc_ci <- paste0(
"(",
round(cm_logit$overall[["AccuracyLower"]], 4),
", ",
round(cm_logit$overall[["AccuracyUpper"]], 4),
")"
)
no_info_rate <- round(
as.numeric(cm_logit$overall["AccuracyNull"]),
4
)
p_value_acc <- formatC(
as.numeric(cm_logit$overall["AccuracyPValue"]),
format = "e",
digits = 2
)
kappa <- round(
cm_logit$overall["Kappa"],
4
)
mcnemar <- formatC(
as.numeric(cm_logit$overall["McnemarPValue"]),
format = "e",
digits = 2
)
#=================================================
# TABLA DE METRICAS
#=================================================
metricas_logit <- data.frame(
Métrica = c(
"Accuracy (Exactitud)",
"95% CI (Intervalo de Confianza)",
"No Information Rate",
"P-Value [Acc > NIR]",
"Kappa",
"Mcnemar's Test P-Value",
"Sensitivity",
"Specificity",
"Pos Pred Value",
"Neg Pred Value",
"Prevalence",
"Detection Rate",
"Detection Prevalence",
"Balanced Accuracy"
),
Valor = c(
acc,
acc_ci,
no_info_rate,
p_value_acc,
kappa,
mcnemar,
round(cm_logit$byClass["Sensitivity"], 4),
round(cm_logit$byClass["Specificity"], 4),
round(cm_logit$byClass["Pos Pred Value"], 4),
round(cm_logit$byClass["Neg Pred Value"], 4),
round(cm_logit$byClass["Prevalence"], 4),
round(cm_logit$byClass["Detection Rate"], 4),
round(cm_logit$byClass["Detection Prevalence"], 4),
round(cm_logit$byClass["Balanced Accuracy"], 4)
),
Interpretación = c(
"Proporcion total de clasificaciones correctas realizadas por el modelo Logit.",
"Margen de incertidumbre del 95% sobre la precision estimada del modelo.",
"Exactitud esperada si el modelo predijera siempre la clase mayoritaria.",
"Evalua si la exactitud del modelo es significativamente mejor que el azar.",
"Grado de concordancia entre predicciones y valores reales ajustado por azar.",
"Evalua posibles diferencias entre errores de clasificacion.",
"Capacidad del modelo para identificar correctamente ingresos mayores a 50K.",
"Capacidad del modelo para identificar correctamente ingresos menores o iguales a 50K.",
"Probabilidad de que una prediccion >50K sea correcta.",
"Probabilidad de que una prediccion <=50K sea correcta.",
"Frecuencia real de la clase positiva en los datos.",
"Porcentaje de positivos correctamente detectados.",
"Frecuencia con la que el modelo predice la clase positiva.",
"Promedio entre sensibilidad y especificidad."
)
)
#=================================================
# TABLA FINAL
#=================================================
metricas_logit %>%
kbl(
caption = "Tabla. Metricas de Evaluacion del Modelo Logit",
align = c("l", "c", "l"),
col.names = c(
"Metrica",
"Valor",
"Interpretacion"
)
) %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed"
),
full_width = FALSE,
font_size = 13,
position = "center"
) %>%
row_spec(
0,
background = "#922b21",
color = "white",
bold = TRUE
) %>%
row_spec(
c(1,7,8,14),
background = "#fdecea"
) %>%
column_spec(
1,
bold = TRUE,
width = "4cm"
) %>%
column_spec(
2,
width = "2.5cm"
) %>%
column_spec(
3,
width = "9cm"
) %>%
footnote(
general = "Elaboracion propia con base en el dataset Adult Census Income.",
general_title = "Nota:",
footnote_as_chunk = TRUE
)| Metrica | Valor | Interpretacion |
|---|---|---|
| Accuracy (Exactitud) | 0.7885 | Proporcion total de clasificaciones correctas realizadas por el modelo Logit. |
| 95% CI (Intervalo de Confianza) | (0.7772, 0.7994) | Margen de incertidumbre del 95% sobre la precision estimada del modelo. |
| No Information Rate | 0.5666 | Exactitud esperada si el modelo predijera siempre la clase mayoritaria. |
| P-Value [Acc > NIR] | 1.02e-252 | Evalua si la exactitud del modelo es significativamente mejor que el azar. |
| Kappa | 0.57 | Grado de concordancia entre predicciones y valores reales ajustado por azar. |
| Mcnemar’s Test P-Value | 3.54e-01 | Evalua posibles diferencias entre errores de clasificacion. |
| Sensitivity | 0.763 | Capacidad del modelo para identificar correctamente ingresos mayores a 50K. |
| Specificity | 0.808 | Capacidad del modelo para identificar correctamente ingresos menores o iguales a 50K. |
| Pos Pred Value | 0.7525 | Probabilidad de que una prediccion >50K sea correcta. |
| Neg Pred Value | 0.8167 | Probabilidad de que una prediccion <=50K sea correcta. |
| Prevalence | 0.4334 | Frecuencia real de la clase positiva en los datos. |
| Detection Rate | 0.3307 | Porcentaje de positivos correctamente detectados. |
| Detection Prevalence | 0.4395 | Frecuencia con la que el modelo predice la clase positiva. |
| Balanced Accuracy | 0.7855 | Promedio entre sensibilidad y especificidad. |
| Nota: Elaboracion propia con base en el dataset Adult Census Income. |
# umbral optimo
thr <- coords(roc_logit,
x = "best",
best.method = "youden",
ret = "threshold")
umbral <- as.numeric(thr)
pred_logit_thr <- ifelse(prob_logit > umbral,
">50K",
"<=50K")
pred_logit_thr <- as.factor(pred_logit_thr)
confusionMatrix(pred_logit_thr, test$income)## Confusion Matrix and Statistics
##
## Reference
## Prediction <=50K >50K
## <=50K 2194 307
## >50K 806 1988
##
## Accuracy : 0.7898
## 95% CI : (0.7786, 0.8007)
## No Information Rate : 0.5666
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5827
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.7313
## Specificity : 0.8662
## Pos Pred Value : 0.8772
## Neg Pred Value : 0.7115
## Prevalence : 0.5666
## Detection Rate : 0.4144
## Detection Prevalence : 0.4723
## Balanced Accuracy : 0.7988
##
## 'Positive' Class : <=50K
## Con el umbral óptimo de Youden el modelo gana especificidad (86.6%) a costa de sensibilidad (73.1%), lo que significa que clasifica mejor a quienes no superan los 50K pero es más conservador al identificar a quienes sí los superan.
4.2 Modelo KNN
En el desarrollo del modelo KNN (K-Nearest Neighbors) se utilizaron tanto funciones del paquete caret como la función knn() del paquete class.
Se realizó la transformación de las variables categóricas en variables dummy utilizando la función dummyVars() del paquete caret. Este paso fue necesario porque el algoritmo KNN trabaja únicamente con variables numéricas y calcula distancias entre observaciones. Variables como ocupación (occupation), estado civil (marital.status) y sexo (sex) contienen categorías de texto, por lo que debieron convertirse en variables binarias (0 y 1).
En una primera etapa, se utilizó directamente la función knn() del paquete class para realizar una búsqueda manual del mejor número de vecinos (k). Para ello, se evaluaron valores de k desde 1 hasta 30 mediante un ciclo for. En cada iteración se generaban predicciones y posteriormente se calculaba la precisión del modelo comparando las predicciones con los valores reales del conjunto de prueba. Finalmente, se construyó una gráfica que permitió visualizar cómo cambiaba la precisión según el número de vecinos utilizados.
# asegurar que income sea factor
train$income <- as.factor(train$income)
test$income <- as.factor(test$income)
# convertir variables categoricas en variables dummy
dummies <- dummyVars(income ~ ., data = train)
train_x <- as.data.frame(predict(dummies, newdata = train))
test_x <- as.data.frame(predict(dummies, newdata = test))
train_y <- train$income
test_y <- test$income# busqueda del mejor k
k <- 1:30
resultado <- data.frame(k, precision = 0)
for(n in k){
pred_temp <- knn(train = train_x,
test = test_x,
cl = train_y,
k = n)
resultado$precision[n] <- mean(pred_temp == test_y)
}
resultadoresultado %>%
ggplot(aes(x = k, y = precision)) +
geom_line() +
geom_point() +
labs(title = "Precision del modelo KNN",
x = "Numero de vecinos (k)",
y = "Precision")
se implementó una segunda versión del modelo utilizando la función
train() del paquete caret, la cual automatiza gran parte del proceso de
entrenamiento y validación. En este caso se aplicó validación cruzada
(cross-validation) de 5 particiones mediante trainControl(method = “cv”,
number = 5).
Durante esta etapa también se realizó la estandarización de las variables numéricas utilizando el argumento:
preProcess = c(“center”, “scale”)
El proceso de center consiste en restar la media de cada variable para centrar los datos alrededor de cero, mientras que scale divide cada valor entre la desviación estándar correspondiente.
control <- trainControl(method = "cv",
number = 5)
set.seed(123)
modelo_knn <- train(income ~ .,
data = train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 30,
trControl = control)
modelo_knn## k-Nearest Neighbors
##
## 12355 samples
## 6 predictor
## 2 classes: '<=50K', '>50K'
##
## Pre-processing: centered (23), scaled (23)
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 9884, 9884, 9884, 9884, 9884
## Resampling results across tuning parameters:
##
## k Accuracy Kappa
## 5 0.7933630 0.5812388
## 7 0.7984622 0.5910317
## 9 0.7994334 0.5932621
## 11 0.7985431 0.5913990
## 13 0.7985431 0.5915168
## 15 0.7982193 0.5908137
## 17 0.8014569 0.5975992
## 19 0.8024282 0.5995351
## 21 0.7997572 0.5942915
## 23 0.7983003 0.5912853
## 25 0.8008094 0.5965186
## 27 0.8005666 0.5959448
## 29 0.8005666 0.5960432
## 31 0.8012141 0.5972907
## 33 0.7991906 0.5934786
## 35 0.7985431 0.5921721
## 37 0.7978146 0.5906932
## 39 0.7976528 0.5904617
## 41 0.7975718 0.5903062
## 43 0.7975718 0.5904124
## 45 0.7971671 0.5895792
## 47 0.7963577 0.5879131
## 49 0.7957102 0.5866821
## 51 0.7952246 0.5856711
## 53 0.7953865 0.5860071
## 55 0.7950627 0.5854622
## 57 0.7947390 0.5849064
## 59 0.7951437 0.5857878
## 61 0.7947390 0.5851070
## 63 0.7944962 0.5845194
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was k = 19.
pred_knn <- predict(modelo_knn, newdata = test)
prob_knn <- predict(modelo_knn, newdata = test, type = "prob")
confusionMatrix(pred_knn, test$income)## Confusion Matrix and Statistics
##
## Reference
## Prediction <=50K >50K
## <=50K 2425 520
## >50K 575 1775
##
## Accuracy : 0.7932
## 95% CI : (0.782, 0.804)
## No Information Rate : 0.5666
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.5801
##
## Mcnemar's Test P-Value : 0.1027
##
## Sensitivity : 0.8083
## Specificity : 0.7734
## Pos Pred Value : 0.8234
## Neg Pred Value : 0.7553
## Prevalence : 0.5666
## Detection Rate : 0.4580
## Detection Prevalence : 0.5562
## Balanced Accuracy : 0.7909
##
## 'Positive' Class : <=50K
## cm_knn <- confusionMatrix(pred_knn, test$income)
acc_knn <- cm_knn$overall["Accuracy"]
sens_knn <- cm_knn$byClass["Sensitivity"]
spec_knn <- cm_knn$byClass["Specificity"]roc_knn <- roc(response = test$income,
predictor = prob_knn$`>50K`,
levels = c("<=50K", ">50K"))
auc_knn <- auc(roc_knn)
auc_knn## Area under the curve: 0.8699
library(caret)
library(dplyr)
library(kableExtra)
#=================================================
# MATRIZ DE CONFUSION
#=================================================
cm_knn <- confusionMatrix(
pred_knn,
test$income,
positive = ">50K"
)
#=================================================
# EXTRAER METRICAS
#=================================================
acc <- round(cm_knn$overall["Accuracy"], 4)
acc_ci <- paste0(
"(",
round(cm_knn$overall[["AccuracyLower"]], 4),
", ",
round(cm_knn$overall[["AccuracyUpper"]], 4),
")"
)
no_info_rate <- round(
as.numeric(cm_knn$overall["AccuracyNull"]),
4
)
p_value_acc <- formatC(
as.numeric(cm_knn$overall["AccuracyPValue"]),
format = "e",
digits = 2
)
kappa <- round(
cm_knn$overall["Kappa"],
4
)
mcnemar <- formatC(
as.numeric(cm_knn$overall["McnemarPValue"]),
format = "e",
digits = 2
)
#=================================================
# TABLA DE METRICAS
#=================================================
metricas_tabla <- data.frame(
Métrica = c(
"Accuracy (Exactitud)",
"95% CI (Intervalo de Confianza)",
"No Information Rate",
"P-Value [Acc > NIR]",
"Kappa",
"Mcnemar's Test P-Value",
"Sensitivity",
"Specificity",
"Pos Pred Value",
"Neg Pred Value",
"Prevalence",
"Detection Rate",
"Detection Prevalence",
"Balanced Accuracy"
),
Valor = c(
acc,
acc_ci,
no_info_rate,
p_value_acc,
kappa,
mcnemar,
round(cm_knn$byClass["Sensitivity"], 4),
round(cm_knn$byClass["Specificity"], 4),
round(cm_knn$byClass["Pos Pred Value"], 4),
round(cm_knn$byClass["Neg Pred Value"], 4),
round(cm_knn$byClass["Prevalence"], 4),
round(cm_knn$byClass["Detection Rate"], 4),
round(cm_knn$byClass["Detection Prevalence"], 4),
round(cm_knn$byClass["Balanced Accuracy"], 4)
),
Interpretación = c(
paste0(
"El modelo clasifica correctamente el ",
round(acc * 100, 2),
"% de los registros."
),
"El intervalo muestra el rango esperado de precision del modelo con 95% de confianza.",
"Representa la precision de un modelo trivial que siempre predice la clase mayoritaria.",
"Evalua si el modelo supera significativamente al azar.",
"Mide el nivel de acuerdo entre predicciones y valores reales.",
"Analiza diferencias entre errores de clasificacion.",
"Capacidad del modelo para identificar correctamente ingresos mayores a 50K.",
"Capacidad para identificar correctamente ingresos menores o iguales a 50K.",
"Probabilidad de acertar cuando el modelo predice >50K.",
"Probabilidad de acertar cuando el modelo predice <=50K.",
"Proporcion real de la clase positiva en los datos.",
"Porcentaje de positivos correctamente detectados.",
"Frecuencia con la que el modelo predice la clase positiva.",
"Promedio entre sensibilidad y especificidad."
)
)
#=================================================
# FUNCION PARA RESALTAR
#=================================================
highlight_values <- function(x) {
case_when(
x > 0.7 ~ "color: #27ae60; font-weight: bold;",
x > 0.6 ~ "color: #2e86c1; font-weight: bold;",
x > 0.5 ~ "color: #f39c12;",
TRUE ~ "color: #c0392b;"
)
}
#=================================================
# TABLA FINAL
#=================================================
metricas_tabla %>%
kbl(
caption = "Tabla. Metricas de Evaluacion - Modelo KNN",
align = c("l", "c", "l"),
col.names = c(
"Metrica",
"Valor",
"Interpretacion"
),
escape = FALSE
) %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed"
),
full_width = FALSE,
font_size = 13,
position = "center"
) %>%
row_spec(
0,
background = "#8B0000",
color = "white",
bold = TRUE
) %>%
row_spec(
c(1,7,8,14),
background = "#fdecea"
) %>%
column_spec(
1,
bold = TRUE,
width = "4cm"
) %>%
column_spec(
2,
width = "2.5cm"
) %>%
column_spec(
3,
width = "9cm"
) %>%
footnote(
general = "Elaboracion propia con base en el dataset Adult Census Income.",
general_title = "Nota:",
footnote_as_chunk = TRUE
)| Metrica | Valor | Interpretacion |
|---|---|---|
| Accuracy (Exactitud) | 0.7932 | El modelo clasifica correctamente el 79.32% de los registros. |
| 95% CI (Intervalo de Confianza) | (0.782, 0.804) | El intervalo muestra el rango esperado de precision del modelo con 95% de confianza. |
| No Information Rate | 0.5666 | Representa la precision de un modelo trivial que siempre predice la clase mayoritaria. |
| P-Value [Acc > NIR] | 2.97e-264 | Evalua si el modelo supera significativamente al azar. |
| Kappa | 0.5801 | Mide el nivel de acuerdo entre predicciones y valores reales. |
| Mcnemar’s Test P-Value | 1.03e-01 | Analiza diferencias entre errores de clasificacion. |
| Sensitivity | 0.7734 | Capacidad del modelo para identificar correctamente ingresos mayores a 50K. |
| Specificity | 0.8083 | Capacidad para identificar correctamente ingresos menores o iguales a 50K. |
| Pos Pred Value | 0.7553 | Probabilidad de acertar cuando el modelo predice >50K. |
| Neg Pred Value | 0.8234 | Probabilidad de acertar cuando el modelo predice <=50K. |
| Prevalence | 0.4334 | Proporcion real de la clase positiva en los datos. |
| Detection Rate | 0.3352 | Porcentaje de positivos correctamente detectados. |
| Detection Prevalence | 0.4438 | Frecuencia con la que el modelo predice la clase positiva. |
| Balanced Accuracy | 0.7909 | Promedio entre sensibilidad y especificidad. |
| Nota: Elaboracion propia con base en el dataset Adult Census Income. |
4.3 Comparación de modelos
Para comparar los modelos KNN y regresión logística utilizados en este análisis, se opta por evaluar el desempeño del modelo KNN implementado con el paquete caret, que facilita la integración de variables categóricas y numéricas.
La comparación se basa en métricas clave como la exactitud, sensibilidad, especificidad y el área bajo la curva ROC (AUC), que ya hemos abordado anteriormente. Estas medidas permiten evaluar cuál modelo clasifica mejor, identifica con mayor precisión los incumplimientos y mantiene un buen equilibrio entre detección y falsos positivos.
library(pROC)
library(plotly)
library(dplyr)
# CURVA ROC KNN
roc_knn_df <- data.frame(
FPR = 1 - roc_knn$specificities,
TPR = roc_knn$sensitivities,
Modelo = "KNN"
)
# CURVA ROC LOGIT
roc_logit_df <- data.frame(
FPR = 1 - roc_logit$specificities,
TPR = roc_logit$sensitivities,
Modelo = "Logit"
)
# UNIR CURVAS
roc_comparada <- rbind(
roc_knn_df,
roc_logit_df
)
#====================================================
# CALCULAR AUC
#====================================================
auc_knn <- round(
auc(roc_knn),
3
)
auc_logit <- round(
auc(roc_logit),
3
)
roc_animada <- plot_ly() %>%
# linea de referencia
add_trace(
x = c(0,1),
y = c(0,1),
type = "scatter",
mode = "lines",
line = list(
dash = "dash",
color = "#b0b0b0",
width = 1
),
name = "Linea de referencia",
showlegend = FALSE
) %>%
# curva knn
add_trace(
data = roc_knn_df,
x = ~FPR,
y = ~TPR,
type = "scatter",
mode = "lines",
line = list(
color = "#8B0000",
width = 3
),
name = "KNN",
hoverinfo = "text",
text = ~paste(
"KNN",
"<br>FPR:", round(FPR,3),
"<br>TPR:", round(TPR,3)
)
) %>%
# curva logit
add_trace(
data = roc_logit_df,
x = ~FPR,
y = ~TPR,
type = "scatter",
mode = "lines",
line = list(
color = "gold",
width = 3
),
name = "Logit",
hoverinfo = "text",
text = ~paste(
"Logit",
"<br>FPR:", round(FPR,3),
"<br>TPR:", round(TPR,3)
)
) %>%
# diseño
layout(
title = list(
text = "Figura. Curvas ROC Comparadas entre KNN y Logit",
font = list(
size = 20,
color = "darkred"
)
),
xaxis = list(
title = "Tasa de Falsos Positivos (1 - Especificidad)",
range = c(0,1),
zeroline = FALSE
),
yaxis = list(
title = "Tasa de Verdaderos Positivos (Sensibilidad)",
range = c(0,1)
),
annotations = list(
list(
x = 0.7,
y = 0.2,
text = paste(
"AUC KNN =",
auc_knn
),
showarrow = FALSE,
font = list(
color = "#8B0000",
size = 14
)
),
list(
x = 0.7,
y = 0.1,
text = paste(
"AUC Logit =",
auc_logit
),
showarrow = FALSE,
font = list(
color = "goldenrod",
size = 14
)
),
list(
x = 0,
y = -0.15,
text = "Fuente: Elaboracion propia con base en el dataset Adult Census Income.",
showarrow = FALSE,
xref = "paper",
yref = "paper",
font = list(
size = 10,
color = "gray"
)
)
),
legend = list(
orientation = "h",
x = 0.5,
y = -0.1,
xanchor = "center"
),
margin = list(
t = 80,
b = 120,
l = 80,
r = 80
)
)
roc_animadadata.frame(
Modelo = c("Logit", "KNN"),
Accuracy = c(acc_logit, acc_knn),
Sensibilidad = c(sens_logit, sens_knn),
Especificidad = c(spec_logit, spec_knn),
AUC = c(as.numeric(auc_logit), as.numeric(auc_knn))
)La comparación entre los modelos de regresión logística y KNN muestra que ambos obtuvieron un desempeño similar en la clasificación de ingresos. Sin embargo, el modelo KNN presentó un rendimiento ligeramente superior en términos de Accuracy (79.32%) y especificidad (77.34%), lo que indica una mejor capacidad para identificar correctamente los casos pertenecientes a la clase negativa. Por otro lado, la regresión logística obtuvo un valor de AUC ligeramente mayor (0.8757 frente a 0.8699), lo que sugiere una mejor capacidad global de discriminación entre clases.
En cuanto a la sensibilidad, ambos modelos alcanzaron resultados prácticamente iguales, alrededor del 80.8%, evidenciando una capacidad similar para detectar correctamente los casos positivos. En general, aunque las diferencias son pequeñas, el modelo KNN mostró un mejor equilibrio entre precisión y especificidad, mientras que la regresión logística destacó por su mayor capacidad discriminativa según el AUC.
5.CONCLUSIONES
Respecto a los modelos de clasificación evaluados, ambos presentaron un desempeño satisfactorio, con valores de accuracy cercanos al 79%. El modelo KNN obtuvo una precisión ligeramente superior (0.793) en comparación con el modelo Logit (0.788), además de una especificidad más alta (0.773 frente a 0.763), lo que indica una mejor capacidad para identificar correctamente los casos pertenecientes a la clase negativa. Asimismo, ambos modelos mostraron sensibilidades prácticamente iguales, cercanas al 81%, evidenciando una capacidad similar para detectar correctamente los individuos con ingresos superiores a 50K.
Sin embargo, aunque el modelo KNN alcanzó métricas de clasificación ligeramente mejores en accuracy y especificidad, el modelo Logit presentó el mayor valor de AUC (0.876 frente a 0.870), lo que refleja una mejor capacidad global de discriminación entre las dos categorías de ingreso. Además, la regresión logística ofrece una ventaja interpretativa importante, ya que permite analizar el efecto individual de cada variable mediante los coeficientes y odds ratios. Esto resulta especialmente relevante en estudios de carácter social y económico, donde no solo interesa realizar predicciones precisas, sino también comprender qué factores influyen significativamente en el nivel de ingresos de las personas.
Considerando los resultados obtenidos, se concluye que ambos modelos lograron responder adecuadamente al objetivo de la investigación, alcanzando métricas de desempeño aceptables y capacidades predictivas sólidas. No obstante, el modelo Logit se considera más apropiado para este estudio debido a su equilibrio entre desempeño predictivo e interpretabilidad estadística. Finalmente, el rendimiento de los modelos podría mejorarse incorporando variables adicionales relevantes, como el tipo de empleo (workclass), ganancias de capital (capital.gain) u otras características socioeconómicas que permitan capturar con mayor profundidad las diferencias en los niveles de ingreso.
6.BIBLIOGRAFÍA
- Kohavi, R. (1996). Scaling Up the Accuracy of Naive-Bayes Classifiers: A Decision-Tree Hybrid. KDD Proceedings.
- UCI Machine Learning Repository. (1996). Adult Data Set. Recuperado de https://archive.ics.uci.edu/ml/datasets/adult
- James, G., Witten, D., Hastie, T., & Tibshirani, R. (2013). An Introduction to Statistical Learning. Springer.
- Kuhn, M. (2008). Building Predictive Models in R Using the caret Package. Journal of Statistical Software, 28(5).
- Barandica, J. (s.f.). Clase 05. Recuperado de Joaqui Barandica https://www.joaquibarandica.com/courses/tdbd/clase05 -UCI Machine Learning. (s.f.). Adult Census Income Dataset. Kaggle. https://www.kaggle.com/datasets/uciml/adult-census-income