Hip-Hop Lyrics Be Flowing with Tidy Text Mining

Data Set

This dataset comes once again from a recent TidyTuesday. BBC Music asked more than 100 critics, artists, and other music industry folks from 15 countries for their five favorite hip-hop tracks and this data contains said polling results. To be clear, these are not the final results of the poll but an aggregation of their top five submissions.

polls <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-14/polls.csv')
polls

## # A tibble: 535 x 9
##     rank title artist gender  year critic_name critic_rols critic_country
##    <dbl> <chr> <chr>  <chr>  <dbl> <chr>       <chr>       <chr>         
##  1     1 Term~ Publi~ male    1998 Joseph Aba~ Fat Beats   US            
##  2     2 4th ~ Gza f~ male    1995 Joseph Aba~ Fat Beats   US            
##  3     3 Pete~ Run D~ male    1986 Joseph Aba~ Fat Beats   US            
##  4     4 Play~ GLOBE~ male    2001 Joseph Aba~ Fat Beats   US            
##  5     5 Time~ O.C.   male    1994 Joseph Aba~ Fat Beats   US            
##  6     1 Play~ Slum ~ male    1997 Biba Adams  Critic      US            
##  7     2 Self~ Stop ~ mixed   1989 Biba Adams  Critic      US            
##  8     3 Push~ Salt-~ female  1986 Biba Adams  Critic      US            
##  9     4 Ambi~ 2Pac   male    1996 Biba Adams  Critic      US            
## 10     5 Big ~ JAY-Z~ male    1999 Biba Adams  Critic      US            
## # ... with 525 more rows, and 1 more variable: critic_country2 <chr>

Data Cleaning

Let’s remove the duplicate entries, remove columns I won’t be using, and create our two buckets - “Old School” for hip-hop songs released before the year 2000, and “Modern” for songs released after 2000.

sorted <- polls %>%
  distinct(title, .keep_all = TRUE) %>%
  mutate(bucket = case_when(year < 2000 ~ "Old School",
                            TRUE ~ "Modern")) %>%
  select(-contains("critic"), -rank)

sorted

## # A tibble: 309 x 5
##    title                   artist                          gender  year bucket  
##    <chr>                   <chr>                           <chr>  <dbl> <chr>   
##  1 Terminator X To The Ed~ Public Enemy                    male    1998 Old Sch~
##  2 4th Chamber             Gza ft. Ghostface Killah & Kil~ male    1995 Old Sch~
##  3 Peter Piper             Run DMC                         male    1986 Old Sch~
##  4 Play That Beat Mr DJ    GLOBE & Whiz Kid                male    2001 Modern  
##  5 Time’s Up               O.C.                            male    1994 Old Sch~
##  6 Players                 Slum Village                    male    1997 Old Sch~
##  7 Self Destruction        Stop The Violence Movement      mixed   1989 Old Sch~
##  8 Push It                 Salt-N-Pepa                     female  1986 Old Sch~
##  9 Ambitionz Az A Ridah    2Pac                            male    1996 Old Sch~
## 10 Big Pimpin'             JAY-Z ft. UGK                   male    1999 Old Sch~
## # ... with 299 more rows

Our dataset now contains a total of 309 unique songs with a fairly even mix across Modern and Old School. I kept the gender column because it could yield some predictive power.

sorted %>% 
  distinct(title, .keep_all = TRUE) %>% 
  count(bucket, gender)

## # A tibble: 6 x 3
##   bucket     gender     n
##   <chr>      <chr>  <int>
## 1 Modern     female    12
## 2 Modern     male     119
## 3 Modern     mixed      7
## 4 Old School female    11
## 5 Old School male     148
## 6 Old School mixed     12

Obtaining Lyrics

Using the genius package from Josiah Parry, the add_genius function is able to pull lyrics for song/album by specifying the artist and the title. Note: Pulling lyrics for 309 songs took slightly over 12 minutes and not all lyrics were successfully retrieved. You can choose to use the code I hash-tagged out, or the resultign dataframe that I uploaded to my GitHub.

library(genius)

#lyrics <- sorted %>% add_genius(artist, title, type = "lyrics")

lyrics <- read_csv("https://raw.githubusercontent.com/DesmondChoy/DataSets/master/lyrics.csv")

From an initial size of 309 songs, add_genius only managed to return lyrics for 142 songs. Let’s also remove NA values.

lyrics %>%
  distinct(title, .keep_all = TRUE)

