class: center, middle, title-slide # Model Tuning ## NHS-R Conference 2021 ### Emil Hvitfeldt ### 2021-11-02 ---
NHS tidymodels workshop
Home
Slides
▾
1: Introduction
2: Models
3: Features
4: Resampling
5: Tuning
☰
class: inverse, middle, center <!--- Packages ---------------------------------------------------------------> <!--- Chunk options ----------------------------------------------------------> <!--- pkg highlight ----------------------------------------------------------> <style> .pkg { font-weight: bold; letter-spacing: 0.5pt; color: #866BBF; } </style> <!--- Highlighing colors -----------------------------------------------------> <div style = "position:fixed; visibility: hidden"> `$$\require{color}\definecolor{purple}{rgb}{0.525490196078431, 0.419607843137255, 0.749019607843137}$$` `$$\require{color}\definecolor{green}{rgb}{0.0117647058823529, 0.650980392156863, 0.415686274509804}$$` `$$\require{color}\definecolor{orange}{rgb}{0.949019607843137, 0.580392156862745, 0.254901960784314}$$` `$$\require{color}\definecolor{white}{rgb}{1, 1, 1}$$` </div> <script type="text/x-mathjax-config"> MathJax.Hub.Config({ TeX: { Macros: { purple: ["{\\color{purple}{#1}}", 1], green: ["{\\color{green}{#1}}", 1], orange: ["{\\color{orange}{#1}}", 1], white: ["{\\color{white}{#1}}", 1] }, loader: {load: ['[tex]/color']}, tex: {packages: {'[+]': ['color']}} } }); </script> <style> .purple {color: #866BBF;} .green {color: #03A66A;} .orange {color: #F29441;} .white {color: #FFFFFF;} </style> <!--- knitr hooks ------------------------------------------------------------> # [`tidymodels.org`](https://www.tidymodels.org/) # _Tidy Modeling with R_ ([`tmwr.org`](https://www.tmwr.org/)) --- # Tuning parameters These are model or preprocessing parameters that are important but cannot be estimated directly form the data. Some examples: .pull-left[ * Tree depth in decision trees. * Number of neighbors in a K-nearest neighbor model. * Activation function (e.g. sigmoidal, ReLu) in neural networks. * Number of PCA components to retain ] .pull-right[ * Covariance/correlation matrix structure in mixed models. * Data distribution in survival models. * Spline degrees of freedom. ] --- # Optimizng tuning parameters The main approach is to try different values and measure their performance. This can lead us to good values for these parameters. The main two classes of optimization models are: * _Grid search_ where a pre-defined set of candidate values are tested. * _Iterative search_ methods suggest/estimate new values of candidate parameters to evaluate. Once the value(s) of the parameter(s) are determine, a model can be finalized but fitting the model to the entire training set. --- # Measuring tuning paramters We need performance metrics to tell us which candidate values are good and which are not. Using the test set, or simply re-predicting the training set, are very bad ideas. Since tuning parameters often control complexity, they can often lead to [_overfitting_](https://www.tmwr.org/tuning.html#overfitting-bad). * This is where the model does very well on the training set but poorly on new data. Using _resampling_ to estimate performance can help identify parameters that lead to overfitting. The cost is computational time. --- # Overfitting with a support vector machine <img src="5-tuning_files/figure-html/overfitting-1.svg" width="60%" style="display: block; margin: auto;" /> --- # Choosing tuning parameters Let's take our previous model and add a few changes: ```r lm_spec <- linear_reg() %>% set_engine("lm") chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_normalize(all_numeric_predictors()) %>% step_corr(all_numeric_predictors(), threshold = 0.9) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Use regularizaed regression ```r lm_spec <- linear_reg() %>% set_engine("glmnet") #<< chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_normalize(all_numeric_predictors()) %>% step_corr(all_numeric_predictors(), threshold = 0.9) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Add model parameters ```r lm_spec <- linear_reg(penalty, mixture) %>% #<< set_engine("glmnet") chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_normalize(all_numeric_predictors()) %>% step_corr(all_numeric_predictors(), threshold = 0.9) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Mark them for tuning ```r lm_spec <- linear_reg(penalty = tune(), mixture = tune()) %>% #<< set_engine("glmnet") chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_normalize(all_numeric_predictors()) %>% step_corr(all_numeric_predictors(), threshold = 0.9) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Remove unneeded step ```r lm_spec <- linear_reg(penalty = tune(), mixture = tune()) %>% set_engine("glmnet") chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_normalize(all_numeric_predictors()) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Add a spline step (just for demonstration) ```r lm_spec <- linear_reg(penalty = tune(), mixture = tune()) %>% set_engine("glmnet") chi_rec <- recipe(ridership ~ ., data = chi_train) %>% step_date(date, features = c("dow", "year")) %>% step_holiday(date) %>% update_role(date, new_role = "id") %>% step_dummy(all_nominal_predictors()) %>% step_zv(all_predictors()) %>% step_ns(temp, deg_free = tune()) %>% #<< step_normalize(all_numeric_predictors()) chi_wflow <- workflow() %>% add_model(lm_spec) %>% add_recipe(chi_rec) ``` --- # Grid search This is the most basic (but very effective) way for tuning models. tidymodels has pre-defined information on tuning parameters, such as their type, range, transformations, etc. A grid can be created manually or automatically. The `parameters()` function extracts the tuning parameters and the info. The `grid_*()` functions can make a grid. --- # Manual grid - get parameters .pull-left[ ```r chi_wflow %>% parameters() ``` This type of object can be updated (e.g. to change the ranges, etc) ] .pull-right[ ``` ## Collection of 3 parameters for tuning ## ## identifier type object ## penalty penalty nparam[+] ## mixture mixture nparam[+] ## deg_free deg_free nparam[+] ``` ] --- # Manual grid - create grid .pull-left[ ```r set.seed(2) grid <- chi_wflow %>% parameters() %>% grid_latin_hypercube(size = 25) grid ``` This is a type of _space-filling design_. It tends to do much better than random grids and is (usually) more efficient than regular grids. ] .pull-right[ ``` ## # A tibble: 25 × 3 ## penalty mixture deg_free ## <dbl> <dbl> <int> ## 1 0.124 0.309 2 ## 2 0.0000000474 0.269 5 ## 3 0.0000000101 0.810 4 ## 4 0.0000140 0.527 11 ## 5 0.172 0.897 3 ## 6 0.0000329 0.701 3 ## 7 0.00000000610 0.590 13 ## 8 0.0141 0.102 6 ## 9 0.00513 0.405 13 ## 10 0.000667 0.145 1 ## # … with 15 more rows ``` ] --- # The results .pull-left[ ```r set.seed(2) grid <- chi_wflow %>% parameters() %>% grid_latin_hypercube(size = 25) grid %>% ggplot(aes(penalty, mixture, col = deg_free)) + geom_point(cex = 4) + scale_x_log10() ``` Note that `penalty` was generated in log-10 units. ] .pull-right[ <img src="5-tuning_files/figure-html/unnamed-chunk-10-1.svg" width="90%" style="display: block; margin: auto;" /> ] --- # Grid search The `tune_*()` functions can be used to tune models. `tune_grid()` is pretty representative of their syntax (and is similar to `last_fit()`): ```r ctrl <- control_grid(save_pred = TRUE) set.seed(9) chi_res <- chi_wflow %>% tune_grid(resamples = chi_rs, grid = grid) # 'grid' = integer for automatic grids chi_res ``` ``` ## # Tuning results ## # Sliding period resampling ## # A tibble: 16 × 4 ## splits id .metrics .notes ## <list> <chr> <list> <list> ## 1 <split [5463/14]> Slice01 <tibble [50 × 7]> <tibble [0 × 1]> ## 2 <split [5467/14]> Slice02 <tibble [50 × 7]> <tibble [0 × 1]> ## 3 <split [5467/14]> Slice03 <tibble [50 × 7]> <tibble [0 × 1]> ## 4 <split [5467/14]> Slice04 <tibble [50 × 7]> <tibble [0 × 1]> ## 5 <split [5467/14]> Slice05 <tibble [50 × 7]> <tibble [0 × 1]> ## 6 <split [5467/14]> Slice06 <tibble [50 × 7]> <tibble [0 × 1]> ## 7 <split [5467/14]> Slice07 <tibble [50 × 7]> <tibble [0 × 1]> ## 8 <split [5467/14]> Slice08 <tibble [50 × 7]> <tibble [0 × 1]> ## 9 <split [5467/14]> Slice09 <tibble [50 × 7]> <tibble [0 × 1]> ## 10 <split [5467/14]> Slice10 <tibble [50 × 7]> <tibble [0 × 1]> ## 11 <split [5467/14]> Slice11 <tibble [50 × 7]> <tibble [0 × 1]> ## 12 <split [5467/14]> Slice12 <tibble [50 × 7]> <tibble [0 × 1]> ## 13 <split [5467/14]> Slice13 <tibble [50 × 7]> <tibble [0 × 1]> ## 14 <split [5467/14]> Slice14 <tibble [50 × 7]> <tibble [0 × 1]> ## 15 <split [5467/14]> Slice15 <tibble [50 × 7]> <tibble [0 × 1]> ## 16 <split [5467/11]> Slice16 <tibble [50 × 7]> <tibble [0 × 1]> ``` --- # Grid results ```r autoplot(chi_res) ``` <img src="5-tuning_files/figure-html/autoplot-1.svg" width="70%" style="display: block; margin: auto;" /> --- # ENHANCE ```r autoplot(chi_res, metric = "rmse") + ylim(c(1.7, 1.85)) ``` <img src="5-tuning_files/figure-html/enhacned-1.svg" width="80%" style="display: block; margin: auto;" /> --- # Returning results ```r collect_metrics(chi_res) ``` ``` ## # A tibble: 50 × 9 ## penalty mixture deg_free .metric .estimator mean n std_err .config ## <dbl> <dbl> <int> <chr> <chr> <dbl> <int> <dbl> <chr> ## 1 1.24e-1 0.309 2 rmse standard 2.11 16 0.266 Preproce… ## 2 1.24e-1 0.309 2 rsq standard 0.924 16 0.0249 Preproce… ## 3 4.91e-1 0.817 2 rmse standard 2.95 16 0.402 Preproce… ## 4 4.91e-1 0.817 2 rsq standard 0.848 16 0.0502 Preproce… ## 5 4.74e-8 0.269 5 rmse standard 1.74 16 0.241 Preproce… ## 6 4.74e-8 0.269 5 rsq standard 0.947 16 0.0213 Preproce… ## 7 3.28e-9 0.483 5 rmse standard 1.74 16 0.241 Preproce… ## 8 3.28e-9 0.483 5 rsq standard 0.947 16 0.0212 Preproce… ## 9 1.01e-8 0.810 4 rmse standard 1.72 16 0.241 Preproce… ## 10 1.01e-8 0.810 4 rsq standard 0.947 16 0.0210 Preproce… ## # … with 40 more rows ``` --- # Returning results ```r collect_metrics(chi_res, summarize = FALSE) ``` ``` ## # A tibble: 800 × 8 ## id penalty mixture deg_free .metric .estimator .estimate .config ## <chr> <dbl> <dbl> <int> <chr> <chr> <dbl> <chr> ## 1 Slice01 0.124 0.309 2 rmse standard 4.20 Preprocessor… ## 2 Slice01 0.124 0.309 2 rsq standard 0.722 Preprocessor… ## 3 Slice02 0.124 0.309 2 rmse standard 1.96 Preprocessor… ## 4 Slice02 0.124 0.309 2 rsq standard 0.961 Preprocessor… ## 5 Slice03 0.124 0.309 2 rmse standard 2.30 Preprocessor… ## 6 Slice03 0.124 0.309 2 rsq standard 0.915 Preprocessor… ## 7 Slice04 0.124 0.309 2 rmse standard 1.78 Preprocessor… ## 8 Slice04 0.124 0.309 2 rsq standard 0.965 Preprocessor… ## 9 Slice05 0.124 0.309 2 rmse standard 2.00 Preprocessor… ## 10 Slice05 0.124 0.309 2 rsq standard 0.938 Preprocessor… ## # … with 790 more rows ``` --- # Metrics over time .pull-left[ ```r chi_res %>% add_date_to_metrics("date") %>% filter(.metric == "rmse") %>% ggplot(aes(x = date, y = .estimate, group = .config, col = .config)) + geom_line(show.legend = FALSE, alpha = .3) + labs(y = "RMSE") ``` ] .pull-right[ <img src="5-tuning_files/figure-html/unnamed-chunk-13-1.svg" width="80%" style="display: block; margin: auto;" /> ] --- # Picking a parameter combination You can create a tibble of your own or use one of the `tune::select_*()` functions: ```r show_best(chi_res, metric = "rmse") ``` ``` ## # A tibble: 5 × 9 ## penalty mixture deg_free .metric .estimator mean n std_err .config ## <dbl> <dbl> <int> <chr> <chr> <dbl> <int> <dbl> <chr> ## 1 1.01e- 8 0.810 4 rmse standard 1.72 16 0.241 Preprocess… ## 2 3.29e- 5 0.701 3 rmse standard 1.73 16 0.241 Preprocess… ## 3 3.11e- 3 0.869 15 rmse standard 1.74 16 0.242 Preprocess… ## 4 2.41e- 4 0.949 7 rmse standard 1.74 16 0.240 Preprocess… ## 5 5.41e-10 0.633 6 rmse standard 1.74 16 0.241 Preprocess… ``` ```r smallest_rmse <- select_best(chi_res, metric = "rmse") smallest_rmse ``` ``` ## # A tibble: 1 × 4 ## penalty mixture deg_free .config ## <dbl> <dbl> <int> <chr> ## 1 0.0000000101 0.810 4 Preprocessor03_Model1 ``` --- # Updating the workflow and final fit ```r chi_wflow <- chi_wflow %>% finalize_workflow(smallest_rmse) test_res <- chi_wflow %>% last_fit(split = chi_split) test_res ``` ``` ## # Resampling results ## # Manual resampling ## # A tibble: 1 × 6 ## splits id .metrics .notes .predictions .workflow ## <list> <chr> <list> <list> <list> <list> ## 1 <split [5684/14]> train/test split <tibble … <tibble… <tibble [14… <workflo… ``` The workflow, fit using the training set: ```r final_chi_wflow <- test_res$.workflow[[1]] ``` --- # Two-week test set results ```r collect_metrics(test_res) ``` ``` ## # A tibble: 2 × 4 ## .metric .estimator .estimate .config ## <chr> <chr> <dbl> <chr> ## 1 rmse standard 0.976 Preprocessor1_Model1 ## 2 rsq standard 0.990 Preprocessor1_Model1 ``` ```r # Resampling results show_best(chi_res, metric = "rmse", n = 1) ``` ``` ## # A tibble: 1 × 9 ## penalty mixture deg_free .metric .estimator mean n std_err .config ## <dbl> <dbl> <int> <chr> <chr> <dbl> <int> <dbl> <chr> ## 1 0.0000000101 0.810 4 rmse standard 1.72 16 0.241 Prepro… ``` --- # Two-week test set results .pull-left[ ```r test_res %>% collect_predictions() %>% ggplot(aes(ridership, .pred)) + geom_abline(col = "green", lty = 2) + geom_point(cex = 3, alpha = 0.5) + coord_obs_pred() ``` ] .pull-right[ <img src="5-tuning_files/figure-html/unnamed-chunk-18-1.svg" width="90%" style="display: block; margin: auto;" /> ] --- # Two-week test set results .pull-left[ ```r library(lubridate) test_values <- final_chi_wflow %>% augment(testing(chi_split)) %>% mutate(day = wday(date, label = TRUE)) test_values %>% ggplot(aes(ridership, .pred, col = day)) + geom_abline(col = "green", lty = 2) + geom_point(cex = 3, alpha = 0.5) + coord_obs_pred() + scale_color_brewer(palette = "Dark2") ``` ] .pull-right[ <img src="5-tuning_files/figure-html/unnamed-chunk-19-1.svg" width="90%" style="display: block; margin: auto;" /> ] --- # Two-week test set results .pull-left[ ```r test_values %>% ggplot(aes(date, ridership)) + geom_point(aes(col = day), cex = 3, alpha = 0.5) + geom_line(aes(y = .pred)) + scale_color_brewer(palette = "Dark2") ``` ] .pull-right[ <img src="5-tuning_files/figure-html/unnamed-chunk-20-1.svg" width="100%" style="display: block; margin: auto;" /> ] --- # Hands-On: Tune hyperparameters Go to the lab and finish the document by tuning a model
10
:
00