---
title: "Relationships between words: n-grams and correlations"
author: "Massimo Franceschet"
output:
  ioslides_presentation:
    css: ../style.css
    incremental: yes
editor_options: 
  chunk_output_type: inline
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(cache = FALSE, message = FALSE, warning = FALSE)
```


## n-grams

We'll explore some of the methods tidytext offers for calculating and visualizing relationships between words in your text dataset. 

> An **n-grams** is a consecutive sequences of n words. By seeing how often word X is followed by word Y, we can then build a model of the relationships between them.


```{r}
library(tidyverse)
library(tidytext)
library(janeaustenr)


austen_bigrams <- austen_books() %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2) %>% 
  filter(!is.na(bigram))

austen_bigrams

# count bigrams
austen_bigrams %>%
  count(bigram, sort = TRUE)

# remove stop words
bigrams_separated <- austen_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_separated %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word)

# new bigram counts
bigram_counts <- bigrams_filtered %>% 
  count(word1, word2, sort = TRUE)

bigram_counts

# back to bigrams
bigrams_united <- bigrams_filtered %>%
  unite(bigram, word1, word2, sep = " ")

bigrams_united

# count 3-grams
austen_books() %>%
  unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%
  filter(!is.na(trigram)) %>% 
  separate(trigram, c("word1", "word2", "word3"), sep = " ") %>%
  filter(!word1 %in% stop_words$word,
         !word2 %in% stop_words$word,
         !word3 %in% stop_words$word) %>%
  count(word1, word2, word3, sort = TRUE)

```

## tf-idf of bigrams

A bigram can also be treated as a term in a document in the same way that we treated individual words. For example, we can look at the tf-idf of bigrams across Austen novels.

```{r fig.width = 8, fig.asp = .75}
bigram_tf_idf <- bigrams_united %>%
  count(book, bigram) %>%
  bind_tf_idf(bigram, book, n) %>%
  arrange(desc(tf_idf))

bigram_tf_idf

bigram_tf_idf %>%
  arrange(desc(tf_idf)) %>%
  group_by(book) %>%
  top_n(12, tf_idf) %>%
  ungroup() %>%
  mutate(bigram = reorder(bigram, tf_idf)) %>%
  ggplot(aes(bigram, tf_idf, fill = book)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ book, ncol = 2, scales = "free") +
  coord_flip() +
  labs(y = "tf-idf of bigram to novel",
       x = "")

```

>* there are advantages and disadvantages to examining the tf-idf of bigrams rather than individual words
>* pairs of consecutive words might capture structure that isn't present when one is just counting single words, and may provide context that makes tokens more understandable
>* however, the per-bigram counts are also sparser: a typical two-word pair is rarer than either of its component words 
>* thus, bigrams can be especially useful when you have a very large text dataset

## Bigrams to provide context in sentiment analysis

* we can use bigrams to provide context in sentiment analysis
* our sentiment analysis approach above simply counted the appearance of positive or negative words, according to a reference lexicon 
* one of the problems with this approach is that a word's context can matter nearly as much as its presence 
* for example, the words "happy" and "like" will be counted as positive, even in a sentence like "I'm not **happy** and I don't **like** it!"

## Bigrams to provide context in sentiment analysis 

Now that we have the data organized into bigrams, it's easy to tell how often words are preceded by a word like "not":

```{r }
bigrams_separated %>%
  filter(word1 == "not") %>%
  count(word1, word2, sort = TRUE)

AFINN <- get_sentiments("afinn")

not_words <- bigrams_separated %>%
  filter(word1 == "not") %>%
  inner_join(AFINN, by = c("word2" = "word")) %>%
  count(word2, value, sort = TRUE)

not_words
```

It's worth asking which words contributed the most in the "wrong" direction. To compute that, we can multiply their score by the number of times they appear.

```{r}
not_words %>%
  mutate(contribution = n * value) %>%
  arrange(desc(abs(contribution))) %>%
  head(20) %>%
  mutate(word2 = reorder(word2, contribution)) %>%
  ggplot(aes(word2, n * value, fill = n * value > 0)) +
  geom_col(show.legend = FALSE) +
  xlab("Words preceded by \"not\"") +
  ylab("Sentiment value * number of occurrences") +
  coord_flip()
```

## Bigrams as graphs

We may be interested in visualizing all of the relationships among words simultaneously, rather than just the top few at a time. 

As one common visualization, we can arrange the words into a **network**, or **graph**. 

```{r}
library(igraph)
library(tidygraph)
library(ggraph)


# original counts
bigram_counts

# create the graph
bigram_graph <- bigram_counts %>%
  filter(n > 20) %>% 
  as_tbl_graph()

