Below is a bigram graph showing the top bigrams in left- and right-leaning outlets. Two ridgeline graphs show these outlets’ weekly volume over an approximately two-month span. To produce these graphs, I had Microsoft Copilot analyze some given data containing headline n-grams that were filtered into one of two political orientations. I then asked Copilot to adapt two existing R scripts into a new one that made the bigram graph and ridgeline graphs using that data frame. 

Looking at the bigram graph, the most frequent bigram for both left- and right-leaning outlets is “white house.” The bigram named “supreme court” came in second for left-leaning outlets and third for right-leaning outlets. The “iran war” bigram came in fourth in right-leaning outlets and fifth in left-leaning outlets. The top public figure for left-leaning headlines is Donald Trump, while the top public figure in right-leaning headlines is Abdul El-Sayed. 

In terms of the overall weekly volume of these headline bigrams, “white house” had a more consistent volume over the first month in right-leaning outlets. By September 15th, both outlets with that bigram had similar volumes. The “supreme court” bigram in both outlets had a similar volume. Though the “iran war” bigram in left-leaning outlets had a little more volume around September 15th, both outlets produced similar volumes before that week. 

With the midterm elections approaching soon, considering active U.S. involvement in the Iran War and events revolving around the administration, it would make sense that news outlets from both political affiliations would use these bigrams the most. It is also important to consider that these changing events can affect how outlets use certain bigrams in their headlines.

Code

Below is the code used to conduct the report.

if (!require(tidyverse)) install.packages("tidyverse")
if (!require(tidytext)) install.packages("tidytext")
if (!require(lubridate)) install.packages("lubridate")
if (!require(ggridges)) install.packages("ggridges")
if (!require(scales)) install.packages("scales")

library(tidyverse)
library(tidytext)
library(lubridate)
library(ggridges)
library(scales)

headlines <- readRDS("Trump_story_headlines.rds")

# Create source ideology lookup table ----

source_ideology <- tribble(
  ~media_name, ~ideology,
  
  # Left
  "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",
  
  # Right
  "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"
)

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


headlines_text <- headlines_lr %>%
  select(
    publish_date,
    title,
    media_name,
    ideology
  ) %>%
  mutate(
    publish_date = as.Date(publish_date),
    WeekStart = floor_date(
      publish_date,
      unit = "week",
      week_start = 1
    ),
    title = str_to_lower(title)
  ) %>%
  filter(
    ideology %in% c(
      "Left",
      "Right"
    )
  )



data("stop_words")

headline_bigrams <- headlines_text %>%
  unnest_tokens(
    bigram,
    title,
    token = "ngrams",
    n = 2
  ) %>%
  separate(
    bigram,
    c("word1", "word2"),
    sep = " "
  ) %>%
  filter(
    !word1 %in% stop_words$word,
    !word2 %in% stop_words$word
  ) %>%
  filter(
    !str_detect(word1, "^[0-9]+$"),
    !str_detect(word2, "^[0-9]+$")
  ) %>%
  unite(
    bigram,
    word1,
    word2,
    sep = " "
  )





bigram_counts <- headline_bigrams %>%
  count(
    ideology,
    bigram,
    sort = TRUE
  )




top_n_bigrams <- 20

top_bigrams <- bigram_counts %>%
  group_by(ideology) %>%
  slice_max(
    n,
    n = top_n_bigrams
  ) %>%
  ungroup()





bigram_graph <- top_bigrams %>%
  mutate(
    bigram = reorder_within(
      bigram,
      n,
      ideology
    )
  ) %>%
  ggplot(
    aes(
      x = bigram,
      y = n,
      fill = ideology
    )
  ) +
  geom_col(
    show.legend = FALSE
  ) +
  coord_flip() +
  scale_x_reordered() +
  facet_wrap(
    ~ ideology,
    scales = "free_y",
    ncol = 1
  ) +
  scale_fill_manual(
    values = c(
      "Left" = "steelblue",
      "Right" = "firebrick"
    )
  ) +
  labs(
    title = "Most Frequent Headline Bigrams by Media Ideology",
    subtitle = "Left-Leaning versus Right-Leaning News Sources",
    x = "Bigram",
    y = "Occurrences"
  ) +
  theme_minimal()

bigram_graph





weekly_bigram_counts <- headline_bigrams %>%
  semi_join(
    top_bigrams,
    by = c(
      "ideology",
      "bigram"
    )
  ) %>%
  count(
    ideology,
    bigram,
    WeekStart,
    name = "weekly_count"
  )




weekly_bigram_counts <- weekly_bigram_counts %>%
  group_by(
    ideology,
    bigram
  ) %>%
  complete(
    WeekStart = seq(
      min(WeekStart),
      max(WeekStart),
      by = "week"
    ),
    fill = list(
      weekly_count = 0
    )
  ) %>%
  ungroup()





left_order <- top_bigrams %>%
  filter(
    ideology == "Left"
  ) %>%
  arrange(
    desc(n)
  ) %>%
  pull(
    bigram
  )

left_weekly <- weekly_bigram_counts %>%
  filter(
    ideology == "Left"
  ) %>%
  mutate(
    bigram = factor(
      bigram,
      levels = left_order
    )
  )

left_ridgeline <- ggplot(
  left_weekly,
  aes(
    x = WeekStart,
    y = weekly_count,
    height = weekly_count
  )
) +
  geom_ridgeline(
    fill = "steelblue",
    color = "white",
    alpha = .8,
    scale = 1
  ) +
  facet_wrap(
    ~ bigram,
    ncol = 1,
    scales = "free_y",
    strip.position = "right"
  ) +
  labs(
    title = paste(
      "Weekly Volume of Top",
      top_n_bigrams,
      "Headline Bigrams: Left-Leaning Outlets"
    ),
    x = "Week",
    y = NULL
  ) +
  theme_ridges() +
  theme(
    strip.text.y.right =
      element_text(
        size = 10,
        angle = 0
      ),
    axis.text.y =
      element_blank(),
    axis.ticks.y =
      element_blank(),
    panel.spacing =
      unit(
        .15,
        "lines"
      ),
    legend.position =
      "none"
  )

left_ridgeline




right_order <- top_bigrams %>%
  filter(
    ideology == "Right"
  ) %>%
  arrange(
    desc(n)
  ) %>%
  pull(
    bigram
  )

right_weekly <- weekly_bigram_counts %>%
  filter(
    ideology == "Right"
  ) %>%
  mutate(
    bigram = factor(
      bigram,
      levels = right_order
    )
  )

right_ridgeline <- ggplot(
  right_weekly,
  aes(
    x = WeekStart,
    y = weekly_count,
    height = weekly_count
  )
) +
  geom_ridgeline(
    fill = "firebrick",
    color = "white",
    alpha = .8,
    scale = 1
  ) +
  facet_wrap(
    ~ bigram,
    ncol = 1,
    scales = "free_y",
    strip.position = "right"
  ) +
  labs(
    title = paste(
      "Weekly Volume of Top",
      top_n_bigrams,
      "Headline Bigrams: Right-Leaning Outlets"
    ),
    x = "Week",
    y = NULL
  ) +
  theme_ridges() +
  theme(
    strip.text.y.right =
      element_text(
        size = 10,
        angle = 0
      ),
    axis.text.y =
      element_blank(),
    axis.ticks.y =
      element_blank(),
    panel.spacing =
      unit(
        .15,
        "lines"
      ),
    legend.position =
      "none"
  )

right_ridgeline