Datos De Salarios

Este conjunto de datos fue obtenido de Kaggle. Haga clic aquí para verlo.

Librerias a utilizar

# Cargar Las Librerías
library(tidyverse)
library(caret)
library(randomForest)
library(rpart)
library(tree)
library(DataExplorer)
library(plotly)

df <- read_csv("Salary_Data_Based_country_and_race.csv")
df$...1<-NULL
fix(df)

# Observamos la cabecera de nuestros datos. 
head(df)

Veamos la estructura de los datos.

glimpse(df)

Rows: 6,704
Columns: 8
$ Age                 <dbl> 32, 28, 45, 36, 52, 29, 42, 31, 26, 38, 29, 48, 35, 40, 27, 44, 33, 39, 25, 51, 34, 47…
$ Gender              <chr> "Male", "Female", "Male", "Female", "Male", "Male", "Female", "Male", "Female", "Male"…
$ Education_Level     <chr> "Bachelor's", "Master's", "PhD", "Bachelor's", "Master's", "Bachelor's", "Master's", "…
$ Job_Title           <chr> "Software Engineer", "Data Analyst", "Senior Manager", "Sales Associate", "Director", …
$ Years_of_Experience <dbl> 5, 3, 15, 7, 20, 2, 12, 4, 1, 10, 3, 18, 6, 14, 2, 16, 7, 12, 0, 22, 5, 19, 2, 9, 13, …
$ Salary              <dbl> 90000, 65000, 150000, 60000, 200000, 55000, 120000, 80000, 45000, 110000, 75000, 14000…
$ Country             <chr> "UK", "USA", "Canada", "USA", "USA", "USA", "USA", "China", "China", "Australia", "UK"…
$ Race                <chr> "White", "Hispanic", "White", "Hispanic", "Asian", "Hispanic", "Asian", "Korean", "Chi…

Realizamos un análisis para cuantificar el porcentaje de valores faltantes (NA) en nuestros datos. Esto nos permitirá identificar la integridad de nuestra muestra y evaluar la calidad de la información disponible.

plot_missing(df)

He considerado la opción de eliminar los valores faltantes debido a que su cantidad es relativamente baja en relación con el total de datos..

df<-na.omit(df)
colSums(is.na(df))

                Age              Gender     Education_Level           Job_Title Years_of_Experience 
                  0                   0                   0                   0                   0 
             Salary             Country                Race 
                  0                   0                   0 

Para mejorar la manipulación y el análisis de nuestras variables, hemos realizado la conversión de aquellas que estaban en formato caracter a formato Factor.

var_fac<-c("Gender", "Education_Level","Job_Title","Country","Race")
df <- df %>%
  mutate(across(all_of(var_fac), as.factor))

He detectado que la variable “Education_Level” contiene valores similares pero con diferentes nombres. Para lograr una representación más coherente y evitar duplicados en nuestro conjunto de datos, he realizado un proceso de unificación de dichos valores.

df$Education_Level <- recode(
 df$Education_Level,
  "Bachelor's Degree" = "Bachelor's",
  "PhD" = "phD",
  "Master's Degree" = "Master's"
)

Después de la unificación de los valores en la variable “Education_Level”, he realizado un conteo para conocer la distribución de los diferentes niveles de educación presentes en nuestro conjunto de datos. A continuación, se muestra una tabla con el número de registros asociados a cada nivel de educación:

Conteo<-fct_count(df$Education_Level)
print(Conteo)

Hemos agrupado los valores de “Education_Level” y calculado el promedio del salario y la desviación estándar para cada grupo. A continuación, se presentan los resultados:.

df %>% 
  group_by(Education_Level) %>% 
  summarise(
    Salario_Promedio = mean(Salary),
    Salario_desvE = sd(Salary)
  )

A continuación, presento un histograma para cada una de las variables numéricas en el conjunto de datos:

plot_histogram(df)

Explorando la Distribución de los Datos Mediante un Gráfico QQ-Plot

plot_qq(df)

Examinando un Resumen Estadístico de los Datos.

