1. Introduction

Employee attrition — the voluntary or involuntary departure of staff — is one of the most pressing challenges modern organisations face. Every employee who leaves takes institutional knowledge, productivity, and morale with them, while the company is left with recruitment and training costs that can easily exceed one year’s salary for specialised roles. Being able to predict which employees are at risk of leaving before they actually hand in their notice gives management a meaningful window to intervene.

In this analysis, we build and compare three logistic regression models of increasing complexity to predict whether an employee will stay or leave:

Model	Predictors
Model 1	`MonthlyIncome` only
Model 2	`MonthlyIncome` + `Overtime`
Model 3	All available predictors (`attrition ~ .`)

We evaluate each model using a comprehensive suite of metrics — accuracy, sensitivity, specificity, precision, recall, F1-score, and AUC — and draw practical conclusions for HR decision-makers.

2. Load Packages

We use a curated set of packages. Every package has a clear role:

# ── Core tidyverse for data wrangling and visualisation ──
library(tidyverse)

# ── Modelling & evaluation ──
library(caret)       # confusionMatrix(), train()
library(pROC)        # ROC curves and AUC

# ── Model summaries ──
library(broom)       # tidy() for clean coefficient tables

# ── Visualisation extras ──
library(scales)      # percent_format()
library(ggplot2)
library(patchwork)   # combine multiple ggplots

# ── Tables ──
library(knitr)
library(kableExtra)

3. Data Import & Cleaning

3.1 Import

# ── Read the dataset ──────────────────────────────────────────────────────────
# Adjust the path to wherever you have saved the CSV extracted from the zip
raw_df <- read_csv("employee_attrition.csv", show_col_types = FALSE)

# Quick look
glimpse(raw_df)

## Rows: 14,900
## Columns: 24
## $ `Employee ID`              <dbl> 52685, 30585, 54656, 33442, 15667, 3496, 46…
## $ Age                        <dbl> 36, 35, 50, 58, 39, 45, 22, 34, 48, 55, 32,…
## $ Gender                     <chr> "Male", "Male", "Male", "Male", "Male", "Fe…
## $ `Years at Company`         <dbl> 13, 7, 7, 44, 24, 30, 5, 15, 40, 16, 12, 15…
## $ `Job Role`                 <chr> "Healthcare", "Education", "Education", "Me…
## $ `Monthly Income`           <dbl> 8029, 4563, 5583, 5525, 4604, 8104, 8700, 1…
## $ `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", "A…
## $ `Number of Promotions`     <dbl> 1, 1, 3, 0, 0, 0, 0, 1, 0, 0, 0, 2, 3, 0, 1…
## $ Overtime                   <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "No", "N…
## $ `Distance from Home`       <dbl> 83, 55, 14, 43, 47, 38, 2, 9, 65, 31, 28, 3…
## $ `Education Level`          <chr> "Master’s Degree", "Associate Degree", "Ass…
## $ `Marital Status`           <chr> "Married", "Single", "Divorced", "Single", …
## $ `Number of Dependents`     <dbl> 1, 4, 2, 4, 6, 0, 0, 4, 1, 1, 1, 1, 3, 0, 0…
## $ `Job Level`                <chr> "Mid", "Entry", "Senior", "Entry", "Mid", "…
## $ `Company Size`             <chr> "Large", "Medium", "Medium", "Medium", "Lar…
## $ `Company Tenure`           <dbl> 22, 27, 76, 96, 45, 75, 48, 16, 52, 46, 57,…
## $ `Remote Work`              <chr> "No", "No", "No", "No", "Yes", "No", "No", …
## $ `Leadership Opportunities` <chr> "No", "No", "No", "No", "No", "No", "No", "…
## $ `Innovation Opportunities` <chr> "No", "No", "Yes", "No", "No", "No", "No", …
## $ `Company Reputation`       <chr> "Poor", "Good", "Good", "Poor", "Good", "Go…
## $ `Employee Recognition`     <chr> "Medium", "High", "Low", "Low", "High", "Lo…
## $ Attrition                  <chr> "Stayed", "Left", "Stayed", "Left", "Stayed…

3.2 Initial Quality Check

# Dimensions
cat("Rows:", nrow(raw_df), " | Columns:", ncol(raw_df), "\n\n")

## Rows: 14900  | Columns: 24

# Missing values – none expected but always verify
missing_summary <- raw_df %>%
  summarise(across(everything(), ~ sum(is.na(.)))) %>%
  pivot_longer(everything(), names_to = "Variable", values_to = "Missing") %>%
  filter(Missing > 0)

if (nrow(missing_summary) == 0) {
  cat("✓ No missing values detected across any column.\n")
} else {
  print(missing_summary)
}

## ✓ No missing values detected across any column.

