library(dplyr)
library(tidyverse)
library(pacman)
library(readr)
library(ggplot2)
library(plotly)
library(readr)
library(VIM)
library(reshape2)
Grupo_1 <- read_csv("Grupo_1.csv")

En la base de datos hay pocos datos faltantes; hay 67 datos faltantes en total. Adicional, hay grandes inconsistencias en las edades de las personas, pues mencionan tener más años de experiencia que la edad que tienen. Además, hay personas, por ejemplo, que tienen 22 años con 11 años de experiencia.

Como se observaron grandes inconsistencias en las edades y los años de experiencia, se graficó un scatterplot para visualizar mejor en dónde se encuentran las inconsistencias.

vis_inconsistencias <- Grupo_1$Edad > Grupo_1$Experiencia

p <- ggplot(Grupo_1, aes(x = Edad, y = Experiencia)) +
  geom_point(alpha = 0.6) +
  geom_point(aes(color = vis_inconsistencias), size = 2) +
  scale_color_manual(values = c("FALSE" = "red", "TRUE" = "blue")) +
  labs(x = "Edad (años)", y = "Experiencia (años)", title = "Edad vs Experiencia") +
  theme_minimal()
ggplotly(p)

Al observar estas inconsistencias de la data, se eliminarán las filas que tengan mayor experiencia que edad

Grupo_1.4 <- Grupo_1[!(Grupo_1$Experiencia >= Grupo_1$Edad & 
                         is.na(Grupo_1$Experiencia) == FALSE & 
                         is.na(Grupo_1$Edad) == FALSE), ]

Igualmente se eliminó aquellos que lleven trabajando desde antes de los 13 años, pues la edad en Puerto Rico para trabajar es desde los 14 (Ley Núm. 230 de 12 de mayo de 1942, según enmendada). Se puso desde 13 por el caso de que hayan habido personas trabajando desde los 13 por razones desconocidas.

Grupo_1.4 <- Grupo_1.4[!((Grupo_1.4$Edad - Grupo_1.4$Experiencia) < 13 & 
                           is.na(Grupo_1.4$Experiencia) == FALSE & 
                           is.na(Grupo_1.4$Edad) == FALSE), ]

Observar la distribución de la data ya habiendo eliminado la data imposible (no es lógica)

hist_Salario2 <- ggplot(Grupo_1.4, aes(x = Salario)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "skyblue", color = "white", alpha = 0.7) +
  labs(title = "Histograma de Salario", x = "Salario",) +
  theme_minimal()

ggplotly(hist_Salario2)

Al observar la distribución de los datos de salario, se puede ver que no es una distribución normal, por lo que se deberá usar otra estrategia de preprocesamiento que no sea la media, como la regresión, para verificar la correlación entre el salario y diferentes variables, como la educación u horas de trabajo. No se utilizará la media debido a que no sería una representación adecuada de los datos para poder imputar.

Reg_Salario <- lm(Salario ~ Nivel_Educativo, data = Grupo_1.4)
summary(Reg_Salario)
## 
## Call:
## lm(formula = Salario ~ Nivel_Educativo, data = Grupo_1.4)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -29340.2 -12116.2    807.3  16318.7  29786.3 
## 
## Coefficients:
##                              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                   49164.3     3876.0  12.684   <2e-16 ***
## Nivel_EducativoSecundaria       878.9     5623.9   0.156    0.876    
## Nivel_EducativoUniversitario   -219.5     5168.0  -0.042    0.966    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 17760 on 64 degrees of freedom
##   (3 observations deleted due to missingness)
## Multiple R-squared:  0.000705,   Adjusted R-squared:  -0.03052 
## F-statistic: 0.02258 on 2 and 64 DF,  p-value: 0.9777
Reg_Salario2 <- lm(Salario ~ Experiencia, data = Grupo_1.4)
summary(Reg_Salario2)
## 
## Call:
## lm(formula = Salario ~ Experiencia, data = Grupo_1.4)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -29673 -13661    369  16066  32890 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  54331.0     4242.5  12.806   <2e-16 ***
## Experiencia   -247.6      216.4  -1.144    0.258    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 18260 on 53 degrees of freedom
##   (15 observations deleted due to missingness)
## Multiple R-squared:  0.0241, Adjusted R-squared:  0.005684 
## F-statistic: 1.309 on 1 and 53 DF,  p-value: 0.2578
Reg_Salario3 <- lm(Salario ~ Sector_Laboral, data = Grupo_1.4)
summary(Reg_Salario3)
## 
## Call:
## lm(formula = Salario ~ Sector_Laboral, data = Grupo_1.4)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -33180 -13361    283  15567  28340 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              47172       3571  13.211   <2e-16 ***
## Sector_LaboralPrivado     6227       4999   1.246    0.218    
## Sector_LaboralPúblico     4281       5758   0.744    0.460    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 17490 on 61 degrees of freedom
##   (6 observations deleted due to missingness)
## Multiple R-squared:  0.02552,    Adjusted R-squared:  -0.006432 
## F-statistic: 0.7987 on 2 and 61 DF,  p-value: 0.4546