summary(df)

      Age           Gender        Education_Level                     Job_Title    Years_of_Experience
 Min.   :21.00   Female:3013   Bachelor's :3021   Software Engineer        : 518   Min.   : 0.000     
 1st Qu.:28.00   Male  :3671   High School: 448   Data Scientist           : 453   1st Qu.: 3.000     
 Median :32.00   Other :  14   Master's   :1860   Software Engineer Manager: 376   Median : 7.000     
 Mean   :33.62                 phD        :1369   Data Analyst             : 363   Mean   : 8.095     
 3rd Qu.:38.00                                    Senior Project Engineer  : 318   3rd Qu.:12.000     
 Max.   :62.00                                    Product Manager          : 313   Max.   :34.000     
                                                  (Other)                  :4357                      
     Salary            Country             Race     
 Min.   :   350   Australia:1336   White     :1962  
 1st Qu.: 70000   Canada   :1325   Asian     :1603  
 Median :115000   China    :1343   Korean    : 457  
 Mean   :115329   UK       :1335   Australian: 452  
 3rd Qu.:160000   USA      :1359   Chinese   : 444  
 Max.   :250000                    Black     : 437  
                                   (Other)   :1343  

Realizaremos un Análisis Exploratorio de Datos (EDA) del conjunto de datos.

Representación gráfica que visualiza la proporción de género según la raza.

mis_colores <- c("#F31559", "#78C1F3", "#9460b5", "#3ca2a2", "#ff348e", "#2a6a66",
                 "#db8fd7", "#fcff6c", "#00bfff", "#ffaf00", "#FF5733", "#00FF00",
                 "#FFD700", "#6A5ACD", "#FF1493")

a <- ggplot(df, aes(x = reorder(Race, -table(Race)[Race]), fill = Gender)) +
  geom_bar(position = "dodge") +
  theme_minimal() +
  scale_fill_manual(values = mis_colores) +
  coord_flip() +
  labs(title = "Proporción De Género Por Raza", y = "Conteo", x = "Raza")

print(a)

Realicemos una visualización de las frecuencias de los valores presentes en la variable “Género”.

b <- ggplot(df, aes(x = reorder(Gender, -table(Gender)[Gender]))) +
  geom_bar(aes(fill = Gender)) +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5) +
  theme_minimal() +
  labs(title = "Frecuencia de Géneros", x = "Género", y = "Conteo") + 
  scale_fill_manual(values = mis_colores)

print(b)

Realizaremos un conteo de las observaciones por Nivel de Educación..

c <- ggplot(df, aes(x = reorder(Education_Level, -table(Education_Level)[Education_Level]))) +
  geom_bar(aes(fill = Education_Level)) +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5) +
  theme_minimal() +
  labs(title = "Frecuencia de Educación", x = "Educación", y = "Conteo") + 
  scale_fill_manual(values = mis_colores)

print(c)

Examinemos cómo el rango de la variable Educación afecta al Salario.

 d <- ggplot(df, aes(x = reorder(Education_Level, Salary, median), y = Salary, fill = Education_Level)) +
  geom_boxplot(color = "black") + 
  labs(title = "Educación vs Salario",
       x = "Educación", y = "Salario") +
  theme_minimal() + scale_fill_manual(values = mis_colores)

ggplotly(d)

NA

Ahora procederemos a analizar cómo se distribuye la variable “Género” dentro de los diferentes niveles de educación.

 df_percentaje<-df %>%
  group_by(Education_Level, Gender) %>%
  tally() %>%
  mutate(Porcentaje = n / sum(n))