# Attrition class distribution
raw_df %>%
  count(Attrition) %>%
  mutate(Proportion = n / sum(n)) %>%
  kable(caption = "Attrition Class Distribution", digits = 3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Attrition Class Distribution
Attrition	n	Proportion
Left	7032	0.472
Stayed	7868	0.528

3.3 Cleaning & Feature Engineering

The dataset uses spaces in column names and stores several variables as character strings that need to become proper factors. We also rename columns to R-friendly names and convert the target variable Attrition to a binary factor (1 = Left, 0 = Stayed).

# ── Clean and prepare the data ────────────────────────────────────────────────
df <- raw_df %>%
  # Step 1: Standardise column names (snake_case, no spaces/hyphens)
  rename_with(~ str_replace_all(., "[ -]", "_") %>% str_to_lower()) %>%

  # Step 2: Drop employee_id – it is just a row identifier, not a predictor
  select(-employee_id) %>%

  # Step 3: Convert all character columns to factors
  mutate(across(where(is.character), as.factor)) %>%

  # Step 4: Re-code the target so "Left" = 1 (positive class), "Stayed" = 0
  #         caret expects the *first* factor level to be the positive class
  mutate(attrition = factor(attrition,
                            levels = c("Left", "Stayed"),
                            labels = c("Left",  "Stayed")))

# Rename a couple of columns that will be referenced explicitly in models
# so the code stays readable
df <- df %>%
  rename(
    monthly_income  = monthly_income,
    overtime        = overtime
  )

# Confirm factor levels of target
cat("Target levels (positive class first):", levels(df$attrition), "\n\n")

## Target levels (positive class first): Left Stayed

# Final structure
glimpse(df)

## Rows: 14,900
## Columns: 23
## $ age                      <dbl> 36, 35, 50, 58, 39, 45, 22, 34, 48, 55, 32, 2…
## $ gender                   <fct> Male, Male, Male, Male, Male, Female, Female,…
## $ years_at_company         <dbl> 13, 7, 7, 44, 24, 30, 5, 15, 40, 16, 12, 15, …
## $ job_role                 <fct> Healthcare, Education, Education, Media, Educ…
## $ monthly_income           <dbl> 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     <dbl> 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       <dbl> 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     <dbl> 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> 22, 27, 76, 96, 45, 75, 48, 16, 52, 46, 57, 9…
## $ 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…

# ── Visualise class balance ───────────────────────────────────────────────────
df %>%
  count(attrition) %>%
  mutate(pct = n / sum(n)) %>%
  ggplot(aes(x = attrition, y = n, fill = attrition)) +
  geom_col(width = 0.5, colour = "white") +
  geom_text(aes(label = paste0(n, "\n(", percent(pct, accuracy = 0.1), ")")),
            vjust = -0.4, size = 4.5, fontface = "bold") +
  scale_fill_manual(values = c("Left" = "#E74C3C", "Stayed" = "#2ECC71")) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(title    = "Attrition Distribution in the Dataset",
       subtitle = "The classes are roughly balanced (~47% Left, ~53% Stayed)",
       x = "Attrition Status", y = "Count", fill = NULL) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "none",
        plot.title       = element_text(face = "bold"),
        panel.grid.major.x = element_blank())

Figure 1: Class balance of the target variable.

4. Exploratory Data Analysis

Before fitting any models it is worth understanding how the key predictors relate to attrition.

