library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.1
## Warning: package 'dplyr' was built under R version 4.4.1
## Warning: package 'lubridate' was built under R version 4.4.1
## ── 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
library(tidymodels)
## Warning: package 'tidymodels' was built under R version 4.4.1
## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──
## ✔ broom 1.0.6 ✔ 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.1
## ✔ recipes 1.0.10
## Warning: package 'dials' was built under R version 4.4.1
## Warning: package 'infer' was built under R version 4.4.1
## Warning: package 'modeldata' was built under R version 4.4.1
## Warning: package 'parsnip' was built under R version 4.4.1
## Warning: package 'tune' was built under R version 4.4.1
## Warning: package 'workflows' was built under R version 4.4.1
## Warning: package 'workflowsets' was built under R version 4.4.1
## Warning: package 'yardstick' was built under R version 4.4.1
## ── 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()
## • Use suppressPackageStartupMessages() to eliminate package startup messages
library(h2o)
## Warning: package 'h2o' was built under R version 4.4.2
##
## ----------------------------------------------------------------------
##
## 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
attrition_raw_tbl <- read_csv("WA_Fn-UseC_-HR-Employee-Attrition.csv") %>%
# h2o requires all variables to be either numeric or factors
mutate(across(where(is.character), factor))
## 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.
attrition_raw_tbl %>% glimpse()
## Rows: 1,470
## Columns: 35
## $ Age <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35, 2…
## $ Attrition <fct> Yes, No, Yes, No, No, No, No, No, No, No, No,…
## $ BusinessTravel <fct> Travel_Rarely, Travel_Frequently, Travel_Rare…
## $ DailyRate <dbl> 1102, 279, 1373, 1392, 591, 1005, 1324, 1358,…
## $ Department <fct> Sales, Research & Development, Research & Dev…
## $ 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 <fct> Life Sciences, Life Sciences, Other, Life Sci…
## $ 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 <fct> Female, Male, Male, Female, Male, Male, Femal…
## $ 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 <fct> Sales Executive, Research Scientist, Laborato…
## $ JobSatisfaction <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, 3, …
## $ MaritalStatus <fct> Single, Married, Single, Married, Married, Si…
## $ 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 <fct> Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, Y, …
## $ OverTime <fct> Yes, No, Yes, Yes, No, No, Yes, No, No, No, N…
## $ 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, …
# Clean the dataset
attrition_clean_tbl <- attrition_raw_tbl %>%
# Remove duplicates
distinct() %>%
# Remove irrelevant or constant columns
select(-EmployeeCount, -StandardHours, -Over18) %>%
# Handle missing values (example: replacing NA with median for numeric columns)
mutate(across(where(is.numeric), ~ ifelse(is.na(.), median(., na.rm = TRUE), .))) %>%
# Convert character columns to factors
mutate(across(where(is.character), as.factor)) %>%
# Ensure all numeric columns are properly formatted
mutate(across(where(is.numeric), as.numeric))
# View cleaned dataset
glimpse(attrition_clean_tbl)
## Rows: 1,470
## Columns: 32
## $ Age <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35, 2…
## $ Attrition <fct> Yes, No, Yes, No, No, No, No, No, No, No, No,…
## $ BusinessTravel <fct> Travel_Rarely, Travel_Frequently, Travel_Rare…
## $ DailyRate <dbl> 1102, 279, 1373, 1392, 591, 1005, 1324, 1358,…
## $ Department <fct> Sales, Research & Development, Research & Dev…
## $ 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 <fct> Life Sciences, Life Sciences, Other, Life Sci…
## $ 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 <fct> Female, Male, Male, Female, Male, Male, Femal…
## $ 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 <fct> Sales Executive, Research Scientist, Laborato…
## $ JobSatisfaction <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, 3, …
## $ MaritalStatus <fct> Single, Married, Single, Married, Married, Si…
## $ 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, …
## $ OverTime <fct> Yes, No, Yes, Yes, No, No, Yes, No, No, No, N…
## $ 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, …
## $ 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, …
# Split Data into Training and Testing Sets
set.seed(123)
data_split <- initial_split(attrition_clean_tbl, prop = 0.8)
train_data <- training(data_split)
test_data <- testing(data_split)
# Initialize H2O
h2o.init(nthreads = -1, max_mem_size = "4G")
## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 7 minutes 15 seconds
## H2O cluster timezone: America/New_York
## H2O data parsing timezone: UTC
## H2O cluster version: 3.44.0.3
## H2O cluster version age: 11 months and 27 days
## H2O cluster name: H2O_started_from_R_Surplus_cva614
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.33 GB
## H2O cluster total cores: 4
## H2O cluster allowed cores: 4
## 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.0 (2024-04-24 ucrt)
## Warning in h2o.clusterInfo():
## Your H2O cluster version is (11 months and 27 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 training and testing datasets to H2O frames
train_h2o <- as.h2o(train_data)
## | | | 0% | |======================================================================| 100%
test_h2o <- as.h2o(test_data)
## | | | 0% | |======================================================================| 100%
# Train H2O AutoML Model
aml <- h2o.automl(
y = "Attrition",
training_frame = train_h2o,
max_models = 10,
seed = 123,
exclude_algos = c("DeepLearning") # Example of excluding certain models
)
## | | | 0% | |====== | 8%
## 10:32:06.45: AutoML: XGBoost is not available; skipping it. | |================== | 25% | |============================================ | 62% | |======================================================================| 100%
# View AutoML leaderboard
lb <- h2o.get_leaderboard(aml, extra_columns = "ALL")
print(lb)
## model_id auc logloss
## 1 StackedEnsemble_BestOfFamily_1_AutoML_2_20241218_103206 0.8101188 0.3390033
## 2 GLM_1_AutoML_2_20241218_103206 0.8096257 0.3432421
## 3 StackedEnsemble_AllModels_1_AutoML_2_20241218_103206 0.8080389 0.3375175
## 4 GBM_grid_1_AutoML_2_20241218_103206_model_2 0.7947015 0.3536282
## 5 GBM_grid_1_AutoML_2_20241218_103206_model_1 0.7917719 0.3520702
## 6 GBM_1_AutoML_2_20241218_103206 0.7802303 0.3591342
## aucpr mean_per_class_error rmse mse training_time_ms
## 1 0.5953457 0.2464820 0.3120193 0.09735603 1233
## 2 0.5870282 0.2507599 0.3133935 0.09821551 50
## 3 0.5852746 0.2459192 0.3126998 0.09778120 1267
## 4 0.5358702 0.2774401 0.3259225 0.10622550 117
## 5 0.5196405 0.2810424 0.3234366 0.10461121 153
## 6 0.5129623 0.2965214 0.3272991 0.10712467 124
## predict_time_per_row_ms algo
## 1 0.025693 StackedEnsemble
## 2 0.006333 GLM
## 3 0.024791 StackedEnsemble
## 4 0.013750 GBM
## 5 0.013382 GBM
## 6 0.011681 GBM
##
## [12 rows x 10 columns]
# Extract the best model
best_model <- h2o.get_best_model(aml)
# Make Predictions on Test Data
predictions <- h2o.predict(best_model, test_h2o) %>% as.data.frame()
## | | | 0% | |======================================================================| 100%
# Combine predictions with the test data
test_results <- test_data %>%
mutate(
.pred_class = predictions$predict, # Predicted class
.pred_Yes = predictions$Yes, # Probability of "Yes"
.pred_No = predictions$No # Probability of "No"
)
# Define metric set
metrics <- metric_set(accuracy, roc_auc)
# Evaluate metrics
results <- test_results %>%
metrics(
truth = Attrition,
estimate = .pred_class, # For accuracy
.pred_Yes # For roc_auc
)
# Print evaluation results
print(results)
## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.871
## 2 roc_auc binary 0.110
# Shutdown h2o when done
h2o.shutdown(prompt = FALSE)