Tuning Text Analysis

Source: vignettes/extras/text_analysis.Rmd

This advanced example shows how to process text data with recipes and use them in a predictive model. It also has an example of extracting information from each model fit for later use.

The data are from Amazon:

“This dataset consists of reviews of fine foods from amazon. The data span a period of more than 10 years, including all ~500,000 reviews up to October 2012. Reviews include product and user information, ratings, and a plaintext review.”

A small subset of the data are contained here; we sampled a single review from 5,000 random products and 80% of these data were used as the training set. The remaining 1,000 were used as the test set.

There is a column for the product, a column for the text of the review, and a factor column for a class variable. The outcome is whether the reviewer game the product a five-star rating or not.

library(tidymodels)

data("small_fine_foods")
training_data
#> # A tibble: 4,000 x 3
#>    product    review                                                       score
#>    <chr>      <chr>                                                        <fct>
#>  1 B000J0LSBG "this stuff is  not stuffing  its  not good at all  save yo… other
#>  2 B000EYLDYE "I absolutely LOVE this dried fruit.  LOVE IT.  Whenever I … great
#>  3 B0026LIO9A "GREAT DEAL, CONVENIENT TOO.  Much cheaper than WalMart and… great
#>  4 B00473P8SK "Great flavor, we go through a ton of this sauce! I discove… great
#>  5 B001SAWTNM "This is excellent salsa/hot sauce, but you can get it for … great
#>  6 B000FAG90U "Again, this is the best dogfood out there.  One suggestion… great
#>  7 B006BXTCEK "The box I received was filled with teas, hot chocolates, a… other
#>  8 B002GWH5OY "This is delicious coffee which compares favorably with muc… great
#>  9 B003R0MFYY "Don't let these little tiny cans fool you.  They pack a lo… great
#> 10 B001EO5ZXI "One of the nicest, smoothest cup of chai I've made. Nice m… great
#> # … with 3,990 more rows

The idea is to process the text data into features and use these features to predict whether the review was five-star or not.

Recipe and Model Specifications

The data processing steps are:

  • create an initial set of features based on simple word/character scores, such as the number of words, URLs and so on; The textfeatures will be used for this

  • the text is tokenized (i.e. broken into smaller components such as words)

  • stop words (such as “the”, “an”, etc.) are removed

  • tokens are stemmed to a common root where possible

  • tokens are converted to dummy variables via a signed, binary hash function

  • non-token features are optionally transformed to a more symmetric state using a Yeo-Johnson transformation

  • predictors with a single distinct value are removed

  • all predictors are centered and scaled.

Some of these steps may or may not be good ideas (such as stemming). In this process, the main tuning parameter will be the number of feature hash features to use.

A recipe will be used to implement this. We’ll also need some helper objects. For example, for the Yeo-Johnson transformation, we need to know the initial feature set:

library(textfeatures)

basics <- names(textfeatures:::count_functions)
head(basics)
#> [1] "n_words"    "n_uq_words" "n_charS"    "n_uq_charS" "n_digits"  
#> [6] "n_hashtags"

Also, the implementation of feature hashes does not produce binary values. This small function will help convert the scores to values of -1, 0, or 1:

binary_hash <- function(x) {
  x <- ifelse(x < 0, -1, x)
  x <- ifelse(x > 0,  1, x)
  x
}

The recipe is:

library(textrecipes)

pre_proc <-
  recipe(score ~ product + review, data = training_data) %>%
  # Do not use the product ID as a predictor
  update_role(product, new_role = "id") %>%
  # Make a copy of the raw text
  step_mutate(review_raw = review) %>%
  # Compute the initial features. This removes the `review_raw` column
  step_textfeature(review_raw) %>%
  # Make the feature names shorter
  step_rename_at(
    starts_with("textfeature_"),
    fn = ~ gsub("textfeature_review_raw_", "", .)
  ) %>%
  step_tokenize(review)  %>%
  step_stopwords(review) %>%
  step_stem(review) %>%
  # Here is where the tuning parameter is declared
  step_texthash(review, signed = TRUE, num_terms = tune()) %>%
  # Simplify these names
  step_rename_at(starts_with("review_hash"), fn = ~ gsub("review_", "", .)) %>%
  # Convert the features from counts to values of -1, 0, or 1
  step_mutate_at(starts_with("hash"), fn = binary_hash) %>%
  # Transform the initial feature set
  step_YeoJohnson(one_of(!!basics)) %>%
  step_zv(all_predictors()) %>%
  step_normalize(all_predictors())

Note that, when objects from the global environment are used, they are injected into the step objects via !!. For some parallel processing technologies, these objects may not be found by the worker processes.

To model these data, a regularized logistic regression model will be used:

lr_mod <-
  logistic_reg(penalty = tune(), mixture = tune()) %>%
  set_engine("glmnet")

Three tuning parameters should be trained for this data analysis.

Resampling

There are enough data here such that 10-fold resampling would hold out 400 reviews at a time to estimate performance. Performance estimates using this many observations have sufficiently low noise to measure and tune models.

set.seed(8935)
folds <- vfold_cv(training_data)

Extracted Results

Jumping back to the grid search results, let’s examine the results of our extract function. For each fitted model, a tibble was saved that has the relationship between the number of predictors and the penalty value. Let’s look at these results for the best model:

params <- select_best(five_star_glmnet, metric = "roc_auc")
params
#> # A tibble: 1 x 4
#>   penalty mixture num_terms .config               
#>     <dbl>   <dbl>     <dbl> <chr>                 
#> 1  0.0379    0.25      4096 Preprocessor3_Model031