e <- ggplot(df_percentaje, aes(x = reorder(Education_Level, Porcentaje, median), y = Porcentaje, fill = Gender)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(aes(label = scales::percent(Porcentaje)), position = position_dodge(width = 0.9), vjust = -0.5) +
  theme_minimal() +
  labs(title = "Porcentaje de Género por Nivel de Educación",
       x = "Nivel de Educación", y = "Porcentaje") + scale_fill_manual(values = mis_colores)

print(e)

A continuación, realizaremos una observación de la variable “Salario” con respecto al género. Analizaremos cómo se distribuye el salario en función de los distintos géneros presentes en nuestro conjunto de datos.

f <- ggplot(df, aes(x = reorder(Gender, Salary, median), y = Salary, fill = Gender)) +
  geom_boxplot(color = "black") +
  scale_fill_manual(values = mis_colores) +
  labs(title = "Gráfico de Caja Género vs Salario",
       x = "Género", y = "Salario") +
  theme_minimal()

ggplotly(f)

NA
NA

A continuación, procederemos a realizar una visualización de cómo se distribuye el salario en diferentes países. Esto nos permitirá analizar las diferencias salariales entre los distintos países presentes en nuestro conjunto de datos..

g <- ggplot(df, aes(x = reorder(Country, Salary, median), y = Salary, fill = Education_Level)) +
  geom_boxplot(color = "black") +
  labs(title = "Gráfico de Cajas Países vs Salario",
       x = "País", y = "Salario") +
  theme_minimal() +
  scale_fill_manual(values = mis_colores)

print(g)

Ante la observación del gráfico anterior, donde se muestra que el promedio del salario es igual en distintos países, surge la duda acerca de la veracidad de los datos. Sin embargo, con el fin de continuar con el análisis de datos a modo de práctica, procederemos a seguir explorando y visualizando la información disponible.

A continuación, presentamos la distribución del salario basada en la variable “Raza”. Este gráfico nos permite visualizar cómo se distribuyen los salarios entre las diferentes categorías de raza en nuestro conjunto de datos. Es importante destacar que este análisis tiene fines puramente exploratorios y nos ayuda a identificar posibles patrones o tendencias relacionadas con la variable de interés.

h <- ggplot(df, aes(x = reorder(Race, Salary, median), y = Salary, fill = Race)) +
  geom_boxplot(color = "black") +
  labs(title = "Gráfico de Cajas Raza vs Salario",
       x = "Raza", y = "Salario") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = mis_colores)

ggplotly(h)

NA

Para realizar una generalización de la edad y estudiar la distribución del salario con respecto a esta variable, he realizado cortes equitativos del rango de edad. Esto nos permite agrupar a las personas en diferentes categorías de edad para facilitar el análisis y la visualización de cómo se distribuyen los salarios en cada grupo.

df$Age_Interva <- cut(df$Age, breaks = c(21, 31, 41, 51, 62), include.lowest = TRUE)

table(df$Age_Interva)

[21,31] (31,41] (41,51] (51,62] 
   3256    2223    1060     159 

i <- ggplot(df, aes(x = reorder(Age_Interva, Salary, median), y = Salary, fill = Age_Interva)) +
  geom_boxplot(color = "black") +
  labs(title = "Edad en intervalos vs Salario",
       x = "Intervalos de Edad", y = "Salario") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = mis_colores)

ggplotly(i)

NA

A continuación, procedemos a realizar un gráfico de puntos para explorar la correlación entre la variable “salario” y “años de experiencia”.

j<- ggplot(df, aes(x = Salary, y = Years_of_Experience, color = Education_Level)) +
  geom_point() +
  theme_minimal() + 
  labs(title = "Salario vs Años de Experiencia",
       x = "Salario", y = "Años de Experiencia" ) + scale_fill_manual(values = mis_colores)
ggplotly(j)

A continuación, procedemos a realizar un gráfico de puntos para visualizar la relación entre el salario y los años de experiencia, utilizando el color para representar los géneros. Este tipo de gráfico nos permitirá observar cómo se distribuyen los salarios y la experiencia en función de los diferentes géneros, lo que nos ayudará a identificar posibles patrones o diferencias entre ellos.

k<- ggplot(df, aes(x = Salary, y = Years_of_Experience, color = Gender)) +
  geom_point() +
  theme_minimal() + 
  labs(title = "Salario vs Años de Experiencia",
       x = "Salario", y = "Años de Experiencia" ) + scale_fill_manual(values = mis_colores)
ggplotly(k)

A continuación, presentamos un gráfico de barras que muestra las profesiones con los salarios más altos. Para ello, hemos ordenado las profesiones de mayor a menor salario y hemos destacado las primeras posiciones para identificar cuáles son las más remuneradas.

# Paso 1: Calcular el percentil 75 del salario
percentil_75 <- quantile(df$Salary, 0.75)

# Paso 2: Filtrar el marco de datos para quedarte con las profesiones mejor pagadas
df_filtrado <- df %>% 
  filter(Salary > percentil_75)

# Paso 3: Ordenar el marco de datos por el salario de forma descendente
df_filtrado <- df_filtrado %>% 
  arrange(desc(Salary))


l <- ggplot(top_15_titulos, aes(x = reorder(Job_Title, -Salario_promedio), y = Salario_promedio, fill = Job_Title)) +
  geom_bar(stat = "identity") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(title = "Top 15 Títulos con Mejor Salario Promedio",
       x = "Título del Trabajo",
       y = "Salario Promedio") +
  guides(fill = FALSE)

