Exam_grupal

Parte 1: Identificación de problemas en los datos:

glimpse(dat)

## Rows: 100
## Columns: 12
## $ ID                   <chr> "1", "2", "3", "4", "5", "6", "7", "8", "9", "10"…
## $ Edad                 <dbl> 39, 40, 27, NA, 43, NA, 54, 30, 39, 47, 50, 27, 6…
## $ Salario              <dbl> 21194, 35185, 55264, 59451, 34924, 67882, 41235, …
## $ Experiencia          <dbl> 12, 13, 32, 5, 21, 34, 23, 18, 38, 25, 31, 34, 38…
## $ Ciudad               <chr> "Caguas", "Caguas", "Bayamón", "Caguas", "Bayamón…
## $ Nivel_Educativo      <chr> "Universitario", "Universitario", "Primaria", "Un…
## $ Horas_Trabajo_Semana <dbl> 51, 31, 50, 34, 20, 54, 59, 34, 21, 20, 30, 22, 4…
## $ Estado_Civil         <chr> "Divorciado", "Soltero", NA, "Divorciado", "Solte…
## $ Sector_Laboral       <chr> "Independiente", "Privado", "Público", "Privado",…
## $ Cantidad_Hijos       <dbl> NA, 1, 4, 1, 5, 5, 2, 5, 1, 5, 2, 4, 3, 4, NA, 3,…
## $ Propietario_Vivienda <chr> "No", "Sí", "No", "Sí", "Sí", "Sí", "Sí", "No", "…
## $ Rango_Salario        <chr> "Bajo", "Medio", "Medio", "Medio", "Medio", "Alto…

Problemas

1. Datos Faltantes

pct_miss_case(dat)

## [1] 44

dat %>% is.na() %>% colSums()

##                   ID                 Edad              Salario 
##                    0                    9                    9 
##          Experiencia               Ciudad      Nivel_Educativo 
##                   13                    5                    2 
## Horas_Trabajo_Semana         Estado_Civil       Sector_Laboral 
##                    3                    2                    2 
##       Cantidad_Hijos Propietario_Vivienda        Rango_Salario 
##                    8                    4                    9

 dat %>% aggr(combined = TRUE, numbers = TRUE, sortVars=TRUE, 
      labels=names(dat), cex.axis=.7, gap=3, 
      ylab=c("Proporcion de Datos Faltantes","Patron de Datos Faltantes"))

## 
##  Variables sorted by number of missings: 
##              Variable Count
##           Experiencia    13
##                  Edad     9
##               Salario     9
##         Rango_Salario     9
##        Cantidad_Hijos     8
##                Ciudad     5
##  Propietario_Vivienda     4
##  Horas_Trabajo_Semana     3
##       Nivel_Educativo     2
##          Estado_Civil     2
##        Sector_Laboral     2
##                    ID     0

Se identificó que el 44% de las variables presentan datos faltantes, concentrados principalmente en las variables de Experiencia, Edad, Salario y Cantidad de Hijos. Se concluye que Rango de Salario, al ser una variable derivada de Salario, presenta la misma cantidad de observaciones faltantes, con una frecuencia de datos incompletos para esta combinación del 0.04. La data faltante presenta un patrón de co-ocurrencia, lo que sugiere que un segmento específico de la muestra omitió responder el bloque de preguntas demográficas y socioeconómicas en su totalidad. Esta estructura indica que la causa de la pérdida de información es de tipo MAR (Missing at Random), relacionando los datos incompletos con otras variables observadas. Debido a esta naturaleza multivariante y la presencia de datos mixtos (discretos, binarios y categóricos), se optará por una Imputación Múltiple por Ecuaciones Encadenadas (MICE), Random Forest , y Regresión Múltiple . Este procedimiento permitirá generar valores que respeten la distribución original de la muestra y mantengan la integridad de las correlaciones, evitando el sesgo que producirían métodos de imputaccion sin iterar.

