Human Resources Analysis

Project Intro

A large company named XYZ, employs, at any given point of time, around 4000 employees. However, every year, around 15% of its employees leave the company and need to be replaced with the talent pool available in the job market. The management believes that this level of attrition (employees leaving, either on their own or because they got fired) is bad for the company, because of the following reasons -

1- The former employees’ projects get delayed, which makes it difficult to meet timelines, resulting in a reputation loss among consumers and partners

2- A sizeable department has to be maintained, for the purposes of recruiting new talent

3- More often than not, the new employees have to be trained for the job and/or given time to acclimatise themselves to the company

Hence, the management has contracted an HR analytics firm to understand what factors they should focus on, in order to curb attrition. In other words, they want to know what changes they should make to their workplace, in order to get most of their employees to stay. Also, they want to know which of these variables is most important and needs to be addressed right away.

Goal

I am required to model the probability of attrition using machine Learning. The results thus obtained will be used by the management to understand what changes they should make to their workplace, in order to get most of their employees to stay.

str(data)

## 'data.frame':    4410 obs. of  29 variables:
##  $ EmployeeID             : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Age                    : int  51 31 32 38 32 46 28 29 31 25 ...
##  $ Attrition              : chr  "No" "Yes" "No" "No" ...
##  $ BusinessTravel         : chr  "Travel_Rarely" "Travel_Frequently" "Travel_Frequently" "Non-Travel" ...
##  $ Department             : chr  "Sales" "Research & Development" "Research & Development" "Research & Development" ...
##  $ DistanceFromHome       : int  6 10 17 2 10 8 11 18 1 7 ...
##  $ Education              : int  2 1 4 5 1 3 2 3 3 4 ...
##  $ EducationField         : chr  "Life Sciences" "Life Sciences" "Other" "Life Sciences" ...
##  $ EmployeeCount          : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ Gender                 : chr  "Female" "Female" "Male" "Male" ...
##  $ JobLevel               : int  1 1 4 3 1 4 2 2 3 4 ...
##  $ JobRole                : chr  "Healthcare Representative" "Research Scientist" "Sales Executive" "Human Resources" ...
##  $ MaritalStatus          : chr  "Married" "Single" "Married" "Married" ...
##  $ MonthlyIncome          : int  131160 41890 193280 83210 23420 40710 58130 31430 20440 134640 ...
##  $ NumCompaniesWorked     : int  1 0 1 3 4 3 2 2 0 1 ...
##  $ Over18                 : chr  "Y" "Y" "Y" "Y" ...
##  $ PercentSalaryHike      : int  11 23 15 11 12 13 20 22 21 13 ...
##  $ StandardHours          : int  8 8 8 8 8 8 8 8 8 8 ...
##  $ StockOptionLevel       : int  0 1 3 3 2 0 1 3 0 1 ...
##  $ TotalWorkingYears      : int  1 6 5 13 9 28 5 10 10 6 ...
##  $ TrainingTimesLastYear  : int  6 3 2 5 2 5 2 2 2 2 ...
##  $ YearsAtCompany         : int  1 5 5 8 6 7 0 0 9 6 ...
##  $ YearsSinceLastPromotion: int  0 1 0 7 0 7 0 0 7 1 ...
##  $ YearsWithCurrManager   : int  0 4 3 5 4 7 0 0 8 5 ...
##  $ EnvironmentSatisfaction: int  3 3 2 4 4 3 1 1 2 2 ...
##  $ JobSatisfaction        : int  4 2 2 4 1 2 3 2 4 1 ...
##  $ WorkLifeBalance        : int  2 4 1 3 3 2 1 3 3 3 ...
##  $ JobInvolvement         : int  3 2 3 2 3 3 3 3 3 3 ...
##  $ PerformanceRating      : int  3 4 3 3 3 3 4 4 4 3 ...

Data Cleaning

Below, I will performing some data re-classifications for improve the analysis.

data$EducationName1 <- case_when(
  data$Education == 1 ~ "Below College",
  data$Education == 2 ~ "College",
  data$Education == 3 ~ "Bachelor",
  data$Education == 4 ~ "Master",
  data$Education == 5 ~ "PhD",
)

data$EnvironmentSatisfaction1 <- case_when(
  data$EnvironmentSatisfaction == 1 ~ "Low",
  data$EnvironmentSatisfaction == 2 ~ "Medium",
  data$EnvironmentSatisfaction == 3 ~ "High",
  data$EnvironmentSatisfaction == 4 ~ "Very High",
)