## # A tibble: 142 x 8
##    title      artist   gender  year bucket track_title     line lyric           
##    <chr>      <chr>    <chr>  <dbl> <chr>  <chr>          <dbl> <chr>           
##  1 Terminato~ Public ~ male    1998 Old S~ Terminator X ~     1 "\"At the count~
##  2 Peter Pip~ Run DMC  male    1986 Old S~ Peter Piper        1 "Now Peter Pipe~
##  3 Play That~ GLOBE &~ male    2001 Modern Play That Bea~     1 "Punk-rock, new~
##  4 Players    Slum Vi~ male    1997 Old S~ Players            1 "(Players)"     
##  5 Ambitionz~ 2Pac     male    1996 Old S~ Ambitionz Az ~     1 "I won't deny i~
##  6 Sucker MCs Run DMC  male    1984 Old S~ Sucker M.C.’s      1 "Two years ago,~
##  7 Lyrics Of~ Eric B ~ male    1988 Old S~ Lyrics of Fury     1 "I'm rated \"R\~
##  8 In Da Club 50 Cent  male    2003 Modern In Da Club         1  <NA>           
##  9 Dear Mama  2Pac     male    1995 Old S~ Dear Mama          1 "You are apprec~
## 10 Fuck Tha ~ NWA      male    1988 Old S~ Fuck tha Poli~     1  <NA>           
## # ... with 132 more rows

lyrics <- lyrics %>% 
  na.omit()

Text Mining using Tidy Data Principles

The process of tidy text mining is as such:

• To make the lyrics dataset tidy, we need to restructure it in the one-token-per-row format using the unnest_tokens() function
  
• Next, remove Stop Words - words that are not useful for an analysis, typically extremely common words such as the, of, to, and so forth in English. The stop_words dataset in the tidytext package contains stop words from three lexicons.
  
• Removal of stop words is done using anti-join()
  
• Finally, merge the dataframe with a lexicon using inner_join()

Here, the NRC lexicon by Saif Mohammad is used. The NRC lexicon categorizes words in a binary fashion (yes, no) into categories of positive, negative, anger, anticipation, disgust, fear, joy, sadness, surprise, and trust.

library(tidytext)
library(textdata)

tidy_lyrics <- lyrics %>% 
  unnest_tokens(word, lyric) %>% 
  anti_join(stop_words, by = "word") %>% 
  inner_join(get_sentiments("nrc")) %>% 
  select(-track_title) #repeated column

tidy_lyrics %>% 
  select(word, sentiment, line, title, artist, bucket) %>% 
  sample_n(10)

## # A tibble: 10 x 6
##    word       sentiment     line title                artist         bucket    
##    <chr>      <chr>        <dbl> <chr>                <chr>          <chr>     
##  1 money      trust           72 Takkies              YoungstaCPT    Modern    
##  2 devil      disgust         51 One Day              UGK            Old School
##  3 faith      trust          158 Mortal Man           Kendrick Lamar Modern    
##  4 jealousy   sadness         68 Ms Jackson           OutKast        Modern    
##  5 resentment sadness         98 Mortal Man           Kendrick Lamar Modern    
##  6 roulette   anticipation    69 Bring Da Ruckus      Wu-Tang Clan   Old School
##  7 child      anticipation    50 Doo Wop (That Thing) Lauryn Hill    Old School
##  8 luck       joy             65 Wot Do U Call It?    Wiley          Modern    
##  9 crazy      fear             1 Insane In The Brain  Cypress Hill   Old School
## 10 expire     negative        29 Ha                   Juvenile       Modern

Let’s peek at the top words used in our songs.

tidy_lyrics %>% 
  count(word, sort = TRUE) 

## # A tibble: 1,686 x 2
##    word        n
##    <chr>   <int>
##  1 bitch     945
##  2 shit      840
##  3 god       650
##  4 money     522
##  5 love      420
##  6 feeling   380
##  7 bout      330
##  8 real      290
##  9 baby      272
## 10 crazy     260
## # ... with 1,676 more rows

To get a sense of which are the primary emotions in each songs, let’s calculate the total number of words in each song, and from there calculate the percentage of each emotion using the total number of words.

#Calculating total words per song
totals <- tidy_lyrics %>% 
  count(title) %>% 
  rename(total_words = n)

#Joining it back to the original dataframe
lyrics_count <- tidy_lyrics %>% 
  left_join(totals, by = "title")