Recall that we saved the glmnet results in a tibble. The column five_star_glmnet$.extracts is a list of tibbles. As an example, the first element of the list is:

five_star_glmnet$.extracts[[1]]
#> # A tibble: 300 x 5
#>    num_terms penalty mixture .extracts          .config               
#>        <dbl>   <dbl>   <dbl> <list>             <chr>                 
#>  1       256       1       0 <tibble [100 × 2]> Preprocessor1_Model001
#>  2       256       1       0 <tibble [100 × 2]> Preprocessor1_Model002
#>  3       256       1       0 <tibble [100 × 2]> Preprocessor1_Model003
#>  4       256       1       0 <tibble [100 × 2]> Preprocessor1_Model004
#>  5       256       1       0 <tibble [100 × 2]> Preprocessor1_Model005
#>  6       256       1       0 <tibble [100 × 2]> Preprocessor1_Model006
#>  7       256       1       0 <tibble [100 × 2]> Preprocessor1_Model007
#>  8       256       1       0 <tibble [100 × 2]> Preprocessor1_Model008
#>  9       256       1       0 <tibble [100 × 2]> Preprocessor1_Model009
#> 10       256       1       0 <tibble [100 × 2]> Preprocessor1_Model010
#> # … with 290 more rows

More nested tibbles! Let’s unnest five_star_glmnet$.extracts:

library(tidyr)
extracted <- 
  five_star_glmnet %>% 
  dplyr::select(id, .extracts) %>% 
  unnest(cols = .extracts)
extracted
#> # A tibble: 3,000 x 6
#>    id     num_terms penalty mixture .extracts          .config               
#>    <chr>      <dbl>   <dbl>   <dbl> <list>             <chr>                 
#>  1 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model001
#>  2 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model002
#>  3 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model003
#>  4 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model004
#>  5 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model005
#>  6 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model006
#>  7 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model007
#>  8 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model008
#>  9 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model009
#> 10 Fold01       256       1       0 <tibble [100 × 2]> Preprocessor1_Model010
#> # … with 2,990 more rows

One thing to realize here is that tune_grid() may not fit all of the models that are evaluated. In this case, for each value of mixture and num_terms, the model is fit overall all penalty values5. To select the best parameter set, we can exclude the penalty column in extracted:

extracted <- 
  extracted %>% 
  dplyr::select(-penalty) %>% 
  inner_join(params, by = c("num_terms", "mixture")) %>% 
  # Now remove it from the final results
  dplyr::select(-penalty)
extracted
#> # A tibble: 200 x 6
#>    id     num_terms mixture .extracts       .config.x          .config.y        
#>    <chr>      <dbl>   <dbl> <list>          <chr>              <chr>            
#>  1 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  2 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  3 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  4 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  5 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  6 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  7 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  8 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#>  9 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#> 10 Fold01      4096    0.25 <tibble [100 ×… Preprocessor3_Mod… Preprocessor3_Mo…
#> # … with 190 more rows

Now we can get at the results that we want using another unnest:

extracted <- 
  extracted %>% 
  unnest(col = .extracts) # <- these contain a `penalty` column
extracted
#> # A tibble: 20,000 x 7
#>    id     num_terms mixture penalty num_vars .config.x         .config.y        
#>    <chr>      <dbl>   <dbl>   <dbl>    <int> <chr>             <chr>            
#>  1 Fold01      4096    0.25   0.360        0 Preprocessor3_Mo… Preprocessor3_Mo…
#>  2 Fold01      4096    0.25   0.344        1 Preprocessor3_Mo… Preprocessor3_Mo…
#>  3 Fold01      4096    0.25   0.328        2 Preprocessor3_Mo… Preprocessor3_Mo…
#>  4 Fold01      4096    0.25   0.313        2 Preprocessor3_Mo… Preprocessor3_Mo…
#>  5 Fold01      4096    0.25   0.299        3 Preprocessor3_Mo… Preprocessor3_Mo…
#>  6 Fold01      4096    0.25   0.286        3 Preprocessor3_Mo… Preprocessor3_Mo…
#>  7 Fold01      4096    0.25   0.273        4 Preprocessor3_Mo… Preprocessor3_Mo…
#>  8 Fold01      4096    0.25   0.260        5 Preprocessor3_Mo… Preprocessor3_Mo…
#>  9 Fold01      4096    0.25   0.248        7 Preprocessor3_Mo… Preprocessor3_Mo…
#> 10 Fold01      4096    0.25   0.237        7 Preprocessor3_Mo… Preprocessor3_Mo…
#> # … with 19,990 more rows

Let’s look at a plot of these results (per resample):

ggplot(extracted, aes(x = penalty, y = num_vars)) + 
  geom_line(aes(group = id, col = id), alpha = .5) + 
  ylab("Number of retained predictors") + 
  scale_x_log10()  + 
  ggtitle(paste("mixture = ", params$mixture, "and", params$num_terms, "features")) + 
  theme(legend.position = "none")

These results might help guide the range of the penalty value if more optimization was conducted.

  1. This is a small sample of the overall data set. When more data are used, a larger feature set is optimal.↩︎

  2. See the last section below for more details.↩︎

  3. See the vignette on acquisition functions for more details.↩︎

  4. Sorry, pun intended.↩︎

  5. This is a feature of this particular model and is not generally true for other engines.↩︎