print(l)

NA
NA

A continuación, presentamos un gráfico de correlación que nos permitirá visualizar las relaciones entre las variables de nuestro conjunto de datos.

df2<-df
# Converimos las variables categóricas a valores numéricos
df2$Gender <- as.numeric(factor(df$Gender))
df2$Education_Level <- as.numeric(factor(df$Education_Level))
df2$Job_Title <- as.numeric(factor(df$Job_Title))
df2$Country <- as.numeric(factor(df$Country))
df2$Race <- as.numeric(factor(df$Race))
df2$Age_Interva<-as.numeric(factor(df$Age_Interva))

#Creamos el Grafico de correlacion
corr_matrix <- cor(df2)

# Visualizamos el gráfico de correlación con ajustes personalizados
m<-corrplot(corr_matrix, method = "color", type = "upper", 
         tl.cex = 0.7, addcolor = TRUE,
         col = colorRampPalette(c("#9460b5", "white", "#F31559"))(100),
         cl.lim = c(-1, 1),
         is.corr = TRUE,
         addCoef.col = "black",
         number.cex = 0.8,
         tl.col = "black",
         diag = FALSE,
         tl.srt = 45,
         addgrid.col = "black") 

Procedemos a realizar una evaluacion de distintos modelos

En esta sección, llevaremos a cabo una evaluación de varios modelos para predecir el salario en función de las variables disponibles en nuestro conjunto de datos. Los modelos que utilizaremos son los siguientes:

1. Regresión Lineal

2. Árbol de Decisión

3. Bosques Aleatorios

Para cada modelo, realizaremos una partición de nuestros datos en conjuntos de entrenamiento y prueba, entrenaremos el modelo en el conjunto de entrenamiento y evaluaremos su rendimiento en el conjunto de prueba. Utilizaremos diferentes métricas de evaluación.

A continuación, presentaremos los resultados de la evaluación para cada modelo, lo que nos permitirá tomar decisiones informadas sobre cuál modelo es el más adecuado para nuestras necesidades de predicción de salarios.

set.seed(42)
partition_indexes <- createDataPartition(df2$Salary, p = 0.7, list = FALSE)

X_train <- df2[partition_indexes, -which(names(df2) == "Salary")]
X_test <- df2[-partition_indexes, -which(names(df2) == "Salary")]
y_train <- df2$Salary[partition_indexes]
y_test <- df2$Salary[-partition_indexes]

models <- list(
  lm_model = lm(Salary ~ ., data = df2),
  tree_model = rpart(Salary ~ ., data = df2),
  rf_model = randomForest(Salary ~ ., data = df2, ntree = 350)
)

results <- data.frame(
  Model_Name = character(),
  Mean_Absolute_Error_MAE = numeric(),
  Mean_Absolute_Percentage_Error_MAPE = numeric(),
  Mean_Squared_Error_MSE = numeric(),
  Root_Mean_Squared_Error_RMSE = numeric(),
  R2_score = numeric(),
  stringsAsFactors = FALSE
)

for (i in 1:length(models)) {
  model <- models[[i]]
  model_name <- names(models)[i]
  
  # Hacer las predicciones con cada modelo en el conjunto de prueba (X_test)
  y_pred <- predict(model, newdata = X_test)
  
  # Calcular las métricas de evaluación para el modelo actual
  mae <- mean(abs(y_test - y_pred))
  mape <- mean(abs((y_test - y_pred) / y_test)) * 100
  mse <- mean((y_test - y_pred)^2)
  rmse <- sqrt(mse)
  r2 <- cor(y_test, y_pred)^2
  
  # Agregar los resultados al data frame 'results'
  results <- rbind(results, data.frame(
    Model_Name = model_name,
    Mean_Absolute_Error_MAE = mae,
    Mean_Absolute_Percentage_Error_MAPE = mape,
    Mean_Squared_Error_MSE = mse,
    Root_Mean_Squared_Error_RMSE = rmse,
    R2_score = r2
  ))
}

print(results)

NA

