Report 9: Bigram Patterns in Trump-Related News Headlines

Data and Methods

This report examines headlines from news stories that mentioned “Donald Trump” at least once in their text, according to the MediaCloud dataset provided for this analysis. The headlines themselves do not necessarily mention Trump.

I used the provided source lookup and an inner join to create headlines_lr. Only outlets matching that lookup enter the analysis. The ideological labels describe the supplied outlet classifications, not an independent assessment of each headline’s political position.

After removing records with missing publication dates or blank headlines, the analysis includes 7,144 headline records, published from August 03, 2026 through October 04, 2026.

Headline records and outlets retained for analysis.

Outlet orientation	Headline records	Distinct outlets
Left	3,787	8
Right	3,357	4

Bigram construction

I removed URLs and account mentions, standardized apostrophes, and converted possessives such as “Trump’s” to “Trump.” I then tokenized the headlines into lowercase bigrams: consecutive two-word combinations.

I created the pairs before removing stop words. I excluded any bigram containing a standard stop word, a web artifact, a number, or a token that was not composed of at least two English letters. This preserves adjacency in the cleaned headline rather than joining words across removed stop words.

I retained names and phrases such as “Donald Trump” because they may be meaningful in this comparison. I did not apply the previous assignment’s unigram grouping dictionary. Counts represent bigram occurrences across the supplied records, including repeated headlines.

I selected the 10 most frequent bigrams separately within each outlet group, breaking ties alphabetically. The comparison graph uses the same horizontal count scale in both panels.

Changes over time

I used publish_date to assign headlines to weeks beginning Monday. For each group’s selected bigrams, I calculated:

Weekly frequency = 1,000 × bigram occurrences ÷ headline records from that group that week.

This rate accounts for differences in the number of headlines available across groups and weeks. It does not adjust for differences in individual outlets’ contributions.

The ridgelines display these observed weekly rates using a shared height scale across both graphs. They are frequency profiles, not smoothed probability-density estimates. Weeks with headlines but no occurrences receive zero; weeks with no headlines receive missing rates. The first and last weeks may contain fewer than seven days of observations.

Outlet matching

The lookup matches outlet names exactly, including the supplied spelling “The New Replublic.” Unmatched entries are reported below rather than silently reassigned.

Lookup entries without matching source names. These entries contribute no records.

Unmatched lookup entry	Assigned orientation
Talking Points Memo	Left
Daily Kos	Left
The New Replublic	Left
Mother Jones	Left
Raw Story	Left
Jezebel	Left
Truthout	Left
colorlines.com	Left
National Memo	Left
TheRealNews.com	Left
AlterNet	Left
MintPress News	Left
Mic	Left
The Root	Left
Hot Air	Right
RedState	Right
National Review	Right
NewsBusters	Right
Daily Caller	Right
PJ Media	Right
Townhall	Right
CNS News	Right
American Spectator	Right
TheBlaze	Right
Daily Signal	Right
One America News Network	Right
Fox Business	Right
shop.americanfreepress.net	Right
National Catholic Register	Right

Most Frequent Bigrams by Outlet Orientation

Figure 1. Top 10 retained bigrams within each outlet group. Bars show total occurrences, not unique stories.

Left-Leaning Outlets Over Time

Figure 2. Weekly occurrences per 1,000 left-group headlines for that group’s top 10 bigrams. Higher ridges indicate higher weekly frequencies.

Right-Leaning Outlets Over Time

Figure 3. Weekly occurrences per 1,000 right-group headlines for that group’s top 10 bigrams. The height scale matches Figure 2.

Analysis and AI Assistance

Among left-leaning outlets, “white house” was the most frequent retained bigram, appearing 130 times. Among right-leaning outlets, “white house” led with 92 occurrences. The two top-ten lists shared 5 bigrams. Their overlap indicates common vocabulary, while differences identify phrases receiving greater prominence within each selected group.

The leading left-group bigram reached its highest weekly rate during the week beginning September 21, at 62.0 occurrences per 1,000 headlines. The leading right-group bigram peaked during the week beginning August 17, at 62.3 per 1,000. Tied peaks use the earliest week. These peaks locate concentrated attention; the ridgelines also reveal whether other phrases recur across weeks or appear in shorter bursts.

Weekly rates help separate vocabulary frequency from changes in publishing volume. Nevertheless, outlets contribute unequal numbers of headlines, and repeated records remain included. The first and last weeks may be partial, so their patterns require additional caution.