Parte 2: Imputación de datos:

 diff_Eda_rg= c()
 diff_Eda_rf= c()
 diff_Eda_mice= c()
 diff_Exp_rg= c()
 diff_Exp_rf= c()
 diff_Exp_mice= c()
 diff_Sal_rg= c()
 diff_Sal_rf= c()
 diff_Sal_mice= c()
 for (i in 1:5) {
 Imput_reg_mult <- mice(dat, method = "norm.predict", m = 1, print = FALSE)
 Complete_reg_mult <- mice::complete(Imput_reg_mult)
   
 Imput_mice <- mice(dat, method = "pmm", m = 1, print = FALSE)  
 Complete_mice <- mice::complete(Imput_mice)
 
 Imput_rf <- mice(dat, method = "rf", m = 1, print = FALSE)
 Complete_rf <- mice::complete(Imput_rf)
 
 diff_Sal_mice <- c(diff_Sal_mice,  mapc(dat$Salario, Complete_mice$Salario))
 diff_Sal_rf   <- c(diff_Sal_rf, mapc(dat$Salario, Complete_rf$Salario))
 diff_Sal_rg =    c(diff_Sal_rg , mapc(dat$Salario, Complete_reg_mult$Salario))
 
 diff_Exp_mice = c( diff_Exp_mice ,mapc (dat$Experiencia , Complete_mice$Experiencia))
 diff_Exp_rf= c( diff_Exp_rf ,mapc (dat$Experiencia , Complete_rf$Experiencia))
 diff_Exp_rg= c( diff_Exp_rg ,mapc (dat$Experiencia , Complete_reg_mult$Experiencia))
 
 
 diff_Eda_mice = c( diff_Eda_mice ,mapc (dat$Edad , Complete_mice$Edad))
 diff_Eda_rf= c( diff_Eda_rf ,mapc (dat$Edad , Complete_rf$Edad))
 diff_Eda_rg= c( diff_Eda_rg ,mapc (dat$Edad , Complete_reg_mult$Edad))
 }

• Gráfico de densidad para variables cuantitativas

p2 <- ggplot(data_long_fact, aes(x = Valor, color = Origen, fill = Origen, text = paste("Metodo:", Origen))) +
  geom_density(alpha = 0.2) +
  facet_wrap(~Variable, scales = "free") + 
  labs(title = "Comparacion de Imputacion Multivariada", x = "Variables", y = "Densidad") +
  theme_minimal()


ggplotly(p2, tooltip = c("text", "x", "y"))

p <- ggplot(data_long, aes(x = Valor, color = Origen, fill = Origen, text = paste("Metodo:", Origen))) +
  geom_density(alpha = 0.2) +
  facet_wrap(~Variable, scales = "free") + 
  labs(title = "Comparacion de Imputacion Multivariada", x = "Variables", y = "Densidad") +
  theme_minimal()

ggplotly(p, tooltip = c("text", "x", "y")) 

• Random Forest : Fue el método que mejor preservó la estructura y distribución original de la data. Presentó la menor desviación en las variables críticas de Edad, Salario y Cantidad de Hijos. Su capacidad para manejar relaciones no lineales permitió una reconstrucción más fiel de la realidad.
• MICE : Se posicionó como el segundo mejor método. No obstante, mostró debilidades en la variable Experiencia (la cual tiene el mayor volumen de valores faltantes), generando una sobreestimación de los datos predictivos que podría sesgar los resultados.
• Regresión Lineal : Fue el método menos efectivo, presentando la mayor desalineación respecto a la estructura original. Generó “picos artificiales” cuya inferencias y conclusiones estuvieran subjetos a sesgos , lo que obliga a su descarte