Which songs have the highest proportion of negative words?

lyrics_count %>% 
  filter(sentiment == "negative") %>% 
  count(title, sentiment, total_words) %>% 
  ungroup() %>% 
  mutate(percent = n/total_words) %>% 
  arrange(desc(percent))

## # A tibble: 141 x 5
##    title                                 sentiment total_words     n percent
##    <chr>                                 <chr>           <int> <int>   <dbl>
##  1 Bout It Bout It                       negative          389   150   0.386
##  2 Players                               negative           26    10   0.385
##  3 I Got 5 On It                         negative          113    41   0.363
##  4 They Want EFX                         negative          136    49   0.360
##  5 We Got It For Cheap (Intro)           negative          162    56   0.346
##  6 Mask Off                              negative          174    58   0.333
##  7 Fight Da Faida                        negative          175    58   0.331
##  8 Insane In The Brain                   negative          180    53   0.294
##  9 Straight Outta Compton (Extended Mix) negative          176    51   0.290
## 10 Get The Bozack                        negative          163    46   0.282
## # ... with 131 more rows

Let’s visualise it across some of the other emotions provided by NRC lexicon.

lyrics_count %>%
  filter(
    sentiment %in% c("positive", "negative", "joy", "fear", "anger", "trust"),
    total_words > 10
  ) %>%
  count(title, sentiment, total_words, artist) %>%
  mutate(percent = n / total_words,
         title = paste(artist, title, sep = " - ")) %>%
  arrange(desc(percent)) %>%
  group_by(sentiment) %>%
  slice(1:10) %>%
  ggplot(aes(reorder_within(title, percent, sentiment), percent, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(
    . ~ fct_relevel(sentiment, "positive", "negative", "joy", "fear", "trust"),
    scales = "free",
    ncol = 2
  ) +
  coord_flip() +
  scale_x_reordered() +
  scale_y_continuous(labels = scales::label_percent(accuracy = 1)) +
  labs(
    x = "",
    y = "Percentage of song's lyrics in each category",
    title = "Tidy Text Mining: Using Sentiment Analysis to Group Hip-Hop Songs across Emotions",
    subtitle = "Selected Hip-Hop Songs from BBC Poll; Categories from NRC Emotion Lexicon; Lyrics from Genius package"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 15),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15)
  )

Data is wrangled further with count() and pivot_wider() to obtain a sentiment score. With the score, we can now visualise how sentiment (positive/negative) changes across ten randomly sampled rap songs.

song_sentiment <- tidy_lyrics %>%
  count(title, artist, index = line %/% 4, sentiment) %>%
  pivot_wider(
    names_from = sentiment,
    values_from = n,
    values_fill = list(n = 0)) %>% 
  mutate(sentiment = positive - negative)

set.seed(2000)
sample <- song_sentiment %>% 
  distinct(title) %>% 
  sample_n(10) %>% 
  pull(title)
  
song_sentiment %>%
  filter(title %in% sample) %>%
  mutate(title = paste(artist, title, sep = " - ")) %>%
  ggplot(aes(index, sentiment, fill = title)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(. ~ title, ncol = 2, scales = c("free")) +
  labs(
    x = "Duration",
    y = "Sentiment Score",
    title = "Visualising Sentiment Scores for 10 randomly selected hip-hop songs",
    subtitle = "Positive scores indicate positive sentiment, and vice versa."
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 15),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15)
  )

Modelling

We begin our modelling process that aims to predict if a hip-hop song is Old School (released before the year 2000) or Modern (released in the year 2000 or later) by using feature engineering on its lyrics as well as artist gender.

Data Splitting

library(tidymodels)

set.seed(2000)
hiphop_split <- initial_split(lyrics, strata = bucket)
hiphop_split

## <Analysis/Assess/Total>
## <8795/2930/11725>

hiphop_train <- training(hiphop_split)
hiphop_test <- testing(hiphop_split)

Resampling

Since we plan on doing some hyperparameter tuning, we will need resampled data.

set.seed(2000)
folds <- vfold_cv(hiphop_train, v = 10)
folds

## #  10-fold cross-validation 
## # A tibble: 10 x 2
##    splits             id    
##    <list>             <chr> 
##  1 <split [7.9K/880]> Fold01
##  2 <split [7.9K/880]> Fold02
##  3 <split [7.9K/880]> Fold03
##  4 <split [7.9K/880]> Fold04
##  5 <split [7.9K/880]> Fold05
##  6 <split [7.9K/879]> Fold06
##  7 <split [7.9K/879]> Fold07
##  8 <split [7.9K/879]> Fold08
##  9 <split [7.9K/879]> Fold09
## 10 <split [7.9K/879]> Fold10