AI assisted with interpreting the n-gram workflow into headline-analysis code, constructing the comparison and ridgeline graphs, and providing an inital intepretation, which I then reviewed and finalized. The script includes checks for required columns, sufficient bigrams, and usable weekly frequencies. These checks support reproducibility but do not independently validate the supplied political classifications.

Finally, frequent phrases indicate textual emphasis, not necessarily ideological framing. A headline may mention a person or institution favorably, critically, or neutrally. Establishing tone, explaining particular peaks, or assessing audience effects would require examining the underlying headlines and stories.

Complete R Script

The following code produced the analysis and all three graphs. It is displayed for documentation without running a second time.

# 1. Install missing packages and load libraries.
required_packages <- c(
  "dplyr", "tidyr", "stringr", "tidytext",
  "ggplot2", "ggridges", "scales", "knitr"
)

missing_packages <- required_packages[
  !vapply(
    required_packages,
    requireNamespace,
    logical(1),
    quietly = TRUE
  )
]

if (length(missing_packages) > 0) {
  install.packages(
    missing_packages,
    repos = "https://cloud.r-project.org"
  )
}

library(dplyr)
library(tidyr)
library(stringr)
library(tidytext)
library(ggplot2)
library(ggridges)

# 2. Download and read the supplied dataset.
data_file <- "Trump_story_headlines.rds"

if (!file.exists(data_file)) {
  download.file(
    url = paste0(
      "https://github.com/drkblake/Data/raw/",
      "refs/heads/main/Trump_story_headlines.rds"
    ),
    destfile = data_file,
    mode = "wb"
  )
}

headlines <- readRDS(data_file)

required_columns <- c(
  "title", "media_name", "publish_date"
)

if (!is.data.frame(headlines) ||
    !all(required_columns %in% names(headlines))) {
  stop(
    "The dataset must contain title, media_name, ",
    "and publish_date columns."
  )
}

if (!is.character(headlines$title)) {
  stop("The title column must contain text.")
}

# 3. Preserve the instructor's outlet classifications.
# "The New Replublic" retains the spelling in the supplied lookup.
source_ideology <- tibble::tribble(
  ~media_name, ~ideology,

  "Talking Points Memo", "Left",
  "Daily Kos", "Left",
  "The New Replublic", "Left",
  "Mother Jones", "Left",
  "thenation.com", "Left",
  "Raw Story", "Left",
  "salon.com", "Left",
  "Jezebel", "Left",
  "slate.com", "Left",
  "Truthout", "Left",
  "colorlines.com", "Left",
  "newsone.com", "Left",
  "National Memo", "Left",
  "TheRealNews.com", "Left",
  "huffpost.com", "Left",
  "AlterNet", "Left",
  "vox.com", "Left",
  "MintPress News", "Left",
  "Mic", "Left",
  "theintercept.com", "Left",
  "theguardian.com", "Left",
  "The Root", "Left",

  "Hot Air", "Right",
  "RedState", "Right",
  "foxnews.com", "Right",
  "National Review", "Right",
  "NewsBusters", "Right",
  "Daily Caller", "Right",
  "PJ Media", "Right",
  "breitbart.com", "Right",
  "Townhall", "Right",
  "CNS News", "Right",
  "American Spectator", "Right",
  "TheBlaze", "Right",
  "newsmax.com", "Right",
  "patriotpost.us", "Right",
  "Daily Signal", "Right",
  "One America News Network", "Right",
  "Fox Business", "Right",
  "shop.americanfreepress.net", "Right",
  "National Catholic Register", "Right"
)

stopifnot(!anyDuplicated(source_ideology$media_name))

headlines_lr <- headlines %>%
  inner_join(
    source_ideology,
    by = "media_name"
  )

# Record lookup entries that do not match any source name.
unmatched_sources <- source_ideology %>%
  anti_join(
    headlines %>% distinct(media_name),
    by = "media_name"
  )

# 4. Clean headlines and establish publication weeks.
# Use publish_date, not indexed_date.
# Preserve repeated headline records.
clean_headlines <- headlines_lr %>%
  mutate(
    story_id = row_number(),
    date = as.Date(publish_date)
  ) %>%
  filter(
    !is.na(title),
    str_trim(title) != "",
    !is.na(date)
  ) %>%
  mutate(
    week = as.Date(
      cut(
        date,
        breaks = "week",
        start.on.monday = TRUE
      )
    ),
    title = str_replace_all(
      title,
      "https?://\\S+|www\\.\\S+|@[[:alnum:]_]+",
      " "
    ),
    title = str_replace_all(
      title,
      "[\u2018\u2019]",
      "'"
    ),
    title = str_replace_all(
      title,
      regex(
        "\\b([[:alpha:]]+)'s\\b",
        ignore_case = TRUE
      ),
      "\\1"
    )
  )