Al eliminar la data imposible, solamente queda un 3.12% de datos faltantes. Se observa igualmente que la regresión no es un método de imputación viable puesto que la relación entre la variable salario y las demás variables no es significante. Se utilizará la imputación con la mediana del salario para el 3.12% de datos faltantes.

Grupo_1.4$Salario[is.na(Grupo_1.4$Salario)] <- median(Grupo_1.4$Salario, na.rm = TRUE)

Para el dato faltante de la edad (1.56% de la variable Edad), se imputará igualmente usando la mediana de esta:

Grupo_1.4$Edad[is.na(Grupo_1.4$Edad)] <- median(Grupo_1.4$Edad, na.rm = TRUE)

Para los datos faltantes de Experiencia, se corroborará si se puede imputar con regresión lineal con la edad, pues son variables altamente relacionadas.

Reg_Exp <- lm(Experiencia ~ Edad, data = Grupo_1.4)
summary(Reg_Exp)
## 
## Call:
## lm(formula = Experiencia ~ Edad, data = Grupo_1.4)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -22.919  -7.831  -1.227   9.251  20.307 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   0.3790     5.9031   0.064  0.94904   
## Edad          0.3522     0.1262   2.791  0.00722 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 10.91 on 55 degrees of freedom
##   (13 observations deleted due to missingness)
## Multiple R-squared:  0.124,  Adjusted R-squared:  0.1081 
## F-statistic: 7.788 on 1 and 55 DF,  p-value: 0.007216

Al no existir una relación significativa entre las variables, se observará la distribución de la data de Experiencia para tomar una decisión para imputar los datos faltantes:

hist_Exp <- ggplot(Grupo_1.4, aes(x = Experiencia)) +
  geom_histogram(aes(y = ..density..), bins = 30, fill = "skyblue", color = "white", alpha = 0.7) +
  labs(title = "Histograma de Experiencia", x = "Experiencia",) +
  theme_minimal()

ggplotly(hist_Exp)

Al observarse un sesgo a la derecha de la data, se imputará usando la mediana de la experiencia:

Grupo_1.4$Experiencia[is.na(Grupo_1.4$Experiencia)] <- median(Grupo_1.4$Experiencia, na.rm = TRUE)

Para los datos faltantes de las Horas de trabajo en la semana, se utilizará la imputación con la mediana, pues los datos tienen un leve sesgo a la derecha.

Grupo_1.4$Horas_Trabajo_Semana[is.na(Grupo_1.4$Horas_Trabajo_Semana)] <- 
  median(Grupo_1.4$Horas_Trabajo_Semana, na.rm = TRUE)

Para los datos de la Cantidad de Hijos, se utilzará también la imputación con la media, pues hay gran cantidad de personas con 0 hijos, por lo que se puede asumir con prudencia que los datos tienen un sesgo a la derecha:

Grupo_1.4$Cantidad_Hijos[is.na(Grupo_1.4$Cantidad_Hijos)] <- 
  median(Grupo_1.4$Cantidad_Hijos, na.rm = TRUE)

Para los datos de la Ciudad, se estará utilizando la imputación con la moda debido a que es una variable categórica:

Grupo_1.4$Ciudad[is.na(Grupo_1.4$Ciudad) | Grupo_1.4$Ciudad == ""] <- 
  mode(Grupo_1.4$Ciudad)

