Finding similar documents

Nearest neighbours depend on the representation

similarity
document similarity
inaugural addresses
Learn how speech-level document similarity changes under raw counts, tf-idf, and stopword removal.

A reading group wants a companion speech similar to a selected address. A similarity method can compare word counts, rare-word weights, or features with common words removed. Each representation gives a different comparison.

Document similarity is a score that compares the features of two documents. The score is meaningful only if those features address the research question.

TipWhat you will learn

This lesson shows how to:

  • build speech-level document-feature matrices
  • compute cosine similarity across 60 speeches
  • list the most and least similar pairs under tf-idf
  • show that nearest neighbours change when features change
  • compare an authorship pattern with shuffled labels
  • notice when document length is part of the signal.

Build speech vectors

Tf-idf stands for term frequency times inverse document frequency. It retains words from each speech. It gives more weight to words that are less common across the full set of speeches.

library(dplyr)
library(tibble)
library(purrr)
library(stringr)
library(quanteda)
library(quanteda.textstats)

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

within_tolerance <- function(observed, expected, tolerance = 1e-3) {
  abs(observed - expected) < tolerance
}

paragraphs <- inaugural_paragraphs()

original_speeches <- tibble(
  speech_id = names(quanteda::data_corpus_inaugural),
  year = as.integer(quanteda::data_corpus_inaugural$Year),
  surname = as.character(quanteda::data_corpus_inaugural$President),
  first_name = as.character(quanteda::data_corpus_inaugural$FirstName),
  party = as.character(quanteda::data_corpus_inaugural$Party),
  text = as.character(quanteda::data_corpus_inaugural)
) |>
  mutate(
    president = str_squish(paste(first_name, surname)),
    era = factor(
      if_else(year < 1900, "before 1900", "1900 or later"),
      levels = c("before 1900", "1900 or later")
    ),
    original_words = str_count(text, "\\S+")
  )

retained_by_speech <- paragraphs |>
  group_by(speech_id) |>
  summarise(retained_words = sum(paragraph_words), .groups = "drop")

paragraph_era_summary <- paragraphs |>
  group_by(era) |>
  summarise(median_kept_paragraph_words = median(paragraph_words), .groups = "drop")

retention_by_era <- original_speeches |>
  select(speech_id, era, original_words) |>
  left_join(retained_by_speech, by = "speech_id") |>
  mutate(retained_words = coalesce(retained_words, 0L)) |>
  group_by(era) |>
  summarise(
    speeches = n(),
    original_words = sum(original_words),
    retained_words = sum(retained_words),
    share_retained = retained_words / original_words,
    .groups = "drop"
  ) |>
  left_join(paragraph_era_summary, by = "era")

speeches <- paragraphs |>
  group_by(speech_id, year, president, surname, party, era) |>
  summarise(
    text = paste(paragraph, collapse = "\n"),
    speech_tokens = sum(paragraph_words),
    .groups = "drop"
  )

make_speech_dfm <- function(remove_stops = FALSE, tfidf = FALSE) {
  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

  if (tfidf) {
    speech_dfm <- dfm_tfidf(speech_dfm)
  }

  speech_dfm
}

raw_dfm <- make_speech_dfm(remove_stops = FALSE, tfidf = FALSE)
tfidf_dfm <- make_speech_dfm(remove_stops = FALSE, tfidf = TRUE)
tfidf_no_stop_dfm <- make_speech_dfm(remove_stops = TRUE, tfidf = TRUE)

representation_table <- tibble(
  representation = c("raw counts", "tf-idf", "tf-idf with stopwords removed"),
  documents = c(ndoc(raw_dfm), ndoc(tfidf_dfm), ndoc(tfidf_no_stop_dfm)),
  features = c(nfeat(raw_dfm), nfeat(tfidf_dfm), nfeat(tfidf_no_stop_dfm))
)

surname_collisions <- speeches |>
  distinct(president, surname) |>
  count(surname, name = "people") |>
  filter(people > 1L) |>
  arrange(surname)

