The first-level agenda-setting theory explains how the media influences what issues the public perceives as most important. According to this theory, the more frequently and prominently a topic is covered by the media, the more likely people are to consider that issue significant. In other words, the media doesn’t tell audiences what to think, but rather what to think about. By choosing which stories to highlight and how much attention to give them. Therefore, news organizations shape the public agenda guiding collective attention toward certain political, social, or economic problems. This process plays a crucial role in public opinion formation and in setting the priorities of both citizens and policymakers.
Based on the hypothesis of this theory, my project will compare the media coverage of two MLB teams: The Los Angeles Dodgers and the Toronto Blue Jays. Specifically, the analysis will compare the number of stories per week that APNews.com published about each team between January 1st and September 30, 2025.
The results will enhance theoretical understanding of how similar but yet different teams, both finalists in the MLB world series compete for attention on the media agenda.
Weekly APNews.com coverage volume for the Toronto Blue Jays was higher than the coverage of the Los Angeles Dodgers.
Weekly APNews.com coverage volume of the two teams served as the analysis’s dependent variable. It was measured continuously as the number of stories published per week. The independent variable was the “story topic” measured categorically as either “Dodgers” or “BlueJays”. Key phrases and words used to identify stories about Dodgers were: “Los Angeles Dodgers,” and “World Series”. Key words for stories about Toronto Blue Jays were: “Toronto Blue Jays” and “World Series.”
A paired-samples t-test is employed to determine the statistical significance of differences in coverage volume between the two story topics.
The results of the analysis are displayed in an interactive line chart showing weekly counts of AP News articles that mentioned either the Los Angeles Dodgers or the Toronto Blue Jays.
The most noticeable difference in volume occurred during week 27, which was the week between June 30 and July 6. The weekly number of stories related to the Blue Jays that week was a high of 21 compared to only 2 stories about the Dodgers. By looking at stories from this week, it was found that the Blue Jays hosted 7 consecutive home games that included several different giveaways and celebrations for Canada Day. Which explains the drop of coverage for the Dodgers.
The peak for the Dodgers occurred during week 22, the week between June 2 and June 8. During this week, the Dodgers had 22 stories published about them, however they still remained in the shadows of the Blue Jays as they occurred 28 stories that same week.
Overall, these results illustrate different levels of APNews.com coverage for the two teams and some nonrandom links between the level of coverage about one over the other.
The Blue Jay’s coverage volume averaged about 13 articles per week across the analysis period. Dodger’s coverage volume averaged about 5 articles per week, a mean difference of 8. The pair differences failed a Shapiro-Wilk Normality Test (p < 0.05), but the dataset’s case count, 40, made a paired-sample t-test nonetheless suitable for assessing the statistical significance of the average paired differences.
Below is a box plot of weekly article volumes for Dodgers (V1) and BlueJays (V2), followed by the results of the paired-samples t-test.
| Paired-Samples t-Test | |||||
| statistic | parameter | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|
| 9.1193 | 39 | 0.0000 | 6.3228 | 9.9272 | Paired t-test |
| Group Means and SDs (t-Test) | |||
| V1_Mean | V2_Mean | V1_SD | V2_SD |
|---|---|---|---|
| 5.025 | 13.150 | 5.127 | 7.547 |
The significant (p < 0.001) t-test result supported the hypothesis that weekly APNews.com coverage volume of the Los Angeles Dodgers and Toronto Blue Jays differed during the first nine months of 2025.
# ============================================
# APNews text analysis (First-level agenda-setting theory version)
# ============================================
# ============================================
# --- Load required libraries ---
# ============================================
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("tidytext")) install.packages("tidytext")
library(tidyverse)
library(tidytext)
# ============================================
# --- Load the APNews data ---
# ============================================
# Read the data from the web
FetchedData <- readRDS(url("https://github.com/drkblake/Data/raw/refs/heads/main/APNews.rds"))
# Save the data on your computer
saveRDS(FetchedData, file = "APNews.rds")
# remove the downloaded data from the environment
rm (FetchedData)
APNews <- readRDS("APNews.rds")
# ============================================
# --- Flag Topic1-related stories ---
# ============================================
# --- Define Topic1 phrases ---
phrases <- c(
"Los Angeles Dogers",
"World Series"
)
# --- Escape regex special characters ---
escaped_phrases <- str_replace_all(
phrases,
"([\\^$.|?*+()\\[\\]{}\\\\])",
"\\\\\\1"
)
# --- Build whole-word/phrase regex pattern ---
pattern <- paste0("\\b", escaped_phrases, "\\b", collapse = "|")
# --- Apply matching to flag Topic1 stories ---
APNews <- APNews %>%
mutate(
Full.Text.clean = str_squish(Full.Text), # normalize whitespace
Topic1 = if_else(
str_detect(Full.Text.clean, regex(pattern, ignore_case = TRUE)),
"Yes",
"No"
)
)
# ============================================
# --- Flag Topic2-related stories ---
# ============================================
# --- Define Topic2 phrases ---
phrases <- c(
"Toronto Blue Jays",
"World Series"
)
# --- Escape regex special characters ---
escaped_phrases <- str_replace_all(
phrases,
"([\\^$.|?*+()\\[\\]{}\\\\])",
"\\\\\\1"
)
# --- Build whole-word/phrase regex pattern ---
pattern <- paste0("\\b", escaped_phrases, "\\b", collapse = "|")
# --- Apply matching to flag Topic2 stories ---
APNews <- APNews %>%
mutate(
Full.Text.clean = str_squish(Full.Text),
Topic2 = if_else(
str_detect(Full.Text.clean, regex(pattern, ignore_case = TRUE)),
"Yes",
"No"
)
)
# ============================================
# --- Visualize weekly counts of Topic1- and Topic2-related stories ---
# ============================================
# --- Load plotly if needed ---
if (!require("plotly")) install.packages("plotly")
library(plotly)
# --- Summarize weekly counts for Topic1 = "Yes" ---
Topic1_weekly <- APNews %>%
filter(Topic1 == "Yes") %>%
group_by(Week) %>%
summarize(Count = n(), .groups = "drop") %>%
mutate(Topic = "Dodgers") # Note custom Topic1 label
# --- Summarize weekly counts for Topic2 = "Yes" ---
Topic2_weekly <- APNews %>%
filter(Topic2 == "Yes") %>%
group_by(Week) %>%
summarize(Count = n(), .groups = "drop") %>%
mutate(Topic = "BlueJays") # Note custom Topic2 label
# --- Combine both summaries into one data frame ---
Weekly_counts <- bind_rows(Topic2_weekly, Topic1_weekly)
# --- Fill in missing combinations with zero counts ---
Weekly_counts <- Weekly_counts %>%
tidyr::complete(
Topic,
Week = full_seq(range(Week), 1), # generate all week numbers
fill = list(Count = 0)
) %>%
arrange(Topic, Week)
# --- Create interactive plotly line chart ---
AS1 <- plot_ly(
data = Weekly_counts,
x = ~Week,
y = ~Count,
color = ~Topic,
colors = c("steelblue", "firebrick"),
type = "scatter",
mode = "lines+markers",
line = list(width = 2),
marker = list(size = 6)
) %>%
layout(
title = "Weekly Counts of Topic1- and Topic2-Related AP News Articles",
xaxis = list(
title = "Week Number (starting with Week 1 of 2025)",
dtick = 1
),
yaxis = list(title = "Number of Articles"),
legend = list(title = list(text = "Topic")),
hovermode = "x unified"
)
# ============================================
# --- Show the chart ---
# ============================================
AS1
# ============================================================
# Setup: Install and Load Required Packages
# ============================================================
if (!require("tidyverse")) install.packages("tidyverse")
if (!require("plotly")) install.packages("plotly")
if (!require("gt")) install.packages("gt")
if (!require("gtExtras")) install.packages("gtExtras")
if (!require("broom")) install.packages("broom")
library(tidyverse)
library(plotly)
library(gt)
library(gtExtras)
library(broom)
options(scipen = 999)
# ============================================================
# Data Import
# ============================================================
# Reshape to wide form
mydata <- Weekly_counts %>%
pivot_wider(names_from = Topic, values_from = Count)
names(mydata) <- make.names(names(mydata))
# Specify the two variables involved
mydata$V1 <- mydata$Dodgers # <== Customize this
mydata$V2 <- mydata$BlueJays # <== Customize this
# ============================================================
# Compute Pair Differences
# ============================================================
mydata$PairDifferences <- mydata$V2 - mydata$V1
# ============================================================
# Interactive Histogram of Pair Differences
# ============================================================
hist_plot <- plot_ly(
data = mydata,
x = ~PairDifferences,
type = "histogram",
marker = list(color = "#1f78b4", line = list(color = "black", width = 1))
) %>%
layout(
title = "Distribution of Pair Differences",
xaxis = list(title = "Pair Differences"),
yaxis = list(title = "Count"),
shapes = list(
list(
type = "line",
x0 = mean(mydata$PairDifferences, na.rm = TRUE),
x1 = mean(mydata$PairDifferences, na.rm = TRUE),
y0 = 0,
y1 = max(table(mydata$PairDifferences)),
line = list(color = "red", dash = "dash")
)
)
)
# ============================================================
# Descriptive Statistics
# ============================================================
desc_stats <- mydata %>%
summarise(
count = n(),
mean = mean(PairDifferences, na.rm = TRUE),
sd = sd(PairDifferences, na.rm = TRUE),
min = min(PairDifferences, na.rm = TRUE),
max = max(PairDifferences, na.rm = TRUE)
)
desc_table <- desc_stats %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Descriptive Statistics: Pair Differences") %>%
fmt_number(columns = where(is.numeric), decimals = 3)
# ============================================================
# Normality Test (Shapiro-Wilk)
# ============================================================
shapiro_res <- shapiro.test(mydata$PairDifferences)
shapiro_table <- tidy(shapiro_res) %>%
select(statistic, p.value, method) %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Normality Test (Shapiro-Wilk)") %>%
fmt_number(columns = c(statistic, p.value), decimals = 4) %>%
tab_source_note(
source_note = "If the P.VALUE is 0.05 or less, the number of pairs is fewer than 40, and the distribution of pair differences shows obvious non-normality or outliers, consider using the Wilcoxon Signed Rank Test results instead of the Paired-Samples t-Test results."
)
# ============================================================
# Reshape Data for Repeated-Measures Plot
# ============================================================
df_long <- mydata %>%
pivot_longer(cols = c(V1, V2),
names_to = "Measure",
values_to = "Value")
# ============================================================
# Repeated-Measures Boxplot (Interactive, with Means)
# ============================================================
group_means <- df_long %>%
group_by(Measure) %>%
summarise(mean_value = mean(Value), .groups = "drop")
boxplot_measures <- plot_ly() %>%
add_trace(
data = df_long,
x = ~Measure, y = ~Value,
type = "box",
boxpoints = "outliers",
marker = list(color = "red", size = 4),
line = list(color = "black"),
fillcolor = "royalblue",
name = ""
) %>%
add_trace(
data = group_means,
x = ~Measure, y = ~mean_value,
type = "scatter", mode = "markers",
marker = list(
symbol = "diamond", size = 9,
color = "black", line = list(color = "white", width = 1)
),
text = ~paste0("Mean = ", round(mean_value, 2)),
hoverinfo = "text",
name = "Group Mean"
) %>%
layout(
title = "Boxplot of Repeated Measures (V1 vs V2) with Means",
xaxis = list(title = "Measure"),
yaxis = list(title = "Value"),
showlegend = FALSE
)
# ============================================================
# Parametric Test (Paired-Samples t-Test)
# ============================================================
t_res <- t.test(mydata$V2, mydata$V1, paired = TRUE)
t_table <- tidy(t_res) %>%
select(statistic, parameter, p.value, conf.low, conf.high, method) %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Paired-Samples t-Test") %>%
fmt_number(columns = c(statistic, p.value, conf.low, conf.high), decimals = 4)
t_summary <- mydata %>%
select(V1, V2) %>%
summarise_all(list(Mean = mean, SD = sd)) %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Group Means and SDs (t-Test)") %>%
fmt_number(columns = everything(), decimals = 3)
# ============================================================
# Nonparametric Test (Wilcoxon Signed Rank)
# ============================================================
wilcox_res <- wilcox.test(mydata$V1, mydata$V2, paired = TRUE,
exact = FALSE)
wilcox_table <- tidy(wilcox_res) %>%
select(statistic, p.value, method) %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Wilcoxon Signed Rank Test") %>%
fmt_number(columns = c(statistic, p.value), decimals = 4)
wilcox_summary <- mydata %>%
select(V1, V2) %>%
summarise_all(list(Mean = mean, SD = sd)) %>%
gt() %>%
gt_theme_538() %>%
tab_header(title = "Group Means and SDs (Wilcoxon)") %>%
fmt_number(columns = everything(), decimals = 3)
# ============================================================
# Results Summary (in specified order)
# ============================================================
hist_plot
desc_table
shapiro_table
boxplot_measures
t_table
t_summary
wilcox_table
wilcox_summary