Model Specification

Let’s use a LASSO (least absolute shrinkage and selection operator) regression model, which has two tuning hyperparameters:
* Penalty: The total amount of regularization in the model. This is set to tune(), a placeholder that will be determined subsequently by tuning.
* Mixture: The proportion of L1 regularization in the model. Setting Mixture to 1 makes it a LASSO model.

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

Feature Pre-processing

Here we begin to do some processing on the lyrics that we previously pulled:

• step_tokenize: Similar to unnest_tokens(); this tokenizes our lyrics. The default option is used where words are broken down into single words (as opposed to n-grams or multiple words)
• step_stopwords: Similar to anti-join(stop_words)
• step_tokenfilter: We keep the top 2000 most-used tokens after accounting for the removal of stop words
• step_tfidf: The statistic tf-idf, or term frequency multiplied by inverse document frequency, identifies words that are important to one document within a collection of documents.
• step_normalize: Once the words have been converted to tf-idf values, they will then be centered and scaled i.e. normalized. This is important as the LASSO model is not robust to outliers.
• step_dummy: Standard practise to convert factor/character columns (such as our gender bucket) to dummy variables to make them numeric.

library(textrecipes)

hiphop_rec <- hiphop_train %>%
  recipe(bucket ~ lyric + gender) %>%
  step_tokenize(lyric) %>%
  step_stopwords(lyric) %>%
  step_tokenfilter(lyric, max_tokens = 2000) %>%
  step_tfidf(lyric) %>%
  step_normalize(all_predictors(),-gender) %>%
  step_dummy(all_nominal(), -all_outcomes())

prep(hiphop_rec) 

## Data Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor          2
## 
## Training data contained 8795 data points and no missing data.
## 
## Operations:
## 
## Tokenization for lyric [trained]
## Stop word removal for lyric [trained]
## Text filtering for lyric [trained]
## Term frequency-inverse document frequency with lyric [trained]
## Centering and scaling for tfidf_lyric_<U+4E86>, tfidf_lyric_<U+4F9D><U+7136>, ... [trained]
## Dummy variables from gender [trained]

Workflows

We next use the workflows package to bundle our model and recipes. Personally I’m rather excited after this package as it has not only has great synergy with the ecosystem, but it makes the process cleaner and more intuitive - especially compared to my previous tidymodels post.

lr_wflow <- workflow() %>% 
  add_model(lr_model) %>% 
  add_recipe(hiphop_rec)
  
lr_wflow

## == Workflow ===============================================================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor -------------------------------------------------------------------------------------------
## 6 Recipe Steps
## 
## * step_tokenize()
## * step_stopwords()
## * step_tokenfilter()
## * step_tfidf()
## * step_normalize()
## * step_dummy()
## 
## -- Model --------------------------------------------------------------------------------------------------
## Logistic Regression Model Specification (classification)
## 
## Main Arguments:
##   penalty = tune()
##   mixture = 1
## 
## Computational engine: glmnet

Tuning

Recall the penalty hyperparamter in our model was given the placeholder tune(). To find an optimal value, we first create a set of possible regularization parameters to conduct a grid search.

grid <- grid_regular(penalty(), levels = 40)

Together with our resampled tibble created earlier, we can begin tuning. We can further specify relevant metrics - in this case, roc_auc, positive predictive value (ppv), negative predictive value (npv), and mean log loss (mn_log_loss) which takes into account the uncertainty in the prediction and gives a more detailed view into the actual performance.

#doParallel::registerDoParallel()
#Step recommended by Julia Silge. Gives me an error on my Windows PC but perhaps it works on Mac?

set.seed(2000)
lr_grid <- tune_grid(
  lr_wflow,
  resamples = folds,
  grid = grid,
  metrics = metric_set(roc_auc, npv, ppv, mn_log_loss))

With our tuning results, we use collect_metrics() and visualize our findings.

lr_grid %>%
  collect_metrics() %>%
  ggplot(aes(penalty, mean, color = .metric)) +
  geom_line(size = 1.5, show.legend = FALSE) +
  facet_wrap(. ~ .metric, nrow = 4) +
  scale_x_log10(label = scales::number_format())

