We need to load some packages for use

if (!requireNamespace("pacman")) install.packages('pacman')

## Loading required namespace: pacman

library(pacman)
p_load(tidyverse,sentimentr, lexicon,syuzhet,parallel)

Load sample data on earnings call transcripts

R tidyverse package provides a series of useful data wrangling tools. You can check it here https://www.tidyverse.org/.

We use earning call transcripts as an illustrative example. We mentioned that the QJE paper on firm level political risk is computed based on earnings call data. You can get their final dataset via https://www.firmlevelrisk.com/

We use some of these earnings call excerpts. It has already been parsed and it is structured by speaker-session. You can get the sample data via https://yongjunzhang.com/files/css/ect_sample.RData

# load data
# load(url("https://yongjunzhang.com/files/css/ect_sample.RData"))
# you can also download the data and then load it
load("ect_sample.RData")
ect_sample <- ect_sample %>% 
  filter(!is.na(tic))

# Show a table for visual check
knitr::kable(ect_sample[1:10,],cap="Earnings call parsed data")

R syuzhet Package

Let us use syuzhet package as the baseline. Matthew Jockers created the syuzhet package that utilizes dictionary lookups for the Bing, NRC, and Afinn methods as well as a custom dictionary. He also utilizes a wrapper for the Stanford coreNLP which uses much more sophisticated analysis.

You can check here for a tutorial for syuzhet: https://cran.r-project.org/web/packages/syuzhet/vignettes/syuzhet-vignette.html

We are going to use its functions:

• get_sentences():implements the openNLP sentence tokenizer (tokenize your texts into sentence level)

• get_tokens:tokenize by words instead of sentences

• get_sentiment():includes two parameters–a character vector (of sentences or words) and a “method.” The method you select determines which of the four available sentiment extraction methods to employ. In the example that follows below, the “syuzhet” (default) method is called.Other methods include “bing”, “afinn”, “nrc”, and “ç” (YZ comment: i.e., using different dictionary lookups)

