Negation in Fringe review sentiment analysis

Nov 16, 2019 in PROJECT • R • TOOLS
edinburgh-fringe nlp sentiment-analysis tidytext
11 min read

In the previous post in this series on sentiment analysis, I used sentiment lexicons on my dataset of reviews from 2019’s Edinburgh Fringe Festival. There were some obvious flaws in the approach, one of which was that by focussing on one word at at time, some important nuance was missed. Here, I’m going to specifically look at how to deal with negation by using bigrams, which means evaluating two tokens (in this case words) at once. That should mean that when a review describes something as “not good”, that will be seen as a negative remark, rather than a positive one simply because it contains the word “good”.

I’m going to go through this using the Bing lexicon and highlighting particular steps, but you can skip to the end if you want the complete code. I drew from Text Mining with R by Julia Silge and Dave Robinson, but I use data.table and have adapted the approach in several places for this project.

The first thing I do once I’ve loaded my reviews is remove modifiers, which are words like “very” or “quite”. This doesn’t matter when you’re evaluating word-by-word like last time, but it does matter for negation. This is because I’m using bigrams, so looking at two words at a time for negated sentiment words. Imagine a play is described as “not very good”. In this analysis, I want to know that a sentiment-laden word is used (“good”) and that it was negated (“not”), so I need them to be in the same bigram token. Removing the modifier “very” gives me “not good”. Modifiers could be useful in other approaches; for example, they might strengthen positivity or negativity. However, here I’m removing them because they will get in the way.

library(data.table)
library(feather)
library(tidytext)
library(textdata)

# Read in test dataset (same as used in previous post)
test_labelled <- as.data.table(read_feather("test_labelled.feather"))

# Remove modifiers (could be useful for score but will get in the way)
test_labelled <- test_labelled[, review := gsub("$very |$quite ", 
                                                "", 
                                                review)]

My next step is to unnest the reviews into words (I use this later on) and bigrams, and then separate the bigrams into individual words for easier analysis.

# Unnest into words
words_in_reviews <- unnest_tokens(test_labelled, 
                                  word, 
                                  review)

# Unnest into bigrams
bigrams_in_reviews <- unnest_tokens(test_labelled, 
                                    bigram, 
                                    review, 
                                    token = "ngrams", 
                                    n = 2)

# Separate into words
separated_bigrams <- copy(bigrams_in_reviews[, .(original_index, bigram)])

separated_bigrams[, c("word_1", "word_2") := tstrsplit(bigram, " ", 
                                                       fixed = TRUE)]

head(separated_bigrams)
##    original_index        bigram    word_1    word_2
## 1:             32      the good       the      good
## 2:             32      good the      good       the
## 3:             32 the selection       the selection
## 4:             32  selection of selection        of
## 5:             32      of plays        of     plays
## 6:             32    plays this     plays      this

At this point, the Text Mining with R book suggests removing stopwords, but I really wouldn’t recommend that for this type of analysis. Partly this is because it doesn’t really matter - the sentiment analysis will ignore bigrams that are not relevant, which would include ones that use words that aren’t sentimentally important. But the main reason is that some stopwords are also negation words. The first time I ran this whole project, I found almost no bigrams of interest, but further investigation showed this was because I had removed all bigrams that started with “no” and some other negation words in the stopword removal stage!

My next step was therefore to create a vector of negation words. The list I came up with through thinking what words might be used, as well as checking through some reviews to catch any I didn’t have.

# Create vector of words that can be used for negation
negation_words <- c("not", "no", "never", "without", 
                    "weren’t", "wasn't", "don't")

Using the Bing sentiment lexicon, I applied this to the dataset of words in reviews I created earlier - this step is also done in the previous post on sentiment analysis. However, then I go on to find bigrams where the first word is a negation word, and a list of reviews that include negated words from the lexicon.

### Approach using bing
bing_words <- as.data.table(get_sentiments("bing"))

# Create a dataset of words in lexicon used anywhere in reviews
bing_sentiment <- merge(words_in_reviews, bing_words)

# Find bigrams where a word in the lexicon is negated
negated_bing <- separated_bigrams[word_1 %in% negation_words & 
                                    word_2 %in% bing_words[, word]]

# List of reviews with negated lexicon words
negated_bing_reviews <- negated_bing[, unique(original_index)]