It does seem the optimal penalty value is below 0.01 - a higher mean is better for npv, ppv and roc_auc, while a lower mean is better for the log_loss metric. Beyond that, the trade-off is ppv gets better while the other three metrics suffer.

Using show_best(), we can see the optimal penalty values of roc_auc and mn_log_loss.

lr_grid %>%
  show_best("mn_log_loss") %>%
  slice(1:3) %>%
  bind_rows(lr_grid %>%
              show_best("roc_auc") %>%
              slice(1:3))

## # A tibble: 6 x 7
##   penalty .metric     .estimator  mean     n std_err .config
##     <dbl> <chr>       <chr>      <dbl> <int>   <dbl> <fct>  
## 1 0.00492 mn_log_loss binary     0.565    10 0.00506 Model31
## 2 0.00273 mn_log_loss binary     0.567    10 0.00741 Model30
## 3 0.00889 mn_log_loss binary     0.599    10 0.00282 Model32
## 4 0.00273 roc_auc     binary     0.785    10 0.00554 Model30
## 5 0.00492 roc_auc     binary     0.784    10 0.00571 Model31
## 6 0.00151 roc_auc     binary     0.781    10 0.00550 Model29

I will go with the penalty value that maximises roc_auc, since it corresponds to the penalty value associated with the second lowest log_loss mean. Updating the workflow with our tuned hyperparamter value is done using finalize_workflow().

best_auc <- lr_grid %>%
  select_best("roc_auc")

final_lr <- lr_wflow %>%
  finalize_workflow(best_auc)
final_lr

## == Workflow ===============================================================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor -------------------------------------------------------------------------------------------
## 6 Recipe Steps
## 
## * step_tokenize()
## * step_stopwords()
## * step_tokenfilter()
## * step_tfidf()
## * step_normalize()
## * step_dummy()
## 
## -- Model --------------------------------------------------------------------------------------------------
## Logistic Regression Model Specification (classification)
## 
## Main Arguments:
##   penalty = 0.00272833337648676
##   mixture = 1
## 
## Computational engine: glmnet

Fitting / Visualizing The Results

After fitting the model to the training data, let’s take a look at variable importance i.e. which words had the highest predictive power.

library(vip)

labels <- c(`NEG` = "Modern",
            `POS` = "Old School")

final_lr %>%
  fit(hiphop_train) %>%
  pull_workflow_fit() %>%
  vi(lambda = best_auc$penalty) %>%
  group_by(Sign) %>%
  top_n(15, wt = abs(Importance)) %>%
  ungroup() %>%
  mutate(
    Importance = abs(Importance),
    Variable = str_remove(Variable, "tfidf_lyric_"),
    Variable = fct_reorder(Variable, Importance)
  ) %>%
  ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
  geom_col(show.legend = FALSE) +
  facet_wrap( ~ Sign, scales = "free", labeller = as_labeller(labels)) +
  labs(y = NULL,
       title = "Hip-hop lyrics with the highest importance when determining the era of a song",
       subtitle = "Modern: Released in 2000 or after; Old School: Songs released before 2000") +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 15),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15)
  )

gender_mixed immediately stands out as an outlier. Taking a look at lyrics data once more, it is now apparent why gender_mixed contributed improportionately. Out of all of the songs that were tagged as gender_mixed, lyrics were only pulled for one!

That means the entire dataset only had one datapoint tagged as gender_mixed - making it an unreliable predictor. As unfortunate as this, this serves as an excellent learning example for myself of the importance of data visualization and variable importance.

lyrics %>% 
  distinct(title, bucket, gender) %>% 
  count(bucket, gender)

## # A tibble: 5 x 3
##   bucket     gender     n
##   <chr>      <chr>  <int>
## 1 Modern     female     8
## 2 Modern     male      61
## 3 Old School female     5
## 4 Old School male      67
## 5 Old School mixed      1

Re-fitting the Model

Because of this anomality in gender training data, I’ll remove gender as a predictor and re-run the entire process.

#update recipe
hiphop_rec_v2 <- hiphop_train %>%
  recipe(bucket ~ lyric) %>%
  step_tokenize(lyric) %>%
  step_stopwords(lyric) %>%
  step_tokenfilter(lyric, max_tokens = 2000) %>%
  step_tfidf(lyric) %>%
  step_normalize(all_predictors())

