Aprendizaje supervisado
David Elizalde - 2438289
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
2.1 Descripción de variables
datos <- read_excel("C:/Users/david/OneDrive/Escritorio/base_de_datos_taller_2_GD.xlsx")
head(datos)## tibble [32,561 × 15] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:32561] 90 82 66 54 41 34 38 74 68 41 ...
## $ workclass : chr [1:32561] "?" "Private" "?" "Private" ...
## $ fnlwgt : num [1:32561] 77053 132870 186061 140359 264663 ...
## $ education : chr [1:32561] "HS-grad" "HS-grad" "Some-college" "7th-8th" ...
## $ education.num : num [1:32561] 9 9 10 4 10 9 6 16 9 10 ...
## $ marital.status: chr [1:32561] "Widowed" "Widowed" "Widowed" "Divorced" ...
## $ occupation : chr [1:32561] "?" "Exec-managerial" "?" "Machine-op-inspct" ...
## $ relationship : chr [1:32561] "Not-in-family" "Not-in-family" "Unmarried" "Unmarried" ...
## $ race : chr [1:32561] "White" "White" "Black" "White" ...
## $ sex : chr [1:32561] "Female" "Female" "Female" "Female" ...
## $ capital.gain : num [1:32561] 0 0 0 0 0 0 0 0 0 0 ...
## $ capital.loss : num [1:32561] 4356 4356 4356 3900 3900 ...
## $ hours.per.week: num [1:32561] 40 18 40 40 40 45 40 20 40 60 ...
## $ native.country: chr [1:32561] "United-States" "United-States" "United-States" "United-States" ...
## $ income : chr [1:32561] "<=50K" "<=50K" "<=50K" "<=50K" ...## age workclass fnlwgt education
## Min. :17.00 Length:32561 Min. : 12285 Length:32561
## 1st Qu.:28.00 Class :character 1st Qu.: 117827 Class :character
## Median :37.00 Mode :character Median : 178356 Mode :character
## Mean :38.58 Mean : 189778
## 3rd Qu.:48.00 3rd Qu.: 237051
## Max. :90.00 Max. :1484705
## education.num marital.status occupation relationship
## Min. : 1.00 Length:32561 Length:32561 Length:32561
## 1st Qu.: 9.00 Class :character Class :character Class :character
## Median :10.00 Mode :character Mode :character Mode :character
## Mean :10.08
## 3rd Qu.:12.00
## Max. :16.00
## race sex capital.gain capital.loss
## Length:32561 Length:32561 Min. : 0 Min. : 0.0
## Class :character Class :character 1st Qu.: 0 1st Qu.: 0.0
## Mode :character Mode :character Median : 0 Median : 0.0
## Mean : 1078 Mean : 87.3
## 3rd Qu.: 0 3rd Qu.: 0.0
## Max. :99999 Max. :4356.0
## hours.per.week native.country income
## Min. : 1.00 Length:32561 Length:32561
## 1st Qu.:40.00 Class :character Class :character
## Median :40.00 Mode :character Mode :character
## Mean :40.44
## 3rd Qu.:45.00
## Max. :99.00Las 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:
- age: La edad puede reflejar experiencia laboral acumulada.
- education.num: Nivel educativo numérico, asociado con la formación académica y las oportunidades de empleo.
- hours.per.week: Horas trabajadas por semana, permite analizar si una mayor dedicación laboral influye en los ingresos.
- occupation: La ocupación aporta información sobre el tipo de trabajo y su posible relación con los ingresos.
- marital.status: El estado civil puede estar asociado a diferencias en los ingresos entre distintos grupos.
- sex: Permite identificar posibles diferencias de ingresos entre hombres y mujeres.
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
datos2 <- datos %>%
select(age,
education.num,
hours.per.week,
occupation,
marital.status,
sex,
income)
summary(datos2)## age education.num hours.per.week occupation
## Min. :17.00 Min. : 1.00 Min. : 1.00 Length:32561
## 1st Qu.:28.00 1st Qu.: 9.00 1st Qu.:40.00 Class :character
## Median :37.00 Median :10.00 Median :40.00 Mode :character
## Mean :38.58 Mean :10.08 Mean :40.44
## 3rd Qu.:48.00 3rd Qu.:12.00 3rd Qu.:45.00
## Max. :90.00 Max. :16.00 Max. :99.00
## marital.status sex income
## Length:32561 Length:32561 Length:32561
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
## ##
## ? Adm-clerical Armed-Forces Craft-repair
## 1843 3770 9 4099
## Exec-managerial Farming-fishing Handlers-cleaners Machine-op-inspct
## 4066 994 1370 2002
## Other-service Priv-house-serv Prof-specialty Protective-serv
## 3295 149 4140 649
## Sales Tech-support Transport-moving
## 3650 928 1597##
## <=50K >50K
## 24720 7841# se eliminan registros con ocupacion desconocida
datos2 <- datos2 %>%
filter(occupation != "?")
table(datos2$occupation)##
## Adm-clerical Armed-Forces Craft-repair Exec-managerial
## 3770 9 4099 4066
## Farming-fishing Handlers-cleaners Machine-op-inspct Other-service
## 994 1370 2002 3295
## Priv-house-serv Prof-specialty Protective-serv Sales
## 149 4140 649 3650
## Tech-support Transport-moving
## 928 1597datos2$occupation <- as.factor(datos2$occupation)
datos2$marital.status <- as.factor(datos2$marital.status)
datos2$sex <- as.factor(datos2$sex)
datos2$income <- as.factor(datos2$income)
str(datos2)## tibble [30,718 × 7] (S3: tbl_df/tbl/data.frame)
## $ age : num [1:30718] 82 54 41 34 38 74 68 41 45 38 ...
## $ education.num : num [1:30718] 9 4 10 9 6 16 9 10 16 15 ...
## $ hours.per.week: num [1:30718] 18 40 40 45 40 20 40 60 35 45 ...
## $ occupation : Factor w/ 14 levels "Adm-clerical",..: 4 7 10 8 1 10 10 3 10 10 ...
## $ marital.status: Factor w/ 7 levels "Divorced","Married-AF-spouse",..: 7 1 6 1 6 5 1 5 1 5 ...
## $ sex : Factor w/ 2 levels "Female","Male": 1 1 1 1 2 1 1 2 1 2 ...
## $ income : Factor w/ 2 levels "<=50K",">50K": 1 1 1 1 1 2 1 2 2 2 ...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.
set.seed(123)
menor_50 <- datos2 %>%
filter(income == "<=50K") %>%
sample_n(10000)
mayor_50 <- datos2 %>%
filter(income == ">50K")
datos_balance <- rbind(menor_50, mayor_50)
table(datos_balance$income)##
## <=50K >50K
## 10000 7650##
## <=50K >50K
## 0.5665722 0.43342782.4 División entrenamiento y prueba
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 7El 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.
3. 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")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 = "steelblue") +
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. Resultados del Modelo
4.1 Modelo de Regresión Logística (Logit)
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)# 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
# 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")
control <- trainControl(method = "cv",
number = 5)
set.seed(123)
modelo_knn <- train(income ~ .,
data = train,
method = "knn",
preProcess = c("center", "scale"),
tuneLength = 15,
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.7925536 0.5797217
## 7 0.7982193 0.5905843
## 9 0.7986240 0.5916978
## 11 0.7987050 0.5917440
## 13 0.7994334 0.5933498
## 15 0.7991097 0.5926794
## 17 0.8006475 0.5959212
## 19 0.8022663 0.5991029
## 21 0.7991097 0.5929327
## 23 0.7981384 0.5909710
## 25 0.8004047 0.5957103
## 27 0.8007285 0.5962895
## 29 0.8007285 0.5963783
## 31 0.8008903 0.5966872
## 33 0.7994334 0.5939562
##
## 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 2423 526
## >50K 577 1769
##
## Accuracy : 0.7917
## 95% CI : (0.7805, 0.8026)
## No Information Rate : 0.5666
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.577
##
## Mcnemar's Test P-Value : 0.1322
##
## Sensitivity : 0.8077
## Specificity : 0.7708
## Pos Pred Value : 0.8216
## Neg Pred Value : 0.7540
## Prevalence : 0.5666
## Detection Rate : 0.4576
## Detection Prevalence : 0.5569
## Balanced Accuracy : 0.7892
##
## '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
4.3 Comparación de modelos
data.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))
)Ambos modelos presentan un desempeño similar. El KNN supera ligeramente al Logit en accuracy (79.2% vs 78.9%) y especificidad (77.1% vs 76.3%), mientras que el Logit obtiene un AUC superior (0.876 vs 0.870), lo que indica una mejor capacidad de discriminación general entre las dos clases.
5. Conclusiones
Los resultados obtenidos permiten responder de forma satisfactoria la pregunta de investigación planteada. Las variables incluidas en los modelos — edad, nivel educativo, horas trabajadas, ocupación, estado civil y sexo — muestran efectos estadísticamente significativos sobre la probabilidad de obtener ingresos superiores a 50K anuales.
En particular, el estado civil casado, las ocupaciones ejecutivas y de especialización profesional, y un mayor nivel educativo son los factores más fuertemente asociados con ingresos altos. Por el contrario, ocupaciones como agricultura y servicios domésticos, así como nunca haber estado casado, reducen considerablemente esa probabilidad.
Respecto a los modelos de clasificación, ambos lograron un desempeño aceptable con un accuracy cercano al 79%. Sin embargo, se recomienda el modelo Logit por dos razones: primero, obtiene un AUC más alto (0.876 vs 0.870), lo que indica una mejor capacidad general para distinguir entre las dos categorías de ingreso; segundo, y más importante, el Logit permite interpretar el efecto de cada variable a través de los odds ratios, lo que resulta valioso en un problema de análisis social donde no solo importa predecir sino también entender qué factores explican las diferencias en los ingresos.
Considerando los resultados obtenidos, se puede afirmar que el modelo
ajustado sí logró responder al objetivo de la investigación. Los
coeficientes son significativos, el AUC supera 0.87 y las métricas de
clasificación son razonables dado el nivel de complejidad del problema.
No obstante, sería posible mejorar el desempeño incorporando variables
adicionales como el tipo de empleo (workclass) o el capital
ganado (capital.gain), que no fueron incluidas en este
ejercicio.
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).