Para las variables restantes se estará utilizando igualmente la imputación mediante la moda pues son variables categóricas:

Grupo_1.4$Estado_Civil[is.na(Grupo_1.4$Estado_Civil)] <- 
  mode(Grupo_1.4$Estado_Civil)
Grupo_1.4$Sector_Laboral[is.na(Grupo_1.4$Sector_Laboral)] <- 
  mode(Grupo_1.4$Sector_Laboral)
Grupo_1.4$Propietario_Vivienda[is.na(Grupo_1.4$Propietario_Vivienda)] <- 
  mode(Grupo_1.4$Propietario_Vivienda)
Grupo_1.4$Rango_Salario[is.na(Grupo_1.4$Rango_Salario) | 
                          Grupo_1.4$Rango_Salario == ""] <- 
  mode(Grupo_1.4$Rango_Salario)

Discretización de los datos

Transformación de variables categóricas

# Verificar variables categóricas 

str(Grupo_1.4)
## tibble [70 × 12] (S3: tbl_df/tbl/data.frame)
##  $ ID                  : num [1:70] 1 3 4 5 6 7 8 9 12 13 ...
##  $ Edad                : num [1:70] 49 22 26 40 26 42 24 62 41 47 ...
##  $ Salario             : num [1:70] 47164 76886 69046 51575 55348 ...
##  $ Experiencia         : num [1:70] 8 1 8 4 3 22 1 15 24 6 ...
##  $ Ciudad              : chr [1:70] "San Juan" "Caguas" "character" "Ponce" ...
##  $ Nivel_Educativo     : chr [1:70] "Secundaria" "Secundaria" "Primaria" "Universitario" ...
##  $ Horas_Trabajo_Semana: num [1:70] 30 46 31 56 57 55 22 50 42 36 ...
##  $ Estado_Civil        : chr [1:70] "Soltero" "Soltero" "Divorciado" "Casado" ...
##  $ Sector_Laboral      : chr [1:70] "Independiente" "Público" "Independiente" "Privado" ...
##  $ Cantidad_Hijos      : num [1:70] 4 4 0 3 5 4 2 2 3 4 ...
##  $ Propietario_Vivienda: chr [1:70] "Sí" "No" "Sí" "Sí" ...
##  $ Rango_Salario       : chr [1:70] "Medio" "Alto" "Alto" "Medio" ...
# Variable Ciudad
# Decisión de convertir a factor nominal puesto que es una etiqueta geográfica sin orden alguno

Grupo_1.4$Ciudad <- as.factor(Grupo_1.4$Ciudad)
levels(Grupo_1.4$Ciudad)
## [1] "Bayamón"   "Caguas"    "character" "Ponce"     "San Juan"
# Variable Nivel educativo
# Decisión de convertir a factor ordenado pues tiene un orden natural

Grupo_1.4$Nivel_Educativo <- factor(Grupo_1.4$Nivel_Educativo, levels = c("Primaria", "Secundaria", "Universitario"),
ordered = TRUE)
levels(Grupo_1.4$Nivel_Educativo)
## [1] "Primaria"      "Secundaria"    "Universitario"
# Variable de estado civil
# Decisión de convertir a factor nominal puesto que no hay un orden establecido entre estados civiles
Grupo_1.4$Estado_Civil <- as.factor(Grupo_1.4$Estado_Civil)
levels(Grupo_1.4$Estado_Civil)
## [1] "Casado"     "character"  "Divorciado" "Soltero"
# Variable de sector laboral
# Decisión de convertir a factor nominal pues no hay un orden establecido entre los sectores
Grupo_1.4$Sector_Laboral <- as.factor(Grupo_1.4$Sector_Laboral)
levels(Grupo_1.4$Sector_Laboral)
## [1] "character"     "Independiente" "Privado"       "Público"
# Variable de propietario de vivienda
# Convertir a factor binario, o variable dummy, para facilitar los modelos de regresión 
Grupo_1.4$Propietario_Vivienda_Num <- ifelse(Grupo_1.4$Propietario_Vivienda == "Sí", 1, 0)
# Variable de rango de salario
# Convertir a factor ordenado, pues hay un orden natural en el ingreso
Grupo_1.4$Rango_Salario <- factor(Grupo_1.4$Rango_Salario,
levels = c("Bajo", "Medio", "Alto"),
ordered = TRUE)
levels(Grupo_1.4$Rango_Salario)
## [1] "Bajo"  "Medio" "Alto"