if (!all(c("Left", "Right") %in%
         clean_headlines$ideology)) {
  stop("Both ideology groups must contain usable headlines.")
}

# 5. Tokenize into adjacent two-word combinations.
# Generate bigrams BEFORE removing stop words.
# This avoids creating pairs that were not adjacent.
social_artifacts <- c(
  "rt", "amp", "http", "https",
  "www", "com", "co"
)

bigrams <- clean_headlines %>%
  unnest_tokens(
    bigram,
    title,
    token = "ngrams",
    n = 2,
    to_lower = TRUE
  ) %>%
  separate(
    bigram,
    into = c("word1", "word2"),
    sep = " ",
    remove = FALSE
  ) %>%
  filter(
    str_detect(word1, "^[a-z]{2,}$"),
    str_detect(word2, "^[a-z]{2,}$"),
    !word1 %in% tidytext::stop_words$word,
    !word2 %in% tidytext::stop_words$word,
    !word1 %in% social_artifacts,
    !word2 %in% social_artifacts
  )

# 6. Count bigram occurrences within each group.
bigram_counts <- bigrams %>%
  count(
    ideology,
    bigram,
    name = "n"
  ) %>%
  arrange(
    ideology,
    desc(n),
    bigram
  )

# Select 10 per group, breaking ties alphabetically.
top_n <- 10L

top_bigrams <- bigram_counts %>%
  group_by(ideology) %>%
  slice_head(n = top_n) %>%
  ungroup()

top_sizes <- top_bigrams %>%
  count(ideology)

if (nrow(top_sizes) != 2L ||
    any(top_sizes$n < top_n)) {
  stop("Each group must contain at least 10 eligible bigrams.")
}

group_summary <- clean_headlines %>%
  group_by(ideology) %>%
  summarise(
    headlines = n(),
    outlets = n_distinct(media_name),
    .groups = "drop"
  )

# 7. Build a complete weekly series for the selected bigrams.
# Zero means no occurrences in a week with available headlines.
# NA means there were no headlines from that group that week.
all_weeks <- seq(
  min(clean_headlines$week),
  max(clean_headlines$week),
  by = "week"
)

weekly_counts <- bigrams %>%
  count(
    ideology,
    bigram,
    week,
    name = "n"
  )

weekly_volume <- clean_headlines %>%
  count(
    ideology,
    week,
    name = "headlines"
  )

weekly_bigrams <- tidyr::crossing(
  top_bigrams %>%
    select(ideology, bigram),
  week = all_weeks
) %>%
  left_join(
    weekly_counts,
    by = c("ideology", "bigram", "week")
  ) %>%
  left_join(
    weekly_volume,
    by = c("ideology", "week")
  ) %>%
  mutate(
    n = replace_na(n, 0L),
    headlines = replace_na(headlines, 0L),
    rate = if_else(
      headlines > 0,
      1000 * n / headlines,
      NA_real_
    )
  )

# Use one height scale across BOTH ridgeline plots.
max_rate <- max(
  weekly_bigrams$rate,
  na.rm = TRUE
)

if (!is.finite(max_rate) || max_rate <= 0) {
  stop("No positive weekly bigram frequencies were found.")
}

weekly_bigrams <- weekly_bigrams %>%
  mutate(
    ridge_height = rate / max_rate
  )

group_colors <- c(
  "Left" = "#2166AC",
  "Right" = "#B2182B"
)

# 8. Compare the top bigrams in a faceted bar graph.
bigram_plot <- ggplot(
  top_bigrams,
  aes(
    x = n,
    y = tidytext::reorder_within(
      bigram,
      n,
      ideology
    ),
    fill = ideology
  )
) +
  geom_col(
    width = 0.75,
    show.legend = FALSE
  ) +
  geom_text(
    aes(label = scales::comma(n)),
    hjust = -0.1,
    size = 3.2
  ) +
  tidytext::scale_y_reordered() +
  facet_wrap(
    ~ideology,
    scales = "free_y"
  ) +
  scale_fill_manual(
    values = group_colors
  ) +
  scale_x_continuous(
    labels = scales::comma,
    expand = expansion(
      mult = c(0, 0.22)
    )
  ) +
  labs(
    title = "Top 10 headline bigrams by outlet orientation",
    subtitle = "Adjacent word pairs after stop-word filtering",
    x = "Number of bigram occurrences",
    y = NULL,
    caption = paste(
      "Source: instructor-supplied MediaCloud dataset.",
      "Outlet groups follow the supplied lookup.",
      "\nCounts include repeated headline records."
    )
  ) +
  theme_minimal(base_size = 12) +
  theme(
    panel.grid.major.y = element_blank(),
    plot.title = element_text(face = "bold"),
    plot.caption = element_text(hjust = 0)
  )