bigram_graph

# arrows
a <- grid::arrow(type = "closed", length = unit(.1, "inches"))

# plot the graph
ggraph(bigram_graph, layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 1) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

```

>* note that this is a visualization of a **Markov chain**, a common model in text processing
>* In a Markov chain, each choice of word depends only on the previous word
>* in this case, a random generator following this model might spit out "dear", then "sir", then "william/walter/thomas/thomas's", by following each word to the most common words that follow it

## Co-occurrence of words

* tokenizing by n-gram is a useful way to explore pairs of adjacent words
* however, we may also be interested in words that tend to co-occur within particular documents or particular chapters, even if they don't occur next to each other
* the [widyr](https://CRAN.R-project.org/package=widyr ) package makes operations such as computing counts and correlations easy, by simplifying the pattern of *widen data, perform an operation, then re-tidy data* 
* the widyr package: 
    1. first *casts* a tidy dataset into a wide matrix
    2. performs an operation such as a correlation on it
    3. then re-tidies the result

```{r widyr, echo = FALSE, out.width = '100%'}
knitr::include_graphics("img/widyr.jpg")
```

## Co-occurrence of words: the wider package

```{r}
library(widyr)

# separate words in sections (10 lines)
austen_section_words <- austen_books() %>%
  filter(book == "Pride & Prejudice") %>%
  mutate(section = row_number() %/% 10) %>%
  filter(section > 0) %>%
  unnest_tokens(word, text) %>%
  filter(!(word %in% stop_words$word))

austen_section_words

# count words co-occuring within sections
word_pairs <- austen_section_words %>%
  pairwise_count(word, section, sort = TRUE)

word_pairs

```

## Co-occurrence of words: correlation coefficient

Pairs like "Elizabeth" and "Darcy" are the most common co-occurring words, but that's not particularly meaningful since *they're also the most common individual words*. 

We may instead want to examine **correlation** among words, which indicates how often they appear together relative to how often they appear separately.

In particular, here we'll focus on the [phi coefficient](https://en.wikipedia.org/wiki/Phi_coefficient), a common measure for binary correlation. 

The focus of the phi coefficient is how much more likely it is that either **both** word X and Y appear, or **neither** do, than that one appears without the other.

Consider the following table:

|  | Has word Y | No word Y | Total |  
|------------|---------------|---------------|--------------|
| Has word X | $n_{11}$ | $n_{10}$ | $n_{1\cdot}$ |  
| No word X | $n_{01}$ | $n_{00}$ | $n_{0\cdot}$ |  
| Total | $n_{\cdot 1}$ | $n_{\cdot 0}$ | n |  

In terms of this table, the phi coefficient is:

$$\phi=\frac{n_{11}n_{00}-n_{10}n_{01}}{\sqrt{n_{1\cdot}n_{0\cdot}n_{\cdot0}n_{\cdot1}}}$$

Introduced by Karl Pearson, this measure is similar to the [Pearson correlation coefficient](https://en.wikipedia.org/wiki/Pearson_correlation_coefficient) in its interpretation.

```{r }
# we need to filter for at least relatively common words first
word_cors <- austen_section_words %>%
  group_by(word) %>%
  filter(n() >= 20) %>%
  pairwise_cor(word, section, sort = TRUE)

word_cors %>%
  filter(item1 == "pounds")
```

Just as we used ggraph to visualize bigrams, we can use it to visualize the correlations and clusters of words that were found by the widyr package.

```{r}
word_cors %>%
  filter(correlation > .15) %>%
  as_tbl_graph() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 1) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()
```

## Play

1. Download from Project Gutenberg Homer's Odyssey ([RDS](odyssey.rds))
2. Study the word co-occurrence withing the same line in the novel 
3. What about the ["...child of morning, rosy-fingered Dawn, appeared..."](https://kottke.org/18/04/tracking-the-appearances-of-rosy-fingered-dawn-in-the-odyssey) cluster?


```{r echo=FALSE, eval=FALSE}
#library(gutenbergr)
odyssey = read_rds("odyssey.rds")

# separate words in sections (lines)
odyssey_line_words <- odyssey %>%
  mutate(line = row_number()) %>%
  unnest_tokens(word, text) %>%
  filter(!(word %in% stop_words$word))

odyssey_line_words

# count words co-occuring within sections
word_pairs <- odyssey_line_words %>%
  pairwise_count(word, line, sort = TRUE)

word_pairs

word_pairs %>%
  filter(item1 == "ulysses")

word_pairs %>%
  filter(item1 == "penelope")

word_pairs %>%
  filter(n > 10) %>%
  as_tbl_graph() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 1) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()



```