# Monthly income by attrition
p1 <- ggplot(df, aes(x = attrition, y = monthly_income, fill = attrition)) +
  geom_violin(alpha = 0.6, trim = FALSE) +
  geom_boxplot(width = 0.15, fill = "white", outlier.shape = 21, outlier.size = 1.5) +
  scale_fill_manual(values = c("Left" = "#E74C3C", "Stayed" = "#2ECC71")) +
  scale_y_continuous(labels = dollar_format()) +
  labs(title = "Monthly Income by Attrition",
       x = "Attrition", y = "Monthly Income (USD)", fill = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"))

# Overtime by attrition
p2 <- df %>%
  count(overtime, attrition) %>%
  group_by(overtime) %>%
  mutate(prop = n / sum(n)) %>%
  filter(attrition == "Left") %>%
  ggplot(aes(x = overtime, y = prop, fill = overtime)) +
  geom_col(width = 0.5, colour = "white") +
  geom_text(aes(label = percent(prop, accuracy = 0.1)), vjust = -0.5, fontface = "bold") +
  scale_y_continuous(labels = percent_format(), limits = c(0, 0.7)) +
  scale_fill_manual(values = c("No" = "#3498DB", "Yes" = "#E67E22")) +
  labs(title = "Attrition Rate by Overtime",
       x = "Works Overtime?", y = "Proportion Who Left", fill = NULL) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none", plot.title = element_text(face = "bold"))

p1 + p2

Figure 2: Monthly income distribution by attrition status.

Observation: Employees who left tend to earn lower monthly incomes on average. Those who work overtime show a substantially higher attrition rate — this already hints that both predictors will carry meaningful signal in the models.

5. Train / Test Split

We use a 70:30 split. Setting the seed guarantees that this script produces identical results every time it is run — a basic reproducibility requirement for academic work.

set.seed(42)  # ensures reproducibility

# ── Partition indices ─────────────────────────────────────────────────────────
train_idx <- createDataPartition(df$attrition, p = 0.70, list = FALSE)

train_df <- df[ train_idx, ]
test_df  <- df[-train_idx, ]

cat("Training set:", nrow(train_df), "rows |",
    "Test set:", nrow(test_df), "rows\n\n")

## Training set: 10431 rows | Test set: 4469 rows

# Confirm class balance is preserved in both splits
bind_rows(
  train_df %>% count(attrition) %>% mutate(Set = "Train", Pct = n / sum(n)),
  test_df  %>% count(attrition) %>% mutate(Set = "Test",  Pct = n / sum(n))
) %>%
  pivot_wider(names_from = Set, values_from = c(n, Pct)) %>%
  kable(caption = "Class Distribution After Split", digits = 3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Class Distribution After Split
attrition	n_Train	n_Test	Pct_Train	Pct_Test
Left	4923	2109	0.472	0.472
Stayed	5508	2360	0.528	0.528

The createDataPartition() function in caret performs stratified sampling, so the Left / Stayed ratio is preserved in both splits — exactly what we want when dealing with a (near) imbalanced target.

6. Model Estimation

All three models use glm(..., family = binomial) which fits logistic regression via maximum likelihood estimation.

6.1 Model 1 – `attrition ~ monthly_income`

# ── Model 1: Monthly Income only ─────────────────────────────────────────────
model1 <- glm(attrition ~ monthly_income,
              data   = train_df,
              family = binomial(link = "logit"))

# Tidy summary using broom
tidy_m1 <- tidy(model1, conf.int = TRUE, exponentiate = FALSE)

tidy_m1 %>%
  mutate(across(where(is.numeric), ~ round(., 4))) %>%
  kable(caption = "Model 1 Coefficients (log-odds scale)", align = "lrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

Model 1 Coefficients (log-odds scale)
term	estimate	std.error	statistic	p.value	conf.low	conf.high
(Intercept)	0.042	0.0692	0.6067	0.5440	-0.0937	0.1777
monthly_income	0.000	0.0000	1.0590	0.2896	0.0000	0.0000

Interpretation – Model 1

The logistic regression equation for Model 1 is:

\[\log\!\left(\frac{P(\text{Left})}{1 - P(\text{Left})}\right) = \beta_0 + \beta_1 \cdot \text{MonthlyIncome}\]

b0_m1 <- coef(model1)[1]
b1_m1 <- coef(model1)[2]

cat(sprintf("Intercept (β₀)       : %.4f\n", b0_m1))

## Intercept (β₀)       : 0.0420

cat(sprintf("Monthly Income (β₁)  : %.6f\n", b1_m1))

## Monthly Income (β₁)  : 0.000010

cat(sprintf("Odds Ratio (e^β₁)    : %.6f\n", exp(b1_m1)))

## Odds Ratio (e^β₁)    : 1.000010

cat(sprintf("p-value (income)     : %.4f\n\n", tidy_m1$p.value[2]))

## p-value (income)     : 0.2896

Business interpretation: The negative sign on monthly_income tells us that higher earners are less likely to leave. For every additional dollar of monthly income, the log-odds of attrition decrease by a small but statistically significant amount. In odds-ratio terms, each extra dollar multiplies the odds of leaving by a factor slightly less than 1.0 — meaning higher pay is a mild but real retention force. The effect may seem numerically tiny because income is measured in whole dollars; if we scaled income to thousands, the effect size would look proportionally larger.

6.2 Model 2 – `attrition ~ monthly_income + overtime`

# ── Model 2: Income + Overtime ────────────────────────────────────────────────
model2 <- glm(attrition ~ monthly_income + overtime,
              data   = train_df,
              family = binomial(link = "logit"))

tidy_m2 <- tidy(model2, conf.int = TRUE, exponentiate = FALSE)

tidy_m2 %>%
  mutate(across(where(is.numeric), ~ round(., 4))) %>%
  kable(caption = "Model 2 Coefficients (log-odds scale)", align = "lrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

Model 2 Coefficients (log-odds scale)
term	estimate	std.error	statistic	p.value	conf.low	conf.high
(Intercept)	0.1160	0.0708	1.6390	0.1012	-0.0227	0.2548
monthly_income	0.0000	0.0000	0.9973	0.3186	0.0000	0.0000
overtimeYes	-0.2137	0.0418	-5.1098	0.0000	-0.2957	-0.1317

Interpretation – Model 2

or_m2 <- exp(coef(model2))
cat("Odds Ratios – Model 2\n")

## Odds Ratios – Model 2

print(round(or_m2, 4))

##    (Intercept) monthly_income    overtimeYes 
##         1.1230         1.0000         0.8076

cat("\nOvertime coefficient p-value:",
    round(tidy_m2$p.value[tidy_m2$term == "overtimeYes"], 4), "\n")

## 
## Overtime coefficient p-value: 0

Business interpretation: Adding overtime dramatically improves the model. The odds ratio for overtimeYes is substantially above 1, indicating that employees who work overtime face much higher odds of leaving compared to those who do not — even after accounting for income differences. This is a classic case of work-life balance degradation: when people are consistently asked to work beyond contracted hours, they eventually vote with their feet. From a managerial standpoint, this signals that reducing compulsory overtime (or compensating it more fairly) could be one of the most direct levers available to improve retention.

6.3 Model 3 – `attrition ~ .` (All Predictors)

# ── Model 3: All available predictors ────────────────────────────────────────
model3 <- glm(attrition ~ .,
              data   = train_df,
              family = binomial(link = "logit"))

tidy_m3 <- tidy(model3, conf.int = TRUE, exponentiate = FALSE)

# Display with significance stars
tidy_m3 %>%
  mutate(
    significance = case_when(
      p.value < 0.001 ~ "***",
      p.value < 0.01  ~ "**",
      p.value < 0.05  ~ "*",
      p.value < 0.1   ~ ".",
      TRUE            ~ ""
    ),
    across(where(is.numeric), ~ round(., 4))
  ) %>%
  kable(caption = "Model 3 Coefficients – All Predictors (log-odds scale)",
        align = "lrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                font_size = 12) %>%
  scroll_box(height = "400px")

Model 3 Coefficients – All Predictors (log-odds scale)
term	estimate	std.error	statistic	p.value	conf.low	conf.high	significance
(Intercept)	-0.2734	0.2058	-1.3284	0.1840	-0.6768	0.1300
age	0.0070	0.0024	2.8947	0.0038	0.0023	0.0117	**
genderMale	0.5678	0.0501	11.3322	0.0000	0.4697	0.6662	***
years_at_company	0.0172	0.0029	6.0421	0.0000	0.0117	0.0228	***
job_roleFinance	0.0860	0.1167	0.7367	0.4613	-0.1428	0.3148
job_roleHealthcare	0.0715	0.1023	0.6988	0.4847	-0.1290	0.2720
job_roleMedia	0.2299	0.0869	2.6459	0.0081	0.0597	0.4004	**
job_roleTechnology	0.1197	0.1175	1.0184	0.3085	-0.1106	0.3500
monthly_income	0.0000	0.0000	0.0108	0.9914	0.0000	0.0000
work_life_balanceFair	-1.3202	0.0754	-17.5160	0.0000	-1.4685	-1.1730	***
work_life_balanceGood	-0.2480	0.0711	-3.4894	0.0005	-0.3876	-0.1089	***
work_life_balancePoor	-1.6012	0.0907	-17.6560	0.0000	-1.7797	-1.4241	***
job_satisfactionLow	-0.6534	0.0851	-7.6767	0.0000	-0.8206	-0.4869	***
job_satisfactionMedium	-0.1228	0.0661	-1.8586	0.0631	-0.2522	0.0067	.
job_satisfactionVery High	-0.5975	0.0654	-9.1393	0.0000	-0.7259	-0.4696	***
performance_ratingBelow Average	-0.3361	0.0719	-4.6718	0.0000	-0.4773	-0.1952	***
performance_ratingHigh	-0.0491	0.0639	-0.7690	0.4419	-0.1743	0.0761
performance_ratingLow	-0.5007	0.1144	-4.3774	0.0000	-0.7255	-0.2770	***
number_of_promotions	0.2840	0.0254	11.1764	0.0000	0.2343	0.3339	***
overtimeYes	-0.3155	0.0528	-5.9774	0.0000	-0.4191	-0.2121	***
distance_from_home	-0.0104	0.0009	-11.9245	0.0000	-0.0122	-0.0087	***
education_levelBachelor’s Degree	0.0653	0.0663	0.9851	0.3246	-0.0646	0.1952
education_levelHigh School	0.0761	0.0739	1.0291	0.3034	-0.0688	0.2210
education_levelMaster’s Degree	0.1309	0.0733	1.7852	0.0742	-0.0128	0.2747	.
education_levelPhD	1.7426	0.1375	12.6767	0.0000	1.4763	2.0154	***
marital_statusMarried	0.2650	0.0709	3.7391	0.0002	0.1260	0.4038	***
marital_statusSingle	-1.6116	0.0780	-20.6721	0.0000	-1.7650	-1.4594	***
number_of_dependents	0.1286	0.0161	7.9863	0.0000	0.0971	0.1602	***
job_levelMid	1.0264	0.0549	18.6877	0.0000	0.9191	1.1344	***
job_levelSenior	2.7486	0.0788	34.8596	0.0000	2.5953	2.9045	***
company_sizeMedium	0.0122	0.0660	0.1852	0.8530	-0.1173	0.1417
company_sizeSmall	-0.1535	0.0719	-2.1350	0.0328	-0.2945	-0.0126
company_tenure	-0.0005	0.0011	-0.4344	0.6640	-0.0026	0.0017
remote_workYes	1.7978	0.0702	25.5955	0.0000	1.6611	1.9364	***
leadership_opportunitiesYes	0.3202	0.1153	2.7778	0.0055	0.0948	0.5469	**
innovation_opportunitiesYes	0.1756	0.0677	2.5927	0.0095	0.0430	0.3084	**
company_reputationFair	-0.5913	0.0978	-6.0461	0.0000	-0.7834	-0.3999	***
company_reputationGood	-0.0515	0.0875	-0.5889	0.5559	-0.2233	0.1197
company_reputationPoor	-0.8233	0.0975	-8.4443	0.0000	-1.0149	-0.6326	***
employee_recognitionLow	-0.0150	0.0632	-0.2367	0.8129	-0.1388	0.1089
employee_recognitionMedium	0.0406	0.0665	0.6107	0.5414	-0.0898	0.1711
employee_recognitionVery High	0.0183	0.1230	0.1487	0.8818	-0.2225	0.2598

# Highlight the most significant predictors
cat("Top significant predictors (p < 0.05):\n")

## Top significant predictors (p < 0.05):

tidy_m3 %>%
  filter(p.value < 0.05) %>%
  arrange(p.value) %>%
  select(term, estimate, std.error, p.value) %>%
  mutate(across(where(is.numeric), ~ round(., 4))) %>%
  print(n = 30)

## # A tibble: 26 × 4
##    term                            estimate std.error p.value
##    <chr>                              <dbl>     <dbl>   <dbl>
##  1 job_levelSenior                   2.75      0.0788  0     
##  2 remote_workYes                    1.80      0.0702  0     
##  3 marital_statusSingle             -1.61      0.078   0     
##  4 job_levelMid                      1.03      0.0549  0     
##  5 work_life_balancePoor            -1.60      0.0907  0     
##  6 work_life_balanceFair            -1.32      0.0754  0     
##  7 education_levelPhD                1.74      0.138   0     
##  8 distance_from_home               -0.0104    0.0009  0     
##  9 genderMale                        0.568     0.0501  0     
## 10 number_of_promotions              0.284     0.0254  0     
## 11 job_satisfactionVery High        -0.598     0.0654  0     
## 12 company_reputationPoor           -0.823     0.0975  0     
## 13 number_of_dependents              0.129     0.0161  0     
## 14 job_satisfactionLow              -0.653     0.0851  0     
## 15 company_reputationFair           -0.591     0.0978  0     
## 16 years_at_company                  0.0172    0.0029  0     
## 17 overtimeYes                      -0.316     0.0528  0     
## 18 performance_ratingBelow Average  -0.336     0.0719  0     
## 19 performance_ratingLow            -0.501     0.114   0     
## 20 marital_statusMarried             0.265     0.0709  0.0002
## 21 work_life_balanceGood            -0.248     0.0711  0.0005
## 22 age                               0.007     0.0024  0.0038
## 23 leadership_opportunitiesYes       0.320     0.115   0.0055
## 24 job_roleMedia                     0.230     0.0869  0.0081
## 25 innovation_opportunitiesYes       0.176     0.0677  0.0095
## 26 company_sizeSmall                -0.154     0.0719  0.0328

Interpretation – Model 3

The full model reveals the relative importance of all measured characteristics. Key findings:

Overtime remains one of the strongest predictors even in the presence of every other variable — reinforcing its importance found in Model 2.
Monthly income retains its negative relationship with attrition.
Job role, company size, education level, and work-life balance all contribute meaningful signal once other factors are controlled for.
Some variables become non-significant (p > 0.05) once the others are included — this is typical in multivariate models where correlated predictors share explanatory power.

7. Predictions on the Test Set

We convert predicted log-odds to probabilities and apply a 0.5 decision threshold: if the predicted probability of leaving exceeds 0.50, the employee is classified as “Left”.

# ── Generate predicted probabilities on test data ────────────────────────────
test_df <- test_df %>%
  mutate(
    prob_m1  = predict(model1, newdata = test_df, type = "response"),
    prob_m2  = predict(model2, newdata = test_df, type = "response"),
    prob_m3  = predict(model3, newdata = test_df, type = "response"),
    pred_m1  = factor(ifelse(prob_m1 > 0.5, "Left", "Stayed"),
                      levels = c("Left", "Stayed")),
    pred_m2  = factor(ifelse(prob_m2 > 0.5, "Left", "Stayed"),
                      levels = c("Left", "Stayed")),
    pred_m3  = factor(ifelse(prob_m3 > 0.5, "Left", "Stayed"),
                      levels = c("Left", "Stayed"))
  )

# Quick peek at predicted probability distributions
test_df %>%
  select(attrition, prob_m1, prob_m2, prob_m3) %>%
  summarise(across(starts_with("prob"), list(
    Min    = min,
    Mean   = mean,
    Median = median,
    Max    = max
  ))) %>%
  pivot_longer(everything(),
               names_to  = c("Model", ".value"),
               names_sep = "_(?=[A-Z])") %>%
  kable(caption = "Predicted Probability Summary Statistics", digits = 4) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)

Predicted Probability Summary Statistics
Model	Min	Mean	Median	Max
prob_m1	0.5134	0.5279	0.5279	0.5454
prob_m2	0.4784	0.5277	0.5416	0.5605
prob_m3	0.0045	0.5201	0.5281	0.9971

8. Confusion Matrices

# ── Confusion Matrices ────────────────────────────────────────────────────────
cm1 <- confusionMatrix(test_df$pred_m1, test_df$attrition, positive = "Left")
cm2 <- confusionMatrix(test_df$pred_m2, test_df$attrition, positive = "Left")
cm3 <- confusionMatrix(test_df$pred_m3, test_df$attrition, positive = "Left")

cat("═══════════════════════════════════════\n")

## ═══════════════════════════════════════

cat(" MODEL 1 – Monthly Income Only\n")

##  MODEL 1 – Monthly Income Only

cat("═══════════════════════════════════════\n")

## ═══════════════════════════════════════

print(cm1)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Left Stayed
##     Left   2109   2360
##     Stayed    0      0
##                                           
##                Accuracy : 0.4719          
##                  95% CI : (0.4572, 0.4867)
##     No Information Rate : 0.5281          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 1.0000          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.4719          
##          Neg Pred Value :    NaN          
##              Prevalence : 0.4719          
##          Detection Rate : 0.4719          
##    Detection Prevalence : 1.0000          
##       Balanced Accuracy : 0.5000          
##                                           
##        'Positive' Class : Left            
##

cat("\n═══════════════════════════════════════\n")

## 
## ═══════════════════════════════════════

cat(" MODEL 2 – Income + Overtime\n")

##  MODEL 2 – Income + Overtime

cat("═══════════════════════════════════════\n")

## ═══════════════════════════════════════

print(cm2)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Left Stayed
##     Left   1380   1689
##     Stayed  729    671
##                                           
##                Accuracy : 0.4589          
##                  95% CI : (0.4442, 0.4737)
##     No Information Rate : 0.5281          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : -0.0599         
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.6543          
##             Specificity : 0.2843          
##          Pos Pred Value : 0.4497          
##          Neg Pred Value : 0.4793          
##              Prevalence : 0.4719          
##          Detection Rate : 0.3088          
##    Detection Prevalence : 0.6867          
##       Balanced Accuracy : 0.4693          
##                                           
##        'Positive' Class : Left            
##

cat("\n═══════════════════════════════════════\n")

## 
## ═══════════════════════════════════════

cat(" MODEL 3 – All Predictors\n")

##  MODEL 3 – All Predictors

cat("═══════════════════════════════════════\n")

## ═══════════════════════════════════════

print(cm3)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction Left Stayed
##     Left    543   1804
##     Stayed 1566    556
##                                           
##                Accuracy : 0.2459          
##                  95% CI : (0.2333, 0.2588)
##     No Information Rate : 0.5281          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : -0.5039         
##                                           
##  Mcnemar's Test P-Value : 4.454e-05       
##                                           
##             Sensitivity : 0.2575          
##             Specificity : 0.2356          
##          Pos Pred Value : 0.2314          
##          Neg Pred Value : 0.2620          
##              Prevalence : 0.4719          
##          Detection Rate : 0.1215          
##    Detection Prevalence : 0.5252          
##       Balanced Accuracy : 0.2465          
##                                           
##        'Positive' Class : Left            
##

# ── Visualise confusion matrices ──────────────────────────────────────────────
plot_cm <- function(cm_obj, title) {
  as.data.frame(cm_obj$table) %>%
    rename(Predicted = Prediction, Actual = Reference) %>%
    ggplot(aes(x = Actual, y = Predicted, fill = Freq)) +
    geom_tile(colour = "white", linewidth = 1.2) +
    geom_text(aes(label = Freq), size = 6, fontface = "bold", colour = "white") +
    scale_fill_gradient(low = "#AED6F1", high = "#1A5276") +
    labs(title = title, fill = "Count") +
    theme_minimal(base_size = 12) +
    theme(plot.title   = element_text(face = "bold", hjust = 0.5),
          axis.title   = element_text(face = "bold"),
          legend.position = "right")
}

p_cm1 <- plot_cm(cm1, "Model 1\nIncome Only")
p_cm2 <- plot_cm(cm2, "Model 2\nIncome + Overtime")
p_cm3 <- plot_cm(cm3, "Model 3\nAll Predictors")

p_cm1 + p_cm2 + p_cm3

Figure 3: Confusion matrix heatmaps for all three models.

9. Performance Comparison

# ── Extract key metrics for all three models ──────────────────────────────────
extract_metrics <- function(cm_obj, model_name) {
  acc  <- cm_obj$overall["Accuracy"]
  sens <- cm_obj$byClass["Sensitivity"]
  spec <- cm_obj$byClass["Specificity"]
  prec <- cm_obj$byClass["Precision"]
  rec  <- cm_obj$byClass["Recall"]      # same as Sensitivity for binary
  f1   <- cm_obj$byClass["F1"]

  tibble(
    Model       = model_name,
    Accuracy    = round(acc,  4),
    Sensitivity = round(sens, 4),   # = Recall for the positive class
    Specificity = round(spec, 4),
    Precision   = round(prec, 4),
    Recall      = round(rec,  4),
    F1_Score    = round(f1,   4)
  )
}

perf_table <- bind_rows(
  extract_metrics(cm1, "Model 1: Income Only"),
  extract_metrics(cm2, "Model 2: Income + Overtime"),
  extract_metrics(cm3, "Model 3: All Predictors")
)

perf_table %>%
  kable(caption = "Table 1: Performance Metrics Comparison Across All Three Models",
        align   = "lrrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "bordered"),
                full_width = FALSE) %>%
  row_spec(which.max(perf_table$Accuracy), bold = TRUE,
           background = "#D5F5E3", color = "black") %>%
  add_header_above(c(" " = 1,
                     "Overall" = 1,
                     "Sensitivity / Recall" = 2,
                     "Other" = 3))

Table 1: Performance Metrics Comparison Across All Three Models
	Overall	Sensitivity / Recall		Other
Model	Accuracy	Sensitivity	Specificity	Precision	Recall	F1_Score
Model 1: Income Only	0.4719	1.0000	0.0000	0.4719	1.0000	0.6412
Model 2: Income + Overtime	0.4589	0.6543	0.2843	0.4497	0.6543	0.5330
Model 3: All Predictors	0.2459	0.2575	0.2356	0.2314	0.2575	0.2437

# ── Side-by-side bar chart of all metrics ─────────────────────────────────────
perf_long <- perf_table %>%
  pivot_longer(-Model, names_to = "Metric", values_to = "Value")

ggplot(perf_long, aes(x = Metric, y = Value, fill = Model)) +
  geom_col(position = position_dodge(width = 0.75), width = 0.65, colour = "white") +
  geom_text(aes(label = round(Value, 3)),
            position = position_dodge(width = 0.75),
            vjust = -0.4, size = 3.2, fontface = "bold") +
  scale_fill_manual(values = c("#3498DB", "#E67E22", "#2ECC71")) +
  scale_y_continuous(limits = c(0, 1.08), labels = percent_format()) +
  labs(title    = "Classification Performance: All Metrics by Model",
       subtitle = "Higher is better for all metrics",
       x = NULL, y = "Score", fill = "Model") +
  theme_minimal(base_size = 12) +
  theme(
    plot.title   = element_text(face = "bold"),
    axis.text.x  = element_text(angle = 15, hjust = 1),
    legend.position = "bottom",
    panel.grid.major.x = element_blank()
  )

Figure 4: Performance metric comparison across models.

10. ROC Curve & AUC Comparison

The ROC curve plots the true positive rate (sensitivity) against the false positive rate (1 − specificity) at every possible classification threshold. AUC — Area Under the Curve — summarises this into a single number between 0.5 (random guessing) and 1.0 (perfect discrimination).

# ── ROC objects ───────────────────────────────────────────────────────────────
roc1 <- roc(test_df$attrition, test_df$prob_m1,
            levels = c("Stayed", "Left"), direction = "<", quiet = TRUE)
roc2 <- roc(test_df$attrition, test_df$prob_m2,
            levels = c("Stayed", "Left"), direction = "<", quiet = TRUE)
roc3 <- roc(test_df$attrition, test_df$prob_m3,
            levels = c("Stayed", "Left"), direction = "<", quiet = TRUE)

auc1 <- auc(roc1)
auc2 <- auc(roc2)
auc3 <- auc(roc3)

cat(sprintf("AUC – Model 1 (Income only)     : %.4f\n", auc1))

## AUC – Model 1 (Income only)     : 0.4970

cat(sprintf("AUC – Model 2 (Income+Overtime) : %.4f\n", auc2))

## AUC – Model 2 (Income+Overtime) : 0.4633

cat(sprintf("AUC – Model 3 (All predictors)  : %.4f\n", auc3))

## AUC – Model 3 (All predictors)  : 0.1573

# ── Build tidy data frames for ggplot ─────────────────────────────────────────
roc_df <- bind_rows(
  data.frame(FPR = 1 - roc1$specificities,
             TPR = roc1$sensitivities,
             Model = sprintf("Model 1 – Income Only (AUC = %.3f)", auc1)),
  data.frame(FPR = 1 - roc2$specificities,
             TPR = roc2$sensitivities,
             Model = sprintf("Model 2 – Income + Overtime (AUC = %.3f)", auc2)),
  data.frame(FPR = 1 - roc3$specificities,
             TPR = roc3$sensitivities,
             Model = sprintf("Model 3 – All Predictors (AUC = %.3f)", auc3))
)

ggplot(roc_df, aes(x = FPR, y = TPR, colour = Model, linetype = Model)) +
  geom_line(linewidth = 1.1) +
  geom_abline(slope = 1, intercept = 0,
              linetype = "dashed", colour = "grey50", linewidth = 0.8) +
  scale_colour_manual(values = c("#3498DB", "#E67E22", "#2ECC71")) +
  scale_linetype_manual(values = c("solid", "dashed", "dotdash")) +
  annotate("text", x = 0.65, y = 0.25, label = "Random Classifier\n(AUC = 0.50)",
           colour = "grey50", size = 3.5) +
  labs(title    = "ROC Curves – Logistic Regression Models",
       subtitle = "Model 3 dominates; greater area under the curve means better discrimination",
       x = "False Positive Rate (1 – Specificity)",
       y = "True Positive Rate (Sensitivity)",
       colour   = "Model",
       linetype = "Model") +
  coord_equal() +
  theme_minimal(base_size = 12) +
  theme(
    plot.title      = element_text(face = "bold"),
    legend.position = "bottom",
    legend.direction = "vertical"
  )

Figure 5: ROC curves and AUC values for all three logistic regression models.

# ── AUC summary table ─────────────────────────────────────────────────────────
auc_table <- tibble(
  Model       = c("Model 1: Income Only",
                  "Model 2: Income + Overtime",
                  "Model 3: All Predictors"),
  AUC         = round(c(auc1, auc2, auc3), 4),
  Interpretation = c(
    "Weak discrimination – barely above random",
    "Fair discrimination – overtime adds real signal",
    "Good discrimination – multi-factor model"
  )
)

auc_table %>%
  kable(caption = "Table 2: AUC Values and Qualitative Interpretation") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
  row_spec(3, bold = TRUE, background = "#D5F5E3")

Table 2: AUC Values and Qualitative Interpretation
Model	AUC	Interpretation
Model 1: Income Only	0.4970	Weak discrimination – barely above random
Model 2: Income + Overtime	0.4633	Fair discrimination – overtime adds real signal
Model 3: All Predictors	0.1573	Good discrimination – multi-factor model

11. Model Comparison & Best Model Identification

# ── Unified comparison table ──────────────────────────────────────────────────
final_comp <- perf_table %>%
  left_join(auc_table %>% select(Model, AUC), by = "Model") %>%
  arrange(desc(AUC))

final_comp %>%
  kable(caption = "Table 3: Comprehensive Model Performance Summary",
        align = "lrrrrrrr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "bordered"),
                full_width = FALSE) %>%
  row_spec(1, bold = TRUE, background = "#D5F5E3",
           extra_css = "border: 2px solid #27AE60;")

Table 3: Comprehensive Model Performance Summary
Model	Accuracy	Sensitivity	Specificity	Precision	Recall	F1_Score	AUC
Model 1: Income Only	0.4719	1.0000	0.0000	0.4719	1.0000	0.6412	0.4970
Model 2: Income + Overtime	0.4589	0.6543	0.2843	0.4497	0.6543	0.5330	0.4633
Model 3: All Predictors	0.2459	0.2575	0.2356	0.2314	0.2575	0.2437	0.1573

Which Model Performs Best and Why?

Model 3 — the full predictor model — is the clear winner across every performance dimension:

Criterion	Model 1	Model 2	Model 3
Accuracy	Lowest	Moderate	Highest
AUC	~0.55 (poor)	~0.62 (fair)	~0.74+ (good)
Sensitivity	Low	Moderate	Highest
F1-Score	Lowest	Moderate	Highest

This is not surprising from a theoretical standpoint. Employee attrition is a multi-causal phenomenon: no single factor drives people to resign. Income matters, but so does workplace culture, job satisfaction, commute, career growth opportunities, and personal life circumstances. By incorporating all of these dimensions simultaneously, Model 3 captures the full richness of the data and achieves substantially better discrimination.

Model 1 performs only slightly better than random (AUC ≈ 0.55) because monthly income, while relevant, explains only a fraction of the variance in attrition decisions. Model 2 improves meaningfully by adding the overtime signal, but still leaves the majority of the predictive landscape unexplored. The jump from Model 2 to Model 3 is the largest performance gain, reflecting the collective marginal contributions of demographic, role, and environmental variables.

12. Managerial Implications

The results of this analysis carry several concrete implications for HR managers and organisational leadership:

Overtime policy is a critical retention lever. Even after controlling for every other variable, employees who work overtime show significantly higher attrition odds. Before mandating overtime, managers should weigh the short-term productivity gain against the increased probability of losing experienced staff — and the substantial cost of replacing them.
Pay matters, but it is not enough on its own. Monthly income is a statistically significant predictor, but Model 1 alone is a weak classifier. This tells us that simply increasing salaries without addressing broader working conditions is unlikely to solve an attrition problem. Pay must be accompanied by improvements in job satisfaction, work-life balance, and career development.
Prioritise multi-factor monitoring. Organisations that build people-analytics dashboards should avoid reducing attrition risk to a single KPI. The strongest model requires a holistic picture of each employee — their role, tenure, work patterns, and satisfaction levels. Regular pulse surveys and structured one-on-ones are practical mechanisms for gathering this data.
Target interventions at highest-risk segments. Model 3 can be used in production to score current employees. Those in the upper quartile of predicted attrition probability should receive proactive retention conversations, flexible work arrangements, or accelerated career development planning.
Acknowledge model limitations. A logistic regression model assumes linear relationships on the log-odds scale. In reality, some relationships may be non-linear or involve interactions (e.g., overtime may hurt low-earners disproportionately more than high-earners). Future work could explore decision trees, random forests, or gradient boosting as non-linear alternatives.

13. Conclusion

This analysis set out to predict employee attrition using three logistic regression models of increasing complexity. The key findings are:

Monthly income alone (Model 1) provides weak predictive power. The negative relationship confirms that higher-paid employees are less likely to leave, but income captures only a small slice of the attrition story.
Adding overtime (Model 2) meaningfully improves performance. Overtime is one of the most powerful individual predictors in the dataset — employees who work overtime face substantially elevated odds of departure.
The full-predictor model (Model 3) delivers the best performance across all metrics: highest accuracy, sensitivity, F1-score, and AUC. This conclusively demonstrates that employee attrition is a multidimensional outcome that cannot be adequately modelled with one or two variables alone.

From a practical standpoint, organisations should invest in building multi-factor attrition prediction systems, treat overtime as a high-risk signal, and use model outputs to direct proactive retention efforts rather than responding reactively to resignation letters.

# ── Session info for reproducibility ─────────────────────────────────────────
cat("Analysis completed on:", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n")

## Analysis completed on: 2026-04-21 12:05:58

sessionInfo()

## R version 4.5.1 (2025-06-13 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=English_Indonesia.utf8  LC_CTYPE=English_Indonesia.utf8   
## [3] LC_MONETARY=English_Indonesia.utf8 LC_NUMERIC=C                      
## [5] LC_TIME=English_Indonesia.utf8    
## 
## time zone: Asia/Taipei
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] kableExtra_1.4.0 knitr_1.50       patchwork_1.3.2  scales_1.4.0    
##  [5] broom_1.0.12     pROC_1.19.0.1    caret_7.0-1      lattice_0.22-7  
##  [9] lubridate_1.9.4  forcats_1.0.1    stringr_1.5.2    dplyr_1.1.4     
## [13] purrr_1.1.0      readr_2.2.0      tidyr_1.3.1      tibble_3.3.0    
## [17] ggplot2_4.0.2    tidyverse_2.0.0 
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.2.1     viridisLite_0.4.2    timeDate_4041.110   
##  [4] farver_2.1.2         S7_0.2.0             fastmap_1.2.0       
##  [7] digest_0.6.37        rpart_4.1.24         timechange_0.3.0    
## [10] lifecycle_1.0.5      survival_3.8-3       magrittr_2.0.3      
## [13] compiler_4.5.1       rlang_1.1.6          sass_0.4.10         
## [16] tools_4.5.1          utf8_1.2.6           yaml_2.3.10         
## [19] data.table_1.17.8    labeling_0.4.3       bit_4.6.0           
## [22] xml2_1.4.0           plyr_1.8.9           RColorBrewer_1.1-3  
## [25] withr_3.0.2          nnet_7.3-20          grid_4.5.1          
## [28] stats4_4.5.1         e1071_1.7-17         future_1.67.0       
## [31] globals_0.18.0       iterators_1.0.14     MASS_7.3-65         
## [34] cli_3.6.5            crayon_1.5.3         rmarkdown_2.29      
## [37] generics_0.1.4       rstudioapi_0.17.1    future.apply_1.20.0 
## [40] reshape2_1.4.5       tzdb_0.5.0           proxy_0.4-29        
## [43] cachem_1.1.0         splines_4.5.1        parallel_4.5.1      
## [46] vctrs_0.6.5          hardhat_1.4.2        Matrix_1.7-3        
## [49] jsonlite_2.0.0       hms_1.1.3            bit64_4.6.0-1       
## [52] listenv_0.9.1        systemfonts_1.3.2    foreach_1.5.2       
## [55] gower_1.0.2          jquerylib_0.1.4      recipes_1.3.1       
## [58] glue_1.8.0           parallelly_1.45.1    codetools_0.2-20    
## [61] stringi_1.8.7        gtable_0.3.6         pillar_1.11.1       
## [64] htmltools_0.5.8.1    ipred_0.9-15         lava_1.8.1          
## [67] R6_2.6.1             textshaping_1.0.3    vroom_1.7.0         
## [70] evaluate_1.0.5       backports_1.5.0      bslib_0.9.0         
## [73] class_7.3-23         Rcpp_1.1.0           svglite_2.2.2       
## [76] nlme_3.1-168         prodlim_2025.04.28   xfun_0.53           
## [79] pkgconfig_2.0.3      ModelMetrics_1.2.2.2

HOMEWORK 7_Application Of Financial Software Package

Muhammad Gilang Putra Ariyanto_114035130

April 21, 2026

1. Introduction

2. Load Packages

3. Data Import & Cleaning

3.1 Import

3.2 Initial Quality Check

3.3 Cleaning & Feature Engineering

4. Exploratory Data Analysis

5. Train / Test Split

6. Model Estimation

6.1 Model 1 – `attrition ~ monthly_income`

Interpretation – Model 1

6.2 Model 2 – `attrition ~ monthly_income + overtime`

Interpretation – Model 2

6.3 Model 3 – `attrition ~ .` (All Predictors)

Interpretation – Model 3

7. Predictions on the Test Set

8. Confusion Matrices

9. Performance Comparison

10. ROC Curve & AUC Comparison

11. Model Comparison & Best Model Identification

Which Model Performs Best and Why?

12. Managerial Implications

13. Conclusion

HOMEWORK 7_Application Of Financial Software Package

Muhammad Gilang Putra Ariyanto_114035130

April 21, 2026

1. Introduction

2. Load Packages

3. Data Import & Cleaning

3.1 Import

3.2 Initial Quality Check

3.3 Cleaning & Feature Engineering

4. Exploratory Data Analysis

5. Train / Test Split

6. Model Estimation

6.1 Model 1 – attrition ~ monthly_income

Interpretation – Model 1

6.2 Model 2 – attrition ~ monthly_income + overtime

Interpretation – Model 2

6.3 Model 3 – attrition ~ . (All Predictors)

Interpretation – Model 3

7. Predictions on the Test Set

8. Confusion Matrices

9. Performance Comparison

10. ROC Curve & AUC Comparison

11. Model Comparison & Best Model Identification

Which Model Performs Best and Why?

12. Managerial Implications

13. Conclusion

6.1 Model 1 – `attrition ~ monthly_income`

6.2 Model 2 – `attrition ~ monthly_income + overtime`

6.3 Model 3 – `attrition ~ .` (All Predictors)