identity_table <- tibble(
  item = c("speeches", "people", "surnames", "surnames used by two people"),
  value = c(nrow(speeches), n_distinct(speeches$president), n_distinct(speeches$surname), nrow(surname_collisions))
)
Three speech representations used for similarity comparisons
Representation Documents Features
raw counts 60 9327
tf-idf 60 9327
tf-idf with stopwords removed 60 9193
Words retained after rebuilding speeches from paragraphs of at least 25 words
Era Speeches Original words Retained words Share retained Median kept paragraph words
before 1900 28 71961 71800 0.998 112
1900 or later 32 69032 63106 0.914 54
The corpus has 60 speeches by 40 people but only 36 surnames
Item Count
speeches 60
people 40
surnames 36
surnames used by two people 4

The helper rebuilds each speech by joining only paragraphs with at least 25 words. The “speeches” below therefore contain only retained paragraphs. The filter keeps nearly all words before 1900 and a smaller share from 1900 or later. The president field is the full name: 60 speeches come from 40 people, while four surnames each refer to two people.

Comparing every speech with every other speech gives 1,770 pairs, because 60 * 59 / 2 = 1,770.

Rank all speech pairs

Cosine similarity ranges from 0 to 1 for these nonnegative vectors. Larger values mean the two speech vectors have more similar directions.

cosine_matrix <- function(speech_dfm) {
  similarity_matrix <- as.matrix(
    textstat_simil(speech_dfm, method = "cosine", margin = "documents")
  )
  diag(similarity_matrix) <- NA_real_
  similarity_matrix
}

cosine_pairs <- function(speech_dfm) {
  similarity_matrix <- cosine_matrix(speech_dfm)
  pair_index <- which(upper.tri(similarity_matrix), arr.ind = TRUE)

  tibble(
    first = rownames(similarity_matrix)[pair_index[, 1]],
    second = colnames(similarity_matrix)[pair_index[, 2]],
    similarity = similarity_matrix[pair_index]
  ) |>
    left_join(
      speeches |> select(first = speech_id, first_year = year, first_president = president, first_tokens = speech_tokens),
      by = "first"
    ) |>
    left_join(
      speeches |> select(second = speech_id, second_year = year, second_president = president, second_tokens = speech_tokens),
      by = "second"
    )
}

tfidf_pairs <- cosine_pairs(tfidf_dfm) |>
  arrange(desc(similarity), first, second)

most_similar_pairs <- tfidf_pairs |>
  slice_head(n = 5) |>
  mutate(group = "Most similar")

least_similar_pairs <- tfidf_pairs |>
  arrange(similarity, first, second) |>
  slice_head(n = 5) |>
  mutate(group = "Least similar")

pair_table <- bind_rows(most_similar_pairs, least_similar_pairs) |>
  transmute(
    group,
    first,
    second,
    first_president,
    second_president,
    first_tokens,
    second_tokens,
    similarity = round(similarity, 4)
  )

least_with_short_washington <- least_similar_pairs |>
  filter(first == "1793-Washington" | second == "1793-Washington") |>
  nrow()
Most and least similar speech pairs under speech-level tf-idf
Group First speech Second speech First president Second president First tokens Second tokens Cosine similarity
Most similar 1817-Monroe 1821-Monroe James Monroe James Monroe 3373 4470 0.2903
Most similar 1837-VanBuren 1841-Harrison Martin Van Buren William Henry Harrison 3846 8465 0.2471
Most similar 1897-McKinley 1909-Taft William McKinley William Howard Taft 3973 5430 0.2454
Most similar 1841-Harrison 1845-Polk William Henry Harrison James Knox Polk 8465 4810 0.2438
Most similar 1825-Adams 1845-Polk John Quincy Adams James Knox Polk 2920 4810 0.2365
Least similar 1793-Washington 1905-Roosevelt George Washington Theodore Roosevelt 135 984 0.0066
Least similar 1793-Washington 2021-Biden George Washington Joseph R. Biden 135 412 0.0073
Least similar 1793-Washington 1941-Roosevelt George Washington Franklin D. Roosevelt 135 1143 0.0074
Least similar 1829-Jackson 2021-Biden Andrew Jackson Joseph R. Biden 1130 412 0.0075
Least similar 1793-Washington 1913-Wilson George Washington Woodrow Wilson 135 1699 0.0095