data$JobInvolvement1 <- case_when(
  data$JobInvolvement == 1 ~ "Low",
  data$JobInvolvement == 2 ~ "Medium",
  data$JobInvolvement == 3 ~ "High",
  data$JobInvolvement == 4 ~ "Very High",
)

data$JobSatisfaction1 <- case_when(
  data$JobSatisfaction == 1 ~ "Low",
  data$JobSatisfaction == 2 ~ "Medium",
  data$JobSatisfaction == 3 ~ "High",
  data$JobSatisfaction == 4 ~ "Very High",
)

data$PerformanceRating1 <- case_when(
  data$PerformanceRating == 1 ~ "Low",
  data$PerformanceRating == 2 ~ "Good",
  data$PerformanceRating == 3 ~ "Excellent",
  data$PerformanceRating == 4 ~ "Outstanding",
)

data$WorkLifeBalance1 <- case_when(
  data$WorkLifeBalance == 1 ~ "Bad",
  data$WorkLifeBalance == 2 ~ "Good",
  data$WorkLifeBalance == 3 ~ "Better",
  data$WorkLifeBalance == 4 ~ "Best",
)

data$AgeGroup <- case_when(
  data$Age >= 0 & data$Age < 10 ~ "0 - 9",
  data$Age >= 10 & data$Age < 20 ~ "10 - 19",
  data$Age >= 20 & data$Age < 30 ~ "20 - 29",
  data$Age >= 30 & data$Age < 40 ~ "30 - 39",
  data$Age >= 40 & data$Age < 50 ~ "40 - 49",
  data$Age >= 50 & data$Age < 60 ~ "50 - 59",
  data$Age >= 60 & data$Age < 70 ~ "60 - 69",
  data$Age >= 70 & data$Age < 80 ~ "70 - 79",
  data$Age >= 80 & data$Age < 90 ~ "80 - 89",
)

head(data)

##   EmployeeID Age Attrition    BusinessTravel             Department
## 1          1  51        No     Travel_Rarely                  Sales
## 2          2  31       Yes Travel_Frequently Research & Development
## 3          3  32        No Travel_Frequently Research & Development
## 4          4  38        No        Non-Travel Research & Development
## 5          5  32        No     Travel_Rarely Research & Development
## 6          6  46        No     Travel_Rarely Research & Development
##   DistanceFromHome Education EducationField EmployeeCount Gender JobLevel
## 1                6         2  Life Sciences             1 Female        1
## 2               10         1  Life Sciences             1 Female        1
## 3               17         4          Other             1   Male        4
## 4                2         5  Life Sciences             1   Male        3
## 5               10         1        Medical             1   Male        1
## 6                8         3  Life Sciences             1 Female        4
##                     JobRole MaritalStatus MonthlyIncome NumCompaniesWorked
## 1 Healthcare Representative       Married        131160                  1
## 2        Research Scientist        Single         41890                  0
## 3           Sales Executive       Married        193280                  1
## 4           Human Resources       Married         83210                  3
## 5           Sales Executive        Single         23420                  4
## 6         Research Director       Married         40710                  3
##   Over18 PercentSalaryHike StandardHours StockOptionLevel TotalWorkingYears
## 1      Y                11             8                0                 1
## 2      Y                23             8                1                 6
## 3      Y                15             8                3                 5
## 4      Y                11             8                3                13
## 5      Y                12             8                2                 9
## 6      Y                13             8                0                28
##   TrainingTimesLastYear YearsAtCompany YearsSinceLastPromotion
## 1                     6              1                       0
## 2                     3              5                       1
## 3                     2              5                       0
## 4                     5              8                       7
## 5                     2              6                       0
## 6                     5              7                       7
##   YearsWithCurrManager EnvironmentSatisfaction JobSatisfaction WorkLifeBalance
## 1                    0                       3               4               2
## 2                    4                       3               2               4
## 3                    3                       2               2               1
## 4                    5                       4               4               3
## 5                    4                       4               1               3
## 6                    7                       3               2               2
##   JobInvolvement PerformanceRating EducationName1 EnvironmentSatisfaction1
## 1              3                 3        College                     High
## 2              2                 4  Below College                     High
## 3              3                 3         Master                   Medium
## 4              2                 3            PhD                Very High
## 5              3                 3  Below College                Very High
## 6              3                 3       Bachelor                     High
##   JobInvolvement1 JobSatisfaction1 PerformanceRating1 WorkLifeBalance1 AgeGroup
## 1            High        Very High          Excellent             Good  50 - 59
## 2          Medium           Medium        Outstanding             Best  30 - 39
## 3            High           Medium          Excellent              Bad  30 - 39
## 4          Medium        Very High          Excellent           Better  30 - 39
## 5            High              Low          Excellent           Better  30 - 39
## 6            High           Medium          Excellent             Good  40 - 49