head(negated_bing)
##    original_index               bigram  word_1       word_2
## 1:             32             no doubt      no        doubt
## 2:            362             not miss     not         miss
## 3:           1840 weren’t disappointed weren’t disappointed
## 4:           3012            not wrong     not        wrong
## 5:           3999             not miss     not         miss
## 6:           7115             not good     not         good

You can see there are quite a few words in the Bing sentiment lexicon that get negated in reviews. Review 362, which you can see includes the bigram “not miss”, reads as follows:

This is a wonderful play, funny at moments but emotionally draining. Lead parts played by two exceptionally talented young actors. Do not miss.

As you can see, “Do not miss” is a positive statement, so it’s good we have identified it to be changed.

The next step took me some time to work out. In my first attempt, I used a for loop to look at each negated word, find the review it was associated with and switch the sentiment associated with that word.

# Take the individual word rating for each review and switch them if negated

for (i in negated_bing[, .N]) {
  bing_sentiment[original_index == negated_bing[i, original_index] &
                   word == negated_bing[i, word_2],
                 sentiment := ifelse(
                   sentiment == "positive", "negative", "positive"
                 )]
}

This did actually work for my purposes but I realised it had a flaw. If a word came up multiple times in a review, it would be negated every time using this approach, regardless of whether that was correct. So I came up with a different approach with more steps. For each review, it assessed for negated words, and then only changed as many as were actually negated.

for (review in 1:length(negated_bing_reviews)) {
  # Filter negated lexicon words to relevant review
  negated_bing_words <- negated_bing[original_index == 
                                       negated_bing_reviews[review]]
  words_to_change <- negated_bing_words[, unique(word_2)]
  # Filter words in reviews to relevant review and words
  scores_to_change <- bing_sentiment[original_index == 
                                       negated_bing_reviews[review] &
                                       word %in% words_to_change]
  bing_sentiment <- bing_sentiment[!(original_index == 
                                       negated_bing_reviews[review] &
                                       word %in% words_to_change)]
  # Go though process for each word in relevant review
  for (token in 1:length(words_to_change)) {
    scores_to_change_word <- scores_to_change[word == 
                                                words_to_change[token]]
    words_for_changing <- negated_bing_words[word_2 == 
                                               words_to_change[token]]
    # Ensure sentiment is only switched for number of negated words
    for (occurrence in 1:words_for_changing[, .N]) {
      scores_to_change_word[occurrence, sentiment := ifelse(
        sentiment == "positive", "negative", "positive"
      )]
    }
    # Combine assessed words back into main dataset
    bing_sentiment <- rbind(bing_sentiment, scores_to_change_word)
  }
}

The process was finished off with the same process as the first post on this topic - you can see below for the full code and approach for other lexicons. These were the results.

Table 1: Sentiment lexicons and their results with negation
Dataset	True positive	True negative	True mixed	False positive	False negative	False mixed
Actual labels	184	12	4	NA	NA	NA
Bing	165	5	0	9	7	14
AFINN	170	3	0	10	6	11
NRC	152	3	1	9	12	23

And let’s remind ourselves of how things were looking without negation:

Table 2: Sentiment lexicons and their results (without negation)
Dataset	True positive	True negative	True mixed	False positive	False negative	False mixed
Actual labels	184	12	4	NA	NA	NA
Bing	164	5	0	9	9	13
AFINN	170	3	0	10	6	11
NRC	152	3	1	9	13	22

The difference is…underwhelming! Only one review has been accurately categorised that wasn’t before; using the Bing lexicon, a review that used to incorrectly be labelled negative is now correctly labelled positive. However, there are also a couple of reviews across the lexicons that are now incorrectly labelled as mixed rather than incorrectly labelled as negative, which is going in the right direction at least.

Overall, although the outcome is not a staggering improvement on the previous approach, it is a straightforward enough addition that it is worth doing if you are using sentiment lexicons.

But how could we approach this without sentiment lexicons? That’s what I’ll be exploring in the next post of this series.

Code

The following is the complete code I used. Although you won’t be able to replicate it without the Fringe reviews data, you can adapt it for similar projects.

library(data.table)
library(feather)
library(tidytext)
library(textdata)

# Read in test dataset (same as used in previous post)

test_labelled <- as.data.table(read_feather("test_labelled.feather"))

# Remove modifiers (could be useful for score but will get in the way)

test_labelled <- test_labelled[, review := gsub("$very |$quite ", "", review)]

# Unnest into words

