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 errorsattrition_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.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, …The goal is to help predict attrition for employees.
Please write R code to create a predictive model that predicts the probability of attrition.
# Load libraries
library(tidyverse)
library(caret)## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## liftlibrary(e1071)
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var# Step 1: Preprocessing
# Convert character columns to factors
attrition_tbl <- attrition_raw_tbl %>%
mutate_if(is.character, as.factor) %>%
select(-EmployeeCount, -StandardHours, -Over18, -EmployeeNumber) # Remove constant or ID columns
# Step 2: Train/test split (80/20)
set.seed(123)
split <- createDataPartition(attrition_tbl$Attrition, p = 0.8, list = FALSE)
train_tbl <- attrition_tbl[split, ]
test_tbl <- attrition_tbl[-split, ]
# Step 3: Train logistic regression model
model_glm <- glm(Attrition ~ ., data = train_tbl, family = "binomial")
# Step 4: Evaluate model
# Predict probabilities
test_probs <- predict(model_glm, newdata = test_tbl, type = "response")
# Predict classes
test_pred <- ifelse(test_probs > 0.5, "Yes", "No") %>% factor(levels = c("No", "Yes"))
# Confusion matrix
confusionMatrix(test_pred, test_tbl$Attrition)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 236 30
## Yes 10 17
##
## Accuracy : 0.8635
## 95% CI : (0.8188, 0.9006)
## No Information Rate : 0.8396
## P-Value [Acc > NIR] : 0.149962
##
## Kappa : 0.3878
##
## Mcnemar's Test P-Value : 0.002663
##
## Sensitivity : 0.9593
## Specificity : 0.3617
## Pos Pred Value : 0.8872
## Neg Pred Value : 0.6296
## Prevalence : 0.8396
## Detection Rate : 0.8055
## Detection Prevalence : 0.9078
## Balanced Accuracy : 0.6605
##
## 'Positive' Class : No
## # AUC
roc_obj <- roc(test_tbl$Attrition, test_probs)## Setting levels: control = No, case = Yes## Setting direction: controls < casesauc(roc_obj)## Area under the curve: 0.8432# Step 5: Predict on new data (example)
# predict(model_glm, newdata = new_employee_data, type = "response")Please update the code to use tidymodels instead of caret and to use the h2o model instead of glmnet.
# Load libraries
library(tidymodels)## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──## ✔ broom 1.0.7 ✔ rsample 1.2.1
## ✔ dials 1.4.0 ✔ tune 1.2.1
## ✔ infer 1.0.7 ✔ workflows 1.1.4
## ✔ modeldata 1.4.0 ✔ workflowsets 1.1.0
## ✔ parsnip 1.3.0 ✔ 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()
## ✖ caret::lift() masks purrr::lift()
## ✖ rsample::permutations() masks e1071::permutations()
## ✖ yardstick::precision() masks caret::precision()
## ✖ yardstick::recall() masks caret::recall()
## ✖ yardstick::sensitivity() masks caret::sensitivity()
## ✖ yardstick::spec() masks readr::spec()
## ✖ yardstick::specificity() masks caret::specificity()
## ✖ recipes::step() masks stats::step()
## ✖ tune::tune() masks parsnip::tune(), e1071::tune()
## • Learn how to get started at https://www.tidymodels.org/start/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 object is masked from 'package:pROC':
##
## var## 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, trunclibrary(janitor)##
## Attaching package: 'janitor'## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.testlibrary(dplyr)
# Initialize H2O
h2o.init()## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 6 minutes 1 seconds
## 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 14 days
## H2O cluster name: H2O_started_from_R_aldendimick_ggl822
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.54 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 14 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# Step 1: Read data
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.# Step 2: Clean and prepare
attrition_tbl <- attrition_raw_tbl %>%
clean_names() %>%
mutate(attrition = factor(attrition, levels = c("No", "Yes")))
# Step 3: Split data
set.seed(123)
attrition_split <- initial_split(attrition_tbl, prop = 0.8, strata = attrition)
attrition_train <- training(attrition_split)
attrition_test <- testing(attrition_split)
# Step 4: Recipe
attrition_recipe <- recipe(attrition ~ ., data = attrition_train) %>%
update_role(employee_number, new_role = "ID") %>%
step_rm(employee_count, over18, standard_hours) %>%
step_zv(all_predictors()) %>%
step_dummy(all_nominal_predictors()) %>%
step_normalize(all_numeric_predictors())
# Step 5: Prep and juice the data
prepped_recipe <- prep(attrition_recipe)
train_juiced <- juice(prepped_recipe)
test_baked <- bake(prepped_recipe, new_data = attrition_test)
# Step 6: Convert to H2O frame
train_h2o <- as.h2o(train_juiced)## | | | 0% | |======================================================================| 100%test_h2o <- as.h2o(test_baked)## | | | 0% | |======================================================================| 100%# Step 7: H2O model training (AutoML or GBM as example)
automl_model <- h2o.automl(
x = setdiff(names(train_h2o), c("attrition", "employee_number")),
y = "attrition",
training_frame = train_h2o,
max_runtime_secs = 30,
balance_classes = TRUE,
seed = 123
)## | | | 0% | |== | 4%
## 09:49:04.779: AutoML: XGBoost is not available; skipping it. | |======= | 10% | |============= | 18% | |================== | 26% | |===================== | 31% | |========================== | 37% | |=============================== | 44% | |==================================== | 51% | |======================================== | 58% | |============================================= | 64% | |================================================== | 71% | |====================================================== | 78% | |=========================================================== | 85% | |================================================================ | 91% | |===================================================================== | 98% | |======================================================================| 100%# Step 8: Make predictions
preds <- h2o.predict(automl_model@leader, test_h2o)## | | | 0% | |======================================================================| 100%preds_df <- as.data.frame(preds)
# Step 9: Combine with actuals
results <- bind_cols(
attrition = test_baked$attrition,
predicted_class = preds_df$predict,
prob_no = preds_df$No,
prob_yes = preds_df$Yes
)
# Accuracy and other metrics
results_metrics <- metrics(results, truth = attrition, estimate = predicted_class)
# AUC
auc_value <- roc_auc(results, truth = attrition, prob_yes)
# Print
print(results_metrics)## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.898
## 2 kap binary 0.614print(auc_value)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 roc_auc binary 0.0957Error in .h2o.doSafeREST(h2oRestApiVersion = h2oRestApiVersion, urlSuffix = page, :
h2o.shutdown(prompt = FALSE)
Sys.sleep(5) # Give it time to shut down
h2o.init()##
## H2O is not running yet, starting it now...
##
## Note: In case of errors look at the following log files:
## /var/folders/kp/5ph4v9l12gq3j0pgz0gd8txr0000gn/T//RtmpYlaUOS/file8cf42d0e55f/h2o_aldendimick_started_from_r.out
## /var/folders/kp/5ph4v9l12gq3j0pgz0gd8txr0000gn/T//RtmpYlaUOS/file8cf46082c16a/h2o_aldendimick_started_from_r.err
##
##
## Starting H2O JVM and connecting: .. Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 2 seconds 318 milliseconds
## 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 14 days
## H2O cluster name: H2O_started_from_R_aldendimick_ggl822
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.54 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 14 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.htmlattrition_raw_tbl <- attrition_raw_tbl %>%
mutate_if(is.character, as.factor) # H2O prefers factors for classification
attrition_h2o <- as.h2o(attrition_raw_tbl)## | | | 0% | |======================================================================| 100%h2o::h2o.clusterInfo()## R is connected to the H2O cluster:
## H2O cluster uptime: 2 seconds 981 milliseconds
## 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 14 days
## H2O cluster name: H2O_started_from_R_aldendimick_ggl822
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.54 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::h2o.clusterInfo():
## Your H2O cluster version is (1 year, 4 months and 14 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.htmlPlease update the code to use h2o.performance in Step 5, instead of mean.
# Step 1: Load libraries and initialize H2O
library(h2o)
h2o.init()## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 3 seconds 4 milliseconds
## 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 14 days
## H2O cluster name: H2O_started_from_R_aldendimick_ggl822
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.54 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 14 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# Step 2: Convert data
attrition_raw_tbl <- attrition_raw_tbl %>%
mutate_if(is.character, as.factor)
attrition_h2o <- as.h2o(attrition_raw_tbl)## | | | 0% | |======================================================================| 100%# Step 3: Split data
splits <- h2o.splitFrame(data = attrition_h2o, ratios = 0.7, seed = 1234)
train <- splits[[1]]
test <- splits[[2]]
# Step 4: Train model
model <- h2o.gbm(
x = setdiff(names(attrition_h2o), c("Attrition")),
y = "Attrition",
training_frame = train,
ntrees = 50,
max_depth = 5,
learn_rate = 0.1,
seed = 1234
)## Warning in .h2o.processResponseWarnings(res): Dropping bad and constant columns: [StandardHours, EmployeeCount, Over18].## | | | 0% | |======================================================================| 100%# Step 5: Evaluate model
# Old (using mean):
# mean(h2o.predict(model, test) == test$Attrition)
# Step 5: Evaluate model with h2o.performance
perf <- h2o.performance(model, newdata = test)
# For classification models:
h2o.auc(perf) # Area under the ROC curve## [1] 0.793594h2o.accuracy(perf) # Accuracy## threshold accuracy
## 1 0.8650728 0.8465116
## 2 0.8217769 0.8488372
## 3 0.8003270 0.8511628
## 4 0.7914861 0.8534884
## 5 0.7559341 0.8558140
##
## ---
## threshold accuracy
## 395 0.009951674 0.1674419
## 396 0.009491380 0.1651163
## 397 0.008732425 0.1627907
## 398 0.008042115 0.1604651
## 399 0.007795504 0.1581395
## 400 0.006920223 0.1558140h2o.confusionMatrix(perf) # Confusion matrix## Confusion Matrix (vertical: actual; across: predicted) for max f1 @ threshold = 0.138644269184748:
## No Yes Error Rate
## No 282 81 0.223140 =81/363
## Yes 18 49 0.268657 =18/67
## Totals 300 130 0.230233 =99/430