Code Along 12
Bella Kalinyak
2024-12-03
library(tidymodels)## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──## ✔ broom 1.0.7 ✔ recipes 1.0.10
## ✔ dials 1.3.0 ✔ rsample 1.2.1
## ✔ dplyr 1.1.4 ✔ tibble 3.2.1
## ✔ ggplot2 3.5.1 ✔ tidyr 1.3.1
## ✔ infer 1.0.7 ✔ tune 1.2.1
## ✔ modeldata 1.4.0 ✔ workflows 1.1.4
## ✔ parsnip 1.2.1 ✔ workflowsets 1.1.0
## ✔ purrr 1.0.2 ✔ yardstick 1.3.1## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ recipes::step() masks stats::step()
## • Learn how to get started at https://www.tidymodels.org/start/attrition_raw_tbl <- readr::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, …Prompt 1:
I have a dataset called attrition_raw_tbl that looks like this:
attrition_raw_tbl %>% glimpse() Rows: 1,470 Columns: 35 $ Age
41, 49, 37, 33, 27, 32, 59, 30, 38, 3… $ Attrition “Yes”, “No”, “Yes”, “No”, “No”, “No”,… $ BusinessTravel “Travel_Rarely”, “Travel_Frequently”,… $ DailyRate 1102, 279, 1373, 1392, 591, 1005, 132… $ Department “Sales”, “Research & Development”, “R… $ DistanceFromHome 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, … $ Education 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1… $ EducationField ”Life Sciences”, “Life Sciences”, “Ot… $ EmployeeCount 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1… $ EmployeeNumber 1, 2, 4, 5, 7, 8, 10, 11, 12, 13, 14,… $ EnvironmentSatisfaction 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1… $ Gender ”Female”, “Male”, “Male”, “Female”, “… $ HourlyRate 94, 61, 92, 56, 40, 79, 81, 67, 44, 9… $ JobInvolvement 3, 2, 2, 3, 3, 3, 4, 3, 2, 3, 4, 2, 3… $ JobLevel 2, 2, 1, 1, 1, 1, 1, 1, 3, 2, 1, 2, 1… $ JobRole ”Sales Executive”, “Research Scientis… $ JobSatisfaction 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3… $ MaritalStatus ”Single”, “Married”, “Single”, “Marri… $ MonthlyIncome 5993, 5130, 2090, 2909, 3468, 3068, 2… $ MonthlyRate 19479, 24907, 2396, 23159, 16632, 118… $ NumCompaniesWorked 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1… $ Over18 ”Y”, “Y”, “Y”, “Y”, “Y”, “Y”, “Y”, “Y… $ OverTime ”Yes”, “No”, “Yes”, “Yes”, “No”, “No”… $ PercentSalaryHike 11, 23, 15, 11, 12, 13, 20, 22, 21, 1… $ PerformanceRating 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3… $ RelationshipSatisfaction 1, 4, 2, 3, 4, 3, 1, 2, 2, 2, 3, 4, 4… $ StandardHours 80, 80, 80, 80, 80, 80, 80, 80, 80, 8… $ StockOptionLevel 0, 1, 0, 0, 1, 0, 3, 1, 0, 2, 1, 0, 1… $ TotalWorkingYears 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, … $ TrainingTimesLastYear 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1… $ WorkLifeBalance 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2… $ YearsAtCompany 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, … $ YearsInCurrentRole 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2… $ YearsSinceLastPromotion 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4… $ YearsWithCurrManager 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 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.
Prompt 2:
Please update the code to use tidymodels instead of caret and to use the h2o model instead of glmnet.
Prompt 3:
Error in conf_mat(): ! Can’t select columns that don’t exist.
# Load necessary libraries
library(tidymodels)
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: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# Initialize h2o
h2o.init()##
## H2O is not running yet, starting it now...
##
## Note: In case of errors look at the following log files:
## C:\Users\bella\AppData\Local\Temp\Rtmpo9XEmH\fileb0832fe5edc/h2o_bella_started_from_r.out
## C:\Users\bella\AppData\Local\Temp\Rtmpo9XEmH\fileb086ffe5452/h2o_bella_started_from_r.err
##
##
## Starting H2O JVM and connecting: Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 4 seconds 243 milliseconds
## 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 12 days
## H2O cluster name: H2O_started_from_R_bella_jjl252
## H2O cluster total nodes: 1
## H2O cluster total memory: 1.93 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.3.3 (2024-02-29 ucrt)## Warning in h2o.clusterInfo():
## Your H2O cluster version is (11 months and 12 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# Prepare the data (converting 'Attrition' to a binary factor)
attrition_raw_tbl <- attrition_raw_tbl %>%
mutate(Attrition = factor(Attrition, levels = c("No", "Yes")))
# Split the data into training and testing sets (80-20 split)
set.seed(123) # Set seed for reproducibility
train_split <- initial_split(attrition_raw_tbl, prop = 0.8)
train_data <- training(train_split)
test_data <- testing(train_split)
# Convert the data frames to h2o objects
train_data_h2o <- as.h2o(train_data)## | | | 0% | |======================================================================| 100%test_data_h2o <- as.h2o(test_data)## | | | 0% | |======================================================================| 100%# Define the model (logistic regression in h2o)
model <- h2o.glm(
x = setdiff(names(train_data), "Attrition"), # Independent variables
y = "Attrition", # Dependent variable
training_frame = train_data_h2o,
family = "binomial", # Binary classification
lambda = 0.1, # Regularization parameter (can adjust as needed)
alpha = 0.5, # Elastic net mixing parameter
seed = 123
)## Warning in .h2o.processResponseWarnings(res): Dropping bad and constant columns: [JobRole, MaritalStatus, StandardHours, BusinessTravel, Department, OverTime, Over18, EmployeeCount, Gender, EducationField].## | | | 0% | |======================================================================| 100%# Summary of the model
summary(model)## Model Details:
## ==============
##
## H2OBinomialModel: glm
## Model Key: GLM_model_R_1733239338389_1
## GLM Model: summary
## family link regularization
## 1 binomial logit Elastic Net (alpha = 0.5, lambda = 0.1 )
## number_of_predictors_total number_of_active_predictors number_of_iterations
## 1 24 4 3
## training_frame
## 1 train_data_sid_a39b_1
##
## H2OBinomialMetrics: glm
## ** Reported on training data. **
##
## MSE: 0.1321766
## RMSE: 0.3635611
## LogLoss: 0.4310792
## Mean Per-Class Error: 0.3608015
## AUC: 0.6882274
## AUCPR: 0.3420089
## Gini: 0.3764548
## R^2: 0.02008047
## Residual Deviance: 1013.898
## AIC: 1023.898
##
## Confusion Matrix (vertical: actual; across: predicted) for F1-optimal threshold:
## No Yes Error Rate
## No 844 143 0.144883 =143/987
## Yes 109 80 0.576720 =109/189
## Totals 953 223 0.214286 =252/1176
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.176756 0.388350 75
## 2 max f2 0.157042 0.518293 216
## 3 max f0point5 0.182666 0.388979 41
## 4 max accuracy 0.194282 0.848639 6
## 5 max precision 0.194282 0.739130 6
## 6 max recall 0.109672 1.000000 399
## 7 max specificity 0.198807 0.995947 0
## 8 max absolute_mcc 0.176756 0.260829 75
## 9 max min_per_class_accuracy 0.167102 0.629630 142
## 10 max mean_per_class_accuracy 0.168036 0.650231 134
## 11 max tns 0.198807 983.000000 0
## 12 max fns 0.198807 185.000000 0
## 13 max fps 0.113326 987.000000 398
## 14 max tps 0.109672 189.000000 399
## 15 max tnr 0.198807 0.995947 0
## 16 max fnr 0.198807 0.978836 0
## 17 max fpr 0.113326 1.000000 398
## 18 max tpr 0.109672 1.000000 399
##
## Gains/Lift Table: Extract with `h2o.gainsLift(<model>, <data>)` or `h2o.gainsLift(<model>, valid=<T/F>, xval=<T/F>)`
##
##
##
## Scoring History:
## timestamp duration iterations negative_log_likelihood objective
## 1 2024-12-03 10:22:31 0.000 sec 0 518.44246 0.44085
## 2 2024-12-03 10:22:31 0.031 sec 1 518.44246 0.44085
## 3 2024-12-03 10:22:31 0.051 sec 2 507.12030 0.43951
## 4 2024-12-03 10:22:31 0.057 sec 3 506.94915 0.43950
## training_rmse training_logloss training_r2 training_auc training_pr_auc
## 1 NA NA NA NA NA
## 2 NA NA NA NA NA
## 3 NA NA NA NA NA
## 4 0.36356 0.43108 0.02008 0.68823 0.34201
## training_lift training_classification_error
## 1 NA NA
## 2 NA NA
## 3 NA NA
## 4 4.30769 0.21429
##
## Variable Importances: (Extract with `h2o.varimp`)
## =================================================
##
## Variable Importances:
## variable relative_importance scaled_importance percentage
## 1 Age 0.078885 1.000000 0.480741
## 2 YearsInCurrentRole 0.039522 0.501008 0.240855
## 3 TotalWorkingYears 0.023700 0.300443 0.144435
## 4 JobLevel 0.021983 0.278672 0.133969
## 5 DailyRate 0.000000 0.000000 0.000000
##
## ---
## variable relative_importance scaled_importance percentage
## 19 StockOptionLevel 0.000000 0.000000 0.000000
## 20 TrainingTimesLastYear 0.000000 0.000000 0.000000
## 21 WorkLifeBalance 0.000000 0.000000 0.000000
## 22 YearsAtCompany 0.000000 0.000000 0.000000
## 23 YearsSinceLastPromotion 0.000000 0.000000 0.000000
## 24 YearsWithCurrManager 0.000000 0.000000 0.000000# Make predictions on the test data
predictions <- h2o.predict(model, test_data_h2o)## | | | 0% | |======================================================================| 100%# Extract probabilities from the predictions
probabilities <- as.data.frame(predictions)[, 3]
# Convert probabilities to class predictions (threshold 0.5)
predicted_classes <- ifelse(probabilities > 0.5, "Yes", "No")
# Confusion matrix for evaluation using tidymodels
conf_matrix <- test_data %>%
mutate(predicted = factor(predicted_classes, levels = c("No", "Yes"))) %>%
conf_mat(truth = Attrition, estimate = predicted)
# Print confusion matrix
print(conf_matrix)## Truth
## Prediction No Yes
## No 246 48
## Yes 0 0# ROC Curve for model performance using pROC
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following object is masked from 'package:h2o':
##
## var## The following objects are masked from 'package:stats':
##
## cov, smooth, varroc_curve <- roc(test_data$Attrition, probabilities)## Setting levels: control = No, case = Yes## Setting direction: controls < casesplot(roc_curve, main = "ROC Curve", col = "blue")
# Shutdown h2o cluster
h2o.shutdown(prompt = FALSE)