library(readr)
library(dplyr)
library(tibble)
library(tidyr)
library(purrr)
library(stringr)
library(ggplot2)
library(tidymodels)
library(textrecipes)
library(glmnet)
library(quanteda)
source("R/inaugural-corpus.R")
paragraphs <- inaugural_paragraphs()
periods <- paragraphs |>
mutate(
period = factor(
cut(
year,
breaks = c(1788, 1847, 1906, 1965, 2025),
labels = c("1789-1847", "1848-1906", "1907-1965", "1966-2025"),
right = TRUE
),
levels = c("1789-1847", "1848-1906", "1907-1965", "1966-2025")
)
)
period_counts <- periods |>
count(period, name = "paragraphs")One label or several labels
Separate multi-class choices from multi-label tags
Ravi is building filters for an archive search page. One control asks for a time period, where each paragraph can belong to only one period. Another asks for themes, where a paragraph can mention work, time, people, all three, or none.
Those two controls look similar on the screen, but they ask different questions. One forces a single choice. The other lets several tags sit on the same paragraph.
By the end of this lesson, you will be able to:
- distinguish multi-class from multi-label classification;
- build a four-way period label from years;
- read a confusion matrix for a multi-class model;
- create theme labels with a small quanteda dictionary; and
- explain why label-level accuracy can mislead in multi-label work.
Load paragraphs and build periods
Multi-class classification means one document receives one label from several mutually exclusive choices. The four periods below are equal-width year bins: 1789-1847, 1848-1906, 1907-1965, and 1966-2025. They are technical bins for this lesson, not claims about political history.
| Period label | Paragraphs |
|---|---|
| 1789-1847 | 210 |
| 1848-1906 | 291 |
| 1907-1965 | 423 |
| 1966-2025 | 453 |
Each paragraph receives exactly one period label. That single-label structure is what makes the task multi-class rather than multi-label.
Fit the four-way classifier
The split keeps whole speeches together. The seed for the split is 5201, and the seed before fitting is 5202. The model uses tf-idf features and a multinomial glmnet classifier.
set.seed(5201)
period_split <- group_initial_split(
periods,
group = speech_id,
prop = 0.75,
strata = period
)
period_train <- training(period_split)
period_test <- testing(period_split)
period_recipe <- recipe(period ~ paragraph, data = period_train) |>
step_tokenize(paragraph) |>
step_tokenfilter(paragraph, max_tokens = 600) |>
step_tfidf(paragraph)
period_model <- multinom_reg(penalty = 0.01, mixture = 1) |>
set_engine("glmnet") |>
set_mode("classification")
set.seed(5202)
period_fit <- workflow() |>
add_recipe(period_recipe) |>
add_model(period_model) |>
fit(data = period_train)
period_predictions <- period_test |>
select(paragraph_id, period) |>
bind_cols(predict(period_fit, period_test))
period_accuracy <- yardstick::accuracy(
period_predictions,
truth = period,
estimate = .pred_class
) |>
pull(.estimate)
period_confusion <- yardstick::conf_mat(
period_predictions,
truth = period,
estimate = .pred_class
)
period_matrix <- as.matrix(period_confusion$table)
test_period_counts <- period_test |>
count(period, name = "paragraphs")
training_majority_period <- period_train |>
count(period, sort = TRUE) |>
slice(1) |>
pull(period)
period_baseline <- mean(period_test$period == training_majority_period)
period_oracle_baseline <- max(test_period_counts$paragraphs) / nrow(period_test)
period_scores <- tibble(
measure = c(
"Model accuracy",
"Training-majority baseline",
"Test-majority oracle"
),
value = c(
period_accuracy,
period_baseline,
period_oracle_baseline
)
)| Measure | Value |
|---|---|
| Model accuracy | 0.5938 |
| Training-majority baseline | 0.3324 |
| Test-majority oracle | 0.3324 |
| Model prediction | Recorded period | Paragraphs |
|---|---|---|
| 1789-1847 | 1789-1847 | 19 |
| 1848-1906 | 1789-1847 | 23 |
| 1907-1965 | 1789-1847 | 5 |
| 1966-2025 | 1789-1847 | 1 |
| 1789-1847 | 1848-1906 | 13 |
| 1848-1906 | 1848-1906 | 63 |
| 1907-1965 | 1848-1906 | 9 |
| 1966-2025 | 1848-1906 | 3 |
| 1789-1847 | 1907-1965 | 14 |
| 1848-1906 | 1907-1965 | 30 |
| 1907-1965 | 1907-1965 | 47 |
| 1966-2025 | 1907-1965 | 8 |
| 1789-1847 | 1966-2025 | 3 |
| 1848-1906 | 1966-2025 | 2 |
| 1907-1965 | 1966-2025 | 32 |
| 1966-2025 | 1966-2025 | 80 |
The overall accuracy is 0.5938 on this speech-level split. A deployable baseline chooses the most common period in training, 1966-2025, then applies that rule to test; it scores 0.3324. Looking at the test labels first produces the same 0.3324 oracle value by coincidence on this split, but that is not a rule a deployed system could choose in advance. The confusion matrix shows, for example, that many 1907-1965 test paragraphs are sent to the 1966-2025 label.
Check recall by class
Recall asks, within one recorded class, how many rows returned to that class. For a multi-class task, recall by class is often more useful than one accuracy number.
period_recall <- period_predictions |>
summarise(
support = n(),
correct = sum(.pred_class == period),
recall = correct / support,
.by = period
) |>
arrange(period)| Recorded period | Test paragraphs | Correct | Recall |
|---|---|---|---|
| 1789-1847 | 48 | 19 | 0.396 |
| 1848-1906 | 88 | 63 | 0.716 |
| 1907-1965 | 99 | 47 | 0.475 |
| 1966-2025 | 117 | 80 | 0.684 |
The 1789-1847 period has recall of 0.396, while the 1848-1906 period has recall of 0.716. The model’s mistakes are uneven, so the confusion matrix is required.
Build several theme labels
Multi-label classification means a document may receive zero, one, or several labels at the same time. A small quanteda dictionary marks three vocabulary themes. These labels are the dictionary’s own output. Agreement with them measures agreement with the dictionary, not agreement with human themes or with the corpus itself.
A document-feature matrix stores document rows and word columns. quanteda dictionaries use glob matching by default, so a star means “starts with” here: work* matches work, working, and workforce.
theme_dictionary <- dictionary(list(
work = c("work*", "labor", "employment", "industry", "business"),
time = c("year*", "day*", "time*", "today", "future"),
people = c("people", "citizen*", "family", "families", "children")
))
theme_dfm <- corpus(
paragraphs,
text_field = "paragraph",
docid_field = "paragraph_id"
) |>
tokens(remove_punct = TRUE) |>
tokens_tolower() |>
dfm() |>
dfm_lookup(dictionary = theme_dictionary)
theme_counts <- convert(theme_dfm, to = "data.frame") |>
as_tibble() |>
rename(paragraph_id = doc_id)
theme_labels <- paragraphs |>
select(paragraph_id) |>
left_join(theme_counts, by = join_by(paragraph_id)) |>
mutate(across(-paragraph_id, \(count) count > 0))
label_count_table <- theme_labels |>
mutate(label_count = rowSums(across(-paragraph_id))) |>
count(label_count, name = "paragraphs")| Theme labels on a paragraph | Paragraphs |
|---|---|
| 0 | 449 |
| 1 | 605 |
| 2 | 273 |
| 3 | 50 |
The memorable distinction is this: multi-class chooses one box from several; multi-label lets the same document carry several tags.
Accuracy can reward saying no
Most possible theme labels are absent. A do-nothing system that predicts every label as absent therefore gets many cells right while finding no present labels. That is why multi-label reporting needs per-label precision and recall.
label_long <- theme_labels |>
pivot_longer(
cols = -paragraph_id,
names_to = "label",
values_to = "present"
)
always_absent <- label_long |>
mutate(predicted = FALSE)
per_label_metrics <- always_absent |>
summarise(
true_present = sum(present),
true_absent = sum(!present),
prevalence = mean(present),
predicted_present = sum(predicted),
true_positive = sum(present & predicted),
false_positive = sum(!present & predicted),
false_negative = sum(present & !predicted),
accuracy = mean(predicted == present),
precision = if_else(
true_positive + false_positive == 0L,
NA_real_,
true_positive / (true_positive + false_positive)
),
recall = if_else(
true_positive + false_negative == 0L,
NA_real_,
true_positive / (true_positive + false_negative)
),
.by = label
) |>
arrange(label)
overall_label_accuracy <- mean(always_absent$predicted == always_absent$present)
exact_empty_accuracy <- theme_labels |>
mutate(
label_count = rowSums(across(-paragraph_id)),
predicted_empty_matches = label_count == 0L
) |>
summarise(value = mean(predicted_empty_matches), .groups = "drop") |>
pull(value)
baseline_accuracy_summary <- tibble(
measure = c(
"Label-cell accuracy",
"Exact empty-set accuracy"
),
value = c(
overall_label_accuracy,
exact_empty_accuracy
)
)| Label | Present | Absent | Prevalence | Accuracy if always absent | Precision | Recall |
|---|---|---|---|---|---|---|
| people | 581 | 796 | 0.422 | 0.578 | NA | 0 |
| time | 501 | 876 | 0.364 | 0.636 | NA | 0 |
| work | 219 | 1158 | 0.159 | 0.841 | NA | 0 |
| Baseline measure | Accuracy |
|---|---|
| Label-cell accuracy | 0.6851 |
| Exact empty-set accuracy | 0.3261 |
Precision is NA because the baseline never predicts a present label, leaving zero predicted positives in the denominator. That is an undefined metric, not a display error.
The always-absent baseline gets 0.6851 label-cell accuracy because absent labels are common. The label prevalences are 0.422 for people, 0.364 for time, and 0.159 for work. Its recall is 0 for every label, so it finds none of the 219 work, 501 time, or 581 people dictionary labels. Exact empty-set accuracy is 0.3261, the share of paragraphs with no dictionary theme at all.
What to remember
- Multi-class means one label from more than two choices.
- Multi-label means zero, one, or several labels can apply at once.
- Multi-class accuracy can hide weak classes.
- Multi-label accuracy can be high when absent labels dominate.
- Per-class or per-label precision and recall tell the reader where the errors are.