# 9. Create weekly ridgelines using observed frequencies.
# stat = "identity" avoids kernel-density smoothing.
make_ridge_plot <- function(side) {

  bigram_order <- top_bigrams %>%
    filter(ideology == side) %>%
    arrange(n, bigram) %>%
    pull(bigram)

  plot_data <- weekly_bigrams %>%
    filter(ideology == side) %>%
    mutate(
      bigram = factor(
        bigram,
        levels = bigram_order
      )
    )

  ggplot(
    plot_data,
    aes(
      x = week,
      y = bigram,
      height = ridge_height,
      group = bigram
    )
  ) +
    geom_ridgeline(
      stat = "identity",
      scale = 0.9,
      min_height = 0,
      fill = group_colors[[side]],
      color = group_colors[[side]],
      alpha = 0.75,
      linewidth = 0.3,
      na.rm = TRUE
    ) +
    scale_x_date(
      limits = range(all_weeks),
      date_breaks = "2 weeks",
      date_labels = "%b %d"
    ) +
    labs(
      title = paste(
        side,
        "outlets: top bigrams over time"
      ),
      subtitle = paste(
        "Weekly occurrences per 1,000 headlines;",
        "shared ridge-height scale"
      ),
      x = "Publication week beginning Monday",
      y = NULL,
      caption = paste0(
        "Full ridge-height unit = ",
        scales::number(max_rate, accuracy = 0.1),
        " occurrences per 1,000 headlines.",
        "\nFirst and last weeks may be partial. ",
        "Weeks without headlines have missing rates.",
        "\nLines connect weekly observations; ",
        "no density smoothing is applied."
      )
    ) +
    theme_minimal(base_size = 12) +
    theme(
      panel.grid.major.y = element_blank(),
      panel.grid.minor = element_blank(),
      plot.title = element_text(face = "bold"),
      plot.caption = element_text(
        hjust = 0,
        size = 9
      ),
      axis.text.x = element_text(
        angle = 30,
        hjust = 1
      )
    )
}

left_ridge <- make_ridge_plot("Left")
right_ridge <- make_ridge_plot("Right")

# 10. Prepare values for a results-based narrative.
left_top <- top_bigrams %>%
  filter(ideology == "Left") %>%
  arrange(desc(n), bigram) %>%
  slice_head(n = 1)

right_top <- top_bigrams %>%
  filter(ideology == "Right") %>%
  arrange(desc(n), bigram) %>%
  slice_head(n = 1)

# Peak week for each group's most frequent bigram.
left_peak <- weekly_bigrams %>%
  filter(
    ideology == "Left",
    bigram == left_top$bigram[[1]],
    !is.na(rate)
  ) %>%
  arrange(desc(rate), week) %>%
  slice_head(n = 1)

right_peak <- weekly_bigrams %>%
  filter(
    ideology == "Right",
    bigram == right_top$bigram[[1]],
    !is.na(rate)
  ) %>%
  arrange(desc(rate), week) %>%
  slice_head(n = 1)

shared_top <- intersect(
  top_bigrams$bigram[
    top_bigrams$ideology == "Left"
  ],
  top_bigrams$bigram[
    top_bigrams$ideology == "Right"
  ]
)

# 11. Save supporting tables and figures.
write.csv(
  bigram_counts,
  "bigram_counts_by_ideology.csv",
  row.names = FALSE
)

write.csv(
  top_bigrams,
  "top10_bigrams_by_ideology.csv",
  row.names = FALSE
)

write.csv(
  weekly_bigrams,
  "weekly_top_bigrams.csv",
  row.names = FALSE
)

write.csv(
  unmatched_sources,
  "unmatched_outlet_lookup.csv",
  row.names = FALSE
)

ggsave(
  "bigram_comparison.png",
  bigram_plot,
  width = 12,
  height = 8,
  dpi = 160
)

ggsave(
  "left_bigram_ridgelines.png",
  left_ridge,
  width = 11,
  height = 8,
  dpi = 160
)

ggsave(
  "right_bigram_ridgelines.png",
  right_ridge,
  width = 11,
  height = 8,
  dpi = 160
)