topic_modeling.Rmd

---
title: "Tidy Topic Modeling"
author: "Julia Silge and David Robinson"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Tidy Topic Modeling}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r}
#| echo = FALSE
library(knitr)
opts_chunk$set(message = FALSE, warning = FALSE,
               eval = requireNamespace("tm", quietly = TRUE))
options(width = 100, dplyr.width = 150)
library(ggplot2)
theme_set(theme_bw())
```

Topic modeling is a method for unsupervised classification of documents, by modeling each document as a mixture of topics and each topic as a mixture of words. [Latent Dirichlet allocation](https://en.wikipedia.org/wiki/Latent_Dirichlet_allocation) is a particularly popular method for fitting a topic model.

We can use tidy text principles, as described in [the main vignette](tidytext.html), to approach topic modeling using consistent and effective tools. In particular, we'll be using tidying functions for LDA objects from the [topicmodels package](https://cran.r-project.org/package=topicmodels).

### Can we tell the difference between Dickens, Wells, Verne, and Austen?

Suppose a vandal has broken into your study and torn apart four of your books:

* *Great Expectations* by Charles Dickens
* *The War of the Worlds* by H.G. Wells
* *Twenty Thousand Leagues Under the Sea* by Jules Verne
* *Pride and Prejudice* by Jane Austen

This vandal has torn the books into individual chapters, and left them in one large pile. How can we restore these disorganized chapters to their original books?

#### Setup

```{r}
#| label = "packages"
library(dplyr)
library(gutenbergr)
```

```{r}
#| label = "books_show",
#| eval = FALSE
titles <- c("Twenty Thousand Leagues under the Sea", "The War of the Worlds",
            "Pride and Prejudice", "Great Expectations")
books <- gutenberg_works(title %in% titles) %>%
  gutenberg_download(meta_fields = "title")
```

```{r}
#| label = "books",
#| echo = FALSE
# Downloading from Project Gutenberg can sometimes not work on automated servers
# such as Travis-CI: see
# https://github.com/ropenscilabs/gutenbergr/issues/6#issuecomment-231596903

# this is a workaround
load(system.file("extdata", "books.rda", package = "tidytext"))
```

```{r}
books
```

As pre-processing, we divide these into chapters, use tidytext's `unnest_tokens` to separate them into words, then remove `stop_words`. We're treating every chapter as a separate "document", each with a name like `Great Expectations_1` or `Pride and Prejudice_11`.

```{r}
#| label = "word_counts"
library(tidytext)
library(stringr)
library(tidyr)

by_chapter <- books %>%
  group_by(title) %>%
  mutate(chapter = cumsum(str_detect(text, regex("^chapter ", ignore_case = TRUE)))) %>%
  ungroup() %>%
  filter(chapter > 0)

by_chapter_word <- by_chapter %>%
  unite(title_chapter, title, chapter) %>%
  unnest_tokens(word, text)

word_counts <- by_chapter_word %>%
  anti_join(stop_words) %>%
  count(title_chapter, word, sort = TRUE)

word_counts
```

### Latent Dirichlet Allocation with the topicmodels package

Right now this data frame is in a tidy form, with one-term-per-document-per-row. However, the topicmodels package requires a `DocumentTermMatrix` (from the tm package). As described in [this vignette](tidying_casting.html), we can cast a one-token-per-row table into a `DocumentTermMatrix` with tidytext's `cast_dtm`:

```{r}
#| label = "chapters_dtm"
chapters_dtm <- word_counts %>%
  cast_dtm(title_chapter, word, n)

chapters_dtm
```

Now we are ready to use the [topicmodels](https://cran.r-project.org/package=topicmodels) package to create a four topic LDA model.

```{r}
#| label = "chapters_lda"
library(topicmodels)
chapters_lda <- LDA(chapters_dtm, k = 4, control = list(seed = 1234))
chapters_lda
```

(In this case we know there are four topics because there are four books; in practice we may need to try a few different values of `k`).

Now tidytext gives us the option of *returning* to a tidy analysis, using the `tidy` and `augment` verbs borrowed from the [broom package](https://github.com/dgrtwo/broom). In particular, we start with the `tidy` verb.

```{r}
#| label = "chapters_lda_td"
chapters_lda_td <- tidy(chapters_lda)
chapters_lda_td
```

Notice that this has turned the model into a one-topic-per-term-per-row format. For each combination the model has $\beta$, the probability of that term being generated from that topic.

We could use dplyr's `slice_max()` to find the top 5 terms within each topic:

```{r}
#| label = "top_terms"
top_terms <- chapters_lda_td %>%
  group_by(topic) %>%
  slice_max(beta, n = 5) %>%
  ungroup() %>%
  arrange(topic, -beta)