The strongest pair under this representation is the two Monroe speeches, with cosine similarity about 0.2903. Four of the five weakest rows include the short 1793 Washington speech, which has 135 retained tokens. The speech’s short length explains its low ranking. The ranking does not establish a difference in subject matter.

tfidf_similarity_matrix <- cosine_matrix(tfidf_dfm)

mean_tfidf_similarity <- tibble(
  speech_id = rownames(tfidf_similarity_matrix),
  mean_similarity = rowMeans(tfidf_similarity_matrix, na.rm = TRUE)
) |>
  left_join(speeches |> select(speech_id, speech_tokens), by = "speech_id")

length_similarity_table <- mean_tfidf_similarity |>
  summarise(
    measure = "Mean tf-idf similarity and speech token count",
    correlation = cor(mean_similarity, speech_tokens)
  )
Mean tf-idf similarity compared with speech token count
Measure Correlation
Mean tf-idf similarity and speech token count 0.861

Mean tf-idf similarity still correlates strongly with speech length. Tf-idf changes the representation, but it does not remove the relationship with length from this corpus.

Change the representation

A nearest neighbour is the highest-scoring other document. The code below compares raw counts, tf-idf, and tf-idf without stopwords for the 1793 Washington speech. Stopwords are common words that an analysis excludes.

nearest_for <- function(speech_dfm, target) {
  similarity_matrix <- cosine_matrix(speech_dfm)
  target_scores <- similarity_matrix[target, ]
  target_scores[target] <- NA_real_

  tibble(
    neighbour = names(target_scores),
    similarity = as.numeric(target_scores)
  ) |>
    arrange(desc(similarity), neighbour) |>
    slice_head(n = 1)
}

target_speech <- "1793-Washington"
nearest_table <- bind_rows(
  nearest_for(raw_dfm, target_speech) |>
    mutate(representation = "raw counts"),
  nearest_for(tfidf_dfm, target_speech) |>
    mutate(representation = "tf-idf"),
  nearest_for(tfidf_no_stop_dfm, target_speech) |>
    mutate(representation = "tf-idf, stopwords removed")
) |>
  left_join(
    speeches |> select(neighbour = speech_id, year, president, speech_tokens),
    by = "neighbour"
  ) |>
  transmute(
    target = target_speech,
    representation,
    neighbour,
    year,
    president,
    speech_tokens,
    similarity = round(similarity, 4)
  )
One target speech gets three nearest neighbours under three representations
Target Representation Nearest neighbour Year President Neighbour tokens Cosine similarity
1793-Washington raw counts 1841-Harrison 1841 William Henry Harrison 8465 0.8474
1793-Washington tf-idf 1861-Lincoln 1861 Abraham Lincoln 3617 0.0552
1793-Washington tf-idf, stopwords removed 1885-Cleveland 1885 Grover Cleveland 1687 0.0512

The three answers differ. The raw-count neighbour for the shortest speech is the longest retained speech, and the score is about 0.8474. Shared high-frequency words and length dominate the raw-count comparison. Do not interpret the raw-count score as evidence of matching topics.

nearest_all <- function(speech_dfm) {
  similarity_matrix <- cosine_matrix(speech_dfm)

  map_dfr(
    rownames(similarity_matrix),
    function(target) {
      scores <- similarity_matrix[target, ]
      tibble(
        target,
        neighbour = names(scores)[which.max(scores)],
        similarity = max(scores, na.rm = TRUE)
      )
    }
  ) |>
    left_join(
      speeches |> select(target = speech_id, target_president = president, target_surname = surname),
      by = "target"
    ) |>
    left_join(
      speeches |> select(neighbour = speech_id, neighbour_president = president, neighbour_surname = surname),
      by = "neighbour"
    ) |>
    mutate(
      same_president = target_president == neighbour_president,
      same_surname = target_surname == neighbour_surname
    )
}

