library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
attrition_raw_tbl <- read_csv("00_data/WA_Fn-UseC_-HR-Employee-Attrition.csv")
## Rows: 1470 Columns: 35
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): Attrition, BusinessTravel, Department, EducationField, Gender, Job...
## dbl (26): Age, DailyRate, DistanceFromHome, Education, EmployeeCount, Employ...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# If data is not sensitive:
attrition_raw_tbl %>% glimpse()
## Rows: 1,470
## Columns: 35
## $ Age <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35, 2…
## $ Attrition <chr> "Yes", "No", "Yes", "No", "No", "No", "No", "…
## $ BusinessTravel <chr> "Travel_Rarely", "Travel_Frequently", "Travel…
## $ DailyRate <dbl> 1102, 279, 1373, 1392, 591, 1005, 1324, 1358,…
## $ Department <chr> "Sales", "Research & Development", "Research …
## $ DistanceFromHome <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 26, …
## $ Education <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, 3, …
## $ EducationField <chr> "Life Sciences", "Life Sciences", "Other", "L…
## $ EmployeeCount <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ EmployeeNumber <dbl> 1, 2, 4, 5, 7, 8, 10, 11, 12, 13, 14, 15, 16,…
## $ EnvironmentSatisfaction <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, 3, …
## $ Gender <chr> "Female", "Male", "Male", "Female", "Male", "…
## $ HourlyRate <dbl> 94, 61, 92, 56, 40, 79, 81, 67, 44, 94, 84, 4…
## $ JobInvolvement <dbl> 3, 2, 2, 3, 3, 3, 4, 3, 2, 3, 4, 2, 3, 3, 2, …
## $ JobLevel <dbl> 2, 2, 1, 1, 1, 1, 1, 1, 3, 2, 1, 2, 1, 1, 1, …
## $ JobRole <chr> "Sales Executive", "Research Scientist", "Lab…
## $ JobSatisfaction <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, 3, …
## $ MaritalStatus <chr> "Single", "Married", "Single", "Married", "Ma…
## $ MonthlyIncome <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, 269…
## $ MonthlyRate <dbl> 19479, 24907, 2396, 23159, 16632, 11864, 9964…
## $ NumCompaniesWorked <dbl> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, 5, …
## $ Over18 <chr> "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", "Y", …
## $ OverTime <chr> "Yes", "No", "Yes", "Yes", "No", "No", "Yes",…
## $ PercentSalaryHike <dbl> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13, 1…
## $ PerformanceRating <dbl> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, 3, …
## $ RelationshipSatisfaction <dbl> 1, 4, 2, 3, 4, 3, 1, 2, 2, 2, 3, 4, 4, 3, 2, …
## $ StandardHours <dbl> 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 80, 8…
## $ StockOptionLevel <dbl> 0, 1, 0, 0, 1, 0, 3, 1, 0, 2, 1, 0, 1, 1, 0, …
## $ TotalWorkingYears <dbl> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5, 3…
## $ TrainingTimesLastYear <dbl> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, 4, …
## $ WorkLifeBalance <dbl> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, 3, …
## $ YearsAtCompany <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2, 4,…
## $ YearsInCurrentRole <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, 2, …
## $ YearsSinceLastPromotion <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, 0, …
## $ YearsWithCurrManager <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, 3, …
# If data is sensitive:
attrition_raw_tbl %>%
slice(0) %>%
glimpse()
## Rows: 0
## Columns: 35
## $ Age <dbl>
## $ Attrition <chr>
## $ BusinessTravel <chr>
## $ DailyRate <dbl>
## $ Department <chr>
## $ DistanceFromHome <dbl>
## $ Education <dbl>
## $ EducationField <chr>
## $ EmployeeCount <dbl>
## $ EmployeeNumber <dbl>
## $ EnvironmentSatisfaction <dbl>
## $ Gender <chr>
## $ HourlyRate <dbl>
## $ JobInvolvement <dbl>
## $ JobLevel <dbl>
## $ JobRole <chr>
## $ JobSatisfaction <dbl>
## $ MaritalStatus <chr>
## $ MonthlyIncome <dbl>
## $ MonthlyRate <dbl>
## $ NumCompaniesWorked <dbl>
## $ Over18 <chr>
## $ OverTime <chr>
## $ PercentSalaryHike <dbl>
## $ PerformanceRating <dbl>
## $ RelationshipSatisfaction <dbl>
## $ StandardHours <dbl>
## $ StockOptionLevel <dbl>
## $ TotalWorkingYears <dbl>
## $ TrainingTimesLastYear <dbl>
## $ WorkLifeBalance <dbl>
## $ YearsAtCompany <dbl>
## $ YearsInCurrentRole <dbl>
## $ YearsSinceLastPromotion <dbl>
## $ YearsWithCurrManager <dbl>
# Load required libraries
library(tidymodels)
## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──
## ✔ broom 1.0.8 ✔ rsample 1.2.1
## ✔ dials 1.3.0 ✔ tune 1.2.1
## ✔ infer 1.0.7 ✔ workflows 1.1.4
## ✔ modeldata 1.4.0 ✔ workflowsets 1.1.0
## ✔ parsnip 1.2.1 ✔ yardstick 1.3.2
## ✔ recipes 1.1.0
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/
library(h2o)
##
## ----------------------------------------------------------------------
##
## Your next step is to start H2O:
## > h2o.init()
##
## For H2O package documentation, ask for help:
## > ??h2o
##
## After starting H2O, you can use the Web UI at http://localhost:54321
## For more information visit https://docs.h2o.ai
##
## ----------------------------------------------------------------------
##
## Attaching package: 'h2o'
## The following objects are masked from 'package:lubridate':
##
## day, hour, month, week, year
## The following objects are masked from 'package:stats':
##
## cor, sd, var
## The following objects are masked from 'package:base':
##
## &&, %*%, %in%, ||, apply, as.factor, as.numeric, colnames,
## colnames<-, ifelse, is.character, is.factor, is.numeric, log,
## log10, log1p, log2, round, signif, trunc
# Set seed for reproducibility
set.seed(123)
# --------------------------
# TIDYMODELS APPROACH
# --------------------------
# Data splitting
data_split <- initial_split(attrition_raw_tbl, prop = 0.8, strata = Attrition)
train_data <- training(data_split)
test_data <- testing(data_split)
# Ensure Attrition is a factor for metrics
train_data <- train_data %>%
mutate(Attrition = as.factor(Attrition))
test_data <- test_data %>%
mutate(Attrition = as.factor(Attrition))
# Recipe
attrition_recipe <- recipe(Attrition ~ ., data = train_data) %>%
update_role(EmployeeNumber, new_role = "ID") %>%
step_rm(EmployeeCount, Over18, StandardHours) %>%
step_naomit(all_predictors()) %>%
step_dummy(all_nominal_predictors()) %>%
step_zv(all_predictors()) %>%
step_normalize(all_numeric_predictors())
# Model specification (logistic regression)
log_spec <- logistic_reg(mode = "classification") %>%
set_engine("glm")
# Workflow
log_wf <- workflow() %>%
add_model(log_spec) %>%
add_recipe(attrition_recipe)
# Fit model
log_fit <- fit(log_wf, data = train_data)
# Predict and evaluate
log_predictions <- predict(log_fit, new_data = test_data, type = "prob") %>%
bind_cols(predict(log_fit, new_data = test_data)) %>%
bind_cols(test_data)
# Classification metrics
log_predictions %>%
metric_set(accuracy, roc_auc)(truth = Attrition, estimate = .pred_class, .pred_Yes)
## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.871
## 2 roc_auc binary 0.112
# --------------------------
# H2O APPROACH
# --------------------------
# Initialize H2O
h2o.init()
## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 13 days 23 hours
## H2O cluster timezone: America/New_York
## H2O data parsing timezone: UTC
## H2O cluster version: 3.44.0.3
## H2O cluster version age: 1 year, 4 months and 15 days
## H2O cluster name: H2O_started_from_R_katiegoy_fyb567
## H2O cluster total nodes: 1
## H2O cluster total memory: 1.29 GB
## H2O cluster total cores: 8
## H2O cluster allowed cores: 8
## H2O cluster healthy: TRUE
## H2O Connection ip: localhost
## H2O Connection port: 54321
## H2O Connection proxy: NA
## H2O Internal Security: FALSE
## R Version: R version 4.4.1 (2024-06-14)
## Warning in h2o.clusterInfo():
## Your H2O cluster version is (1 year, 4 months and 15 days) old. There may be a newer version available.
## Please download and install the latest version from: https://h2o-release.s3.amazonaws.com/h2o/latest_stable.html
# Convert data to H2O frame
attrition_h2o <- as.h2o(attrition_raw_tbl)
## | | | 0% | |======================================================================| 100%
# Set target and features
y <- "Attrition"
x <- setdiff(names(attrition_raw_tbl), c("Attrition", "EmployeeCount", "Over18", "StandardHours", "EmployeeNumber"))
# Convert target to factor in H2O
attrition_h2o[, y] <- as.factor(attrition_h2o[, y])
# Split data
splits <- h2o.splitFrame(data = attrition_h2o, ratios = 0.8, seed = 123)
train_h2o <- splits[[1]]
test_h2o <- splits[[2]]
# Train model using AutoML
automl_model <- h2o.automl(
x = x,
y = y,
training_frame = train_h2o,
leaderboard_frame = test_h2o,
max_models = 10,
seed = 123,
balance_classes = TRUE
)
## | | | 0% | |====== | 9%
## 11:27:41.833: AutoML: XGBoost is not available; skipping it.
## 11:27:41.837: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:42.16: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:42.388: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:42.799: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:43.55: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:43.291: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:43.554: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField] | |================================= | 47%
## 11:27:44.86: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:44.285: _train param, Dropping bad and constant columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:44.781: _train param, Dropping unused columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField]
## 11:27:45.222: _train param, Dropping unused columns: [JobRole, MaritalStatus, BusinessTravel, Department, OverTime, Gender, EducationField] | |======================================================================| 100%
# View leaderboard
lb <- automl_model@leaderboard
print(lb)
## model_id auc logloss
## 1 StackedEnsemble_BestOfFamily_1_AutoML_7_20250506_112741 0.7614415 0.3508678
## 2 StackedEnsemble_AllModels_1_AutoML_7_20250506_112741 0.7538447 0.3523847
## 3 DeepLearning_1_AutoML_7_20250506_112741 0.7495831 0.3935578
## 4 GLM_1_AutoML_7_20250506_112741 0.7476376 0.3580588
## 5 GBM_2_AutoML_7_20250506_112741 0.7244766 0.3805443
## 6 XRT_1_AutoML_7_20250506_112741 0.7200760 0.4144839
## aucpr mean_per_class_error rmse mse
## 1 0.4027133 0.3187882 0.3240251 0.1049922
## 2 0.4079460 0.3107745 0.3236140 0.1047260
## 3 0.3594937 0.2879841 0.3318992 0.1101571
## 4 0.3777062 0.2745970 0.3262879 0.1064638
## 5 0.3052033 0.2921994 0.3374844 0.1138958
## 6 0.3629790 0.3443117 0.3454135 0.1193105
##
## [12 rows x 7 columns]
# Get the best model
best_model <- automl_model@leader
# Predict on test set
pred_h2o <- h2o.predict(best_model, test_h2o)
## | | | 0% | |======================================================================| 100%
# Evaluate performance
perf <- h2o.performance(best_model, newdata = test_h2o)
print(perf)
## H2OBinomialMetrics: stackedensemble
##
## MSE: 0.1049922
## RMSE: 0.3240251
## LogLoss: 0.3508678
## Mean Per-Class Error: 0.3187882
## AUC: 0.7614415
## AUCPR: 0.4027133
## Gini: 0.5228831
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Yes Error Rate
## No 240 17 0.066148 =17/257
## Yes 24 18 0.571429 =24/42
## Totals 264 35 0.137124 =41/299
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.324741 0.467532 34
## 2 max f2 0.091384 0.544413 180
## 3 max f0point5 0.358609 0.500000 26
## 4 max accuracy 0.654408 0.869565 2
## 5 max precision 0.794219 1.000000 0
## 6 max recall 0.018442 1.000000 289
## 7 max specificity 0.794219 1.000000 0
## 8 max absolute_mcc 0.324741 0.391716 34
## 9 max min_per_class_accuracy 0.172373 0.666667 108
## 10 max mean_per_class_accuracy 0.251793 0.711784 61
## 11 max tns 0.794219 257.000000 0
## 12 max fns 0.794219 41.000000 0
## 13 max fps 0.006237 257.000000 298
## 14 max tps 0.018442 42.000000 289
## 15 max tnr 0.794219 1.000000 0
## 16 max fnr 0.794219 0.976190 0
## 17 max fpr 0.006237 1.000000 298
## 18 max tpr 0.018442 1.000000 289
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
# Shutdown H2O (optional)
# h2o.shutdown(prompt = FALSE)