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 builds 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 requires a single choice. The other permits several tags on one 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.
- 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 year bins: 1789-1847, 1848-1906, 1907-1965, and 1966-2025. The first three bins are 59 years long, and the last bin is 60 years long. All four 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 training period, 1966-2025, and applies that label to the test set. It scores 0.3324.
An oracle baseline instead chooses the majority label after reading the test labels. It also scores 0.3324 by coincidence on this split. A deployed system cannot choose that rule in advance. The confusion matrix shows many 1966-2025 test paragraphs with predictions of 1907-1965.
Compare recall by class
Recall is the share of rows in a recorded class that receive the same predicted 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 |
Multi-class classification chooses one label from several. Multi-label classification can assign several labels to the same document.
Accuracy can reward saying no
Most possible theme labels are absent. A system that always predicts absent therefore classifies many cells correctly but finds no present labels. Each cell represents one label for one document. Multi-label reports therefore need 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. Its denominator, the number of predicted positives, is zero. The metric is undefined rather than 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. 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.