Finding speeches unlike the rest

Cosine-distance rankings and speech length

signals and discovery
outlier detection
inaugural addresses
Learn how outlier detection depends on the text representation and why length belongs beside distance.

Owen has one shelf for speeches that deserve closer reading. He asks for the addresses most unlike the rest, expecting a neutral ranking.

An outlier is a case with a large measured distance from other cases. Different text features can produce different distances. Very short documents can appear unusual because their small vocabularies provide little information for the average.

TipWhat you will learn

This lesson shows how to:

  • build speech-level document-feature matrices.
  • compute cosine distance from the average speech.
  • report word length next to distance.
  • measure the association between distance and length.
  • compare rank agreement with a random baseline that keeps document lengths fixed.

Build the representations

A representation records the text features available to a method. The first representation retains content-word counts after stopword removal. The second applies tf-idf weights to those content words. The third retains raw counts for all words.

Cosine distance compares the direction of two word-count vectors. A value closer to 1 indicates greater distance from the average vector.

library(dplyr)
library(tibble)
library(quanteda)
library(proxy)

source("R/inaugural-corpus.R")
source("R/permutation-null.R")

paragraphs <- inaugural_paragraphs()

speeches <- paragraphs |>
  summarise(text = paste(paragraph, collapse = "\n"), .by = c(speech_id, year, president, party))

make_speech_dfm <- function(remove_stops = TRUE) {
  speech_tokens <- tokens(
    speeches$text,
    remove_punct = TRUE,
    remove_numbers = TRUE
  ) |>
    tokens_tolower()

  if (remove_stops) {
    speech_tokens <- tokens_remove(speech_tokens, stopwords("en"))
  }

  speech_dfm <- dfm(speech_tokens)
  docnames(speech_dfm) <- speeches$speech_id
  speech_dfm
}

cosine_from_matrix <- function(matrix_counts) {
  average_speech <- colMeans(matrix_counts)
  numerator <- as.numeric(matrix_counts %*% average_speech)
  denominator <- sqrt(rowSums(matrix_counts * matrix_counts)) * sqrt(sum(average_speech * average_speech))
  1 - numerator / denominator
}

cosine_from_average <- function(speech_dfm) {
  cosine_from_matrix(as.matrix(speech_dfm))
}

content_dfm <- make_speech_dfm(remove_stops = TRUE)
content_tfidf_dfm <- dfm_tfidf(content_dfm)
all_words_dfm <- make_speech_dfm(remove_stops = FALSE)

lengths <- tibble(
  speech_id = speeches$speech_id,
  year = speeches$year,
  president = speeches$president,
  total_words = ntoken(all_words_dfm),
  content_words = ntoken(content_dfm)
)

shortest_speech <- lengths |>
  slice_min(total_words, n = 1, with_ties = FALSE)

representation_summary <- tibble(
  representation = c("Content words, raw counts", "Content words, tf-idf", "All words, raw counts"),
  documents = c(ndoc(content_dfm), ndoc(content_tfidf_dfm), ndoc(all_words_dfm)),
  features = c(nfeat(content_dfm), nfeat(content_tfidf_dfm), nfeat(all_words_dfm))
)
Three speech representations for outlier detection
Representation Documents Features
Content words, raw counts 60 9193
Content words, tf-idf 60 9193
All words, raw counts 60 9327

Cosine distance compares direction rather than raw size. Length still matters because very short speeches can have unusual word mixes.

Rank distance from the average

The next table uses content words with raw counts. It shows the most distant speeches and the closest speeches under that one representation.

content_rank <- lengths |>
  mutate(
    distance = cosine_from_average(content_dfm),
    representation = "content words, raw counts"
  ) |>
  arrange(desc(distance))

most_typical <- content_rank |>
  arrange(distance) |>
  slice_head(n = 5) |>
  mutate(group = "Least distant")

most_distant <- content_rank |>
  slice_head(n = 5) |>
  mutate(group = "Most distant")

rank_table <- bind_rows(most_distant, most_typical) |>
  transmute(
    group,
    speech_id,
    year,
    president,
    total_words,
    content_words,
    shortest_in_corpus = if_else(total_words == min(lengths$total_words), "yes", "no"),
    distance = round(distance, 3)
  )
Most and least distant speeches using content-word raw counts
Group Speech Year President Total words Content words Shortest in corpus Cosine distance
Most distant 1793-Washington 1793 George Washington 135 62 yes 0.677
Most distant 2021-Biden 2021 Joseph R. Biden 407 188 no 0.639
Most distant 1865-Lincoln 1865 Abraham Lincoln 698 338 no 0.605
Most distant 2017-Trump 2017 Donald J. Trump 713 346 no 0.601
Most distant 1945-Roosevelt 1945 Franklin D. Roosevelt 511 238 no 0.600
Least distant 1897-McKinley 1897 William McKinley 3960 1931 no 0.235
Least distant 1841-Harrison 1841 William Henry Harrison 8446 3796 no 0.247
Least distant 1925-Coolidge 1925 Calvin Coolidge 4053 1879 no 0.255
Least distant 1881-Garfield 1881 James A. Garfield 2951 1430 no 0.263
Least distant 1845-Polk 1845 James Knox Polk 4802 2263 no 0.276

