library(mintR)
library(stm) # attached: stm's formulas use its s() for splines
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]
paragraphs[, era := factor(ifelse(Year < 1900, "before 1900", "since 1900"))]
tokens <- extract_ngrams(paragraphs, ngrams = 2L, document_col = "id")
stm_data <- tokens_to_stm(
filter_vocabulary(tokens, document_col = "id", min_documents = 5, verbose = FALSE),
meta = paragraphs[, .(id, Year, President, Party, era)],
document_col = "id"
)
fit <- stm(
stm_data$documents, stm_data$vocab, K = 15,
prevalence = ~ s(Year), data = stm_data$meta,
max.em.its = 75, verbose = FALSE
)A fitted model is two tables: for each topic, a probability for every word of the vocabulary (\(\beta\)); for each document, a proportion of every topic (\(\theta\)). Neither says what a topic is about. Interpreting them is the researcher’s work, and it should combine several views: the words of a topic, measured in several ways; the documents where it dominates; how it relates to the other topics; and how its prevalence varies with the metadata (Grimmer and Stewart 2013; Roberts et al. 2016). This guide shows the functions of mintR for each view, on the inaugural addresses of US presidents. The first guide builds the corpus and explains the model; reading a model does not replace validating it, which is the subject of validating topics with humans.
A first table
topic_summary() gives, for each topic, a label made of its most characteristic words (FREX, see below), its average prevalence (the mean of \(\theta_{dk}\) over documents, summing to 1 over topics) and the share of documents where it is the main topic. A topic can be prevalent because it is a small part of many documents, or because it dominates a few: the two columns tell them apart.
summary_table <- topic_summary(fit, n_terms = 4)
summary_table[, .(topic, label, prevalence = round(prevalence, 3), share_main = round(share_main, 3))] topic label prevalence
<int> <char> <num>
1: 8 8: peoples, era, world, ideals 0.147
2: 5 5: journey, americans, meaning, centuries 0.125
3: 14 14: tariff, business, currency, amendment 0.081
4: 2 2: american_people, chosen, popular, party 0.077
5: 7 7: counsel, purpose, life, common 0.064
6: 4 4: naval, countries, texas, resources 0.061
7: 12 12: federal_government, federal, constitution, granted 0.059
8: 1 1: oath, presence, chief, solemn 0.058
9: 11 11: territory, population, extended, trade 0.057
10: 3 3: earth, destiny, islands, destroy 0.056
11: 13 13: fellow_citizens, fellow, called, term 0.055
12: 6 6: international, relations, settlement, policy 0.052
13: 10 10: efforts, wise, credit, tasks 0.048
14: 9 9: voices, tax, taxes, revenue 0.042
15: 15 15: confederacy, possessed, effects, citizen 0.018
share_main
<num>
1: 0.189
2: 0.130
3: 0.091
4: 0.069
5: 0.055
6: 0.060
7: 0.060
8: 0.061
9: 0.052
10: 0.052
11: 0.049
12: 0.050
13: 0.040
14: 0.028
15: 0.013
The words of a topic
“Top words” can be measured in several ways, and each shows a different side of a topic:
-
probability (\(\beta_{kv}\),
"prob"): the most probable words, often shared with other topics; -
FREX (
"frex"; Bischof and Airoldi (2012), Roberts et al. (2014)): the harmonic mean of the rank of a word in the topic and of its exclusivity to the topic, \(\beta_{kv} / \sum_j \beta_{jv}\). The weightfrexwof frequency (0.5 by default, as instm::labelTopics(); stm’s exclusivity uses 0.7) moves the balance between frequency and exclusivity; -
score (
"score"): the probability weighted by how much the word’s log-probability exceeds its average over topics; -
lift (
"lift", Taddy (2012)): the probability in the topic divided by the frequency of the word in the corpus, which brings out rare and specific words.
topic_terms() puts one or several of them in one table, and topic_labels() gives the labels of stm::labelTopics().
top_terms <- topic_terms(fit, c("prob", "frex", "score", "lift"), n_terms = 6, stm_data = stm_data)
top_terms[topic == summary_table$topic[1], .(words = paste(term, collapse = ", ")), by = measure] measure words
<char> <char>
1: prob world, freedom, america, peace, free, hope
2: frex peoples, era, ideals, world, understanding, building
3: score peoples, america, star, world, ideals, story
4: lift adversaries, decency, drugs, heal, star, borders
labels <- topic_labels(fit, measure = "frex", n_terms = 4)The vocabulary here counts bigrams on top of single words, as in the first guide, so a label can contain both “fellow” and “fellow_citizens”. Building the vocabulary shows how to merge selected expressions into single tokens instead.
Lift needs the frequency of each word in the corpus, which term_counts() computes from the input of stm. With by, it counts within groups of documents defined by the metadata, which shows how the vocabulary itself changes, independently of the model:
counts_by_era <- term_counts(stm_data, by = "era")
counts_by_era[, head(.SD, 6), by = era] era term count
<fctr> <char> <num>
1: before 1900 government 369
2: before 1900 people 321
3: before 1900 country 204
4: before 1900 public 180
5: before 1900 constitution 178
6: before 1900 union 162
7: since 1900 world 235
8: since 1900 people 221
9: since 1900 government 207
10: since 1900 nation 168
11: since 1900 america 153
12: since 1900 freedom 128
The documents of a topic
Words are not enough: a topic is understood by reading the documents where it dominates. topic_documents() returns, for each topic, the documents with the highest \(\theta_{dk}\), optionally within groups (by) so that one period or one type of document does not take all the places. Two options help on corpora with repetitions or prolific authors: text_col drops duplicated texts and unique_col keeps one document per author. The documents with the highest proportion show a topic in its purest form, often with a narrow vocabulary; method = "sampled" draws instead among the documents the topic dominates, to see an ordinary clear case. Read both before naming a topic.
top_docs <- topic_documents(fit, stm_data$meta, n = 2, by = "era", document_col = "id")
top_docs[paragraphs, on = "id", text := i.text]
top_docs[topic == summary_table$topic[1], .(era, id, theta = round(theta, 2), text = paste0(substr(text, 1, 200), "..."))] era id theta
<char> <char> <num>
1: before 1900 1873_Grant_004 0.05
2: before 1900 1865_Lincoln_005 0.03
3: since 1900 1993_Clinton_013 0.93
4: since 1900 2005_Bush_003 0.91
text
<char>
1: It seemed to me wise that no new questions should be raised so long as that condition of affairs existed. Therefore the past four years, so far as I could control events, have been consumed in the eff...
2: With malice toward none, with charity for all, with firmness in the right as God gives us to see the right, let us strive on to finish the work we are in, to bind up the nation's wounds, to care for h...
3: To renew America we must meet challenges abroad, as well as at home. There is no longer a clear division between what is foreign and what is domestic. The world economy, the world environment, the wor...
4: We have seen our vulnerability, and we have seen its deepest source. For as long as whole regions of the world simmer in resentment and tyranny, prone to ideologies that feed hatred and excuse murder,...
Words of interest
A study often starts from a theme rather than from the topics: which topics are about war? topic_word_mass() sums, in each topic, the probability of the words matching a pattern. The words of a bigram are joined by _ in the vocabulary; a space in the pattern is replaced by _, with a warning.
topic_word_mass(fit, "^(war|wars|army|navy|military|enemy|peace)$", n_terms = 4)[1:4] topic mass top_terms
<int> <num> <char>
1: 4 0.06687637 war, peace, wars, military
2: 6 0.03766820 peace, war, navy, army
3: 3 0.03276615 war, peace, military, army
4: 8 0.02337937 peace, war, enemy, wars
Relations between topics
topic_correlation() correlates the proportions of the topics over documents (the simple method of stm::topicCorr()): two topics that appear in the same paragraphs correlate positively. Since the proportions of a document sum to one, most correlations are slightly negative; the positive ones point to topics that are discussed together.
correlations <- topic_correlation(fit)
correlations[labels, on = c(topic_a = "topic"), label_a := i.label]
correlations[labels, on = c(topic_b = "topic"), label_b := i.label]
correlations[1:5, .(label_a, label_b, correlation = round(correlation, 2))] label_a
<char>
1: 1: oath, presence, chief, solemn
2: 5: journey, americans, meaning, centuries
3: 12: federal_government, federal, constitution, granted
4: 3: earth, destiny, islands, destroy
5: 2: american_people, chosen, popular, party
label_b correlation
<char> <num>
1: 13: fellow_citizens, fellow, called, term 0.16
2: 8: peoples, era, world, ideals 0.08
3: 15: confederacy, possessed, effects, citizen 0.03
4: 8: peoples, era, world, ideals 0.02
5: 14: tariff, business, currency, amendment 0.01
heat <- rbind(correlations, correlations[, .(topic_a = topic_b, topic_b = topic_a, correlation, label_a = label_b, label_b = label_a)])
ggplot(heat, aes(factor(topic_a), factor(topic_b), fill = correlation)) +
geom_tile() +
scico::scale_fill_scico(palette = "vik", midpoint = 0) +
labs(x = "Topic", y = "Topic", fill = "Correlation") +
theme_minimal(base_size = 12)Prevalence by group and over time
plot_topic_prevalence() shows the average prevalence of each topic. topic_prevalence_by() gives the mean proportion of each topic within groups of documents, here before and since 1900. It is purely descriptive: nothing is modelled or smoothed, and documents can be weighted (e.g. by their length).
plot_topic_prevalence(fit, labels, base_size = 12)
by_era <- topic_prevalence_by(fit$theta, stm_data$meta, by = "era")
by_era <- dcast(by_era, topic ~ era, value.var = "prevalence")
by_era[labels, on = "topic", label := i.label][order(-abs(`since 1900` - `before 1900`))][1:5] topic before 1900 since 1900
<int> <num> <num>
1: 8 0.002353856 0.25097057
2: 5 0.007638517 0.20911879
3: 12 0.118889497 0.01498853
4: 13 0.105615386 0.01840586
5: 1 0.102297528 0.02575070
label
<char>
1: 8: peoples, era, world, ideals
2: 5: journey, americans, meaning, centuries
3: 12: federal_government, federal, constitution, granted
4: 13: fellow_citizens, fellow, called, term
5: 1: oath, presence, chief, solemn
With a prevalence covariate, stm::estimateEffect() regresses the topic proportions on the metadata, taking the uncertainty of \(\theta\) into account (Roberts et al. 2019). topic_effects() turns its simulations into a table (expected proportions over a numeric covariate or at each level of a categorical one, or differences between two values), and plot_topic_prevalence_over_time() draws the expected proportions with their intervals.
set.seed(1)
effects <- estimateEffect(1:15 ~ s(Year), fit, metadata = stm_data$meta, uncertainty = "Global")
plot_topic_prevalence_over_time(effects, labels, covariate = "Year", n_sims = 200, wrap_width = 25, base_size = 11)Models with a content covariate
A content covariate lets the words of a topic vary with the metadata: the same topic is expressed with different words before and after 1900. The model then has one word distribution per topic and level, and most functions reading words (topic_labels(), topic_terms(), topic_word_mass(), the metrics) need a single one, and stop with an error on a content model. marginal_topic_model() averages the levels’ distributions, each weighted by its share of the corpus tokens, \(\beta_{kv} = \sum_a \pi_a \beta^{a}_{kv}\).
fit_content <- stm(
stm_data$documents, stm_data$vocab, K = 15,
prevalence = ~ s(Year), content = ~ era, data = stm_data$meta,
max.em.its = 50, verbose = FALSE
)
marginal <- marginal_topic_model(fit_content, stm_data$documents, stm_data$meta$era)
topic_labels(marginal, measure = "prob", n_terms = 5)[1:5] topic label
<int> <char>
1: 1 1: country, responsibility, oath, office, duties
2: 2 2: people, government, american, power, american_people
3: 3 3: union, free, earth, happy, destiny
4: 4 4: peace, nations, war, united, foreign
5: 5 5: nation, americans, time, century, occasion
The distributions of each level remain in fit_content$beta$logbeta, one matrix per level, to compare how a topic is worded in each period.
Where next
-
Choosing a topic model gives diagnostics per topic (coherence, exclusivity) with
topic_diagnostics(). - Validating topics with humans turns the reading of topics into measured tests.