raw_neighbours <- nearest_all(raw_dfm)
raw_hub_table <- raw_neighbours |>
  count(neighbour, name = "nearest_neighbour_count", sort = TRUE) |>
  slice_head(n = 10)

harrison_hub_count <- raw_neighbours |>
  filter(neighbour == "1841-Harrison") |>
  nrow()
How often each speech is the nearest neighbour under raw counts
Raw-count nearest neighbour Number of target speeches
1985-Reagan 7
1925-Coolidge 6
1897-McKinley 4
1953-Eisenhower 4
1845-Polk 3
1853-Pierce 3
1877-Hayes 3
1889-Harrison 3
1909-Taft 3
1817-Monroe 2

The raw-count comparison does not show that 1841-Harrison is a corpus-wide hub. A hub is the nearest neighbour for many other documents. 1841-Harrison is the nearest neighbour for two speeches. Several other speeches are nearest neighbours for many targets under raw counts. This pattern also indicates that shared common words dominate the comparison, rather than distinctive vocabulary.

Separate vocabulary signal from authorship signal

When one person has more than one address in the corpus, repeated phrasing can make those speeches neighbours. That can be useful for authorship or style questions and distracting for topic questions.

tfidf_neighbours <- nearest_all(tfidf_dfm)
same_president_count <- sum(tfidf_neighbours$same_president)

authorship_examples <- tfidf_neighbours |>
  filter(same_president) |>
  arrange(desc(similarity), target) |>
  slice_head(n = 6) |>
  transmute(
    target,
    neighbour,
    president = target_president,
    similarity = round(similarity, 4)
  )

same_president_observed <- tfidf_pairs |>
  filter(first_president == second_president) |>
  summarise(mean_similarity = mean(similarity)) |>
  pull(mean_similarity)

author_labels <- speeches$president
names(author_labels) <- speeches$speech_id

same_president_null <- permutation_null(
  observed = same_president_observed,
  replicate_fn = function() {
    shuffled_labels <- sample(author_labels)
    names(shuffled_labels) <- names(author_labels)
    tfidf_pairs |>
      filter(shuffled_labels[first] == shuffled_labels[second]) |>
      summarise(mean_similarity = mean(similarity)) |>
      pull(mean_similarity)
  },
  replicates = 1000L,
  seed = 6002L,
  alternative = "greater"
)
Examples where a speech’s nearest tf-idf neighbour has the same president
Target Nearest neighbour President Cosine similarity
1817-Monroe 1821-Monroe James Monroe 0.2903
1821-Monroe 1817-Monroe James Monroe 0.2903
2009-Obama 2013-Obama Barack Obama 0.2043
2013-Obama 2009-Obama Barack Obama 0.2043
1993-Clinton 1997-Clinton Bill Clinton 0.2026
1997-Clinton 1993-Clinton Bill Clinton 0.2026
Same-president tf-idf similarity compared with shuffled author labels
Observed Null mean Null 5th pct Null 95th pct p-value Replicates Alternative
0.128 0.081 0.068 0.095 0.001 1000 greater

Under tf-idf, 19 of the 60 speeches have a nearest neighbour by the same person. The null comparison uses randomly rearranged author labels. Same-person pairs are more similar than this chance comparison predicts in this corpus. The result is evidence of repeated wording or style, not proof that the speeches discuss the same subjects.

What to remember

  • Document similarity compares representations, not documents in the abstract.
  • Speech-level tf-idf gives 1,770 pairwise comparisons for 60 speeches.
  • The nearest neighbour of one speech changed across raw counts, tf-idf, and stopword removal.
  • Same-person neighbours can show authorship or style rather than subject matter.
  • Similarity functions return a ranking even when length or labels explain it.

Sources