Analysis

In this section, I will filter the data to display only those employees who are no longer with XYZ. I will then analyze various trends to understand the potential reasons why these employees chose to leave the company instead of continuing to grow within it.

## Attrition Percetange=  16.12 %

## The highest two groups combined make up 71.73 % of the overall attrition

As shown in the graph, the age groups with the highest attrition rates are 30 to 39 and 20 to 29. This indicates that the most active age groups, which together make up nearly half of the overall workforce in the USA, are leaving the company. This trend is quite alarming as it suggests that a significant portion of XYZ’s most dynamic and potentially high-performing employees are choosing to leave rather than grow within the company.

by_department <- attrition %>%
  group_by(Department) %>%
  summarise(
    Count= n_distinct(EmployeeID)
  )

p2 <- ggplot(
  data = by_department,
  aes(x= reorder(Department, -Count), y= Count, fill= Count)
)+ geom_bar(stat = 'identity')+
geom_text(aes(label = Count), vjust = -0.3) +
  scale_fill_gradient(low = '#CCFFCC', high = '#FFCCCC')+
  theme_minimal()+
  labs(
    title = 'Attrition by Age Group',
    x='Department',
    y='Count'
  )

ggplotly(p2, dynamicTicks = TRUE, tooltip = 'all')

As shown in the graph, the Research and Development department is experiencing the highest employee attrition. This high turnover could negatively impact XYZ’s productivity, as a lack of stable staffing in this crucial department may lead to instability in the company’s overall performance.

by_education <- attrition %>%
  group_by(Department) %>%
  summarise(
    Education = round(mean(Education),2)
  )

p3 <- ggplot(
  data = by_education,
  aes(x= reorder(Department, -Education), y= Education, fill= Education)
)+ geom_bar(stat = 'identity')+
geom_text(aes(label = Education), vjust = -0.3) +
  scale_fill_gradient(low = '#CCFFCC', high = '#FFCCCC')+
  theme_minimal()+
  labs(
    title = 'Attrition by Age Group',
    x='Education',
    y='Count'
  )

ggplotly(p3, dynamicTicks = TRUE, tooltip = 'all')

Education Level and Attrition by Department

Observation: The graph indicates that while the HR department shows a slightly higher average education level compared to other departments, the overall education levels across all departments round to approximately 3. This value corresponds to a Bachelor’s degree.

Interpretation: This suggests that attrition does not significantly vary with education levels, as the majority of employees in each department hold a Bachelor’s degree. Therefore, based on this data, education level does not appear to be a key factor influencing attrition rates.

by_Job <- attrition %>%
  group_by(JobRole) %>%
  summarise(
    Count= n_distinct(EmployeeID),
    Education = mean(Education)
  )

p4 <- ggplot(by_Job, aes(x = reorder(JobRole, -Count))) +
  geom_bar(aes(y = Count, fill = Education), stat = "identity", position = "dodge") +
  geom_line(aes(y = Education * 10, group = 1, color = 'Average Education Level'), size = 1) +
  geom_point(aes(y = Education * 10, color = 'Average Education Level'), size = 2) +  
  geom_text(aes(y = Count, label = Count), vjust = -0.5) +
  geom_text(aes(y = Education * 10, label = round(Education, 2)), vjust = -1.5) +
  scale_y_continuous(
    name = "Count",
    sec.axis = sec_axis(~./10, name = "Average Education Level")
  ) +
  scale_fill_gradient(low = '#CCFFCC', high = '#FFCCCC') +
  theme_minimal() +
  labs(
    title = 'Count and Average Education Level by Job Role',
    x = 'Job Role'
  ) +
  theme(
    axis.text.x = element_text(angle = 25, hjust = 1),
    legend.position = "none"
  )

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

ggplotly(p4, dynamicTicks = TRUE, tooltip = 'all')