Discretización de variables numéricas

# Variable de edad
# Decisión de dividir en 4 rangos de edad laboral para facilitar comparaciones entre generaciones
Grupo_1.4$Grupo_Edad <- cut(Grupo_1.4$Edad,
breaks = c(0, 25, 35, 50, 100),
labels = c("Joven (18-25)", 
"Adulto Joven (26-35)",
 "Adulto (36-50)", 
"Senior (51+)"),
right = TRUE)
table(Grupo_1.4$Grupo_Edad)
## 
##        Joven (18-25) Adulto Joven (26-35)       Adulto (36-50) 
##                    5                    8                   31 
##         Senior (51+) 
##                   26
# Variable de Horas de trabajo en semana
# Decisión de dividir en tiempo parcial, normal y tiempo extra para establecer los estándares de labor
Grupo_1.4$Carga_Laboral <- cut(Grupo_1.4$Horas_Trabajo_Semana,
breaks = c(0, 35, 45, 168),
labels = c("Tiempo Parcial (<35h)",
"Tiempo Normal (35-45h)",
"Tiempo Extra (>45h)"),
right = TRUE)
table(Grupo_1.4$Carga_Laboral)
## 
##  Tiempo Parcial (<35h) Tiempo Normal (35-45h)    Tiempo Extra (>45h) 
##                     22                     25                     23
str(Grupo_1.4)
## tibble [70 × 15] (S3: tbl_df/tbl/data.frame)
##  $ ID                      : num [1:70] 1 3 4 5 6 7 8 9 12 13 ...
##  $ Edad                    : num [1:70] 49 22 26 40 26 42 24 62 41 47 ...
##  $ Salario                 : num [1:70] 47164 76886 69046 51575 55348 ...
##  $ Experiencia             : num [1:70] 8 1 8 4 3 22 1 15 24 6 ...
##  $ Ciudad                  : Factor w/ 5 levels "Bayamón","Caguas",..: 5 2 3 4 4 4 1 2 5 2 ...
##  $ Nivel_Educativo         : Ord.factor w/ 3 levels "Primaria"<"Secundaria"<..: 2 2 1 3 1 2 1 1 2 3 ...
##  $ Horas_Trabajo_Semana    : num [1:70] 30 46 31 56 57 55 22 50 42 36 ...
##  $ Estado_Civil            : Factor w/ 4 levels "Casado","character",..: 4 4 3 1 4 3 4 1 1 1 ...
##  $ Sector_Laboral          : Factor w/ 4 levels "character","Independiente",..: 2 4 2 3 2 2 3 3 1 4 ...
##  $ Cantidad_Hijos          : num [1:70] 4 4 0 3 5 4 2 2 3 4 ...
##  $ Propietario_Vivienda    : chr [1:70] "Sí" "No" "Sí" "Sí" ...
##  $ Rango_Salario           : Ord.factor w/ 3 levels "Bajo"<"Medio"<..: 2 3 3 2 2 2 3 1 3 3 ...
##  $ Propietario_Vivienda_Num: num [1:70] 1 0 1 1 1 0 1 1 0 1 ...
##  $ Grupo_Edad              : Factor w/ 4 levels "Joven (18-25)",..: 3 1 2 3 2 3 1 4 3 3 ...
##  $ Carga_Laboral           : Factor w/ 3 levels "Tiempo Parcial (<35h)",..: 1 3 1 3 3 3 1 3 2 2 ...
summary(Grupo_1.4)
##        ID              Edad          Salario       Experiencia   
##  Min.   :  1.00   Min.   :22.00   Min.   :20069   Min.   : 0.00  
##  1st Qu.: 26.25   1st Qu.:38.00   1st Qu.:37192   1st Qu.: 8.00  
##  Median : 51.00   Median :47.00   Median :49879   Median :15.00  
##  Mean   : 50.07   Mean   :45.16   Mean   :49749   Mean   :16.10  
##  3rd Qu.: 74.75   3rd Qu.:52.75   3rd Qu.:66126   3rd Qu.:22.75  
##  Max.   :100.00   Max.   :64.00   Max.   :79793   Max.   :39.00  
##        Ciudad        Nivel_Educativo Horas_Trabajo_Semana     Estado_Civil
##  Bayamón  :21   Primaria     :21     Min.   :21.00        Casado    :26   
##  Caguas   :23   Secundaria   :20     1st Qu.:31.25        character : 3   
##  character: 2   Universitario:28     Median :42.00        Divorciado:22   
##  Ponce    :13   NA's         : 1     Mean   :40.91        Soltero   :19   
##  San Juan :11                        3rd Qu.:50.00                        
##                                      Max.   :60.00                        
##        Sector_Laboral Cantidad_Hijos  Propietario_Vivienda Rango_Salario
##  character    : 4     Min.   :0.000   Length:70            Bajo :13     
##  Independiente:26     1st Qu.:1.000   Class :character     Medio:35     
##  Privado      :25     Median :2.500   Mode  :character     Alto :20     
##  Público      :15     Mean   :2.514                        NA's : 2     
##                       3rd Qu.:4.000                                     
##                       Max.   :5.000                                     
##  Propietario_Vivienda_Num                Grupo_Edad
##  Min.   :0.0000           Joven (18-25)       : 5  
##  1st Qu.:0.0000           Adulto Joven (26-35): 8  
##  Median :1.0000           Adulto (36-50)      :31  
##  Mean   :0.5857           Senior (51+)        :26  
##  3rd Qu.:1.0000                                    
##  Max.   :1.0000                                    
##                 Carga_Laboral
##  Tiempo Parcial (<35h) :22   
##  Tiempo Normal (35-45h):25   
##  Tiempo Extra (>45h)   :23   
##                              
##                              
##

