Code Along 12
Anil Eser
2024-12-09
Load Libraries and Retrieve Data
library(tidymodels)## Warning: package 'tidymodels' was built under R version 4.4.1## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──## ✔ broom 1.0.6 ✔ 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## 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.2## Warning: package 'tune' was built under R version 4.4.1## Warning: package 'workflows' was built under R version 4.4.2## Warning: package 'workflowsets' was built under R version 4.4.1## Warning: package 'yardstick' was built under R version 4.4.2## ── 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/library(dplyr)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.3 ✔ stringr 1.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ stringr::fixed() masks recipes::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ readr::spec() masks yardstick::spec()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsattrition_raw_tbl <- read_csv("C:/Users/anese/OneDrive/Desktop/PSU DAT3100/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, …# Preprocessing: Convert categorical variables to factors
attrition_raw_tbl <- attrition_raw_tbl %>%
mutate(across(where(is.character), as.factor))# Remove columns with constant values
attrition_raw_tbl <- attrition_raw_tbl %>%
select(where(~ n_distinct(.) > 1))# Split the data into training and testing sets
set.seed(123) # For reproducibility
data_split <- initial_split(attrition_raw_tbl, prop = 0.8, strata = Attrition)
train_data <- training(data_split)
test_data <- testing(data_split)# Check for any problematic columns with only one level after the split
single_level_columns <- train_data %>%
select(where(is.factor)) %>%
summarise(across(everything(), ~ n_distinct(.))) %>%
pivot_longer(everything(), names_to = "col_name", values_to = "n_levels") %>%
filter(n_levels == 1) %>%
pull(col_name)# Drop problematic columns from train and test sets
train_data <- train_data %>%
select(-all_of(single_level_columns))
test_data <- test_data %>%
select(-all_of(single_level_columns))# Define a recipe for preprocessing
attrition_recipe <- recipe(Attrition ~ ., data = train_data) %>%
step_dummy(all_nominal_predictors(), -all_outcomes()) %>% # Convert factors to dummy variables
step_zv(all_predictors()) %>% # Remove zero-variance predictors
step_normalize(all_numeric_predictors()) # Normalize numeric variables# Specify a logistic regression model
logistic_model <- logistic_reg() %>%
set_engine("glm") %>%
set_mode("classification")# Combine recipe and model into a workflow
attrition_workflow <- workflow() %>%
add_recipe(attrition_recipe) %>%
add_model(logistic_model)# Fit the model on the training data
attrition_fit <- fit(attrition_workflow, data = train_data)# Make predictions on the test data
test_predictions <- predict(attrition_fit, test_data, type = "prob") %>%
bind_cols(predict(attrition_fit, test_data)) %>%
bind_cols(test_data %>% select(Attrition))# Evaluate the model
metrics <- test_predictions %>%
metrics(truth = Attrition, estimate = .pred_class)confusion_mat <- test_predictions %>%
conf_mat(truth = Attrition, estimate = .pred_class)# Print metrics and confusion matrix
print(metrics)## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.888
## 2 kap binary 0.530autoplot(confusion_mat)
The only error produced by Rstudios with ChatGPT building the model is Caused by error in bake(): ! Only one factor level in col_name: Y. R.
The issue arose because:
Some categorical columns had only one unique level after splitting (e.g., Over18 always being “Y”) or due to rare levels in the training/testing split. Creating dummy variables (step_dummy) for such columns resulted in errors during bake() as they introduced predictors with a single level. Changes Made: Identified Single-Level Columns: Added a step to check for categorical columns with a single level after splitting. Dropped Single-Level Columns: Explicitly removed these columns from both the training and testing datasets before fitting the recipe.