top_terms
```

This model lends itself to a visualization:

```{r}
#| label = "top_terms_plot",
#| fig.height = 7,
#| fig.width = 7,
#| fig.alt = "The highest probability words from each of the four topics"
library(ggplot2)
theme_set(theme_bw())

top_terms %>%
  mutate(term = reorder_within(term, beta, topic)) %>%
  ggplot(aes(term, beta)) +
  geom_col() +
  scale_x_reordered() +
  facet_wrap(vars(topic), scales = "free_x")
```

These topics are pretty clearly associated with the four books! There's no question that the topic of "nemo", "sea", and "nautilus" belongs to *Twenty Thousand Leagues Under the Sea*, and that "jane", "darcy", and "elizabeth" belongs to *Pride and Prejudice*. We see "pip" and "joe" from *Great Expectations* and "martians", "black", and "night" from *The War of the Worlds*.

#### Per-document classification

Each chapter was a "document" in this analysis. Thus, we may want to know which topics are associated with each document. Can we put the chapters back together in the correct books?

```{r}
#| label = "chapters_lda_gamma_raw"
chapters_lda_gamma <- tidy(chapters_lda, matrix = "gamma")
chapters_lda_gamma
```

Setting `matrix = "gamma"` returns a tidied version with one-document-per-topic-per-row. Now that we have these document classifications, we can see how well our unsupervised learning did at distinguishing the four books. First we re-separate the document name into title and chapter:

```{r}
#| label = "chapters_lda_gamma"
chapters_lda_gamma <- chapters_lda_gamma %>%
  separate(document, c("title", "chapter"), sep = "_", convert = TRUE)
chapters_lda_gamma
```

Then we examine what fraction of chapters we got right for each:

```{r}
#| label = "chapters_lda_gamma_plot",
#| fig.width = 8,
#| fig.height = 6,
#| fig.alt = "Histograms for the document-topic probabilities plotted for each book"
ggplot(chapters_lda_gamma, aes(gamma, fill = factor(topic))) +
  geom_histogram() +
  facet_wrap(vars(title), nrow = 2)
```

We notice that almost all of the chapters from *Pride and Prejudice*, *War of the Worlds*, and *Twenty Thousand Leagues Under the Sea* were uniquely identified as a single topic each.

```{r}
#| label = "chapter_classifications"
chapter_classifications <- chapters_lda_gamma %>%
  group_by(title, chapter) %>%
  slice_max(gamma, n = 1) %>%
  ungroup() %>%
  arrange(gamma)

chapter_classifications
```

We can determine this by finding the consensus book for each, which we note is correct based on our earlier visualization:

```{r}
#| label = "book_topics"
book_topics <- chapter_classifications %>%
  count(title, topic) %>%
  group_by(topic) %>%
  slice_max(n, n = 1) %>%
  ungroup() %>%
  transmute(consensus = title, topic)

book_topics
```

Then we see which chapters were misidentified:

```{r}
chapter_classifications %>%
  inner_join(book_topics, by = "topic") %>%
  count(title, consensus)
```

We see that only a few chapters from *Great Expectations* were misclassified. Not bad for unsupervised clustering!

#### By word assignments: `augment`

One important step in the topic modeling expectation-maximization algorithm is assigning each word in each document to a topic. The more words in a document are assigned to that topic, generally, the more weight (`gamma`) will go on that document-topic classification.

We may want to take the original document-word pairs and find which words in each document were assigned to which topic. This is the job of the `augment` verb.

```{r}
#| label = "assignments"
assignments <- augment(chapters_lda, data = chapters_dtm)
```

We can combine this with the consensus book titles to find which words were incorrectly classified.

```{r}
assignments <- assignments %>%
  separate(document, c("title", "chapter"), sep = "_", convert = TRUE) %>%
  inner_join(book_topics, join_by(.topic == topic))

assignments
```

We can, for example, create a "confusion matrix" using dplyr's `count()` and tidyr's `pivot_wider()`:

```{r}
assignments %>%
  count(title, consensus, wt = count) %>%
  pivot_wider(names_from = consensus, values_from = n, values_fill = 0)
```

We notice that almost all the words for *Pride and Prejudice*, *Twenty Thousand Leagues Under the Sea*, and *War of the Worlds* were correctly assigned, while *Great Expectations* had a fair amount of misassignment.

What were the most commonly mistaken words?

```{r}
wrong_words <- assignments %>%
  filter(title != consensus)

wrong_words

wrong_words %>%
  count(title, consensus, term, wt = count) %>%
  arrange(desc(n))
```

Notice the word "flopson" here; these wrong words do not necessarily appear in the novels they were misassigned to. Indeed, we can confirm "flopson" appears only in *Great Expectations*:

```{r}
word_counts %>%
  filter(word == "flopson")
```

The algorithm is stochastic and iterative, and it can accidentally land on a topic that spans multiple books.