Visualización avanzada

Mapa de calor interactivo

# Solo variables numéricas
variables_numericas <- Grupo_1.4[, c("Edad", "Salario", "Experiencia", "Horas_Trabajo_Semana", "Cantidad_Hijos")]

# Matriz de correlación
matriz_cor <- round(cor(variables_numericas, use = "complete.obs"), 2)
# Convertir a formato largo
matriz_melted <- melt(matriz_cor)
# Heatmap

heatmap_plot <- plot_ly(
  x = colnames(matriz_cor),
  y = rownames(matriz_cor),
  z = matriz_cor,
  type = "heatmap",
  colorscale = list(
    c(0, "red"),
    c(0.5, "white"),
    c(1, "blue")
  ))
heatmap_plot

Gráfico de barras interactivo

# Calcular promedio de hijos por rango de salario
datos_barras <- aggregate(Cantidad_Hijos ~ Rango_Salario, 
data = Grupo_1.4, 
FUN = mean)
datos_barras$Cantidad_Hijos <- round(datos_barras$Cantidad_Hijos, 2)


#Gráfico de barras
barras_gg <- ggplot(datos_barras, 
aes(x = Rango_Salario, 
y = Cantidad_Hijos, 
fill = Rango_Salario,
text = paste("Rango:", Rango_Salario,
"<br>Promedio Hijos:", Cantidad_Hijos))) +
  geom_bar(stat = "identity", width = 0.6)

barras_gg

ggplotly(barras_gg, tooltip ="text")
# Se observa que las personas con salario medio son las personas que tienen más hijos. Aunque sea con puntos decimales, se puede entender que tienen más hijos que los otros rangos de salario.
dispersion_plot <- plot_ly(
  data = Grupo_1.4,
  x = ~Experiencia,
  y = ~Salario,
  type = "scatter",
  mode = "markers",
  color = ~Rango_Salario,
  colors = c("Bajo" = "magenta", 
             "Medio" = "blue", 
             "Alto" = "green"),
  marker = list(size = 9, opacity = 0.7))
dispersion_plot <- dispersion_plot %>%
  add_lines(x = ~Experiencia, y = ~fitted(lm(Salario ~ Experiencia, data = Grupo_1.4)), line = list(color = "darkblue", width = 2, dash = "dash"), name = "Tendencia", hoverinfo = "none")

dispersion_plot

Se observa que, aunque es altamente común que el salario esté altamente relacionado con los años, no existe esa relación en estas variables.