Finding speeches unlike the rest

Rank cosine distance and test 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.

The ranking arrives with a catch. An outlier is a case that looks far from other cases under a chosen measurement. For text, changing the features can change what looks far away, and very short documents can look strange because they have little vocabulary to 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;
  • test how much distance tracks length; and
  • compare rank agreement with a shuffled-feature null.

Build the representations

A representation is the version of the text that a method sees. Here one representation keeps content words after removing stopwords, another gives those content words tf-idf weights, and a third keeps all words as raw counts. Cosine distance compares the direction of two word-count vectors. A value closer to 1 means farther 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 the most distant under this representation, and it is the shortest speech at 135 total words. A 135-word document has little vocabulary to average, so a handful of words can drive its position.

Check 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: -0.738 for content-word counts, -0.908 for content-word tf-idf, and -0.534 for all-word counts. Shorter speeches tend to sit farther from the average. Once speeches under 1,000 words are removed, 1793-Washington and 2021-Biden leave the top lists. The outlier ranking is substantially a length ranking.

Compare the feature choices with a null

Now add tf-idf weights and then keep stopwords in a separate raw-count representation. This changes both the weighting rule and the feature set. A rank agreement statistic checks whether the three distance rankings put speeches in similar order.

A permutation null reruns the rank-agreement calculation after feature counts are randomized. The p-value is the fraction of shuffled agreements that are at least as large as the observed agreement.

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
Permutation null for rank agreement across representations
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. Keeping stopwords shares four of five with content-word raw counts and changes the third slot from 1865-Lincoln to 2001-Bush. The average Spearman rank agreement across the three full rankings is 0.770. When document lengths are held fixed but features are randomly reassigned, the null mean is 0.953 with a 90% interval from 0.939 to 0.966. The observed agreement does not exceed that shuffled-feature null (p = 1). Cross-representation agreement is therefore not reassuring by itself.

Outlier methods always rank something first. The shuffle removes document-specific word patterns while preserving lengths, so it asks whether the three representations agree more than feature noise would. They do not. The shortest-speech result remains a length-confounded reading lead.

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 tied to length here; the shortest speeches drive the top of the list.
  • The three representation rankings do not agree more than shuffled features predict after lengths are fixed.

Use outlier scores to choose what to read next. Do not treat the ranking as a property of the speech apart from the features you chose.

Sources