Part 1: Tuning our Regularized Regression Model
#1
boston <- read_csv(here('data', 'boston.csv'))
## Rows: 506 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (16): lon, lat, cmedv, crim, zn, indus, chas, nox, rm, age, dis, rad, ta...
##
## ℹ 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.
set.seed(123)
boston_split <- initial_split(boston, 0.7, strata = cmedv)
boston_train <- training(boston_split)
boston_test <- testing(boston_split)
#2
boston_recipe <- recipe(cmedv ~ ., boston_train) %>%
step_YeoJohnson(all_numeric_predictors()) %>%
step_normalize(all_numeric_predictors())
#3
kfold <- vfold_cv(boston_train, v = 5, strata = cmedv)
#4
reg_model <- linear_reg(penalty = tune(), mixture = tune()) %>%
set_engine('glmnet')
#5
reg_grid <- grid_regular(penalty(range = c(-10, 5)), mixture(), levels = 10)
#6
boston_wf <- workflow() %>%
add_recipe(boston_recipe) %>%
add_model(reg_model)
#7
tuning_results <- boston_wf %>%
tune_grid(resamples = kfold, grid = reg_grid)
## Warning: package 'glmnet' was built under R version 4.2.2
## ! Fold1: internal: A correlation computation is required, but `estimate` is constant and ha...
## ! Fold2: internal: A correlation computation is required, but `estimate` is constant and ha...
## ! Fold3: internal: A correlation computation is required, but `estimate` is constant and ha...
## ! Fold4: internal: A correlation computation is required, but `estimate` is constant and ha...
## ! Fold5: internal: A correlation computation is required, but `estimate` is constant and ha...
#8
tuning_results %>%
collect_metrics() %>%
filter(.metric == "rmse") %>%
arrange(mean)
## # A tibble: 100 × 8
## penalty mixture .metric .estimator mean n std_err .config
## <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 0.0215 1 rmse standard 4.49 5 0.296 Preprocessor1_M…
## 2 0.0215 0.889 rmse standard 4.49 5 0.295 Preprocessor1_M…
## 3 0.0215 0.778 rmse standard 4.49 5 0.294 Preprocessor1_M…
## 4 0.0215 0.667 rmse standard 4.49 5 0.293 Preprocessor1_M…
## 5 0.0215 0.556 rmse standard 4.49 5 0.292 Preprocessor1_M…
## 6 0.0215 0.444 rmse standard 4.49 5 0.291 Preprocessor1_M…
## 7 0.0215 0.333 rmse standard 4.49 5 0.290 Preprocessor1_M…
## 8 0.0000000001 0.444 rmse standard 4.49 5 0.290 Preprocessor1_M…
## 9 0.00000000464 0.444 rmse standard 4.49 5 0.290 Preprocessor1_M…
## 10 0.000000215 0.444 rmse standard 4.49 5 0.290 Preprocessor1_M…
## # … with 90 more rows
best_hyperparameters <- tuning_results %>%
select_best(metric = 'rmse')
final_wf <- workflow() %>%
add_recipe(boston_recipe) %>%
add_model(reg_model) %>%
finalize_workflow(best_hyperparameters)
# Step 2. fit our final workflow object across the full training set data
final_fit <- final_wf %>%
fit(data = boston_train)
# Step 3. plot the top 10 most influential features
final_fit %>%
extract_fit_parsnip() %>%
vip()
Part 2: Tuning a Regularized Classificatin Model
library(kernlab)
##
## Attaching package: 'kernlab'
## The following object is masked from 'package:purrr':
##
## cross
## The following object is masked from 'package:ggplot2':
##
## alpha
## The following object is masked from 'package:scales':
##
## alpha
data(spam)
#1
set.seed(123) # for reproducibility
split <- initial_split(spam, prop = 0.7, strata = type)
spam_train <- training(split)
spam_test <- testing(split)
#2
spam_recipe <- recipe(type ~ ., data = spam_train) %>%
step_YeoJohnson(all_numeric_predictors()) %>%
step_normalize(all_numeric_predictors())
#3
set.seed(123)
kfolds <- vfold_cv(spam_train, v = 5, strata = type)
#4
logit_mod <- logistic_reg(penalty = tune(), mixture = tune()) %>%
set_engine('glmnet') %>%
set_mode('classification')
#5
logit_grid <- grid_regular(penalty(range = c(-10, 5)), mixture(), levels = 10)
#6
spam_wf <- workflow() %>%
add_recipe(spam_recipe) %>%
add_model(logit_mod)
#7
tuning_results <- spam_wf %>%
tune_grid(resamples = kfolds, grid = logit_grid)
#8
tuning_results %>%
collect_metrics() %>%
filter(.metric == "roc_auc") %>%
arrange(desc(mean))
## # A tibble: 100 × 8
## penalty mixture .metric .estimator mean n std_err .config
## <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 0.000464 1 roc_auc binary 0.979 5 0.00352 Preprocessor1_Mo…
## 2 0.000464 0.889 roc_auc binary 0.979 5 0.00349 Preprocessor1_Mo…
## 3 0.000464 0.778 roc_auc binary 0.979 5 0.00347 Preprocessor1_Mo…
## 4 0.000464 0.667 roc_auc binary 0.979 5 0.00344 Preprocessor1_Mo…
## 5 0.000464 0.222 roc_auc binary 0.979 5 0.00329 Preprocessor1_Mo…
## 6 0.000464 0.333 roc_auc binary 0.979 5 0.00333 Preprocessor1_Mo…
## 7 0.000464 0.556 roc_auc binary 0.979 5 0.00342 Preprocessor1_Mo…
## 8 0.000464 0.111 roc_auc binary 0.979 5 0.00328 Preprocessor1_Mo…
## 9 0.000464 0.444 roc_auc binary 0.979 5 0.00339 Preprocessor1_Mo…
## 10 0.0000000001 0.111 roc_auc binary 0.979 5 0.00335 Preprocessor1_Mo…
## # … with 90 more rows
autoplot(tuning_results)
# Step 1. finalize our workflow object with the optimal hyperparameter values
best_hyperparameters <- select_best(tuning_results, metric = "roc_auc")
final_wf <- workflow() %>%
add_recipe(spam_recipe) %>%
add_model(logit_mod) %>%
finalize_workflow(best_hyperparameters)
# Step 2. fit our final workflow object across the full training set data
final_fit <- final_wf %>%
fit(data = spam_train)
# Step 3. plot the top 10 most influential features
final_fit %>%
extract_fit_parsnip() %>%
vip()
Part 3: Tuning a MARS Classification Model
#1
set.seed(123) # for reproducibility
split <- initial_split(spam_train, prop = 0.7, strata = type)
spam_train <- training(split)
spam_test <- testing(split)
#2
spam_recipe <- recipe(type ~ ., data = spam_train) %>%
step_YeoJohnson(all_numeric_predictors()) %>%
step_normalize(all_numeric_predictors())
#3
set.seed(123)
kfolds <- vfold_cv(spam_train, v = 5, strata = type)
#4
mars_mod <- mars(num_terms = tune(), prod_degree = tune()) %>%
set_mode('classification')
#5
mars_grid <- grid_regular(num_terms(range = c(1, 30)), prod_degree(), levels = 25)
#6
spam_wf <- workflow() %>%
add_recipe(spam_recipe) %>%
add_model(mars_mod)
#7
tuning_results <- spam_wf %>%
tune_grid(resamples = kfolds, grid = mars_grid)
## Warning: package 'earth' was built under R version 4.2.2
## Warning: package 'plotmo' was built under R version 4.2.2
## Warning: package 'TeachingDemos' was built under R version 4.2.2
## ! Fold3: preprocessor 1/1, model 1/2: glm.fit: fitted probabilities numerically 0 or 1 occurred
## ! Fold3: preprocessor 1/1, model 1/2 (predictions): glm.fit: fitted probabilities numerically 0 or 1 occurred
## ! Fold3: preprocessor 1/1, model 2/2: glm.fit: fitted probabilities numerically 0 or 1 occurred
## ! Fold3: preprocessor 1/1, model 2/2 (predictions): glm.fit: fitted probabilities numerically 0 or 1 occurred
#8
tuning_results %>%
collect_metrics() %>%
filter(.metric == "roc_auc") %>%
arrange(desc(mean))
## # A tibble: 50 × 8
## num_terms prod_degree .metric .estimator mean n std_err .config
## <int> <int> <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 13 2 roc_auc binary 0.977 5 0.00366 Preprocessor1_M…
## 2 14 2 roc_auc binary 0.977 5 0.00359 Preprocessor1_M…
## 3 15 2 roc_auc binary 0.977 5 0.00322 Preprocessor1_M…
## 4 22 2 roc_auc binary 0.977 5 0.00325 Preprocessor1_M…
## 5 16 2 roc_auc binary 0.977 5 0.00316 Preprocessor1_M…
## 6 27 2 roc_auc binary 0.977 5 0.00338 Preprocessor1_M…
## 7 28 2 roc_auc binary 0.977 5 0.00338 Preprocessor1_M…
## 8 30 2 roc_auc binary 0.977 5 0.00338 Preprocessor1_M…
## 9 25 2 roc_auc binary 0.977 5 0.00338 Preprocessor1_M…
## 10 26 2 roc_auc binary 0.977 5 0.00332 Preprocessor1_M…
## # … with 40 more rows
autoplot(tuning_results)
# Step 1. finalize our workflow object with the optimal hyperparameter values
best_hyperparameters <- select_best(tuning_results, metric = "roc_auc")
final_wf <- workflow() %>%
add_recipe(spam_recipe) %>%
add_model(mars_mod) %>%
finalize_workflow(best_hyperparameters)
# Step 2. fit our final workflow object across the full training set data
final_fit <- final_wf %>%
fit(data = spam_train)
# Step 3. plot the top 10 most influential features
final_fit %>%
extract_fit_parsnip() %>%
vip()
