Employee attrition is an important challenge for organizations, as high rates of employee turnover can result in higher recruitment costs, loss of expertise, and decreased productivity. Understanding the factors that shape the choices of employees to stay or leave is crucial in creating effective retention strategies. This study is based on an employee data set that includes demographic, job-related, and organizational factors that will analyze the patterns of attrition and identify key drivers of employee turnover. By using data analytics methods, the analysis is intended to offer information that can be used to support improved decision making in human resource management.
Install the packages, if the library is not exist in R. Load the library, if there are exist.
#install.packages("dplyr")
#install.packages("janitor")
#install.packages("ggplot2")
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(janitor)
##
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(ggplot2)
library(ggthemes)
There are two datasets.
train<-read.csv("test.csv")
test <-read.csv("train.csv")
# Quick structure overview
glimpse(train)
## Rows: 14,900
## Columns: 24
## $ Employee.ID <int> 52685, 30585, 54656, 33442, 15667, 3496, 4677…
## $ Age <int> 36, 35, 50, 58, 39, 45, 22, 34, 48, 55, 32, 2…
## $ Gender <chr> "Male", "Male", "Male", "Male", "Male", "Fema…
## $ Years.at.Company <int> 13, 7, 7, 44, 24, 30, 5, 15, 40, 16, 12, 15, …
## $ Job.Role <chr> "Healthcare", "Education", "Education", "Medi…
## $ Monthly.Income <int> 8029, 4563, 5583, 5525, 4604, 8104, 8700, 110…
## $ Work.Life.Balance <chr> "Excellent", "Good", "Fair", "Fair", "Good", …
## $ Job.Satisfaction <chr> "High", "High", "High", "Very High", "High", …
## $ Performance.Rating <chr> "Average", "Average", "Average", "High", "Ave…
## $ Number.of.Promotions <int> 1, 1, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2, 3, 0, 1, …
## $ Overtime <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "No", "No"…
## $ Distance.from.Home <int> 83, 55, 14, 43, 47, 38, 2, 9, 65, 31, 28, 35,…
## $ Education.Level <chr> "Master’s Degree", "Associate Degree", "Assoc…
## $ Marital.Status <chr> "Married", "Single", "Divorced", "Single", "M…
## $ Number.of.Dependents <int> 1, 4, 2, 4, 6, 0, 0, 4, 1, 1, 1, 1, 3, 0, 0, …
## $ Job.Level <chr> "Mid", "Entry", "Senior", "Entry", "Mid", "Se…
## $ Company.Size <chr> "Large", "Medium", "Medium", "Medium", "Large…
## $ Company.Tenure <int> 22, 27, 76, 96, 45, 75, 48, 16, 52, 46, 57, 9…
## $ Remote.Work <chr> "No", "No", "No", "No", "Yes", "No", "No", "N…
## $ Leadership.Opportunities <chr> "No", "No", "No", "No", "No", "No", "No", "No…
## $ Innovation.Opportunities <chr> "No", "No", "Yes", "No", "No", "No", "No", "N…
## $ Company.Reputation <chr> "Poor", "Good", "Good", "Poor", "Good", "Good…
## $ Employee.Recognition <chr> "Medium", "High", "Low", "Low", "High", "Low"…
## $ Attrition <chr> "Stayed", "Left", "Stayed", "Left", "Stayed",…
glimpse(test)
## Rows: 59,598
## Columns: 24
## $ Employee.ID <int> 8410, 64756, 30257, 65791, 65026, 24368, 6497…
## $ Age <int> 31, 59, 24, 36, 56, 38, 47, 48, 57, 24, 30, 2…
## $ Gender <chr> "Male", "Female", "Female", "Female", "Male",…
## $ Years.at.Company <int> 19, 4, 10, 7, 41, 3, 23, 16, 44, 1, 12, 6, 38…
## $ Job.Role <chr> "Education", "Media", "Healthcare", "Educatio…
## $ Monthly.Income <int> 5390, 5534, 8159, 3989, 4821, 9977, 3681, 112…
## $ Work.Life.Balance <chr> "Excellent", "Poor", "Good", "Good", "Fair", …
## $ Job.Satisfaction <chr> "Medium", "High", "High", "High", "Very High"…
## $ Performance.Rating <chr> "Average", "Low", "Low", "High", "Average", "…
## $ Number.of.Promotions <int> 2, 3, 0, 1, 0, 3, 1, 2, 1, 1, 1, 2, 1, 4, 0, …
## $ Overtime <chr> "No", "No", "No", "No", "Yes", "No", "Yes", "…
## $ Distance.from.Home <int> 22, 21, 11, 27, 71, 37, 75, 5, 39, 57, 51, 26…
## $ Education.Level <chr> "Associate Degree", "Master’s Degree", "Bache…
## $ Marital.Status <chr> "Married", "Divorced", "Married", "Single", "…
## $ Number.of.Dependents <int> 0, 3, 3, 2, 0, 0, 3, 4, 4, 4, 1, 0, 0, 2, 0, …
## $ Job.Level <chr> "Mid", "Mid", "Mid", "Mid", "Senior", "Mid", …
## $ Company.Size <chr> "Medium", "Medium", "Medium", "Small", "Mediu…
## $ Company.Tenure <int> 89, 21, 74, 50, 68, 47, 93, 88, 75, 45, 17, 3…
## $ Remote.Work <chr> "No", "No", "No", "Yes", "No", "No", "No", "N…
## $ Leadership.Opportunities <chr> "No", "No", "No", "No", "No", "No", "No", "No…
## $ Innovation.Opportunities <chr> "No", "No", "No", "No", "No", "Yes", "No", "N…
## $ Company.Reputation <chr> "Excellent", "Fair", "Poor", "Good", "Fair", …
## $ Employee.Recognition <chr> "Medium", "Low", "Low", "Medium", "Medium", "…
## $ Attrition <chr> "Stayed", "Stayed", "Stayed", "Stayed", "Stay…
summary(train)
## Employee.ID Age Gender Years.at.Company
## Min. : 5 Min. :18.00 Length:14900 Min. : 1.00
## 1st Qu.:18826 1st Qu.:28.00 Class :character 1st Qu.: 7.00
## Median :37433 Median :38.00 Mode :character Median :13.00
## Mean :37339 Mean :38.39 Mean :15.59
## 3rd Qu.:55858 3rd Qu.:49.00 3rd Qu.:23.00
## Max. :74471 Max. :59.00 Max. :51.00
## Job.Role Monthly.Income Work.Life.Balance Job.Satisfaction
## Length:14900 Min. : 1226 Length:14900 Length:14900
## Class :character 1st Qu.: 5634 Class :character Class :character
## Mode :character Median : 7332 Mode :character Mode :character
## Mean : 7287
## 3rd Qu.: 8852
## Max. :15063
## Performance.Rating Number.of.Promotions Overtime Distance.from.Home
## Length:14900 Min. :0.0000 Length:14900 Min. : 1.00
## Class :character 1st Qu.:0.0000 Class :character 1st Qu.:25.00
## Mode :character Median :1.0000 Mode :character Median :50.00
## Mean :0.8344 Mean :49.93
## 3rd Qu.:2.0000 3rd Qu.:75.00
## Max. :4.0000 Max. :99.00
## Education.Level Marital.Status Number.of.Dependents Job.Level
## Length:14900 Length:14900 Min. :0.000 Length:14900
## Class :character Class :character 1st Qu.:0.000 Class :character
## Mode :character Mode :character Median :1.000 Mode :character
## Mean :1.659
## 3rd Qu.:3.000
## Max. :6.000
## Company.Size Company.Tenure Remote.Work Leadership.Opportunities
## Length:14900 Min. : 2.0 Length:14900 Length:14900
## Class :character 1st Qu.: 36.0 Class :character Class :character
## Mode :character Median : 56.0 Mode :character Mode :character
## Mean : 55.6
## 3rd Qu.: 75.0
## Max. :127.0
## Innovation.Opportunities Company.Reputation Employee.Recognition
## Length:14900 Length:14900 Length:14900
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## Attrition
## Length:14900
## Class :character
## Mode :character
##
##
##
summary(test)
## Employee.ID Age Gender Years.at.Company
## Min. : 1 Min. :18.00 Length:59598 Min. : 1.00
## 1st Qu.:18580 1st Qu.:28.00 Class :character 1st Qu.: 7.00
## Median :37210 Median :39.00 Mode :character Median :13.00
## Mean :37227 Mean :38.57 Mean :15.75
## 3rd Qu.:55877 3rd Qu.:49.00 3rd Qu.:23.00
## Max. :74498 Max. :59.00 Max. :51.00
## Job.Role Monthly.Income Work.Life.Balance Job.Satisfaction
## Length:59598 Min. : 1316 Length:59598 Length:59598
## Class :character 1st Qu.: 5658 Class :character Class :character
## Mode :character Median : 7354 Mode :character Mode :character
## Mean : 7302
## 3rd Qu.: 8880
## Max. :16149
## Performance.Rating Number.of.Promotions Overtime Distance.from.Home
## Length:59598 Min. :0.0000 Length:59598 Min. : 1.00
## Class :character 1st Qu.:0.0000 Class :character 1st Qu.:25.00
## Mode :character Median :1.0000 Mode :character Median :50.00
## Mean :0.8326 Mean :50.01
## 3rd Qu.:2.0000 3rd Qu.:75.00
## Max. :4.0000 Max. :99.00
## Education.Level Marital.Status Number.of.Dependents Job.Level
## Length:59598 Length:59598 Min. :0.000 Length:59598
## Class :character Class :character 1st Qu.:0.000 Class :character
## Mode :character Mode :character Median :1.000 Mode :character
## Mean :1.648
## 3rd Qu.:3.000
## Max. :6.000
## Company.Size Company.Tenure Remote.Work
## Length:59598 Min. : 2.00 Length:59598
## Class :character 1st Qu.: 36.00 Class :character
## Mode :character Median : 56.00 Mode :character
## Mean : 55.76
## 3rd Qu.: 76.00
## Max. :128.00
## Leadership.Opportunities Innovation.Opportunities Company.Reputation
## Length:59598 Length:59598 Length:59598
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
## Employee.Recognition Attrition
## Length:59598 Length:59598
## Class :character Class :character
## Mode :character Mode :character
##
##
##
# Check missing values
colSums(is.na(train))
## Employee.ID Age Gender
## 0 0 0
## Years.at.Company Job.Role Monthly.Income
## 0 0 0
## Work.Life.Balance Job.Satisfaction Performance.Rating
## 0 0 0
## Number.of.Promotions Overtime Distance.from.Home
## 0 0 0
## Education.Level Marital.Status Number.of.Dependents
## 0 0 0
## Job.Level Company.Size Company.Tenure
## 0 0 0
## Remote.Work Leadership.Opportunities Innovation.Opportunities
## 0 0 0
## Company.Reputation Employee.Recognition Attrition
## 0 0 0
colSums(is.na(test))
## Employee.ID Age Gender
## 0 0 0
## Years.at.Company Job.Role Monthly.Income
## 0 0 0
## Work.Life.Balance Job.Satisfaction Performance.Rating
## 0 0 0
## Number.of.Promotions Overtime Distance.from.Home
## 0 0 0
## Education.Level Marital.Status Number.of.Dependents
## 0 0 0
## Job.Level Company.Size Company.Tenure
## 0 0 0
## Remote.Work Leadership.Opportunities Innovation.Opportunities
## 0 0 0
## Company.Reputation Employee.Recognition Attrition
## 0 0 0
# Check duplicates
get_dupes(train)
## No variable names specified - using all columns.
## No duplicate combinations found of: Employee.ID, Age, Gender, Years.at.Company, Job.Role, Monthly.Income, Work.Life.Balance, Job.Satisfaction, Performance.Rating, ... and 15 other variables
## [1] Employee.ID Age Gender
## [4] Years.at.Company Job.Role Monthly.Income
## [7] Work.Life.Balance Job.Satisfaction Performance.Rating
## [10] Number.of.Promotions Overtime Distance.from.Home
## [13] Education.Level Marital.Status Number.of.Dependents
## [16] Job.Level Company.Size Company.Tenure
## [19] Remote.Work Leadership.Opportunities Innovation.Opportunities
## [22] Company.Reputation Employee.Recognition Attrition
## [25] dupe_count
## <0 rows> (or 0-length row.names)
get_dupes(test)
## No variable names specified - using all columns.
##
## No duplicate combinations found of: Employee.ID, Age, Gender, Years.at.Company, Job.Role, Monthly.Income, Work.Life.Balance, Job.Satisfaction, Performance.Rating, ... and 15 other variables
## [1] Employee.ID Age Gender
## [4] Years.at.Company Job.Role Monthly.Income
## [7] Work.Life.Balance Job.Satisfaction Performance.Rating
## [10] Number.of.Promotions Overtime Distance.from.Home
## [13] Education.Level Marital.Status Number.of.Dependents
## [16] Job.Level Company.Size Company.Tenure
## [19] Remote.Work Leadership.Opportunities Innovation.Opportunities
## [22] Company.Reputation Employee.Recognition Attrition
## [25] dupe_count
## <0 rows> (or 0-length row.names)
# metadata states tenure in years but there are unrealistic values (e.g. 89,95)
# Convert tenure from months to years
train$Company.Tenure <- round(train$Company.Tenure /12,2)
test$Company.Tenure <- round(test$Company.Tenure /12,2)
## Check Age Vs Company.Tenure (must not exceed age)
train %>% filter(Company.Tenure > Age)
## [1] Employee.ID Age Gender
## [4] Years.at.Company Job.Role Monthly.Income
## [7] Work.Life.Balance Job.Satisfaction Performance.Rating
## [10] Number.of.Promotions Overtime Distance.from.Home
## [13] Education.Level Marital.Status Number.of.Dependents
## [16] Job.Level Company.Size Company.Tenure
## [19] Remote.Work Leadership.Opportunities Innovation.Opportunities
## [22] Company.Reputation Employee.Recognition Attrition
## <0 rows> (or 0-length row.names)
test %>% filter(Company.Tenure > Age)
## [1] Employee.ID Age Gender
## [4] Years.at.Company Job.Role Monthly.Income
## [7] Work.Life.Balance Job.Satisfaction Performance.Rating
## [10] Number.of.Promotions Overtime Distance.from.Home
## [13] Education.Level Marital.Status Number.of.Dependents
## [16] Job.Level Company.Size Company.Tenure
## [19] Remote.Work Leadership.Opportunities Innovation.Opportunities
## [22] Company.Reputation Employee.Recognition Attrition
## <0 rows> (or 0-length row.names)
## Check Age Vs Years.at.Company (must not exceed age)
checkdata2<-function(df){
# Filter and count rows where Age < Years.at.Company
issue_count<- df %>%
filter(Age<Years.at.Company) %>%
nrow()
# Check the count
if(issue_count== 0) {
print("No problem.No one has years_at_company greater than age.")
} else {
print(paste(issue_count,"rows have years_at_company > age"))
}
}
checkdata2(train)
## [1] "No problem.No one has years_at_company greater than age."
checkdata2(test)
## [1] "No problem.No one has years_at_company greater than age."
# Convert categorical variables to factors
type_change <- function(df){
categorical_cols<-c("Gender","Job.Role","Work.Life.Balance","Job.Satisfaction",
"Performance.Rating","Marital.Status","Overtime","Education.Level",
"Job.Level","Company.Size","Remote.Work","Leadership.Opportunities",
"Innovation.Opportunities","Company.Reputation","Employee.Recognition",
"Attrition")
for (col in categorical_cols){
if(col %in% names(df)){
df[[col]] <- as.factor(df[[col]])
}
}
return(df)
}
train <- type_change(train)
test <- type_change(test)
glimpse(train)
## Rows: 14,900
## Columns: 24
## $ Employee.ID <int> 52685, 30585, 54656, 33442, 15667, 3496, 4677…
## $ Age <int> 36, 35, 50, 58, 39, 45, 22, 34, 48, 55, 32, 2…
## $ Gender <fct> Male, Male, Male, Male, Male, Female, Female,…
## $ Years.at.Company <int> 13, 7, 7, 44, 24, 30, 5, 15, 40, 16, 12, 15, …
## $ Job.Role <fct> Healthcare, Education, Education, Media, Educ…
## $ Monthly.Income <int> 8029, 4563, 5583, 5525, 4604, 8104, 8700, 110…
## $ Work.Life.Balance <fct> Excellent, Good, Fair, Fair, Good, Fair, Good…
## $ Job.Satisfaction <fct> High, High, High, Very High, High, High, High…
## $ Performance.Rating <fct> Average, Average, Average, High, Average, Ave…
## $ Number.of.Promotions <int> 1, 1, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2, 3, 0, 1, …
## $ Overtime <fct> Yes, Yes, Yes, Yes, Yes, No, No, No, No, No, …
## $ Distance.from.Home <int> 83, 55, 14, 43, 47, 38, 2, 9, 65, 31, 28, 35,…
## $ Education.Level <fct> Master’s Degree, Associate Degree, Associate …
## $ Marital.Status <fct> Married, Single, Divorced, Single, Married, D…
## $ Number.of.Dependents <int> 1, 4, 2, 4, 6, 0, 0, 4, 1, 1, 1, 1, 3, 0, 0, …
## $ Job.Level <fct> Mid, Entry, Senior, Entry, Mid, Senior, Mid, …
## $ Company.Size <fct> Large, Medium, Medium, Medium, Large, Large, …
## $ Company.Tenure <dbl> 1.83, 2.25, 6.33, 8.00, 3.75, 6.25, 4.00, 1.3…
## $ Remote.Work <fct> No, No, No, No, Yes, No, No, No, No, No, No, …
## $ Leadership.Opportunities <fct> No, No, No, No, No, No, No, No, No, No, No, N…
## $ Innovation.Opportunities <fct> No, No, Yes, No, No, No, No, No, No, No, No, …
## $ Company.Reputation <fct> Poor, Good, Good, Poor, Good, Good, Poor, Goo…
## $ Employee.Recognition <fct> Medium, High, Low, Low, High, Low, High, Low,…
## $ Attrition <fct> Stayed, Left, Stayed, Left, Stayed, Stayed, S…
glimpse(test)
## Rows: 59,598
## Columns: 24
## $ Employee.ID <int> 8410, 64756, 30257, 65791, 65026, 24368, 6497…
## $ Age <int> 31, 59, 24, 36, 56, 38, 47, 48, 57, 24, 30, 2…
## $ Gender <fct> Male, Female, Female, Female, Male, Female, M…
## $ Years.at.Company <int> 19, 4, 10, 7, 41, 3, 23, 16, 44, 1, 12, 6, 38…
## $ Job.Role <fct> Education, Media, Healthcare, Education, Educ…
## $ Monthly.Income <int> 5390, 5534, 8159, 3989, 4821, 9977, 3681, 112…
## $ Work.Life.Balance <fct> Excellent, Poor, Good, Good, Fair, Fair, Fair…
## $ Job.Satisfaction <fct> Medium, High, High, High, Very High, High, Hi…
## $ Performance.Rating <fct> Average, Low, Low, High, Average, Below Avera…
## $ Number.of.Promotions <int> 2, 3, 0, 1, 0, 3, 1, 2, 1, 1, 1, 2, 1, 4, 0, …
## $ Overtime <fct> No, No, No, No, Yes, No, Yes, No, Yes, Yes, N…
## $ Distance.from.Home <int> 22, 21, 11, 27, 71, 37, 75, 5, 39, 57, 51, 26…
## $ Education.Level <fct> Associate Degree, Master’s Degree, Bachelor’s…
## $ Marital.Status <fct> Married, Divorced, Married, Single, Divorced,…
## $ Number.of.Dependents <int> 0, 3, 3, 2, 0, 0, 3, 4, 4, 4, 1, 0, 0, 2, 0, …
## $ Job.Level <fct> Mid, Mid, Mid, Mid, Senior, Mid, Entry, Entry…
## $ Company.Size <fct> Medium, Medium, Medium, Small, Medium, Medium…
## $ Company.Tenure <dbl> 7.42, 1.75, 6.17, 4.17, 5.67, 3.92, 7.75, 7.3…
## $ Remote.Work <fct> No, No, No, Yes, No, No, No, No, No, No, No, …
## $ Leadership.Opportunities <fct> No, No, No, No, No, No, No, No, No, No, No, N…
## $ Innovation.Opportunities <fct> No, No, No, No, No, Yes, No, No, No, Yes, No,…
## $ Company.Reputation <fct> Excellent, Fair, Poor, Good, Fair, Fair, Good…
## $ Employee.Recognition <fct> Medium, Low, Low, Medium, Medium, High, Mediu…
## $ Attrition <fct> Stayed, Stayed, Stayed, Stayed, Stayed, Left,…
# Check outliers for Monthly.Income with Boxplot
ggplot(train, aes(y=Monthly.Income)) + geom_boxplot()
ggplot(test, aes(y=Monthly.Income)) + geom_boxplot()
# Remove extreme outliers from training set
Q1 <- quantile(train$Monthly.Income, 0.25)
Q3 <- quantile(train$Monthly.Income, 0.75)
IQR <- Q3 - Q1
train_clean <- train %>%
filter(Monthly.Income >(Q1-1.5*IQR) & Monthly.Income < (Q3+1.5*IQR))
ggplot(train_clean, aes(y=Monthly.Income)) + geom_boxplot()
# Remove extreme outliers from testing set
Q1 <- quantile(test$Monthly.Income, 0.25)
Q3 <- quantile(test$Monthly.Income, 0.75)
IQR <- Q3 - Q1
test_clean <- test %>% filter(Monthly.Income >(Q1-1.5*IQR) & Monthly.Income < (Q3+1.5*IQR))
ggplot(test_clean, aes(y=Monthly.Income)) + geom_boxplot()
# Final versions
# View(train_clean)
# View(test_clean)
# Export cleaned data
# write.csv(train_clean, "train_clean.csv",row.names = F)
# write.csv(test_clean, "test_clean.csv",row.names = F)
Graph 1: Monthly Income vs Years at Company with Job Satisfaction
High income doesn’t guarantee high satisfaction
- The green and blue dots (High and Very High Job Satisfaction) are
scattered across all income levels.
- Some employees with high monthly income are in the red (Low
satisfaction), suggesting that money alone does not ensure job
satisfaction.
Longer tenure doesn’t guarantee higher pay
- On the x-axis (Years at Company), even employees with 40–50 years at
the company do not always have high income.
- Income appears widely distributed for almost all tenure lengths,
indicating that salary growth is not strictly tied to years of
service.
Job satisfaction is not strongly correlated with tenure or
income
- All four colors (satisfaction levels) are fairly mixed across the
chart.
- This suggests that factors other than income or tenure—like work-life
balance, role fit, or company culture—may play a stronger role in job
satisfaction.
## 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.
## Ignoring unknown labels:
## • fill : "Attrition"
Graph 2: Employee Attrition by Age
The probability of employees staying in the company increases
with age.
The “Stayed” line is generally higher than the “Left” line for older age groups.
Younger employees show higher attrition rates.
At lower ages, the number of employees who left is closer to or higher than those who stayed.
As age increases, the gap between staying and leaving
widens.
This suggests improved job stability among older employees.
Older employees may have stronger job commitment, possibly due to career stability, family responsibilities, or accumulated benefits.
Graph 3: Total Number of Promotions by Performance Rating
Employees with average and above-average performance ratings have
a higher chance of receiving promotions.
The total number of promotions is highest for employees with an Average performance rating.
Employees with below-average or low performance receive
significantly fewer promotions.
Promotion counts are lowest in the Low and Below Average categories.
This trend is consistent across all job levels (Entry, Mid, and
Senior).
Entry- and mid-level employees show higher promotion counts
compared to senior employees.
Overall, the chart suggests that better performance increases promotion opportunities, regardless of job level.
Function
Calculate Coefficients
Coefficient - The change in the dependent variable for a one-unit change
in the independent variable, holding all other predictors
constant.
- E.g. coefficient for Age ~ 0.2152248, every one year increase in age,
the Monthly Income is predicted to increase 0.2152248
Intercept - The predicted value of the dependent variable when all
independent variables are zero
- E.g. If all predictors (Age, Year at Company, Distance from Home) were
zero, 7321.7292215 is the baseline Monthly income
calculate_coef <- function (linear_model){
summary(linear_model)
print("Linear Model Coefficients:")
print(coef(linear_model))
}
Root Mean Squared Error (MSE)
Root Mean Squared Error measures the amount of error in statistical
model. It calculates the average squared difference between the observed
and predicted values.
R-Square (Coefficient of Determination)
R-Square measures how well a statistical model explains the variability
of the observed data. It calculates the proportion of variance in the
dependent variable that is predictable from the independent
variables.
calculate_rmse <- function (test_clean_dependent, test_predictions_lm){
rmse_test_lm <- sqrt(mean((test_clean_dependent - test_predictions_lm)^2))
print(paste("Test Data RMSE:", round(rmse_test_lm, 2)))
return (round(rmse_test_lm, 2))
}
calculate_rsquared <- function (test_clean_dependent, test_predictions_lm){
sst_test_lm <- sum((test_clean_dependent - mean(test_clean_dependent))^2) # Total Sum of Squares
sse_test_lm <- sum((test_clean_dependent - test_predictions_lm)^2) # Sum of Squared Errors
r_squared_test_lm <- 1 - (sse_test_lm / sst_test_lm)
print(paste("Test Data R-squared:", round(r_squared_test_lm, 4)))
}
Train the model based on train data
Model Equation - Monthly Income = β0 + β1(Age) +
β2(Years at Company) + β3(Distance from Home) + ϵ
- β0 is the Intercept
- β1 ,β2 ,β3 are the Estimates (Coefficients) for the respective
variables.
- ϵ is the error term (residuals).
Model A
- Dependent Variable (Y) - Monthly Income
- Independent Variable (X) - Age, Year at Company, Distance from
Home
linear_modelA <- lm(Monthly.Income ~ Age + Years.at.Company + Distance.from.Home, data = train_clean)
test_predictions_lmA <- predict(linear_modelA, newdata = test_clean)
# Calculate Model A Coefficients
calculate_coef(linear_modelA)
## [1] "Linear Model Coefficients:"
## (Intercept) Age Years.at.Company Distance.from.Home
## 7283.6747737 0.7791033 -2.5007546 0.1068661
# Calculate Model A RMSE
my_rmse = calculate_rmse(test_clean$Monthly.Income, test_predictions_lmA)
## [1] "Test Data RMSE: 2142.82"
# Calculate Model A Error Percentage
# Percentage Error = (RMSE / Average Salary) * 100
(my_rmse / (mean(train_clean$Monthly.Income))) * 100
## [1] 29.4346
# Calculate Model A RSquare
calculate_rsquared(test_clean$Monthly.Income, test_predictions_lmA)
## [1] "Test Data R-squared: -1e-04"
Monthly Income = 7283.6748 + 0.7791(Age) - 2.5008(Years at Company) + 0.1069(Distance from Home)
RMSE: 2142.82
Percentage Error: 29.4346%
R-squared: 0
Summary for Model A (Age + Year at Company + Distance from
Home)
- The combination of variables (Age, Year at Company, Distance from
home) has failed to predict Monthly Income.
- “Test Data R-squared: 0” - The model explains 0% of the variation in
salary.
- “Age: 0.7791 | Years.at.Company: -2.5008” - For every 1 year older an
employee get, the model predict salary increase by 78 cents and for
every 1 additional year stay at the company, their salary deduct by
$2.50.
- “Intercept = 7283” - The model is predicting 7283 is the base salary
regardless the independent variable.
Model B
Dependent Variable (Y) - Monthly Income
Independent Variable (X) - Job Role
#Convert categorical variables to factors
train_clean$Job.Role <- as.factor(train_clean$Job.Role)
linear_modelB <- lm(Monthly.Income ~ Job.Role, data = train_clean)
test_predictions_lmB <- predict(linear_modelB, newdata = test_clean)
# Calculate Coefficients for Model B
calculate_coef(linear_modelB)
## [1] "Linear Model Coefficients:"
## (Intercept) Job.RoleFinance Job.RoleHealthcare Job.RoleMedia
## 4489.902 4005.537 3514.999 1504.310
## Job.RoleTechnology
## 4619.577
# Calculate Model B RMSE
my_rmse = calculate_rmse(test_clean$Monthly.Income, test_predictions_lmB)
## [1] "Test Data RMSE: 1232.39"
# Calculate Model B Error Percentage
# Percentage Error = (RMSE / Average Salary) * 100
(my_rmse / (mean(train_clean$Monthly.Income))) * 100
## [1] 16.92858
# Calculate Model A RSquare
calculate_rsquared(test_clean$Monthly.Income, test_predictions_lmB)
## [1] "Test Data R-squared: 0.6692"
Job Role: Calculation -> Predicted Monthly Income
Baseline Role: 4,490 + 0 = $4,490
Media: 4,490 + 1,504 = $5,994
Healthcare: 4,490 + 3,515 = $8,005
Finance: 4,490 + 4,006 = $8,496
Technology: 4,490 + 4,620 = $9,110
RMSE: 1232.39
Percentage Error: 16.92858%
R-squared: 0.6692
Summary for Model B (Job Role)
- The Job Role as the predictor is provides meaningful business
insights.
- “Test Data R-squared: 0.6692” - The model explains 66.92% of the
variance in salary.
- “Error Percentage: 16.93%” - The relative error percentage is under
20%. Around 17% margin of error is quite reliable for general payroll
budgeting.
- “Intercept = 4490” - The model is predicting 4490 is the average
salary of the base. The predicted salary calculation is the base salary
+ role.
Boxplot with Predicted Mean
- It shows the actual distribution of salaries for each role and marks
exactly where your model’s coefficients are placing the “average.”
Actual vs Predicted Plot
- It plots what the employee actually earns against what the model
predicted.
- The closer the columns to the diagonal line, the better the model
is.
# Boxplot
ggplot(train_clean, aes(x = Job.Role, y = Monthly.Income, fill = Job.Role)) +
geom_boxplot(alpha = 0.5) +
stat_summary(fun = mean, geom = "point", shape = 20, size = 4, color = "red") +
theme_minimal() +
labs(title = "Salary Distribution by Job Role",
subtitle = "Red dots represent the Model B predicted means",
y = "Monthly Income", x = "Job Role")
# Actual vs Predicted Plot
results <- data.frame(Actual = test_clean$Monthly.Income, Predicted = test_predictions_lmB)
ggplot(results, aes(x = Predicted, y = Actual)) +
geom_point(color = "darkblue", alpha = 0.6) +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
theme_minimal() +
labs(title = "Actual vs. Predicted Monthly Income",
subtitle = "Closer to the dashed line means higher accuracy")
# install.packages("readr")
library(readr)
library(ggplot2)
# This function takes the original Overtime value and prefixes it with "Overtime: "
overtime_labeller <- function(labels) {
lapply(labels, function(x) {
if (names(labels)[1] == "Overtime") {
paste("Overtime:", x)
} else {
x
}
})
}
train_clean$Attrition = as.factor(train_clean$Attrition)
# Create the Plot for data visualization
attrition_interaction_plot <- ggplot(train_clean, aes(x = Job.Level, fill = Attrition)) +
geom_bar(position = "stack") +
facet_grid(Gender ~ Overtime, scales = "free_y", labeller = overtime_labeller) +
labs(
title = "Attrition Count across Job Level, Gender, and Overtime",
x = "Job Level",
y = "Count of Staff",
fill = "Attrition Status"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 16)
)
print(attrition_interaction_plot)
# Convert 'Attrition' to a binary variable where 'Stayed' = 0 and 'Left' = 1
train_clean$Attrition_Binary <- ifelse(train_clean$Attrition == "Left", 1, 0)
test_clean$Attrition_Binary <- ifelse(test_clean$Attrition == "Left", 1, 0)
# Predict Attrition_Binary using Age, Monthly.Income, Job.Level, Gender, and Overtime
logistic_formula <- Attrition_Binary ~ Age + Monthly.Income + Job.Level + Gender + Overtime
# Train the model on train_clean
logistic_model <- glm(
logistic_formula,
family = binomial(link = "logit"), # Specifies the logistic regression model
data = train_clean
)
# Predict probabilities on the Test Data
test_probabilities_logit <- predict(logistic_model, newdata = test_clean, type = "response")
# Convert probabilities to binary predictions (using a 0.5 threshold)
test_predictions_logit <- ifelse(test_probabilities_logit > 0.5, 1, 0)
# Confusion Matrix
conf_matrix_logit <- table(Actual = test_clean$Attrition_Binary, Predicted = test_predictions_logit)
print("Confusion Matrix on Test Data (0=Stayed, 1=Left):")
## [1] "Confusion Matrix on Test Data (0=Stayed, 1=Left):"
print(conf_matrix_logit)
## Predicted
## Actual 0 1
## 0 19783 11452
## 1 9967 18345
True Positives (18345) - Right Bottom: Staff members who actually
left and the model correctly predicted they would leave. (Good)
True Negatives (19783) - Left Top: Staff members who actually stayed and
the model correctly predicted they would stay. (Good)
False Positives (11452) - Left Bottom: Staff members who stayed but the
model incorrectly predicted would leave (False Alarms).
False Negatives (9967) - Right Top: Staff members who left but the model
incorrectly predicted would stay (Missed Opportunities for
Intervention).
# Calculate Accuracy
accuracy_logit <- sum(diag(conf_matrix_logit)) / sum(conf_matrix_logit)
print(paste("Test Data Accuracy:", round(accuracy_logit, 4)))
## [1] "Test Data Accuracy: 0.6403"
# The model was correct in its prediction (Left or Stayed) for 64.03% of the staff in the test dataset.
# Metric - F1 Score Evaluation
# Extract components from the Confusion Matrix
TP <- conf_matrix_logit[2, 2] # True Positives (Predicted 1, Actual 1)
FP <- conf_matrix_logit[2, 1] # False Positives (Predicted 1, Actual 0)
FN <- conf_matrix_logit[1, 2] # False Negatives (Predicted 0, Actual 1)
TN <- conf_matrix_logit[1, 1] # True Negatives (Predicted 0, Actual 0)
# Calculate Precision, Recall, and F1-Score for the POSITIVE CLASS (1 = Left)
precision <- TP / (TP + FP)
recall <- TP / (TP + FN)
f1_score <- 2 * (precision * recall) / (precision + recall)
print("--- Logistic Regression F1-Score Evaluation ---")
## [1] "--- Logistic Regression F1-Score Evaluation ---"
print("Confusion Matrix (Positive Class: 1 = Left):")
## [1] "Confusion Matrix (Positive Class: 1 = Left):"
print(conf_matrix_logit)
## Predicted
## Actual 0 1
## 0 19783 11452
## 1 9967 18345
print(paste("Precision:", round(precision, 4)))
## [1] "Precision: 0.648"
#- When the model flags an employee as "Likely to Leave," it is correct 64.8% of the time.
print(paste("Recall (Sensitivity):", round(recall, 4)))
## [1] "Recall (Sensitivity): 0.6157"
#- The model successfully catches 61.57% of the people who actually end up leaving.
print(paste("F1-Score:", round(f1_score, 4)))
## [1] "F1-Score: 0.6314"
#- Solid baseline for human behavior prediction
The analysis indicates that Job Role and Job Level are the main determinants of the employee income, whereas the basic factors such as age, tenure, or distance to home do not influence it significantly. Attrition can be predicted moderately effectively, with higher job level employees or those working overtime having more chances of leaving. In general, these findings demonstrate that role-based and work-condition variables have the greatest impact on income and attrition, which can be used as actionable insights to guide HR policies and retention practices.
The linear regression results show that Model A, which included only Age, Years at Company, and Distance from Home, performed poorly, with an R-squared close to zero. This indicates that basic demographic and location factors do not meaningfully explain variations in Monthly Income.
In contrast, Model B, which added Job Role and Job Level, showed a significant improvement, achieving an R-squared of 0.6692 and a much lower MSE. This highlights that job-related factors are the primary determinants of employee income, while age and tenure have minimal impact.
For attrition prediction, the logistic regression model achieved moderate performance, with an accuracy of 64.03% and an F1-score of 0.63. The confusion matrix indicates some misclassification, but overall the model is reasonably effective. Variables such as Job Level and Overtime appear to play an important role in predicting employee turnover.
Overall, the results indicate that role-based and work-condition variables have the strongest influence on both income and attrition. While basic demographic factors contribute little explanatory power, job-related characteristics provide meaningful insights. These findings can help HR departments design targeted compensation structures and proactive retention strategies.