This template offers an opinionated guide on how to structure a modeling analysis. Your individual modeling analysis may require you to add to, subtract from, or otherwise change this structure, but consider this a general framework to start from. If you want to learn more about using tidymodels, check out our Getting Started guide.

In this example analysis, let’s fit a model to predict the sex of penguins from species and measurement information.

library(tidyverse)

url <- "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-01-18/chocolate.csv"
chocolate <- read_csv(url)
## Rows: 2530 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): company_manufacturer, company_location, country_of_bean_origin, spe...
## dbl (3): ref, review_date, rating
## 
## ℹ 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.
chocolate
## # A tibble: 2,530 × 10
##      ref company_manufacturer company_location review_date
##    <dbl> <chr>                <chr>                  <dbl>
##  1  2454 5150                 U.S.A.                  2019
##  2  2458 5150                 U.S.A.                  2019
##  3  2454 5150                 U.S.A.                  2019
##  4  2542 5150                 U.S.A.                  2021
##  5  2546 5150                 U.S.A.                  2021
##  6  2546 5150                 U.S.A.                  2021
##  7  2542 5150                 U.S.A.                  2021
##  8   797 A. Morin             France                  2012
##  9   797 A. Morin             France                  2012
## 10  1011 A. Morin             France                  2013
## # ℹ 2,520 more rows
## # ℹ 6 more variables: country_of_bean_origin <chr>,
## #   specific_bean_origin_or_bar_name <chr>, cocoa_percent <chr>,
## #   ingredients <chr>, most_memorable_characteristics <chr>, rating <dbl>

Explore data

Exploratory data analysis (EDA) is an important part of the modeling process.

chocolate %>%
  ggplot(aes(rating)) +
  geom_histogram(bins = 15)

library(tidytext)

tidy_chocolate <-
  chocolate %>%
  unnest_tokens(word, most_memorable_characteristics)

tidy_chocolate %>%
  count(word, sort = TRUE)
## # A tibble: 547 × 2
##    word        n
##    <chr>   <int>
##  1 cocoa     419
##  2 sweet     318
##  3 nutty     278
##  4 fruit     273
##  5 roasty    228
##  6 mild      226
##  7 sour      208
##  8 earthy    199
##  9 creamy    189
## 10 intense   178
## # ℹ 537 more rows
tidy_chocolate %>%
  group_by(word) %>%
  summarise(
    n = n(),
    rating = mean(rating)) %>%
    
  ggplot(aes(n, rating)) +
  geom_hline(yintercept = mean(chocolate$rating), lty = 2,
    color = "gray50", size = 1.2) +
  geom_point(color = "midnightblue", alpha = 0.7) +
  geom_text(aes(label = word),
    check_overlap = TRUE,
    vjust = "top", hjust = "left") +
  scale_x_log10()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Build models

Let’s consider how to spend our data budget:

library(tidymodels)
## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──
## ✔ broom        1.0.5      ✔ rsample      1.2.1 
## ✔ dials        1.2.1      ✔ tune         1.2.1 
## ✔ infer        1.0.7      ✔ workflows    1.1.4 
## ✔ modeldata    1.4.0      ✔ workflowsets 1.1.0 
## ✔ parsnip      1.2.1      ✔ yardstick    1.3.1 
## ✔ recipes      1.0.10
## Warning: package 'modeldata' was built under R version 4.3.3
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ recipes::check()  masks devtools::check()
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter()   masks stats::filter()
## ✖ recipes::fixed()  masks stringr::fixed()
## ✖ dplyr::lag()      masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step()   masks stats::step()
## • Use tidymodels_prefer() to resolve common conflicts.
set.seed(123)
choco_split <- initial_split(chocolate, strata = rating)
choco_train <- training(choco_split)
choco_test <- testing(choco_split)

set.seed(234)
choco_folds <- vfold_cv(choco_train, strata = rating)
choco_folds
## #  10-fold cross-validation using stratification 
## # A tibble: 10 × 2
##    splits             id    
##    <list>             <chr> 
##  1 <split [1705/191]> Fold01
##  2 <split [1705/191]> Fold02
##  3 <split [1705/191]> Fold03
##  4 <split [1706/190]> Fold04
##  5 <split [1706/190]> Fold05
##  6 <split [1706/190]> Fold06
##  7 <split [1707/189]> Fold07
##  8 <split [1707/189]> Fold08
##  9 <split [1708/188]> Fold09
## 10 <split [1709/187]> Fold10

Let’s set up our preprocessing:

library(textrecipes)

choco_rec <-
  recipe(rating ~ most_memorable_characteristics, data = choco_train) %>%
  step_tokenize(most_memorable_characteristics) %>%
  step_tokenfilter(most_memorable_characteristics, max_tokens = 100) %>%
  step_tfidf(most_memorable_characteristics)