The 1793-Washington speech is most distant under this representation. It is also the shortest speech, with 135 total words. Its ranking can depend on only a few words because it has a small vocabulary.

Examine the length confound

A confound is a second factor that can explain a result the analyst might otherwise attribute to the method’s target. Here the candidate confound is document length.

tfidf_rank <- lengths |>
  mutate(
    distance = cosine_from_average(content_tfidf_dfm),
    representation = "content words, tf-idf"
  ) |>
  arrange(desc(distance))

all_words_rank <- lengths |>
  mutate(
    distance = cosine_from_average(all_words_dfm),
    representation = "all words, raw counts"
  ) |>
  arrange(desc(distance))

all_rankings <- bind_rows(content_rank, tfidf_rank, all_words_rank)

length_correlations <- all_rankings |>
  summarise(
    correlation = round(cor(total_words, distance), 3),
    .by = representation
  )

length_threshold <- 1000L

restricted_top <- all_rankings |>
  filter(total_words >= length_threshold) |>
  arrange(desc(distance), .by_group = TRUE) |>
  slice_head(n = 5, by = representation) |>
  transmute(
    representation,
    speech_id,
    year,
    total_words,
    distance = round(distance, 3)
  )
Distance is strongly related to speech length
Representation Correlation between total words and distance
content words, raw counts -0.738
content words, tf-idf -0.908
all words, raw counts -0.534
Top outliers after restricting to speeches with at least 1,000 words
Representation Speech Year Total words Cosine distance
content words, tf-idf 1813-Madison 1813 1152 0.805
content words, tf-idf 1965-Johnson 1965 1362 0.782
content words, tf-idf 1941-Roosevelt 1941 1118 0.781
content words, tf-idf 1977-Carter 1977 1185 0.778
content words, tf-idf 1789-Washington 1789 1420 0.769
content words, raw counts 1813-Madison 1813 1152 0.554
content words, raw counts 1809-Madison 1809 1175 0.503
content words, raw counts 1941-Roosevelt 1941 1118 0.494
content words, raw counts 1961-Kennedy 1961 1320 0.471
content words, raw counts 1849-Taylor 1849 1088 0.451
all words, raw counts 2001-Bush 2001 1289 0.146
all words, raw counts 1977-Carter 1977 1185 0.128
all words, raw counts 2025-Trump 2025 2555 0.124
all words, raw counts 1993-Clinton 1993 1568 0.115
all words, raw counts 1973-Nixon 1973 1491 0.112

The correlations are negative under all three representations. They are -0.738 for content-word counts, -0.908 for content-word tf-idf, and -0.534 for all-word counts. Shorter speeches tend to have greater distances from the average. The analysis excludes speeches under 1,000 words, which removes 1793-Washington and 2021-Biden from the top lists. The outlier ranking therefore reflects speech length to a substantial degree.

Compare the feature choices with a null

The comparison uses tf-idf weights and a separate raw-count representation that retains stopwords. The representations differ in weighting rule and feature set. A rank agreement statistic measures whether the three distance rankings place speeches in similar order.

The random baseline draws new word counts while keeping each speech’s content-word and all-word totals fixed. Word probabilities come from the corresponding corpus-wide counts. The code draws the content-word and all-word matrices separately. Both the raw-count and tf-idf rankings use the same content-word matrix. The code compares all three rankings and repeats this process 500 times.

The p-value adds 1 to the number of random agreements at least as large as the observed agreement. It then divides that sum by the number of random agreements plus 1.

feature_comparison <- all_rankings |>
  slice_head(n = 5, by = representation) |>
  transmute(
    representation,
    speech_id,
    year,
    president,
    total_words,
    content_words,
    distance = round(distance, 3)
  )

shared_content_tfidf <- length(intersect(
  content_rank$speech_id[1:5],
  tfidf_rank$speech_id[1:5]
))

shared_content_all <- length(intersect(
  content_rank$speech_id[1:5],
  all_words_rank$speech_id[1:5]
))

rank_agreement <- function(distance_data) {
  mean(c(
    cor(distance_data$content_raw, distance_data$content_tfidf, method = "spearman"),
    cor(distance_data$content_raw, distance_data$all_words, method = "spearman"),
    cor(distance_data$content_tfidf, distance_data$all_words, method = "spearman")
  ))
}