As shown in the graph above, the top three job titles account for the largest number of employees experiencing attrition. Therefore, we will delve deeper into the data to closely examine these top three job roles with the lowest retention rates.

newData <- attrition %>%
  filter(JobRole %in% c("Sales Executive", "Research Scientist", "Laboratory Technician"))

newData$Gender <- ifelse(newData$Gender == "Male", 1, 0)
newData$MaritalStatus <- ifelse(newData$MaritalStatus == "Married", 1, 0)

newData <- newData %>%
  mutate_all(~replace(., is.na(.), 0))

deep <- newData %>%
  group_by(JobRole,Department) %>%
  summarise(
    Education = round(mean(Education),2),
    Count= n_distinct(EmployeeID),
    Salaries= round(mean(MonthlyIncome)/12),
    Distance= round(mean(DistanceFromHome)*0.621371,2),
    Gender= round(mean(Gender)),
    Marital = round(mean(MaritalStatus)),
    Years= round(mean(YearsAtCompany),2),
    Pormotion = round(mean(YearsSinceLastPromotion)),
    Management= round(mean(YearsWithCurrManager),2),
    Satisfaction= round(mean(JobSatisfaction), 2),
    WorkLifeBalance= round(mean(WorkLifeBalance)),
    WorkingYear = round(mean(YearsAtCompany))
  ) %>%
  ungroup()

## `summarise()` has grouped output by 'JobRole'. You can override using the
## `.groups` argument.

datatable(deep, 
          style = "auto", 
          class = "display", 
          fillContainer = FALSE)

top_three <- round(((111+99+72)/ sum(deep$Count))*100, 2)

cat("The top 3 job titles related to attrition is ", top_three, " %", "\n")

## The top 3 job titles related to attrition is  62.67  %

Given that the top three job titles account for 62.67 % of the total attrition, we will delve deeper to analyze and understand the reasons and patterns behind this attrition.

Since the majority of attrition is occurring within the ‘Research & Development’ department, we will run some comparisons between the overall data and the new dataset containing only the attrition data related to the Research & Development department.”

Initial Findings

1- When comparing the average salaries between the entire company and the employees who left the Research & Development department, we found that the latter group’s average salary is 6.37 % below the company average. This indicates potential underpayment, which may contribute to these employees feeling undervalued and unfairly treated.

2- When comparing job satisfaction levels between the entire company and the employees who left the Research & Development department, we found that the latter group’s job satisfaction is 10.26 % lower than the company average. This significant decrease in job satisfaction suggests that these employees felt less content with their work environment, which may have contributed to their decision to leave. Addressing the factors leading to lower job satisfaction in this department could be crucial in reducing attrition rates.

3- The data indicates that employees who left the company worked with the same manager for an average of 3 years, compared to the company-wide average of 4.12 years, showing a difference of 27.18 % less. Additionally, these employees spent 20.74 % less time at the company overall. This suggests potential management issues within this department, which could be contributing to higher attrition rates.

4- The table below focuses on the Research & Development Department, which has a very high turnover rate. It shows that the number of employees who left the company is nearly 25% of those who stayed after reaching the three-year mark.

Validations Through Satatistics

Feature Engineering

Below, I will proceed with feature engineering that would help me later on to apply it on Machine Learning models.

features <- data %>%
  mutate(
    AttritionCode= ifelse(Attrition == "Yes", 1, 0),
    Gender = ifelse(Gender == "Male", 1, 0),
    Income= round(MonthlyIncome / 12),
    Satisfaction = case_when(
      data$JobSatisfaction >= 2 ~ 1,
      data$JobSatisfaction >= 0 ~ 0
    )
  ) %>%
  select(
   AttritionCode,
    Department,
    JobRole,
    Education,
    Gender,
    Income,
    YearsAtCompany,
    YearsSinceLastPromotion,
    YearsWithCurrManager,
    Satisfaction,
    PerformanceRating
  )

features <- na.omit(features)
features$AttritionCode <- factor(features$AttritionCode)
features$AttritionCode <- factor(features$AttritionCode)
features$Department <- factor(features$Department)
features$JobRole <- factor(features$JobRole)
features$Education <- factor(features$Education)
features$Gender <- factor(features$Gender)
features$PerformanceRating <- factor(features$PerformanceRating)
features$YearsSinceLastPromotion<- factor(features$YearsSinceLastPromotion)
features$YearsWithCurrManager<- factor(features$YearsWithCurrManager)