Tras evaluar las tres técnicas de imputación, se determinó que Random Forest es la estrategia más adecuada para este conjunto de datos. Al elegir Random Forest, la imputación no será afectada por la necesidad de una distribución normal en los datos, dado a que este basado método no paramétricos. Aunque el riesgo de introducir sesgos artifíciales en las variables como Edad y Experiencia en comparación con los otros métodos es menor, se debe considerar el impacto de la información generada sobre la relación de las variables de estudio. Es fundamental considerar que Random Forest no puede extrapolar valores fuera del rango observado en el entrenamiento. Esto significa que el análisis posterior podría subestimar valores extremos.

Parte 3: Discretización y modificación:

Factores Ordinales (Nivel Educativo y Rango Salario)

Complete_rf$Rango_Salario <- factor(Complete_rf$Rango_Salario, 
                              levels = c("Bajo", "Medio", "Alto"), 
                              ordered = TRUE)


Complete_rf$Nivel_Educativo = factor( Complete_rf$Nivel_Educativo ,
                              levels = c("Primaria" ,"Secundaria" , "Universitario"),
                              ordered= TRUE)

Se definen niveles específicos para las variables Rango_Salario y Nivel_Educativo debido a su naturaleza ordinal. Establecer este orden explícitamente en R garantiza que las visualizaciones y los análisis estadísticos respeten la progresión real de los datos

Eliminación de tildes

Complete_rf$Ciudad = recode(Complete_rf$Ciudad, "Bayam\u00f3n" = "Bayamon")


Complete_rf$Sector_Laboral = recode(Complete_rf$Sector_Laboral, "P\u00fablico" = "Publico")

Se procedió a normalizar los caracteres eliminando tildes y caracteres especiales para evitar errores de codificación durante la importación y procesamiento en R

Definir los puntos de corte

cortes <- c(18, 30, 50, 80)
etiquetas <- c("Joven", "Adulto", "Senior")
Complete_rf$Edad= cut(Complete_rf$Edad, breaks = cortes, labels = etiquetas, right = FALSE)

La discretización de las variables ‘Edad’ mediante los cortes es necesaria para transformar variables discretas en categorías ordinales. Esto reduce la dispersión, facilita la detección de patrones en gráficos y mejora la interpretabilidad del análisis.

Parte 4: Visualización avanzada

Mapa de calor

corr <- cor(dplyr::select_if(Complete_rf, is.numeric))
plot_ly(colors = "RdBu") %>%
  add_heatmap(x = rownames(corr), y = colnames(corr), z = corr) %>%
  colorbar(limits = c(-1, 1))

Las variables de estudio possen una relacion debil entre si . Demostrando que no hay una causalidad o dependencia entre la S No hay un patron de codependencia en las variables selecionadas

Gráfico de barras interactivo

plot_ly(Complete_rf, x = ~Cantidad_Hijos, color = ~Rango_Salario) 

• Se observa una distribución multimodal donde el nivel de salario “Medio” predomina en la mayoría de las categorías de cantidad de hijos, alcanzando su frecuencia máxima en individuos sin hijos

• Los participantes con salarios más altos muestran una preferencia por familias de 2 hijos o por no tener hijos

• Los individuos con salario “Bajo” representan la minoría en casi todos los niveles de cantidad de hijos , mostrando su mayor participación relativa en el grupo de 3 hijos, donde superan en frecuencia a los individuos de salario alto.

Gráfico de dispersión

plot_ly(Complete_rf, x = ~as.numeric(Experiencia), y = ~Salario, color = ~as.numeric(Experiencia), 
        type = "scatter", 
        mode = "markers",
        marker = list(size = 10, opacity = 0.7))%>%
  layout(xaxis = list(title = "Experiencia (Años)"))

La ausencia de una tendencia lineal entre la experiencia y el salario sugiere que la primera no es un predictor sólido del nivel de ingresos en este conjunto de datos. Se observa una alta variabilidad; por ejemplo, individuos con nula experiencia acceden a salarios medios (30k-60k). Asimismo, destaca un caso atípico (outlier) donde un individuo con la mayor experiencia registrada percibe un salario inferior a 40k, lo cual refuerza la falta de correlación directa entre años de experiencia y ingreso.