Actividad 5
Arlet Montoya
2026-06-12
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.
if (!require("tidyverse")) install.packages("tidyverse")## Cargando paquete requerido: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("caret")) install.packages("caret")## Cargando paquete requerido: caret## Warning: package 'caret' was built under R version 4.5.3## Cargando paquete requerido: lattice
##
## Adjuntando el paquete: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(tidyverse)
library(caret)
train_url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.data"
test_url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/adult/adult.test"
col_names <- c("age", "workclass", "fnlwgt", "education", "education_num",
"marital_status", "occupation", "relationship", "race", "sex",
"capital_gain", "capital_loss", "hours_per_week", "native_country", "income")
train_data <- read_csv(train_url, col_names = col_names,
na = c("?", " ?", "? ", "NA"), show_col_types = FALSE)
test_data <- read_csv(test_url, col_names = col_names,
na = c("?", " ?", "? ", "NA"), skip = 1, show_col_types = FALSE)
df <- bind_rows(train_data, test_data)# Dimensiones del dataset completo
cat("Dimensiones del dataset:", dim(df), "\n")## Dimensiones del dataset: 48842 15# Tipos de variables y primeras observaciones
str(df)## spc_tbl_ [48,842 × 15] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ age : num [1:48842] 39 50 38 53 28 37 49 52 31 42 ...
## $ workclass : chr [1:48842] "State-gov" "Self-emp-not-inc" "Private" "Private" ...
## $ fnlwgt : num [1:48842] 77516 83311 215646 234721 338409 ...
## $ education : chr [1:48842] "Bachelors" "Bachelors" "HS-grad" "11th" ...
## $ education_num : num [1:48842] 13 13 9 7 13 14 5 9 14 13 ...
## $ marital_status: chr [1:48842] "Never-married" "Married-civ-spouse" "Divorced" "Married-civ-spouse" ...
## $ occupation : chr [1:48842] "Adm-clerical" "Exec-managerial" "Handlers-cleaners" "Handlers-cleaners" ...
## $ relationship : chr [1:48842] "Not-in-family" "Husband" "Not-in-family" "Husband" ...
## $ race : chr [1:48842] "White" "White" "White" "Black" ...
## $ sex : chr [1:48842] "Male" "Male" "Male" "Male" ...
## $ capital_gain : num [1:48842] 2174 0 0 0 0 ...
## $ capital_loss : num [1:48842] 0 0 0 0 0 0 0 0 0 0 ...
## $ hours_per_week: num [1:48842] 40 13 40 40 40 40 16 45 50 40 ...
## $ native_country: chr [1:48842] "United-States" "United-States" "United-States" "United-States" ...
## $ income : chr [1:48842] "<=50K" "<=50K" "<=50K" "<=50K" ...
## - attr(*, "spec")=
## .. cols(
## .. age = col_double(),
## .. workclass = col_character(),
## .. fnlwgt = col_double(),
## .. education = col_character(),
## .. education_num = col_double(),
## .. marital_status = col_character(),
## .. occupation = col_character(),
## .. relationship = col_character(),
## .. race = col_character(),
## .. sex = col_character(),
## .. capital_gain = col_double(),
## .. capital_loss = col_double(),
## .. hours_per_week = col_double(),
## .. native_country = col_character(),
## .. income = col_character()
## .. )
## - attr(*, "problems")=<externalptr># Conteo de valores faltantes por columna
cat("\nValores faltantes por columna:\n")##
## Valores faltantes por columna:print(colSums(is.na(df)))## age workclass fnlwgt education education_num
## 0 2799 0 0 0
## marital_status occupation relationship race sex
## 0 2809 0 0 0
## capital_gain capital_loss hours_per_week native_country income
## 0 0 0 857 0Se opta por eliminación listwise
(drop_na()): se eliminan todas las filas que contienen al
menos un valor faltante. Los valores faltantes se concentran en tres
variables categóricas (workclass, occupation,
native_country) y representan aproximadamente el 2
% del total de registros, por lo que su eliminación no
introduce un sesgo relevante. Imputar variables categóricas con moda
puede distorsionar la distribución real de categorías minoritarias,
especialmente en native_country, que tiene alta
cardinalidad.
df <- drop_na(df)
cat("Dimensiones tras eliminar filas con NA:", dim(df), "\n")## Dimensiones tras eliminar filas con NA: 45222 15# Limpieza y codificación de la variable objetivo
df <- df %>%
mutate(
income = str_trim(income),
income = as.factor(ifelse(grepl(">50K", income), 1, 0))
)
# Verificar orden de niveles
cat("Niveles de income:", levels(df$income), "\n")## Niveles de income: 0 1# Distribución de clases
prop_clases <- prop.table(table(df$income))
cat("\nDistribución de clases:\n")##
## Distribución de clases:print(round(prop_clases * 100, 2))##
## 0 1
## 75.22 24.78Aproximadamente el 24 % de los individuos gana más de 50 K USD anuales, mientras que el 76 % restante gana 50 K o menos. Este desbalance de clases puede afectar al modelado de las siguientes formas:
- Los modelos tienden a sesgar sus predicciones hacia la clase mayoritaria (≤50K), obteniendo un accuracy elevado pero con baja sensibilidad para detectar la clase minoritaria (>50K).
- Métricas como accuracy pueden ser engañosas; es preferible complementarlas con sensibilidad, especificidad y eventualmente AUC-ROC.
# Visualización 1: Ingreso por nivel educativo
ggplot(df,
aes(x = education,
fill = income)) +
geom_bar(position = "fill") +
labs(
title = "Proporción de ingreso según educación",
x = "Nivel educativo",
y = "Proporción"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45))
# Visualización 2: Ingreso por ocupación
ggplot(df,
aes(x = occupation,
fill = income)) +
geom_bar(position = "fill") +
labs(
title = "Proporción de ingreso según ocupación",
x = "Ocupación",
y = "Proporción"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
# Visualización 3: Ingreso por sexo
ggplot(df,
aes(x = sex,
fill = income)) +
geom_bar(position = "fill") +
labs(
title = "Proporción de ingreso según sexo",
x = "Sexo",
y = "Proporción"
) +
theme_minimal()
Las variables categóricas se convierten a factores. Las variables
numéricas se estandarizan (media = 0, desviación estándar = 1) porque la
regresión logística es sensible a la escala. El dataset se divide en
70 % entrenamiento y 30 % prueba con
semilla fija para reproducibilidad.
df <- df %>%
mutate(across(where(is.character), as.factor)) %>%
mutate(across(where(is.numeric) & !all_of("income"),
~ as.vector(scale(.))))
set.seed(123)
index <- createDataPartition(df$income, p = 0.7, list = FALSE)
train_set <- df[ index, ]
test_set <- df[-index, ]
cat("Dimensiones entrenamiento:", dim(train_set), "\n")## Dimensiones entrenamiento: 31656 15cat("Dimensiones prueba: ", dim(test_set), "\n")## Dimensiones prueba: 13566 15Se elige Regresión Logística como primer modelo por
ser el clasificador binario de referencia: interpretable, rápido y
adecuado cuando se sospecha una relación aproximadamente lineal entre
los predictores y el log-odds de la clase positiva. Se usan las
variables que, según el EDA, mostraron mayor asociación visual con el
ingreso: age, education_num, sex,
hours_per_week y occupation.
glm.df <- glm(income ~ age + education_num + sex + hours_per_week + occupation,
data = train_set,
family = binomial(link = "logit"))
summary(glm.df)##
## Call:
## glm(formula = income ~ age + education_num + sex + hours_per_week +
## occupation, family = binomial(link = "logit"), data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.42570 0.05501 -44.098 < 2e-16 ***
## age 0.58619 0.01673 35.035 < 2e-16 ***
## education_num 0.67435 0.02041 33.032 < 2e-16 ***
## sexMale 1.18885 0.04017 29.592 < 2e-16 ***
## hours_per_week 0.37832 0.01673 22.615 < 2e-16 ***
## occupationArmed-Forces 0.41407 0.68253 0.607 0.544067
## occupationCraft-repair 0.08943 0.06678 1.339 0.180537
## occupationExec-managerial 0.84420 0.06249 13.509 < 2e-16 ***
## occupationFarming-fishing -1.16140 0.12039 -9.647 < 2e-16 ***
## occupationHandlers-cleaners -0.89673 0.12512 -7.167 7.67e-13 ***
## occupationMachine-op-inspct -0.29959 0.08870 -3.377 0.000732 ***
## occupationOther-service -1.14909 0.10462 -10.984 < 2e-16 ***
## occupationPriv-house-serv -3.18038 1.07698 -2.953 0.003146 **
## occupationProf-specialty 0.54071 0.06484 8.339 < 2e-16 ***
## occupationProtective-serv 0.28447 0.10494 2.711 0.006712 **
## occupationSales 0.24583 0.06630 3.708 0.000209 ***
## occupationTech-support 0.43437 0.09252 4.695 2.67e-06 ***
## occupationTransport-moving -0.04802 0.08463 -0.567 0.570399
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 35452 on 31655 degrees of freedom
## Residual deviance: 26747 on 31638 degrees of freedom
## AIC: 26783
##
## Number of Fisher Scoring iterations: 7# Predicción sobre el conjunto de prueba
prob_logit <- predict(glm.df, newdata = test_set, type = "response")
pred_logit <- as.factor(ifelse(prob_logit > 0.5, 1, 0))
pred_logit <- factor(pred_logit, levels = levels(test_set$income))
# Matriz de confusión
cm_logit <- confusionMatrix(pred_logit, test_set$income, positive = "1")
print(cm_logit)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 9462 1914
## 1 742 1448
##
## Accuracy : 0.8042
## 95% CI : (0.7974, 0.8109)
## No Information Rate : 0.7522
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4054
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.4307
## Specificity : 0.9273
## Pos Pred Value : 0.6612
## Neg Pred Value : 0.8318
## Prevalence : 0.2478
## Detection Rate : 0.1067
## Detection Prevalence : 0.1614
## Balanced Accuracy : 0.6790
##
## 'Positive' Class : 1
## Se elige Random Forest como segundo modelo porque, a diferencia de la regresión logística, puede capturar relaciones no lineales e interacciones entre variables sin necesidad de especificarlas explícitamente. Además, es robusto frente al desbalance moderado de clases y proporciona una medida de importancia de variables útil para la interpretación. Se usan las mismas variables predictoras para facilitar la comparación directa con el modelo anterior.
if (!require("randomForest")) install.packages("randomForest")## Cargando paquete requerido: randomForest## Warning: package 'randomForest' was built under R version 4.5.3## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Adjuntando el paquete: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginlibrary(randomForest)
set.seed(123)
modelo_rf <- randomForest(
income ~ age + education_num + sex + hours_per_week + occupation,
data = train_set,
ntree = 100,
importance = TRUE
)
print(modelo_rf)##
## Call:
## randomForest(formula = income ~ age + education_num + sex + hours_per_week + occupation, data = train_set, ntree = 100, importance = TRUE)
## Type of random forest: classification
## Number of trees: 100
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 19.57%
## Confusion matrix:
## 0 1 class.error
## 0 21821 1989 0.08353633
## 1 4207 3639 0.53619679# Importancia de variables
importancia_vars <- importance(modelo_rf)
cat("\nImportancia de variables:\n")##
## Importancia de variables:print(round(importancia_vars, 2))## 0 1 MeanDecreaseAccuracy MeanDecreaseGini
## age 23.45 72.22 77.88 1991.59
## education_num 19.95 57.06 63.42 1406.57
## sex 26.46 55.42 52.65 472.17
## hours_per_week 3.37 47.08 37.83 1125.79
## occupation 16.32 43.45 57.71 1213.10varImpPlot(modelo_rf, main = "Importancia de Variables (Random Forest)")
# Predicción de clases
pred_rf <- predict(modelo_rf, newdata = test_set)
# Predicción de probabilidades
prob_rf <- predict(modelo_rf, newdata = test_set, type = "prob")[, "1"]
# Matriz de confusión
cm_rf <- confusionMatrix(pred_rf, test_set$income, positive = "1")
print(cm_rf)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 9383 1778
## 1 821 1584
##
## Accuracy : 0.8084
## 95% CI : (0.8017, 0.815)
## No Information Rate : 0.7522
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4319
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.4711
## Specificity : 0.9195
## Pos Pred Value : 0.6586
## Neg Pred Value : 0.8407
## Prevalence : 0.2478
## Detection Rate : 0.1168
## Detection Prevalence : 0.1773
## Balanced Accuracy : 0.6953
##
## 'Positive' Class : 1
## #Parte 4. Contraste y discusión económica
# Extracción de métricas de ambos modelos
metricas <- data.frame(
Metrica = c("Accuracy (Exactitud)", "Sensitivity (Sensibilidad / Recall)",
"Specificity (Especifidad)", "Balanced Accuracy"),
Regresion_Logistica = c(cm_logit$overall["Accuracy"], cm_logit$byClass["Sensitivity"],
cm_logit$byClass["Specificity"], cm_logit$byClass["Balanced Accuracy"]),
Random_Forest = c(cm_rf$overall["Accuracy"], cm_rf$byClass["Sensitivity"],
cm_rf$byClass["Specificity"], cm_rf$byClass["Balanced Accuracy"])
)
# Renderizar tabla limpia
knitr::kable(metricas, digits = 4, caption = "Comparativa de Rendimiento: Regresión Logística vs. Random Forest")| Metrica | Regresion_Logistica | Random_Forest | |
|---|---|---|---|
| Accuracy | Accuracy (Exactitud) | 0.8042 | 0.8084 |
| Sensitivity | Sensitivity (Sensibilidad / Recall) | 0.4307 | 0.4711 |
| Specificity | Specificity (Especifidad) | 0.9273 | 0.9195 |
| Balanced Accuracy | Balanced Accuracy | 0.6790 | 0.6953 |
¡Hola, Alejandra! Tienes un excelente trabajo avanzado. El código está muy limpio, bien estructurado en R y la lógica de preprocesamiento es impecable para el dataset Adult.
Como mencionas que solo te falta la Parte 4 (Contraste y
discusión económica), aquí tienes el desarrollo analítico y
económico de esa sección. Para que tu reporte en R Markdown
(.Rmd) quede completamente terminado, he estructurado esta
respuesta de dos formas: primero, el bloque de código R
que debes pegar para generar la tabla comparativa de métricas
automáticamente, y segundo, el texto de análisis
económico redactado listo para tu reporte.
Parte 4. Contraste y discusión económica
# Extracción de métricas de ambos modelos
metricas <- data.frame(
Metrica = c("Accuracy (Exactitud)", "Sensitivity (Sensibilidad / Recall)",
"Specificity (Especifidad)", "Balanced Accuracy"),
Regresion_Logistica = c(cm_logit$overall["Accuracy"], cm_logit$byClass["Sensitivity"],
cm_logit$byClass["Specificity"], cm_logit$byClass["Balanced Accuracy"]),
Random_Forest = c(cm_rf$overall["Accuracy"], cm_rf$byClass["Sensitivity"],
cm_rf$byClass["Specificity"], cm_rf$byClass["Balanced Accuracy"])
)
# Renderizar tabla limpia
knitr::kable(metricas, digits = 4, caption = "Comparativa de Rendimiento: Regresión Logística vs. Random Forest")| Metrica | Regresion_Logistica | Random_Forest | |
|---|---|---|---|
| Accuracy | Accuracy (Exactitud) | 0.8042 | 0.8084 |
| Sensitivity | Sensitivity (Sensibilidad / Recall) | 0.4307 | 0.4711 |
| Specificity | Specificity (Especifidad) | 0.9273 | 0.9195 |
| Balanced Accuracy | Balanced Accuracy | 0.6790 | 0.6953 |
Parte 4. Contraste y discusión económica
1. ¿Cuándo preferiría un economista cada modelo? (Interpretabilidad vs. Predicción)
Regresión Logística (Interpretabilidad): Un economista elegirá este modelo cuando su prioridad sea explicar las causas y entender el “por qué”. Como este modelo nos da coeficientes, nos permite medir el impacto exacto de cada variable. Por ejemplo, permite decir con claridad: “Si una persona estudia un año más, la probabilidad de que gane más de 50K aumenta en un porcentaje específico”. Es el modelo ideal para diseñar leyes o justificar políticas públicas basadas en causas claras.
Random Forest (Poder Predictivo): Se elegirá cuando el objetivo principal sea atinarle al resultado con la mayor precisión posible. Este modelo es excelente para encontrar patrones complejos sin que se los tengamos que pedir (por ejemplo, cómo cambia el ingreso combinando la edad, el sexo y el tipo de trabajo a la vez). Aunque no nos da una fórmula simple para explicarlo, es el mejor si queremos identificar con exactitud qué personas tienen ingresos altos o bajos para, por ejemplo, repartir apoyos del gobierno sin equivocarnos.
2. Importancia de las variables: ¿Qué nos dicen sobre el ingreso?
Ambos modelos coinciden en cuáles son las variables más importantes para determinar si alguien gana bien. Esto nos deja tres conclusiones
Educación y Edad: Son los factores más potentes. Esto confirma la teoría económica de que estudiar más y ganar experiencia (representada por la edad) son las mejores herramientas para aumentar la productividad y, por lo tanto, el salario.
El tipo de trabajo (Ocupación):No solo importa cuánto estudiaste, sino en qué trabajas. Los puestos ejecutivos o especializados tienen una ventaja enorme frente a los sectores de servicios o soporte, lo que demuestra que el mercado laboral paga de forma muy desigual según el sector.
El Sexo: Sale como una variable muy importante en ambos modelos. Esto significa que, desafortunadamente, el género sigue pesando a la hora de definir los ingresos, incluso si comparamos a personas con los mismos estudios y el mismo trabajo.
3. Propuestas de Política Pública
Basándonos en estos resultados, el gobierno podría implementar lo siguiente
1.Invertir en educación útil: Como la educación es el motor principal para ganar más, no basta con abrir escuelas; se debe guiar a los jóvenes hacia las carreras y habilidades técnicas que el mercado laboral realmente valora y paga mejor.
2.Combatir la brecha de género: Dado que el sexo influye en el ingreso por sí solo, se necesitan guarderías públicas gratuitas para que las mujeres no tengan que reducir sus horas de trabajo, además de reglas estrictas en las empresas para asegurar “a igual trabajo, igual salario”.
3.Reducir el subempleo: Las horas trabajadas a la semana son vitales. Se deben crear incentivos para que los empleos de pocas horas se conviertan en puestos de tiempo completo con prestaciones de ley, evitando que la gente se quede atrapada en sueldos bajos. ```