---
title: "Topic Modeling"
subtitle: "Week 8 — Codealong Notes"
author: "YOUR NAME HERE"
date: "2026-10-12"
format: pdf
execute:
  echo: true
  warning: false
  message: false
  error: true
---

```{r}
library(tidyverse)
library(tidytext)
library(topicmodels)  # install.packages("topicmodels") before use
```

# TTM 5.1 — Tidying a document-term matrix

## What is a document-term matrix?

- one **row** per _______
- one **column** per _______
- each **cell** is a _______

## A real one: `AssociatedPress`

```{r}
data("AssociatedPress")
AssociatedPress
```

## Sparsity: most cells are 0

**Sparsity** = the percent of cells in a matrix that are _______.

## Why do we care about sparsity?

```{r}
n_cells  <- nrow(AssociatedPress) * ncol(AssociatedPress)
n_filled <- length(AssociatedPress$v)   # $v holds only the non-zero counts

tibble(total_cells = n_cells,
       filled      = n_filled,
       empty       = n_cells - n_filled,
       pct_empty   = round(100 * (n_cells - n_filled) / n_cells, 1))
```

## Matrix $\rightarrow$ tidy: `AssociatedPress`

```{r}
(ap_td <- ______(AssociatedPress))
```

Note the column is called `term` here, where our tidy text used `word`.

# TTM 5.2 — Casting tidy text data into a matrix

## Three toy documents $\rightarrow$ tidy counts

```{r}
toy_text <- tibble(
  document = c("doc1", "doc2", "doc3"),
  text = c("The budget vote was delayed again",
           "The vote on the school budget passed",
           "The storm damaged the school roof")
)

toy_counts <- toy_text |>
  ______(word, text) |>
  anti_join(______, by = "word") |>
  count(document, word)

toy_counts
```

## Tidy counts $\rightarrow$ DTM: `cast_dtm()`

```{r}
toy_dtm <- toy_counts |>
  cast_dtm(_______, _______, n)

toy_dtm
```

## 🎯 Your turn

Use the matrix below to answer these questions. Do not use code here. 👀 + 🧠 only

1. Which two documents share the most words? Which words? _______
2. Does any word appear in all three documents? _______
3. If we added more documents with new words, would sparsity go up or down? _______

```{r}
as.matrix(toy_dtm)
```

# TTM 6.1 — Latent Dirichlet allocation

## Two principles

1. Every document is a mixture of _______.
2. Every topic is a mixture of _______.

## Warning: Probability! 

* **$\beta$** (beta) = P( _______ | topic ): how likely is this word *within* this topic?
* **$\gamma$** (gamma) = P( _______ | document ): how much of this document comes from this topic?

## Fit the model

```{r}
(ap_lda <- LDA(AssociatedPress,
               k = ___,
               control = list(seed = ____)))
```

## TTM 6.1.1 Word-topic probabilities ($\beta$)

```{r}
ap_topics <- tidy(ap_lda, matrix = "______")
head(ap_topics)
```

**Watch the notation**

`1.69e-12` is scientific notation for 0.00000000000169

## Top terms per topic

```{r}
ap_top_terms <- ap_topics |>
  group_by(______) |>
  slice_max(beta, n = ___) |>
  ungroup() |>
  arrange(topic, -beta)
```

What would you "name" each topic? Remember this data set contains news articles from the AP.

```{r}
ap_top_terms |>
  mutate(term = reorder_within(term, beta, topic)) |>
  ggplot(aes(beta, term, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  scale_y_reordered()
```

Topic 1: _______ Topic 2: _______

## Biggest $\beta$ differences

```{r}
beta_wide <- ap_topics |>
  mutate(topic = paste0("topic", topic)) |>
  ______(names_from = topic, values_from = beta) |>
  filter(topic1 > .001 | topic2 > .001) |>
  mutate(log_ratio = ______(topic2 / topic1))

head(beta_wide)
```

## Interpreting the log2 $\beta$ ratio

* log2 ratio of +4.46 = $_______$ = 22 times more likely `aid` is in topic _______ than topic _______
* log2 ratio of -0.27 = $_______$ = 1.2 times more likely that `american` comes from topic _______ compared to topic _______

## Biggest $\beta$ differences

```{r}
beta_wide |>
  group_by(direction = log_ratio > 0) |>
  slice_max(abs(log_ratio), n = 10) |>
  ungroup() |>
  mutate(term = reorder(term, log_ratio)) |>
  ggplot(aes(log_ratio, term)) +
  geom_col() +
  labs(x = "Log2 ratio of beta in topic 2 / topic 1", y = NULL)
```

## TTM 6.1.2 Document-topic probabilities ($\gamma$)

```{r}
ap_documents <- tidy(ap_lda, matrix = "______")
head(ap_documents)
```

- `tidy()` renames the response identifier to _______. Here a document is a news article.
- News article #6 has an extremely low probability of being in Topic _______

## Reading $\gamma$ across a row

We can use `pivot_wider()` to create one row per article, one column per topic.

```{r}
ap_documents |>
  pivot_wider(names_from = topic, names_prefix = "topic", values_from = _______) |>
  head()
```

- Each row adds up to _______: that is the article's *mix*
- **Clean:** one topic is near _______. **Blended:** the $\gamma$ is spread across _______

**Try it yourself**

Which of these articles are clean? Which are blends? What would a blend mean for a news article?

Clean: _______ Blend: _______

## Check the words

```{r}
ap_td |>
  filter(document == ___) |>
  arrange(desc(______)) |>
  head(10)
```

## One label per document: the dominant topic

Keep only the row with the biggest $\gamma$ within each article (document).

```{r}
topic_mixture <- ap_documents |>
  group_by(______) |>
  slice_max(______)

table(topic_mixture$topic)
table(topic_mixture$topic) |> prop.table()
```

_______% (n = _______) of all news articles are in Topic _______

Caveat: a single label throws away the _______.