set.seed(123)

train_indices <- sample(seq_len(nrow(features)), size = .7 * nrow(features))

train_data <- features[train_indices, ]
test_data <- features[-train_indices, ]

## 
## Call:
## glm(formula = AttritionCode ~ Department + YearsWithCurrManager + 
##     Satisfaction, family = "binomial", data = train_data)
## 
## Coefficients:
##                                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                         0.33751    0.23673   1.426 0.153951    
## DepartmentResearch & Development   -0.60574    0.21802  -2.778 0.005463 ** 
## DepartmentSales                    -0.74332    0.23020  -3.229 0.001242 ** 
## YearsWithCurrManager1              -0.81284    0.23889  -3.403 0.000668 ***
## YearsWithCurrManager2              -1.06620    0.14685  -7.260 3.86e-13 ***
## YearsWithCurrManager3              -1.24640    0.20429  -6.101 1.05e-09 ***
## YearsWithCurrManager4              -1.28791    0.23784  -5.415 6.13e-08 ***
## YearsWithCurrManager5              -1.19616    0.39513  -3.027 0.002468 ** 
## YearsWithCurrManager6              -0.86738    0.37963  -2.285 0.022326 *  
## YearsWithCurrManager7              -0.99281    0.16380  -6.061 1.35e-09 ***
## YearsWithCurrManager8              -1.33553    0.23626  -5.653 1.58e-08 ***
## YearsWithCurrManager9              -1.35209    0.29865  -4.527 5.97e-06 ***
## YearsWithCurrManager10             -1.15667    0.39359  -2.939 0.003295 ** 
## YearsWithCurrManager11             -3.01380    1.01688  -2.964 0.003039 ** 
## YearsWithCurrManager12            -15.86262  389.69866  -0.041 0.967531    
## YearsWithCurrManager13            -15.85417  440.19133  -0.036 0.971269    
## YearsWithCurrManager14              0.06416    0.71916   0.089 0.928913    
## YearsWithCurrManager15            -15.57760  758.52748  -0.021 0.983615    
## YearsWithCurrManager16            -16.23053 1199.24568  -0.014 0.989202    
## YearsWithCurrManager17            -15.99342  792.07041  -0.020 0.983890    
## Satisfaction                       -0.68018    0.11823  -5.753 8.76e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2656.4  on 3072  degrees of freedom
## Residual deviance: 2470.7  on 3052  degrees of freedom
## AIC: 2512.7
## 
## Number of Fisher Scoring iterations: 15

## Accuracy: 82.08

## If attrition = Yes then 1 else 0

## If attrition = Yes then 1 else 0

## If attrition = Yes then 1 else 0

- The Logistic Regression model corroborates the initial findings with an accuracy of 82.08 %.

- We will proceed with another machine learning model, specifically a Decision Tree, to seek higher accuracy %

## Decision Tree Model Accuracy: 82.84

- The decision tree corroborates the initial findings with an accuracy of 82.84 %.

- We will proceed with another machine learning model, specifically a Random Forest, to seek higher accuracy %

##           AttritionCode              Department                 JobRole 
##                       0                       0                       0 
##               Education                  Gender                  Income 
##                       0                       0                       0 
##          YearsAtCompany YearsSinceLastPromotion    YearsWithCurrManager 
##                       0                       0                       0 
##            Satisfaction       PerformanceRating 
##                       0                       0

## 
##    0    1 
## 2595  478

## 
##    0    1 
## 1085  232

## Random Forest Model Accuracy: 89.22

- The random forest model corroborated the initial findings, achieving an accuracy of 89.22 %. The variable importance plot indicates that Income and YearsAtCompany are the most significant predictors of attrition, highlighting the importance of compensation and tenure. Managerial relationships (YearsWithCurrManager) and career progression (YearsSinceLastPromotion) also play critical roles in predicting employee attrition.

Analysis Recommendations

1- The management in the Research and Development department should undergo refresher leadership training and re-evaluation.

2- XYZ should aim to reduce the income gap and ensure that no job title or department is significantly underpaid or overpaid, aligning salaries with the overall company average.

3- Implement a policy to promote employees at least once every 2.5 years from their start date, as most attrition occurs around the three-year mark.

4- By addressing these recommendations, overall job satisfaction is likely to increase, which will enhance employee retention and optimize workforce stability.