library(mintR)
library(stm)
library(data.table)
library(ggplot2)
corpus <- quanteda::corpus_reshape(quanteda::data_corpus_inaugural, to = "paragraphs")
paragraphs <- data.table(quanteda::docvars(corpus), text = as.character(corpus))
paragraphs[, id := sprintf("%d_%s_%03d", Year, President, seq_len(.N)), by = .(Year, President)]
paragraphs <- paragraphs[stringi::stri_count_words(text) >= 40]
tokens <- extract_ngrams(paragraphs, ngrams = 2L, document_col = "id")
kept <- filter_vocabulary(tokens, document_col = "id", min_documents = 5, verbose = FALSE)
stm_data <- tokens_to_stm(kept, paragraphs[id %in% kept$id, .(id, Year)], document_col = "id")
fit_model <- function(K) {
stm(stm_data$documents, stm_data$vocab, K = K, prevalence = ~ s(Year),
data = stm_data$meta, max.em.its = 75, verbose = FALSE)
}
models <- list(k10 = fit_model(10), k20 = fit_model(20))The metrics of the previous guide are computed by the machine. Whether a topic means something to a reader is a different question, and the machine’s answer to it can be wrong. Chang et al. (2009) asked human subjects to judge topics, and found that models with a better held-out likelihood did not produce topics that humans found more interpretable, and sometimes produced worse ones. Automatic coherence measures track human judgements better, but imperfectly (Lau et al. 2014; Hoyle et al. 2021). Validation with humans is therefore part of the method (Grimmer and Stewart 2013; Grimmer et al. 2022).
Reading the topics carefully is the first validation, and cannot be replaced. Intrusion tasks add a second: they ask coders a precise question whose right answer is known, so that the results are measured rather than judged, comparable across models, and robust to the analyst’s wishful reading.
The idea of an intrusion task
A coder sees a few items that belong together and one that does not, the intruder, and must find it. If the items that belong together form a meaningful whole, the intruder stands out; if they do not, the coder has to guess. The share of intruders found, compared with the chance level, measures how meaningful the whole is. mintR implements three tasks:
| Task | What the coder sees | What it validates | Chance |
|---|---|---|---|
| Word intrusion (Chang et al. 2009) | 5 top words of a topic + 1 intruder word | the topic’s words (\(\beta\)) | 1/6 |
| Word-set intrusion (Ying et al. 2022) | 3 sets of top words of a topic + 1 set from another topic | the topic as distinct from others | 1/4 |
| Topic intrusion (Chang et al. 2009) | a document + its 3 main topics + 1 improbable topic | the document’s topic proportions (\(\theta\)) | 1/4 |
Each make_*() function returns an intrusion_test: the questions, the answer key, and one sheet per coder. All coders answer the same questions, in a different order and with the options shuffled.
The models to validate
Two candidate models from the previous guide are compared: 10 and 20 topics, on the paragraphs of US inaugural addresses.
Word intrusion
For each topic, five words are drawn from its 10 most probable words, and one intruder is added. How the intruder is drawn matters. Following Chang et al. (2009), the default (intruder = "other_topic") takes a word that is improbable in the topic (below the median of its word probabilities) but among the top words of another topic. The intruder is then a meaningful, frequent word of the corpus: it cannot be spotted only because it is rare or odd, but only because it does not fit the theme of the five others. Grimmer et al. (2022) describe the same design. The alternative intruder = "within_topic" draws a mid-probability word of the topic itself, a harder and different test. By default, the intruder also has as many words as one of the shown words, so that a bigram does not stand out among unigrams.
word_test <- make_word_intrusion(models, n_coders = 3, seed = 2026)
word_test$questions[1:3, .(model, topic, option_1, option_2, option_3, option_4, option_5, option_6)] model topic option_1 option_2 option_3 option_4 option_5
<char> <int> <char> <char> <char> <char> <char>
1: k10 1 public fellow duties people fellow_citizens
2: k10 2 constitution executive powers system people
3: k10 3 liberty government political law people
option_6
<char>
1: business
2: south
3: office
word_test$key[1:3] question_id model topic intruder
<int> <char> <int> <char>
1: 1 k10 1 business
2: 2 k10 2 south
3: 3 k10 3 officeThe coder sheets hide the model and the topic, so coders cannot guess from them. write_intrusion_sheets() writes one CSV per coder and the key, to keep away from the coders:
write_intrusion_sheets(word_test, "intrusion/word")
# Each coder fills the `answer` column of coder_<n>.csv with the word chosen
# (or its option number). Then:
responses <- read_intrusion_responses(Sys.glob("intrusion/word/coder_*.csv"))
word_test$sheets[coder == 1][1:3, !"answer"] coder order question_id option_1 option_2 option_3 option_4 option_5
<int> <int> <int> <char> <char> <char> <char> <char>
1: 1 1 8 freedom human hope peace public
2: 1 2 7 president currency government revenue purpose
3: 1 3 16 trade rights foreign international nations
option_6
<char>
1: people
2: question
3: fellowInstructions to coders should be short and identical for all: “Each row shows six words. Five of them were chosen because they often appear together in the corpus; one was not. Write the word that does not belong.” Coders should not know which model a question comes from, nor how many models are compared.
Scoring
Real answers would come from your coders. To show the scoring here, the answers below are simulated: three coders who find the intruder with probability 0.8 for the 10-topic model and 0.6 for the 20-topic model, and otherwise pick one of the other words at random.
simulate_answers <- function(test, p_correct, seed) {
set.seed(seed)
key <- unique(test$key[, .(question_id, model, intruder)])
answers <- merge(test$sheets, key, by = "question_id")
option_cols <- grep("^option_", names(answers), value = TRUE)
answers[, answer := {
others <- setdiff(unlist(.SD), intruder)
if (runif(1) < p_correct[[model]]) intruder else sample(others, 1)
}, by = .(coder, question_id), .SDcols = option_cols]
answers[, .(coder, question_id, answer)]
}
responses <- simulate_answers(word_test, p_correct = c(k10 = 0.8, k20 = 0.6), seed = 1)score_intrusion() compares the answers with the key:
scores <- score_intrusion(word_test, responses)
scores$models model precision ci_lower ci_upper chance n_questions n_answers
<char> <num> <num> <num> <num> <int> <int>
1: k10 0.8000000 0.626943 0.9049489 0.1666667 10 30
2: k20 0.6166667 0.490176 0.7291173 0.1666667 20 60- Precision is Chang et al.’s “model precision”: the share of intruders found. Compare it with chance (1/6 here). The interval is a Wilson interval over all answers. It treats answers as independent, which they are not entirely (the same coders answer many questions), so read it as indicative.
-
scores$questionsgives the precision of each topic, to find the topics coders could not make sense of;scores$codersgives each coder’s precision, to spot a coder who misunderstood the task.
scores$questions[order(precision)][1:5] question_id topic model precision n_coders
<int> <int> <char> <num> <int>
1: 2 2 k10 0.3333333 3
2: 11 1 k20 0.3333333 3
3: 12 2 k20 0.3333333 3
4: 16 6 k20 0.3333333 3
5: 18 8 k20 0.3333333 3
plot_intrusion_results(scores)
Agreement between coders
Do coders agree with each other? The observed agreement is the share of coder pairs who chose the same option. Some agreement arises by chance, and kappa statistics correct for it, but they define chance differently. Fleiss’ kappa (Fleiss 1971) takes chance from the observed distribution of choices. In an intrusion task most answers fall on one option (the intruder) when topics are good, so the expected agreement is close to the observed one, and Fleiss’ kappa becomes low, or undefined, even when coders agree almost perfectly. The free-marginal kappa (Brennan and Prediger 1981) takes chance as a random choice among the \(m\) options, \((P_o - 1/m)/(1 - 1/m)\), which fits a forced choice among a fixed number of options.
scores$agreement model observed free_kappa fleiss_kappa n_questions n_coders
<char> <num> <num> <num> <int> <num>
1: k10 0.6333333 0.56 -0.04430380 10 3
2: k20 0.3833333 0.26 -0.04815864 20 3How many questions?
The precision of a model is a proportion, and its uncertainty shrinks with the number of answers: with 20 topics and 3 coders (60 answers), a precision around 0.7 has a 95% interval of roughly \(\pm 0.11\). Differences between models of that size or smaller need more topics, more coders, or both. The number needed depends on the precision itself (Grimmer et al. 2022, ch. 12): proportions near 0.5 are the most uncertain.
Word-set intrusion
Ying et al. (2022) propose tasks designed to validate topics as measures of concepts. In word-set intrusion, the coder sees four sets of words: three drawn from the top words of a topic, one from the top words of another topic, and must find the set that does not belong. Comparing sets rather than single words asks whether the topic as a whole is distinguishable from other topics, and is less sensitive to one odd word. The sets are drawn without overlap from the 20 most probable words; the sizes can be adapted (n_sets, set_size, n_terms).
set_test <- make_word_set_intrusion(models, n_coders = 3, seed = 2026)
set_test$questions[1:2, .(model, topic, option_1, option_2, option_3, option_4)] model topic option_1
<char> <int> <char>
1: k10 1 fellow, duties, countrymen, support
2: k10 2 liberty, system, citizen, people
option_2 option_3
<char> <char>
1: confidence, united, country, people oath, principles, citizens, trust
2: united, executive, exercise, party rights, power, instrument, congress
option_4
<char>
1: union, nation, defense, war
2: citizens, children, time, centuryThe coder writes the chosen set (or its option number); scoring and plots are the same as for word intrusion.
Topic intrusion
Word intrusion validates the topics’ words. Analyses usually rely on something else: the topic proportions of each document \(\theta_{dk}\), which give prevalences and covariate effects. Topic intrusion (Chang et al. 2009) validates them. The coder reads an excerpt of a document and sees four topics, each described by its top words: the document’s three most probable topics and one topic drawn from the lower half of its proportions. The coder must find the topic that does not belong to the document.
texts <- paragraphs$text[match(names(stm_data$documents), paragraphs$id)]
topic_test <- make_topic_intrusion(models, texts, n_documents = 20, n_chars = 600, n_coders = 3, seed = 2026)
cat(topic_test$questions$excerpt[1], "\n\n")Having no pretensions to the high and commanding claims of my predecessors, whose names are so much more conspicuously identified with our Revolution, and who contributed so preeminently to promote its success, I consider myself rather as the instrument than the cause of the union which has prevailed in the late election In surmounting, in favor of my humble pretensions, the difficulties which so often produce division in like occurrences, it is obvious that other powerful causes, indicating the great strength and stability of our Union, have essentially contributed to draw you together. That [...]
topic_test$questions[1, .(model, option_1, option_2, option_3, option_4)] model option_1
<char> <char>
1: k10 fellow_citizens, discharge, fellow, station, trust, countrymen
option_2
<char>
1: slavery, union, supreme, south, sectional, suffrage
option_3
<char>
1: instrument, federal, federal_government, granted, acts, authority
option_4
<char>
1: peoples, economic, world, lives, era, leadershipTopic intrusion is scored by precision, as above, and by topic log odds (Chang et al. 2009). For document \(d\), with \(j^*\) the true intruder and \(j_s\) the topic chosen by coder \(s\),
\[ \mathrm{TLO}_d = \frac{1}{S}\sum_s \left(\log\hat\theta_{d,j^*} - \log\hat\theta_{d,j_s}\right) \le 0. \]
It is 0 when every coder finds the intruder, and very negative when coders choose a topic the model deems central to the document: a large disagreement between the model and the reader. Precision counts errors; topic log odds also weigh how serious they are.
topic_scores <- score_intrusion(topic_test, simulate_answers(topic_test, c(k10 = 0.75, k20 = 0.55), seed = 2))
topic_scores$models[, .(model, precision, ci_lower, ci_upper, chance, tlo)] model precision ci_lower ci_upper chance tlo
<char> <num> <num> <num> <num> <num>
1: k10 0.6833333 0.5576623 0.7869413 0.25 -0.8506123
2: k20 0.5333333 0.4089343 0.6537209 0.25 -2.1565185Long documents make long excerpts, and topics that occur late in a document may be absent from its excerpt: prefer models fitted on chunks or paragraphs, choose n_chars so that excerpts can be read in a minute, and tell coders that excerpts may be partial.
Reading the results
- Precision well above chance means that coders can tell a topic’s words (or a document’s topics) from the rest. It does not mean the topics are the ones you need: interpret them, read documents, and check that topics measure your concepts (Grimmer et al. 2022; Ying et al. 2022).
- Compare models with the same tasks, coders and settings; differences in precision smaller than the intervals are not evidence.
- Low-precision topics are candidates for being junk or mixed topics: look at them in the diagnostics of the previous guide.
- Report the design (tasks, number of topics and coders, instructions, how coders were recruited) and the results with the model.
References
Brennan, Robert L., and Dale J. Prediger. 1981. “Coefficient Kappa: Some Uses, Misuses, and Alternatives.” Educational and Psychological Measurement 41 (3): 687–99.
Chang, Jonathan, Jordan Boyd-Graber, Sean Gerrish, Chong Wang, and David M. Blei. 2009. “Reading Tea Leaves: How Humans Interpret Topic Models.” Advances in Neural Information Processing Systems 22, 288–96.
Fleiss, Joseph L. 1971. “Measuring Nominal Scale Agreement Among Many Raters.” Psychological Bulletin 76 (5): 378–82. https://doi.org/10.1037/h0031619.
Grimmer, Justin, Margaret E. Roberts, and Brandon M. Stewart. 2022. Text as Data: A New Framework for Machine Learning and the Social Sciences. Princeton University Press.
Grimmer, Justin, and Brandon M. Stewart. 2013. “Text as Data: The Promise and Pitfalls of Automatic Content Analysis Methods for Political Texts.” Political Analysis 21 (3): 267–97. https://doi.org/10.1093/pan/mps028.
Hoyle, Alexander, Pranav Goel, Andrew Hian-Cheong, Denis Peskov, Jordan Boyd-Graber, and Philip Resnik. 2021. “Is Automated Topic Model Evaluation Broken? The Incoherence of Coherence.” Advances in Neural Information Processing Systems 34.
Lau, Jey Han, David Newman, and Timothy Baldwin. 2014. “Machine Reading Tea Leaves: Automatically Evaluating Topic Coherence and Topic Model Quality.” Proceedings of the 14th Conference of the European Chapter of the Association for Computational Linguistics, 530–39.
Ying, Luwei, Jacob M. Montgomery, and Brandon M. Stewart. 2022. “Topics, Concepts, and Measurement: A Crowdsourced Procedure for Validating Topics as Measures.” Political Analysis 30 (4): 570–89. https://doi.org/10.1017/pan.2021.33.