words_in_reviews <- unnest_tokens(test_labelled, 
                                  word, 
                                  review)

# Unnest into bigrams

bigrams_in_reviews <- unnest_tokens(test_labelled, 
                                    bigram, 
                                    review, 
                                    token = "ngrams", 
                                    n = 2)

# Separate into words

separated_bigrams <- copy(bigrams_in_reviews[, .(original_index, bigram)])

separated_bigrams[, c("word_1", "word_2") := tstrsplit(bigram, " ", 
                                                       fixed = TRUE)]

# Create vector of words that can be used for negation

negation_words <- c("not", "no", "never", "without", 
                    "weren’t", "wasn't", "don't")

### Approach using bing

bing_words <- as.data.table(get_sentiments("bing"))

# Create a dataset of words in lexicon used anywhere in reviews

bing_sentiment <- merge(words_in_reviews, bing_words)

# Find bigrams where a word in the lexicon is negated

negated_bing <- separated_bigrams[word_1 %in% negation_words & 
                                    word_2 %in% bing_words[, word]]

# List of reviews with negated lexicon words

negated_bing_reviews <- negated_bing[, unique(original_index)]

# Switch sentiment of negated words

for (review in 1:length(negated_bing_reviews)) {
  # Filter negated lexicon words to relevant review
  negated_bing_words <- negated_bing[original_index == negated_bing_reviews[review]]
  words_to_change <- negated_bing_words[, unique(word_2)]
  # Filter words in reviews to relevant review and words
  scores_to_change <- bing_sentiment[original_index == negated_bing_reviews[review] &
                                       word %in% words_to_change]
  bing_sentiment <- bing_sentiment[!(original_index == negated_bing_reviews[review] &
                                       word %in% words_to_change)]
  # Go though process for each word in relevant review
  for (token in 1:length(words_to_change)) {
    scores_to_change_word <- scores_to_change[word == words_to_change[token]]
    words_for_changing <- negated_bing_words[word_2 == words_to_change[token]]
    # Ensure sentiment is only switched for number of negated words
    for (occurrence in 1:words_for_changing[, .N]) {
      scores_to_change_word[occurrence, sentiment := ifelse(
        sentiment == "positive", "negative", "positive"
      )]
    }
    # Combine assessed words back into main dataset
    bing_sentiment <- rbind(bing_sentiment, scores_to_change_word)
    print(paste0("Completed: ", negated_bing_reviews[review], ", ", words_to_change[token]))
  }
}

# Count the number of positive/negative words by review
# (identified by an original_index number)

positive_bing_words <- bing_sentiment[sentiment == "positive", .(positive_words = .N), by = original_index]
negative_bing_words <- bing_sentiment[sentiment == "negative", .(negative_words = .N), by = original_index]

all_bing_words <- merge(positive_bing_words, negative_bing_words, all = TRUE)

all_bing_words[is.na(all_bing_words)] <- 0

# Calculate net positive/negative score
# Less than 0 is negative, more than 0 is positive

all_bing_words[, combined_sentiment := positive_words - negative_words]
all_bing_words[, overall_sentiment := ifelse(combined_sentiment < 0, "negative", ifelse(combined_sentiment == 0, "mixed", "positive"))]

# Combine sentiment score with reviews dataset

bing_sentiment_outcome <- merge(test_labelled,
                                all_bing_words[, .(original_index, overall_sentiment)],
                                by = "original_index", all.x = TRUE)

# No sentiment is assigned mixed

bing_sentiment_outcome[is.na(overall_sentiment), overall_sentiment := "mixed"]

# New column to show if the manually assigned sentiment_label matches the 
# overall_sentiment calculated from the lexicon

bing_sentiment_outcome[, match := sentiment_label == overall_sentiment]

bing_sentiment_outcome[, .N, by = match]


# Process for AFINN

afinn_words <- as.data.table(get_sentiments("afinn"))

negated_afinn <- separated_bigrams[word_1 %in% negation_words & word_2 %in% afinn_words[, word]]

# Take the individual word rating for each review and switch them if negated

# for (i in negated_afinn[, .N]) {
#   afinn_sentiment[original_index == negated_afinn[i, original_index] & 
#                    word == negated_afinn[i, word_2],
#                  sentiment := ifelse(
#                    sentiment == "positive", "negative", "positive"
#                  )]
# }

# NB - in the above think of how to deal with multiple

