10-usenet.Rmd

# Case study: analyzing usenet text {#usenet}

```{r echo = FALSE}
library(knitr)
opts_chunk$set(message = FALSE, warning = FALSE, cache = TRUE)
options(width = 100, dplyr.width = 150)
library(ggplot2)
theme_set(theme_light())
```

In our final chapter, we'll use what we've learned in this book to perform a start-to-finish analysis of a set of 20,000 messages sent to 20 Usenet bulletin boards in 1993. The Usenet bulletin boards in this data set include boards for topics like politics, autos, "for sale", atheism, etc. This data set is [publicly available](http://qwone.com/~jason/20Newsgroups/) and has become popular for testing and exercises in text analysis and machine learning.

## Wrangling the data

We'll start by reading in all the messages. (Note that this step takes several minutes).

```{r}
library(dplyr)
library(tidyr)
library(purrr)
library(readr)
library(stringr)
```

```{r eval = FALSE}
training_folder <- "data/20news-bydate/20news-bydate-train/"

read_folder <- function(infolder) {
  print(infolder)
  data_frame(file = dir(infolder, full.names = TRUE)) %>%
    mutate(text = map(file, read_lines)) %>%
    transmute(id = basename(file), text) %>%
    unnest(text)
}

raw_text <- data_frame(folder = dir(training_folder, full.names = TRUE)) %>%
  unnest(map(folder, read_folder)) %>%
  transmute(board = basename(folder), id, text)
```

```{r raw_text, echo = FALSE}
load("data/raw_text.rda")
# save(raw_text, file = "data/raw_text.rda")
```

Each email has structure we need to remove. For starters:

* Every email has one or more headers (e.g. "from:", "in_reply_to:")
* Many have signatures, which (since they're constant for each user) we wouldn't want to examine alongside the content

We need to remove headers and signatures.

```{r dependson = "raw_text"}
# remove headers and signatures
cleaned_text <- raw_text %>%
  group_by(id) %>%
  filter(cumsum(text == "") > 0,
         cumsum(str_detect(text, "^--")) == 0) %>%
  ungroup()

# remove nested text (starting with ">") and lines that note the author
# of those
cleaned_text <- cleaned_text %>%
  filter(str_detect(text, "^[^>]+[A-Za-z\\d]") | text == "",
         !str_detect(text, "writes(:|\\.\\.\\.)$"),
         !str_detect(text, "^In article <"),
         !id %in% c(9704, 9985))
```

Now it is time to use `unnest_tokens` to identify the words in this data set.

```{r cleaned_text}
library(tidytext)

usenet_words <- cleaned_text %>%
  unnest_tokens(word, text) %>%
  filter(str_detect(word, "^[a-z]"),
         str_detect(word, "[a-z]$"),
         !word %in% stop_words$word)
```

What are the most common words?

```{r}
usenet_words %>%
  count(word, sort = TRUE)
```

Or perhaps more sensibly, we could examine the most common words by board.

```{r words_by_board, dependson = "cleaned_text"}
words_by_board <- usenet_words %>%
  count(board, word) %>%
  ungroup()
```

```{r dependson = "words_by_board"}
words_by_board %>%
  group_by(board) %>%
  top_n(3)
```

These look sensible and illuminating so far; let's move on to some more sophisticated analysis!

## Term frequency and inverse document frequency: tf-idf

Some words are likely to be more common on particular boards. Let's try quantifying this using the tf-idf metric we learned in [Chapter 4](#tfidf).

```{r tf_idf, dependson = "words_by_board"}
tf_idf <- words_by_board %>%
  bind_tf_idf(word, board, n) %>%
  arrange(desc(tf_idf))

tf_idf
```

We can visualize this for a few select boards. First, let's look at all the `sci.` boards.

```{r, dependson = "tf_idf", fig.width=9, fig.height=8}
library(ggplot2)

tf_idf %>%
  filter(str_detect(board, "^sci\\.")) %>%
  group_by(board) %>%
  top_n(12, tf_idf) %>%
  mutate(word = reorder(word, tf_idf)) %>%
  ggplot(aes(word, tf_idf, fill = board)) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  facet_wrap(~ board, scales = "free") +
  ylab("tf-idf") +
  coord_flip()
```

We could use almost the same code (not shown) to compare the "rec." (recreation) or "talk." boards:

```{r, dependson = "tf_idf", echo = FALSE, fig.width=9, fig.height=8}
plot_tf_idf <- function(d) {
  d %>%
    group_by(board) %>%
    top_n(10, tf_idf) %>%
    mutate(word = reorder(word, tf_idf)) %>%
    ggplot(aes(word, tf_idf, fill = board)) +
    geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
    facet_wrap(~ board, scales = "free") +
    ylab("tf-idf") +
    coord_flip()
}

tf_idf %>%
  filter(str_detect(board, "^rec\\.")) %>%
  plot_tf_idf()

tf_idf %>%
  filter(str_detect(board, "^talk\\.")) %>%
  plot_tf_idf()
```

We see lots of characteristic words for these boards, from "pitching" and "hitter" for the baseball board to "firearm" and "militia" on the guns board. Notice how high tf-idf is for words like "Stephanopoulos" or "Armenian"; this means that these words are very unique among the documents as a whole and important to those particular boards.

## Sentiment analysis

We can use the sentiment analysis techniques we explored in [Chapter 3](#sentiment) to examine how positive and negative words were used in these Usenet posts. Which boards used the most positive and negative words?

```{r board_sentiments, dependson = "words_by_board", fig.width=7, fig.height=6}
AFINN <- get_sentiments("afinn")

word_board_sentiments <- words_by_board %>%
  inner_join(AFINN, by = "word")

board_sentiments <- word_board_sentiments %>%
  group_by(board) %>%
  summarize(score = sum(score * n) / sum(n))

board_sentiments %>%
  mutate(board = reorder(board, score)) %>%
  ggplot(aes(board, score, fill = score > 0)) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  coord_flip() +
  ylab("Average sentiment score")
```

## Sentiment analysis by word

It's worth looking deeper to understand *why* some boards ended up more positive than others. For that, we can examine the total positive and negative contributions of each word.

```{r contributions, dependson = "cleaned_text"}
contributions <- usenet_words %>%
  inner_join(AFINN, by = "word") %>%
  group_by(word) %>%
  summarize(occurences = n(),
            contribution = sum(score))

contributions
```

Which words had the most effect?

```{r, dependson = "contributions", fig.width=6, fig.height=6}
contributions %>%
  top_n(25, abs(contribution)) %>%
  mutate(word = reorder(word, contribution)) %>%
  ggplot(aes(word, contribution, fill = contribution > 0)) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  coord_flip()
```

These words look generally reasonable as indicators of each message's sentiment, but we can spot possible problems with the approach. "True" could just as easily be a part of "not true" or a similar negative expression, and the words "God" and "Jesus" are apparently very common on Usenet but could easily be used in many contexts, positive or negative.

The important point is that we may also care about which words contributed the most *within each board*. We can calculate each word's contribution to each board's sentiment score from our `word_board_sentiments` variable:

```{r top_sentiment_words, dependson = "word_board_sentiments", fig.height = 10, fig.width = 10}
top_sentiment_words <- word_board_sentiments %>%
  mutate(contribution = score * n / sum(n))

top_sentiment_words %>%
  group_by(board) %>%
  top_n(8, abs(contribution)) %>%
  ungroup() %>%
  mutate(board = reorder(board, contribution),
         word = reorder(word, contribution)) %>%
  ggplot(aes(word, contribution, fill = contribution > 0)) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  facet_wrap(~ board, scales = "free") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))
```

We can see here how much sentiment is confounded with topic in this particular approach. An atheism board is likely to discuss "god" in detail even in a negative context, and we can see it makes the board look more positive. Similarly, the negative contribution of the word "gun" to the "talk.politics.guns" board would occur even if the board members were discussing guns positively.

## Sentiment analysis by message

We can also try finding the most positive and negative *messages*.

```{r}
sentiment_messages <- usenet_words %>%
  inner_join(AFINN, by = "word") %>%
  group_by(board, id) %>%
  summarize(sentiment = mean(score),
            words = n()) %>%
  ungroup() %>%
  filter(words >= 5)
```

As a simple measure to reduce the role of randomness, we filtered out messages that had fewer than five words that contributed to sentiment.

What were the most positive messages?

```{r}
sentiment_messages %>%
  arrange(desc(sentiment))
```

Let's check this by looking at the most positive message in the whole data set.

```{r print_message, dependson = "cleaned_text"}
print_message <- function(message_id) {
  cleaned_text %>%
    filter(id == message_id) %>%
    filter(text != "") %>%
    .$text %>%
    cat(sep = "\n")
}

print_message(53560)
```

Looks like it's because the message uses the word "winner" a lot! How about the most negative message? Turns out it's also from the hockey site, but has a very different attitude.

```{r dependson = "sentiment_messages"}
sentiment_messages %>%
  arrange(sentiment)

print_message(53907)
```

Well then.

## N-grams

We can also examine the effect of words that are used in negation, like we did in [Chapter 5](#ngrams). Let's start by finding all the bigrams in the Usenet posts.

```{r usenet_2grams, dependson = "cleaned_text"}
usenet_bigrams <- cleaned_text %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

usenet_bigrams
```

Now let's count how many of these bigrams are used in each board.

```{r usenet_bigram_counts, dependson = "usenet_2grams"}
usenet_bigram_counts <- usenet_bigrams %>%
  count(board, bigram)

usenet_bigram_counts %>% 
  arrange(desc(n))
```

Next, we can calculate tf-idf for the bigrams to find the ones that are important for each board.

```{r bigram_tf_idf, dependson = "usenet_bigram_counts"}
bigram_tf_idf <- usenet_bigram_counts %>%
  bind_tf_idf(bigram, board, n)

bigram_tf_idf %>%
  arrange(desc(tf_idf))
```

Now we come back to the words used in negation that we are interested in examining. Let's define a vector of words that we suspect are used in negation, and use the same joining and counting approach from [Chapter 5](#ngrams) to examine all of them at once.

```{r negate_words, dependson = "usenet_bigram_counts", fig.width=8, fig.height=10}
negate_words <- c("not", "without", "no", "can't", "don't", "won't")

usenet_bigram_counts %>%
  ungroup() %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  filter(word1 %in% negate_words) %>%
  count(word1, word2, wt = n, sort = TRUE) %>%
  inner_join(AFINN, by = c(word2 = "word")) %>%
  mutate(contribution = score * nn) %>%
  top_n(10, abs(contribution)) %>%
  ungroup() %>%
  mutate(word2 = reorder(word2, contribution)) %>%
  ggplot(aes(word2, contribution, fill = contribution > 0)) +
  geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
  facet_wrap(~ word1, scales = "free", nrow = 3) +
  xlab("Words preceded by negation") +
  ylab("Sentiment score * # of occurrences") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1))
```

These words are the ones that contribute the most to the sentiment scores in the wrong direction, because they are being used with negation words before them. Phrases like "no problem" and "don't want" are important sources of misidentification.


```{r eval = FALSE, echo = FALSE}
# we're not going to use this one
metadata <- raw_text %>%
  group_by(id) %>%
  filter(cumsum(text == "") == 0) %>%
  ungroup() %>%
  separate(text, c("header", "content"),
           sep = ": ", extra = "merge", fill = "right") %>%
  filter(!is.na(content)) %>%
  mutate(header = str_replace_all(str_to_lower(header), "-", "_")) %>%
  distinct(id, header, .keep_all = TRUE) %>%
  spread(header, content)
```