Bigram Graph

Left Ridgeline Plot

Right Ridgeline Plot

Analysis

When creating these graphs, I compared headlines from left-leaning and right-leaning news outlets. The headlines were converted into bigrams. Then, I compared the most common bigrams used by each group and created ridgeline plots to see how the frequency of those phrases changed over time.

The results showed that some of the most common bigrams in left-leaning outlets were “white house,” “supreme court,” “donald trump,” “iran war,” and “trump administration.” Right-leaning outlets also frequently used “white house,” “supreme court,” “donald trump,” and “trump administration,” showing that both groups were focused on many of the same major political events. However, some differences appeared in the other top bigrams, suggesting that each side emphasized different aspects of the news.

The ridgeline plots showed that the frequency of these bigrams changed over time. Some phrases remained fairly consistent throughout the period, while others experienced spikes during certain weeks. It is shown that the right-leaning outlets were more consistent and frequent compared to the left-leaning outlets. Overall, the results suggest that both left-leaning and right-leaning outlets covered many of the same topics, but often framed or emphasized them differently.

AI was used to help modify the scripts so they would work with the headlines_lr dataset. It also helped me fix R Markdown errors, update the code for this assignment, and create the required graphs. Then, I used the results from the graphs and data to draw my conclusions.

Code’s:

Bigram Chart

############################################################
# TOP BIGRAMS BY IDEOLOGY
############################################################
n_size <- 2

data("stop_words")

headline_bigrams <- headlines_lr %>%
  unnest_tokens(
    ngram,
    title,
    token = "ngrams",
    n = n_size
  ) %>%
  separate(
    ngram,
    into = c("word1", "word2"),
    sep = " "
  ) %>%
  filter(
    !word1 %in% stop_words$word,
    !word2 %in% stop_words$word
  ) %>%
  unite(
    ngram,
    word1,
    word2,
    sep = " "
  )

ideology_ngram_counts <- headline_bigrams %>%
  count(
    ideology,
    ngram,
    sort = TRUE
  )

top_ngrams_chart_data <- ideology_ngram_counts %>%
  group_by(ideology) %>%
  slice_max(
    n,
    n = 15
  ) %>%
  ungroup()

bigram_chart <- ggplot(
  top_ngrams_chart_data,
  aes(
    x = reorder_within(
      ngram,
      n,
      ideology
    ),
    y = n,
    fill = ideology
  )
) +
  geom_col(show.legend = FALSE) +
  coord_flip() +
  scale_x_reordered() +
  facet_wrap(
    ~ ideology,
    ncol = 1,
    scales = "free_y"
  ) +
  scale_fill_manual(
    values = c(
      "Left" = "steelblue",
      "Right" = "firebrick"
    )
  ) +
  labs(
    title = "Most Common Bigrams in News Headlines",
    subtitle = "Left-Leaning vs. Right-Leaning Outlets",
    x = "Bigram",
    y = "Frequency"
  ) +
  theme_minimal()

bigram_chart

Left Ridgeline Plot

############################################################
# LEFT-LEANING RIDGELINE PLOT
############################################################

headlines_lr <- headlines_lr %>%
  mutate(
    WeekStart = floor_date(
      as.Date(publish_date),
      unit = "week",
      week_start = 1
    )
  )

top_left_bigrams <- ideology_ngram_counts %>%
  filter(
    ideology == "Left"
  ) %>%
  slice_max(
    n,
    n = 20
  )

left_weekly <- headline_bigrams %>%
  mutate(
    WeekStart = floor_date(
      as.Date(publish_date),
      "week"
    )
  ) %>%
  semi_join(
    top_left_bigrams,
    by = c(
      "ideology",
      "ngram"
    )
  ) %>%
  count(
    ideology,
    ngram,
    WeekStart,
    name = "weekly_count"
  )

left_order <- top_left_bigrams %>%
  arrange(desc(n)) %>%
  pull(ngram)

left_weekly <- left_weekly %>%
  mutate(
    ngram = factor(
      ngram,
      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(
    ~ ngram,
    ncol = 1,
    scales = "free_y",
    strip.position = "right"
  ) +
  labs(
    title = "Weekly Volume of Top 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 Ridgeline Plot

############################################################
# RIGHT-LEANING RIDGELINE PLOT
############################################################

headline_bigrams <- headlines_lr %>%
  select(
    ideology,
    WeekStart,
    title
  ) %>%
  unnest_tokens(
    ngram,
    title,
    token = "ngrams",
    n = 2
  )

# Find top right-leaning bigrams

top_right_bigrams <- ideology_ngram_counts %>%
  filter(
    ideology == "Right"
  ) %>%
  slice_max(
    n,
    n = 20
  )

# Count weekly usage of those bigrams

right_weekly <- headline_bigrams %>%
  semi_join(
    top_right_bigrams,
    by = c(
      "ideology",
      "ngram"
    )
  ) %>%
  count(
    ideology,
    ngram,
    WeekStart,
    name = "weekly_count"
  )

# Fill missing weeks with zeros

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

# Arrange bigrams by overall frequency

right_order <- top_right_bigrams %>%
  arrange(
    desc(n)
  ) %>%
  pull(
    ngram
  )

right_weekly <- right_weekly %>%
  mutate(
    ngram = factor(
      ngram,
      levels = right_order
    )
  )

# Create ridgeline plot

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(
    ~ ngram,
    ncol = 1,
    scales = "free_y",
    strip.position = "right"
  ) +
  labs(
    title = "Weekly Volume of Top 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