#update workflow
lr_wflow_v2 <- lr_wflow %>%
  update_recipe(hiphop_rec_v2)

#re-tune
set.seed(2000)
lr_grid_v2 <- tune_grid(
  lr_wflow_v2,
  resamples = folds,
  grid = grid,
  metrics = metric_set(roc_auc, npv, ppv, mn_log_loss))

#visualization
lr_grid_v2 %>% 
  collect_metrics() %>% 
  ggplot(aes(penalty, mean, color = .metric)) +
  geom_line(size = 1.5, show.legend = FALSE) +
  facet_wrap(. ~ .metric, nrow = 4) +
  scale_x_log10(label = scales::number_format())

Optimal penalty parameter of 0.0273 remains unchanged.

lr_grid_v2 %>%
  show_best("mn_log_loss") %>%
  slice(1:3) %>% 
  bind_rows(lr_grid_v2 %>%
              show_best("roc_auc") %>%
              slice(1:3))

## # A tibble: 6 x 7
##   penalty .metric     .estimator  mean     n std_err .config
##     <dbl> <chr>       <chr>      <dbl> <int>   <dbl> <fct>  
## 1 0.00492 mn_log_loss binary     0.570    10 0.00563 Model31
## 2 0.00273 mn_log_loss binary     0.573    10 0.00807 Model30
## 3 0.00889 mn_log_loss binary     0.604    10 0.00310 Model32
## 4 0.00273 roc_auc     binary     0.780    10 0.00582 Model30
## 5 0.00492 roc_auc     binary     0.777    10 0.00605 Model31
## 6 0.00151 roc_auc     binary     0.776    10 0.00569 Model29

best_auc_v2 <- lr_grid_v2 %>% 
  select_best("roc_auc")

final_lr_v2 <- lr_wflow_v2 %>% 
  finalize_workflow(best_auc_v2)

Visualizing Results Once More

After filtering for stop words, we used tf-idf as one of our recipe steps to extract importance. The idea behind tf-idf is to find the important words for the content of each document by decreasing the weight for commonly used words and increasing the weight for words that are not used very much in a collection of documents. Calculating tf-idf attempts to find the words that are important (i.e. common) in a text, but not too common.

final_lr_v2 %>%
  fit(hiphop_train) %>%
  pull_workflow_fit() %>%
  vi(lambda = best_auc$penalty) %>%
  group_by(Sign) %>%
  top_n(15, wt = abs(Importance)) %>%
  ungroup() %>%
  mutate(
    Importance = abs(Importance),
    Variable = str_remove(Variable, "tfidf_lyric_"),
    Variable = fct_reorder(Variable, Importance)
  ) %>%
  ggplot(aes(x = Importance, y = Variable, fill = Sign)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ Sign, scales = "free", labeller = as_labeller(labels)) +
  labs(y = NULL,
       title = "Hip-hop lyrics with the highest importance when determining the era of a song",
       subtitle = "Modern: Released in 2000 or after; Old School: Songs released before 2000") +
  theme(
    plot.title = element_text(face = "bold", size = 20),
    plot.title.position = "plot",
    plot.subtitle = element_text(size = 15),
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 15)
  )

Final fit on Test Data

Now we perform the final fit using last_fit() to evaluate our model on the test data. Somewhat counter-intuitively, last_fit() is fitted onto our initial split data instead of test data.

hiphop_final <- final_lr_v2 %>% 
  last_fit(hiphop_split)

hiphop_final %>% 
  collect_metrics()

## # A tibble: 2 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.707
## 2 roc_auc  binary         0.778

Conclusion

How did our model do? Our LASSO model, post tuning, gave a roc_auc mean of 0.78, while performance on test data was 0.778 - indicating we did not overfit. While I wouldn’t say performance is excellent, the model did perform better than random chance (46%/54% chance to pick Modern/Old School). Some considerations which could increase performance: Trying other models, increasing the number of tokens, and increasing the sample size of songs.

lyrics %>% 
  count(bucket) %>% 
  mutate(percent = n/sum(n))

## # A tibble: 2 x 3
##   bucket         n percent
##   <chr>      <int>   <dbl>
## 1 Modern      5447   0.465
## 2 Old School  6278   0.535

Writing and re-iterating through this blog post was fascinating and educational - giving me preliminary insight to the domain of NLP and another opportunity to familiarise myself with tidymodels. Lastly, the tidy text mining workflow is testament to how robust the dplyr package is when it comes to data wrangling.