## just to check this works
prep(choco_rec) %>% bake(new_data = NULL)
## # A tibble: 1,896 × 101
##    rating tfidf_most_memorable_c…¹ tfidf_most_memorable…² tfidf_most_memorable…³
##     <dbl>                    <dbl>                  <dbl>                  <dbl>
##  1   3                        0                         0                      0
##  2   2.75                     0                         0                      0
##  3   3                        0                         0                      0
##  4   3                        0                         0                      0
##  5   2.75                     0                         0                      0
##  6   3                        1.38                      0                      0
##  7   2.75                     0                         0                      0
##  8   2.5                      0                         0                      0
##  9   2.75                     0                         0                      0
## 10   3                        0                         0                      0
## # ℹ 1,886 more rows
## # ℹ abbreviated names: ¹​tfidf_most_memorable_characteristics_acidic,
## #   ²​tfidf_most_memorable_characteristics_and,
## #   ³​tfidf_most_memorable_characteristics_astringent
## # ℹ 97 more variables: tfidf_most_memorable_characteristics_banana <dbl>,
## #   tfidf_most_memorable_characteristics_base <dbl>,
## #   tfidf_most_memorable_characteristics_basic <dbl>, …

Let’s create a model specification for each model we want to try:

ranger_spec <-
  rand_forest(trees = 500) %>%
  set_engine("ranger") %>%
  set_mode("regression")

ranger_spec 
## Random Forest Model Specification (regression)
## 
## Main Arguments:
##   trees = 500
## 
## Computational engine: ranger
svm_spec <-
    svm_linear() %>%
    set_engine("LiblineaR") %>%
    set_mode("regression")

svm_spec
## Linear Support Vector Machine Model Specification (regression)
## 
## Computational engine: LiblineaR

To set up your modeling code, consider using the parsnip addin or the usemodels package.

Now let’s build a model workflow combining each model specification with a data preprocessor:

ranger_wf <- workflow(choco_rec, ranger_spec)
svm_wf <- workflow(choco_rec, svm_spec)

If your feature engineering needs are more complex than provided by a formula like sex ~ ., use a recipe. Read more about feature engineering with recipes to learn how they work.

Evaluate models

These models have no tuning parameters so we can evaluate them as they are. Learn about tuning hyperparameters here.

doParallel::registerDoParallel()
contrl_preds <- control_resamples(save_pred = TRUE)

svm_rs <- fit_resamples(
  svm_wf,
  resamples = choco_folds,
  control = contrl_preds
)
## Warning: package 'LiblineaR' was built under R version 4.3.3
ranger_rs <- fit_resamples(
  ranger_wf,
  resamples = choco_folds,
  control = contrl_preds
)

How did these two models compare?

collect_metrics(svm_rs)
## # A tibble: 2 × 6
##   .metric .estimator  mean     n std_err .config             
##   <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
## 1 rmse    standard   0.347    10 0.00656 Preprocessor1_Model1
## 2 rsq     standard   0.367    10 0.0181  Preprocessor1_Model1
collect_metrics(ranger_rs)
## # A tibble: 2 × 6
##   .metric .estimator  mean     n std_err .config             
##   <chr>   <chr>      <dbl> <int>   <dbl> <chr>               
## 1 rmse    standard   0.350    10 0.00688 Preprocessor1_Model1
## 2 rsq     standard   0.359    10 0.0164  Preprocessor1_Model1

We can visualize these results:

bind_rows(
  collect_predictions(svm_rs) %>%
    mutate(mod = "SVM"), collect_predictions(ranger_rs) %>%
    mutate(mod = "ranger")) %>%
    
  ggplot(aes(rating, .pred, color = id)) +
    geom_abline(lty = 2, color = "gray50", size = 1.2) +
    geom_jitter(width = 0.5, alpha = 0.5) +
        facet_wrap(vars(mod)) +
        coord_fixed()

These models perform very similarly, so perhaps we would choose the simpler, linear model. The function last_fit() fits one final time on the training data and evaluates on the testing data. This is the first time we have used the testing data.

final_fitted <- last_fit(svm_wf, choco_split)
collect_metrics(final_fitted)  ## metrics evaluated on the *testing* data
## # A tibble: 2 × 4
##   .metric .estimator .estimate .config             
##   <chr>   <chr>          <dbl> <chr>               
## 1 rmse    standard       0.381 Preprocessor1_Model1
## 2 rsq     standard       0.348 Preprocessor1_Model1

This object contains a fitted workflow that we can use for prediction.

final_wf <- extract_workflow(final_fitted)
predict(final_wf, choco_test[55,])
## # A tibble: 1 × 1
##   .pred
##   <dbl>
## 1  3.51

You can save this fitted final_wf object to use later with new data, for example with readr::write_rds().

extract_workflow(final_fitted) %>%
    tidy() %>%
    filter(term != "Bias") %>%
    group_by(estimate > 0) %>%
    slice_max(abs(estimate), n = 10) %>%
    ungroup() %>%
    mutate(term = str_remove(term, "tfidf_most_memorable_characteristics_")) %>%
    
    ggplot(aes(estimate, fct_reorder(term, estimate), fill = estimate > 0)) +
    geom_col(alpha = 0.8) +
    scale_fill_discrete(labels = c("low ratings", "high ratings")) +
    labs(y = NULL, fill = "More from...")