observed_distances <- lengths |>
  transmute(
    speech_id,
    content_raw = cosine_from_average(content_dfm),
    content_tfidf = cosine_from_average(content_tfidf_dfm),
    all_words = cosine_from_average(all_words_dfm)
  )

observed_rank_agreement <- rank_agreement(observed_distances)

tfidf_matrix <- function(matrix_counts) {
  document_frequency <- colSums(matrix_counts > 0)
  idf <- log(nrow(matrix_counts) / pmax(document_frequency, 1))
  sweep(matrix_counts, 2, idf, `*`)
}

random_matrix <- function(length_vector, probabilities) {
  t(vapply(length_vector, function(one_length) {
    as.numeric(rmultinom(n = 1L, size = one_length, prob = probabilities))
  }, numeric(length(probabilities))))
}

content_matrix <- as.matrix(content_dfm)
all_words_matrix <- as.matrix(all_words_dfm)
content_lengths <- rowSums(content_matrix)
all_words_lengths <- rowSums(all_words_matrix)
content_probabilities <- colSums(content_matrix)
all_words_probabilities <- colSums(all_words_matrix)

rank_agreement_null <- permutation_null(
  observed = observed_rank_agreement,
  replicate_fn = function() {
    random_content <- random_matrix(content_lengths, content_probabilities)
    random_all_words <- random_matrix(all_words_lengths, all_words_probabilities)

    random_distances <- tibble(
      content_raw = cosine_from_matrix(random_content),
      content_tfidf = cosine_from_matrix(tfidf_matrix(random_content)),
      all_words = cosine_from_matrix(random_all_words)
    )

    rank_agreement(random_distances)
  },
  replicates = 500L,
  seed = 5702L,
  alternative = "greater"
)

rank_agreement_display <- rank_agreement_null |>
  mutate(across(c(observed, null_mean, null_low, null_high, p_value), \(x) round(x, 3)))
Top five outliers across three representations
Representation Speech Year President Total words Content words Cosine distance
content words, raw counts 1793-Washington 1793 George Washington 135 62 0.677
content words, raw counts 2021-Biden 2021 Joseph R. Biden 407 188 0.639
content words, raw counts 1865-Lincoln 1865 Abraham Lincoln 698 338 0.605
content words, raw counts 2017-Trump 2017 Donald J. Trump 713 346 0.601
content words, raw counts 1945-Roosevelt 1945 Franklin D. Roosevelt 511 238 0.600
content words, tf-idf 1793-Washington 1793 George Washington 135 62 0.913
content words, tf-idf 2021-Biden 2021 Joseph R. Biden 407 188 0.873
content words, tf-idf 1865-Lincoln 1865 Abraham Lincoln 698 338 0.839
content words, tf-idf 2017-Trump 2017 Donald J. Trump 713 346 0.833
content words, tf-idf 1945-Roosevelt 1945 Franklin D. Roosevelt 511 238 0.830
all words, raw counts 1793-Washington 1793 George Washington 135 62 0.188
all words, raw counts 2021-Biden 2021 Joseph R. Biden 407 188 0.167
all words, raw counts 2001-Bush 2001 George W. Bush 1289 635 0.146
all words, raw counts 2017-Trump 2017 Donald J. Trump 713 346 0.144
all words, raw counts 1945-Roosevelt 1945 Franklin D. Roosevelt 511 238 0.142
Random baseline for rank agreement with fixed document lengths
Observed Null mean Null low Null high p-value Replicates Alternative
0.77 0.953 0.939 0.966 1 500 greater

Content-word raw counts and content-word tf-idf share all five top speeches. The representation with stopwords shares four of five with content-word raw counts. Its third-ranked speech is 2001-Bush rather than 1865-Lincoln. The average Spearman rank agreement across the three full rankings is 0.770.

Random feature allocation with fixed document lengths gives a null mean of 0.953 and a 90% interval from 0.939 to 0.966. The observed agreement does not exceed that random baseline (p = 1). Agreement across representations therefore provides insufficient evidence by itself.

Outlier methods always rank one item first. The randomization removes document-specific word patterns while preserving document lengths. It compares agreement across representations with agreement from random features. The observed agreement does not exceed that null. Document length still confounds the shortest-speech result, which requires closer reading.

What to remember

  • Cosine distance ranks each speech against the average vector.
  • The content-word representations have 9,193 features. The all-word representation has 9,327.
  • Under content-word raw counts, 1793-Washington is farthest and 1897-McKinley is closest to the average.
  • Distance is strongly associated with length here. The shortest speeches occupy the highest ranks.
  • The observed rank agreement does not exceed agreement from random word counts with fixed document lengths.

Use outlier scores to choose what to read next. Interpret each ranking in relation to its selected features.

Sources