Para evaluar la eficacia de cada modelo, graficaremos el “Error Medio Absoluto” (MAE) obtenido en la evaluación de cada uno de ellos. El MAE es una métrica que nos indica el promedio de las diferencias absolutas entre las predicciones del modelo y los valores reales.Cuanto menor sea el MAE, mejor será el rendimiento del modelo en términos de precisión de las predicciones. \[ MAE = \frac{1}{n} \sum |y_{pred} - y_{real}| \]

# Crear el gráfico de barras con ggplot2
n <- ggplot(results, aes(x = Model_Name, y = Mean_Absolute_Error_MAE, fill = Model_Name)) +
  geom_bar(stat = 'identity') +
  labs(title = '(MAE) por modelo', x = 'Modelos', y = 'MAE') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) + scale_fill_manual(values = mis_colores) + theme_minimal()

# Mostrar el gráfico estático
print(n)

Para evaluar la eficacia de cada modelo, Graficaremos graficar el coeficiente R cuadrado (R2) de cada modelo. El coeficiente R2 es una medida que indica cuánta varianza de la variable dependiente (en nuestro caso, el salario) es explicada por el modelo. Cuanto más cercano a 1 sea el valor de R2, mejor será la capacidad del modelo para explicar la variabilidad de los datos.

o<-ggplot(results, aes(x = Model_Name, y = R2_score, fill = Model_Name)) +
  geom_bar(stat = "identity") +
  labs(title = "R-squared por modelo", x = "Modelos", y = "R-squared") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_fill_manual(values = mis_colores) + theme_minimal()
print(o)

Tras llevar a cabo una evaluación de los diferentes modelos, se ha destacado que el modelo de Bosques Aleatorios ha sobresalido por su alto rendimiento y precisión predictiva. Ahora, para profundizar en su desempeño, observaremos detalladamente las métricas obtenidas por este modelo, lo cual nos permitirá medir su eficacia en la predicción del salario basándose en las variables independientes consideradas.

# Obtenemos los errores del modelo de bosque aleatorio
rf_errors <- models$rf_model$mse

# Creamos un data frame para la curva de aprendizaje
curve_data <- data.frame(trees = seq_along(rf_errors), Error = rf_errors)

# Creamos el gráfico de curva de aprendizaje con ggplot2
ggplot(curve_data, aes(x = trees, y = Error)) +
  geom_line() +
  labs(title = "Curva de Aprendizaje - Bosque Aleatorio",
       x = "Número de Árboles",
       y = "Error") +
  theme_minimal()

# Creamos un data frame con las predicciones y valores reales
comparison_data <- data.frame(Valor_Real = y_test, Prediccion = y_pred_rf)

# Creamos el gráfico de dispersión con ggplot2
ggplot(comparison_data, aes(x = Valor_Real, y = Prediccion)) +
  geom_point() +
  geom_abline(intercept = 0, slope = 1, color = "red") +
  labs(title = "Comparación de Predicciones - Bosque Aleatorio",
       x = "Valor Real",
       y = "Predicción") +
  theme_minimal()

NA
NA

En conclusión, este análisis exploratorio de datos ha proporcionado una visión general de las relaciones y patrones presentes en el conjunto de datos estudiado. Se ha evidenciado la influencia de variables como el género, nivel de educación, experiencia laboral y país de origen en el salario de los individuos.

Se han identificado algunas relaciones significativas, como la tendencia creciente entre salario y años de experiencia, así como las diferencias en los salarios promedio entre distintos niveles de educación. También se ha destacado la presencia de valores atípicos que pueden tener un impacto en la interpretación de los resultados.

Es importante mencionar que se han identificado algunas inconsistencias en los datos, como la similitud en los salarios promedio entre diferentes países, lo cual sugiere la posibilidad de datos erróneos o sesgos en la muestra.

El modelo de Bosques Aleatorios ha demostrado ser el más eficaz en términos de rendimiento y precisión predictiva.

En resumen, este análisis exploratorio de datos proporciona una base sólida para futuros estudios y análisis más profundos. Se deben considerar las conjeturas y observaciones realizadas como hipótesis iniciales, y se invita a realizar análisis más detallados y rigurosos para obtener conclusiones más sólidas. El proceso de exploración de datos es continuo y dinámico, lo que nos permite seguir descubriendo y comprendiendo nuevas relaciones y patrones en los datos en futuras investigaciones.

¡Gracias por llegar hasta acá no dudes en dejar tu comentario para ayudarme a seguir prendiendo!