afinn_sentiment <- merge(words_in_reviews, afinn_words)

negated_afinn_reviews <- negated_afinn[, unique(original_index)]

for (review in 1:length(negated_afinn_reviews)) {
  negated_afinn_words <- negated_afinn[original_index == negated_afinn_reviews[review]]
  words_to_change <- negated_afinn_words[, unique(word_2)]
  scores_to_change <- afinn_sentiment[original_index == negated_afinn_reviews[review] &
                                       word %in% words_to_change]
  afinn_sentiment <- afinn_sentiment[!(original_index == negated_afinn_reviews[review] &
                                       word %in% words_to_change)]
  for (token in 1:length(words_to_change)) {
    scores_to_change_word <- scores_to_change[word == words_to_change[token]]
    words_for_changing <- negated_afinn_words[word_2 == words_to_change[token]]
    for (occurrence in 1:words_for_changing[, .N]) {
      scores_to_change_word[occurrence, value := value * -1]
    }
    afinn_sentiment <- rbind(afinn_sentiment, scores_to_change_word)
    print(paste0("Completed: ", negated_afinn_reviews[review], ", ", words_to_change[token]))
  }
}

afinn_sentiment <- merge(words_in_reviews, get_sentiments("afinn"))

afinn_reviews <- afinn_sentiment[, .(sentiment_score = sum(value)), by = original_index]

afinn_reviews[, overall_sentiment := ifelse(sentiment_score < 0, "negative", ifelse(sentiment_score == 0, "mixed", "positive"))]

afinn_sentiment_outcome <- merge(test_labelled,
                                 afinn_reviews[, .(original_index, overall_sentiment)],
                                 by = "original_index", all.x = TRUE)

afinn_sentiment_outcome[is.na(overall_sentiment), overall_sentiment := "mixed"]

afinn_sentiment_outcome[, match := sentiment_label == overall_sentiment]

afinn_sentiment_outcome[, .N, by = match]

# Process for NRC

nrc_words <- as.data.table(get_sentiments("nrc"))

negated_nrc <- separated_bigrams[word_1 %in% negation_words & word_2 %in% nrc_words[, word]]

nrc_sentiment <- merge(words_in_reviews, nrc_words)

negated_nrc_reviews <- negated_nrc[, unique(original_index)]

for (review in 1:length(negated_nrc_reviews)) {
  negated_nrc_words <- negated_nrc[original_index == negated_nrc_reviews[review]]
  words_to_change <- negated_nrc_words[, unique(word_2)]
  scores_to_change <- nrc_sentiment[original_index == negated_nrc_reviews[review] &
                                       word %in% words_to_change]
  nrc_sentiment <- nrc_sentiment[!(original_index == negated_nrc_reviews[review] &
                                       word %in% words_to_change)]
  for (token in 1:length(words_to_change)) {
    scores_to_change_word <- scores_to_change[word == words_to_change[token]]
    words_for_changing <- negated_nrc_words[word_2 == words_to_change[token]]
    for (occurrence in 1:words_for_changing[, .N]) {
      scores_to_change_word[occurrence, sentiment := ifelse(
        sentiment == "positive", "negative", "positive"
      )]
    }
    nrc_sentiment <- rbind(nrc_sentiment, scores_to_change_word)
    print(paste0("Completed: ", negated_nrc_reviews[review], ", ", words_to_change[token]))
  }
}


positive_nrc_words <- nrc_sentiment[sentiment == "positive", .(positive_words = .N), by = original_index]
negative_nrc_words <- nrc_sentiment[sentiment == "negative", .(negative_words = .N), by = original_index]

all_nrc_words <- merge(positive_nrc_words, negative_nrc_words, all = TRUE)

all_nrc_words[is.na(all_nrc_words)] <- 0

all_nrc_words[, combined_sentiment := positive_words - negative_words]
all_nrc_words[, overall_sentiment := ifelse(combined_sentiment < 0, "negative", ifelse(combined_sentiment == 0, "mixed", "positive"))]

nrc_sentiment_outcome <- merge(test_labelled,
                                all_nrc_words[, .(original_index, overall_sentiment)],
                                by = "original_index", all.x = TRUE)

nrc_sentiment_outcome[is.na(overall_sentiment), overall_sentiment := "mixed"]

nrc_sentiment_outcome[, match := sentiment_label == overall_sentiment]

nrc_sentiment_outcome[, .N, by = match]