• get_nrc_sentiment: implements Saif Mohammad’s NRC Emotion lexicon. The NRC emotion lexicon is a list of words and their associations with eight emotions (anger, fear, anticipation, trust, surprise, sadness, joy, and disgust) and two sentiments (negative and positive) (See http://www.purl.org/net/NRCemotionlexicon).

• get_percentage_values:divides a text into an equal number of “chunks” and then calculates the mean sentiment valence for each.

• simple_plot:akes a sentiment vector and applies three smoothing methods. The smoothers include a moving average, loess, and discrete cosine transformation.

Some Notes:

• afinn is an English word list developed by Finn Nielsen. Words scores range from minus five (negative) to plus five (positive). You can download the original list via http://www2.imm.dtu.dk/pubdb/pubs/6010-full.html;

• bing opinion lexicon can be accessed via https://www.cs.uic.edu/~liub/FBS/sentiment-analysis.html;

• nrc is a list of English words and their associations with eight basic emotions (anger, fear, anticipation, trust, surprise, sadness, joy, and disgust) and two sentiments (negative and positive), and it can can be accessed via https://saifmohammad.com/WebPages/NRC-Emotion-Lexicon.htm

# Let use tokenize our texts first
my_example_text <- ect_sample$text
s_v <- get_sentences(my_example_text)
head(s_v)

## [1] "Thank you."                                                                                                                                              
## [2] "Thank you."                                                                                                                                              
## [3] "Ryan, in general terms there is not a lot we can say at this point in time."                                                                             
## [4] "We go through our normal procedures as we do every year during the third quarter."                                                                       
## [5] "We do our internal studies, we supplement that with external studies, we get external and internal actuarial advice on that."                            
## [6] "Our auditors are involved, we look at economic assumptions, we look at actuarial assumptions, we look at policy holder behavioral assumptions and so on."

syuzhet_vector <- get_sentiment(s_v, method="syuzhet")
head(syuzhet_vector)

## [1]  0.50  0.50  0.40  0.00  0.00 -0.25

Let us try different methods (use different lexicons)

bing_vector <- get_sentiment(s_v, method="bing")
head(bing_vector)

## [1] 1 1 0 0 0 0

afinn_vector <- get_sentiment(s_v, method="afinn")
head(afinn_vector)

## [1] 2 2 0 0 0 0

nrc_vector <- get_sentiment(s_v, method="nrc", lang = "english")
head(nrc_vector)

## [1] 0 0 1 0 0 0

Let us compare the difference

rbind(
  sign(head(syuzhet_vector)),
  sign(head(bing_vector)),
  sign(head(afinn_vector)),
  sign(head(nrc_vector))
)

##      [,1] [,2] [,3] [,4] [,5] [,6]
## [1,]    1    1    1    0    0   -1
## [2,]    1    1    0    0    0    0
## [3,]    1    1    0    0    0    0
## [4,]    0    0    1    0    0    0

Let us plot the result

plot(
  syuzhet_vector, 
  type="h", 
  main="Example Plot Trajectory", 
  xlab = "Narrative Time", 
  ylab= "Emotional Valence"
  )

Let us see get_nrc_sentiment results

nrc_data <- get_nrc_sentiment(s_v)

## Warning: `spread_()` was deprecated in tidyr 1.2.0.
## Please use `spread()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

angry_items <- which(nrc_data$anger > 0)
s_v[angry_items][1:10]

##  [1] "We're real excited obviously about the progress we're making on Bad Daddy's and continued progress on Good Times."                                                                                                                                                                                                                                                                                                       
##  [2] "But we're not really beating our self up or anything about where we stand today."                                                                                                                                                                                                                                                                                                                                        
##  [3] "We've deployed a fair amount of money in buybacks because we think it's a good buy and based on what our outlook is for cash flow and acquisition pipeline and timing of deals and where we want to be from a leverage standpoint, I don't think it's changed at all."                                                                                                                                                   
##  [4] "But, you got – the folks off the bench as Jack mentioned that hurt our gross margins in the first quarter but folks are on project and we changed our model a little bit in that – we are going to do a little bit plus bench moving forward for Q2 and Q3 and probably in the Q4 than we have up until now and use the market a little bit more to make that sales force practice and I'm convinced that would be fine."
##  [5] "We are way early in the process and I don't want to confuse anyone or scare anyone, right, that we are going to change the counseling because that's not the plan."                                                                                                                                                                                                                                                      
##  [6] "I expect that to be a bit of synergy there that given our SG&A model versus most of our peers but nothing on the side in recruiting side."                                                                                                                                                                                                                                                                               
##  [7] "We also had strong product expansion with the on-demand service going live, NSX service, hybrid networking."                                                                                                                                                                                                                                                                                                             
##  [8] "Well, I think that something that management is going to decide depending on what type of pickup and demand we see and the type of margins we're going to see."                                                                                                                                                                                                                                                          
##  [9] "I think that this is an area that we feel we could generate cash and that won't be an incremental expenses."                                                                                                                                                                                                                                                                                                             
## [10] "And then the other thing that plays into it of course, with being on a cash basis for more than half of our revenue is the timing of reimbursement one quarter versus the next."

joy_items <- which(nrc_data$joy > 0)
s_v[joy_items][1:10]

##  [1] "We're real excited obviously about the progress we're making on Bad Daddy's and continued progress on Good Times."                                                     
##  [2] "Release one will have the click-through seating, where am I on the waitlist, is my table ready and the ability to pay at the table."                                   
##  [3] "Good morning."                                                                                                                                                         
##  [4] "We believe we can improve margins even in a soft break environment as we hyper focus like never before on utilization, improved safety and increased driver retention."
##  [5] "In our intermodal segment margins should improve as we continue to work to fill the existing container fleet and meet our turn objectives of two turns a month."       
##  [6] "Reaching these levels of turns will significantly improve our chassis and dray costs and as a result create opportunities to expand our intermodal margins."           
##  [7] "Good, good to hear your voice."                                                                                                                                        
##  [8] "We're happy with our offering."                                                                                                                                        
##  [9] "So big focus, top priority, and we're making good progress."                                                                                                           
## [10] "With respect to pricing of those types of assets, I don't really have any comment on that."

valence <- (nrc_data[, 9]*-1) + nrc_data[, 10]
valence[1:10]

##  [1] 0 0 1 0 0 0 0 0 0 0

barplot(
  sort(colSums(prop.table(nrc_data[, 1:8]))), 
  horiz = TRUE, 
  cex.names = 0.7, 
  las = 1, 
  main = "Emotions in Sample Earnings Call Transcripts", xlab="Percentage"
  )

You can also customize your lexicons

my_text <- "I love when I see something beautiful.  I hate it when ugly feelings creep into my head."
char_v <- get_sentences(my_text)
method <- "custom"
custom_lexicon <- data.frame(word=c("love", "hate", "beautiful", "ugly"), value=c(1,-1,1, -1))
my_custom_values <- get_sentiment(char_v, method = method, lexicon = custom_lexicon)
my_custom_values

## [1]  2 -2

Let Us Move to sentimentR package

YZ’s comment: because the Syuzhet package does not account for negation and valence shifter. I typically use sentimentr as the default package for sentiment analysis in R. Note that sentimentr use some functions from Syuzhet, for instance, get_sentences().

Another R package that deal with valen shifter is https://cran.r-project.org/web/packages/vader/vader.pdf. You can use the function get_vader().

This tutorial is based on Tyler Rinke’s amazing one: https://github.com/trinker/sentimentr

-> sentimentr attempts to take into account valence shifters (i.e., negators, amplifiers (intensifiers), de-amplifiers (downtoners), and adversative conjunctions) while maintaining speed. Simply put, sentimentr is an augmented dictionary lookup. The next questions address why it matters.

-> A negator flips the sign of a polarized word (e.g., “I do not like it.”). See lexicon::hash_valence_shifters[y==1] for examples. An amplifier (intensifier) increases the impact of a polarized word (e.g., “I really like it.”). See lexicon::hash_valence_shifters[y==2] for examples. A de-amplifier (downtoner) reduces the impact of a polarized word (e.g., “I hardly like it.”). See lexicon::hash_valence_shifters[y==3] for examples. An adversative conjunction overrules the previous clause containing a polarized word (e.g., “I like it but it’s not worth it.”). See lexicon::hash_valence_shifters[y==4] for examples.

-> Well valence shifters affect the polarized words. In the case of negators and adversative conjunctions the entire sentiment of the clause may be reversed or overruled. So if valence shifters occur fairly frequently a simple dictionary lookup may not be modeling the sentiment appropriately. You may be wondering how frequently these valence shifters co-occur with polarized words, potentially changing, or even reversing and overruling the clause’s sentiment. The table below shows the rate of sentence level co-occurrence of valence shifters with polarized words across a few types of texts.

Preferred Workflow

Here is a basic sentiment demo. Notice that the first thing you should do is to split your text data into sentences (a process called sentence boundary disambiguation) via the get_sentences function. This can be handled within sentiment (i.e., you can pass a raw character vector) but it slows the function down and should be done one time rather than every time the function is called. Additionally, a warning will be thrown if a larger raw character vector is passed. The preferred workflow is to spit the text into sentences with get_sentences before any sentiment analysis is done.

mytext <- c(
    'do you like it?  But I hate really bad dogs',
    'I am the best friend.',
    'Do you really like it?  I\'m not a fan'
)
mytext <- get_sentences(mytext)
sentiment(mytext)

##    element_id sentence_id word_count  sentiment
## 1:          1           1          4  0.2500000
## 2:          2           1          6 -1.8677359
## 3:          3           1          5  0.5813777
## 4:          4           1          5  0.4024922
## 5:          5           1          4  0.0000000

To aggregate by element (column cell or vector element) use sentiment_by with by = NULL.

mytext <- c(
    'do you like it?  But I hate really bad dogs',
    'I am the best friend.',
    'Do you really like it?  I\'m not a fan'
)
mytext <- get_sentences(mytext)
sentiment_by(mytext)

##    element_id word_count sd ave_sentiment
## 1:          1          4 NA     0.2500000
## 2:          2          6 NA    -1.8677359
## 3:          3          5 NA     0.5813777
## 4:          4          5 NA     0.4024922
## 5:          5          4 NA     0.0000000

To aggregate by grouping variables use sentiment_by using the by argument.

out <- with(
    ect_sample, 
    sentiment_by(
        get_sentences(text), 
        list(tic)
    )
)

## Warning: Each time `sentiment_by` is run it has to do sentence boundary disambiguation when a
## raw `character` vector is passed to `text.var`. This may be costly of time and
## memory.  It is highly recommended that the user first runs the raw `character`
## vector through the `get_sentences` function.

head(out)

##     tic word_count        sd ave_sentiment
## 1: <NA>     126209 0.2727835     0.2363563
## 2:    A         35        NA     0.8062772
## 3: AACC         28 0.1961161     0.1513462
## 4:  AAI         15        NA     0.2065591
## 5:  AAL         11        NA     0.0000000
## 6: AAON         66        NA    -0.1169369

# let us plot random 20 companies
out_20 <- sample_n(out,20)
plot(out_20)

out <- with(
    ect_sample, 
    sentiment_by(get_sentences(text),
                 polarity_dt=lexicon::hash_sentiment_loughran_mcdonald,
                 list(tic)) 
    )

## Warning: Each time `sentiment_by` is run it has to do sentence boundary disambiguation when a
## raw `character` vector is passed to `text.var`. This may be costly of time and
## memory.  It is highly recommended that the user first runs the raw `character`
## vector through the `get_sentences` function.

plot(sample_n(out,30))

plot(uncombine(sample_n(out,30)))

Let us take a look at imdb movie review data first

table(corp_movies$sentiment)

## 
##  neg  pos 
## 1000 1000

Okay, we have 1k positive and 1k negative movie reviews. Let us use xgboost to classify these movies. You can always use other methods. We will use words as features.

# generate 1500 numbers without replacement
set.seed(300)
id_train <- sample(1:2000, 1500, replace = FALSE)
head(id_train, 10)

##  [1]  590  874 1602  985 1692  789  553 1980 1875 1705

# create docvar with ID
corp_movies$id_numeric <- 1:ndoc(corp_movies)

# tokenize texts
toks_movies <- tokens(corp_movies, remove_punct = TRUE, remove_number = TRUE) %>% 
               tokens_remove(pattern = stopwords("en")) %>% 
               tokens_wordstem()
dfmt_movie <- dfm(toks_movies)

# get training set
dfmat_training <- dfm_subset(dfmt_movie, id_numeric %in% id_train)

# get test set (documents not in id_train)
dfmat_test <- dfm_subset(dfmt_movie, !id_numeric %in% id_train)

# Next we train the naive Bayes classifier using textmodel_nb().

tmod_nb <- textmodel_nb(dfmat_training, dfmat_training$sentiment)
summary(tmod_nb)

## 
## Call:
## textmodel_nb.dfm(x = dfmat_training, y = dfmat_training$sentiment)
## 
## Class Priors:
## (showing first 2 elements)
## neg pos 
## 0.5 0.5 
## 
## Estimated Feature Scores:
##         plot      two      teen     coupl       go    church     parti
## neg 0.002579 0.002318 0.0002870 0.0007157 0.002663 8.719e-05 0.0002652
## pos 0.001507 0.002338 0.0001656 0.0005456 0.002348 8.768e-05 0.0002728
##         drink     drive      get     accid      one       guy       die
## neg 1.199e-04 0.0003052 0.004487 9.446e-05 0.007389 0.0014459 0.0005486
## pos 9.418e-05 0.0002630 0.003783 1.851e-04 0.007355 0.0009937 0.0005488
##     girlfriend   continu      see     life  nightmar      deal    watch
## neg  0.0003124 0.0003161 0.002558 0.001435 0.0001199 0.0004323 0.001642
## pos  0.0002338 0.0003215 0.003020 0.002497 0.0001202 0.0005196 0.001539
##         movi     sorta     find   critiqu mind-fuck   generat     touch
## neg 0.010118 1.090e-05 0.001453 9.446e-05 3.633e-06 0.0002652 0.0002289
## pos 0.007657 1.624e-05 0.001630 8.443e-05 3.247e-06 0.0002923 0.0004449
##          cool      idea
## neg 0.0003052 0.0008210
## pos 0.0002273 0.0005845

# Naive Bayes can only take features into consideration that occur both in the training set and the test set, but we can make the features identical using dfm_match()

dfmat_matched <- dfm_match(dfmat_test, features = featnames(dfmat_training))

# Let’s inspect how well the classification worked.

actual_class <- dfmat_matched$sentiment
predicted_class <- predict(tmod_nb, newdata = dfmat_matched)
tab_class <- table(actual_class, predicted_class)
tab_class

##             predicted_class
## actual_class neg pos
##          neg 213  45
##          pos  37 205

# We can use the function confusionMatrix() from the caret package to assess the performance of the classification.

confusionMatrix(tab_class, mode = "everything")

## Confusion Matrix and Statistics
## 
##             predicted_class
## actual_class neg pos
##          neg 213  45
##          pos  37 205
##                                           
##                Accuracy : 0.836           
##                  95% CI : (0.8006, 0.8674)
##     No Information Rate : 0.5             
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.672           
##                                           
##  Mcnemar's Test P-Value : 0.4395          
##                                           
##             Sensitivity : 0.8520          
##             Specificity : 0.8200          
##          Pos Pred Value : 0.8256          
##          Neg Pred Value : 0.8471          
##               Precision : 0.8256          
##                  Recall : 0.8520          
##                      F1 : 0.8386          
##              Prevalence : 0.5000          
##          Detection Rate : 0.4260          
##    Detection Prevalence : 0.5160          
##       Balanced Accuracy : 0.8360          
##                                           
##        'Positive' Class : neg             
## 

Of course, you can achieve this just using caret package as well.

YOU can also try to figure out how to use bert model. I do not see some good practices in terms of training bert model in R using tensorflow and keras. But definitely you should try it in python.

THE END…