Agenda-setting theory explains that media attention shapes public attention. According to political scientist Bernard Cohen (1963), it does not necessarily tell people what to think, but instead what to think about. More specifically, first-level agenda-setting theory explains that certain topics or issues can compete to gain salience. The key to why certain topics are more important than others is an individual’s need for orientation. If they perceive something as having high relevance, they will pay more attention to that topic depending on their degree of uncertainty. This is why many issues and events compete. Each topic can have varying degrees of relevance for each individual at different points in time. While this theory can ascertain which world issues and events are more prevalent in the public mind, it may also be used to explain why certain sports are covered more than others at certain time periods.
Using first-level agenda-setting theory, my project will compare the media influence of two of the four major sports leagues in the United States: the NBA and MLB. Specifically, the analysis will cover weekly story volume in MediaCloud.org’s National news archive for each sport over the last ten months, from the week of January 10th, 2026, to the week of October 17th, 2026. The results will explain how these sports can be prominent in the public mind at different points in time.
The average weekly coverage volume of each sport will differ during the first ten months of 2026.
The dependent variable in the analysis is a continuous measure of the number of stories per week, which includes terms from MediaCloud.org queries indicating coverage for either the NBA or MLB. The independent variable is “sport.” It is a categorical measure identified as either NBA or MLB stories.
Stories about each sport were operationalized as stories matching each respective MediaCloud query:
NBA_query <-
'(NBA OR
"National Basketball Association" OR
"NBA Finals" OR
"NBA Draft" OR
"NBA All-Star Game")'MLB_query <-
'(MLB OR
"Major League Baseball" OR
"World Series" OR
"MLB All-Star Game" OR
"MLB Draft")'A paired-samples t-test will assess the statistical significance of the coverage volume variation between the two sports.
The figure and table below summarize each sport’s weekly coverage volume over the last ten months. There are two time periods when both sports have different coverage volumes: from January 2026 to mid-March and from early July to October. Only in one period is their coverage volume relatively similar, barring a few spikes and drops, starting in late March and lasting until late June. MLB averages about 3,076 stories per week, while the NBA averages about 3,002 stories per week. Notably, the NBA has a higher median weekly coverage volume, but just barely.
| topic | Total_Stories | Weekly_Minimum | Weekly_Maximum | Weekly_Median | Weekly_Mean | Weekly_SD |
|---|---|---|---|---|---|---|
| MLB | 126107 | 1551 | 4084 | 3233 | 3075.78 | 752.67 |
| NBA | 123075 | 1130 | 5102 | 3311 | 3001.83 | 1136.71 |
Below is a box plot that summarizes the distributions of the NBA (V1) and MLB (V2) story counts. The analysis also used a paired-samples t-test to assess whether the average difference in coverage volume fell nonrandomly above or below zero.
The results show that MLB stories outnumber NBA stories by an average of 73.9 stories per week with a standard deviation of 1,232.2 stories. This difference can be reflected in the different time periods when each sport had an increased number of weekly stories. The NBA had over 3,000 stories starting from the first week in January and ending around late June, while the MLB hit that mark mid-March and lasted until around late August. The large standard deviation may have originated from both extreme high and low weekly coverage volume for each sport at various times. Particularly, the NBA had the highest and lowest weekly coverage volume over the analyzed period, peaking at 5,102 weekly stories in early June and bottoming out at just 1,130 stories by early September.
A Shapiro-Wilk normality test revealed that the paired differences show a non-normal distribution. However, since the analysis covered over 40 weeks in the observation, the paired-samples t-test is a valid method to yield accurate results. The paired-samples t-test found that the coverage volume variation of the two sports was not statistically significant. Therefore, the hypothesis was not supported. Even though there are spikes and drops in coverage for each sport, the weekly coverage volume was the same.
| Paired-Samples t-Test | |||||
| statistic | parameter | p.value | conf.low | conf.high | method |
|---|---|---|---|---|---|
| 0.3843 | 40 | 0.7028 | −314.9902 | 462.8926 | Paired t-test |
One explanation for the surges and drops in coverage for certain sports is the events that occur. Particularly, events like the beginning of a season, playoffs, a championship game/series, or a draft may draw more coverage to that particular sport. It may also draw attention away from sports that are in their regular season or offseason. In this case, there are periods when either sport will see a spike or drop in coverage depending on what is going on within the year. Even if a sport is in its midseason, any major developing news or events in the other sport can see more coverage for that sport within a given time period.
Below is the code used to conduct this analysis.
############################################################
# STEP 1: Install and Load Required Packages
############################################################
required_packages <- c(
"tidyverse",
"httr2",
"lubridate",
"plotly",
"knitr",
"kableExtra"
)
for (pkg in required_packages) {
if (!requireNamespace(pkg, quietly = TRUE)) {
install.packages(pkg)
}
}
library(tidyverse)
library(httr2)
library(lubridate)
library(plotly)
library(knitr)
library(kableExtra)
############################################################
# STEP 2: Verify Media Cloud API Key
############################################################
if (!nzchar(Sys.getenv("MEDIACLOUD_KEY"))) {
stop(
"No Media Cloud API key was found.\n",
"Run the setup section once,\n",
"then restart R and try again."
)
}
mc_key <- Sys.getenv("MEDIACLOUD_KEY")
############################################################
# STEP 3: Define the Date Range
############################################################
start_date <- "2026-01-04"
end_date <- "2026-10-17"
############################################################
# STEP 4: Define Search Queries
############################################################
NBA_query <-
'(NBA OR
"National Basketball Association" OR
"NBA Finals" OR
"NBA Draft" OR
"NBA All-Star Game")'
MLB_query <-
'(MLB OR
"Major League Baseball" OR
"World Series" OR
"MLB All-Star Game" OR
"MLB Draft")'
############################################################
# STEP 5: Create Topic Definitions
############################################################
topics <- c(
"NBA" = NBA_query,
"MLB" = MLB_query
)
############################################################
# STEP 6: Create a Function to Retrieve Daily
# Story Counts
############################################################
mc_counts_over_time <- function(
query,
start_date,
end_date,
collection_id = 34412234
) {
resp <-
request(
"https://search.mediacloud.org/api/search/count-over-time"
) |>
req_headers(
Authorization = paste("Token", mc_key)
) |>
req_url_query(
q = query,
start = start_date,
end = end_date,
platform = "onlinenews-mediacloud",
cs = collection_id
) |>
req_perform()
results <- resp |>
resp_body_json()
map_dfr(
results$count_over_time$counts,
as_tibble
) |>
mutate(
date = as.Date(date)
)
}
############################################################
# STEP 7: Download Daily Counts for All Topics
############################################################
topic_data <-
imap_dfr(
topics,
function(search_string, topic_name) {
message(
"Downloading: ",
topic_name
)
results <-
mc_counts_over_time(
query = search_string,
start_date = start_date,
end_date = end_date
)
Sys.sleep(35)
results |>
mutate(
topic = topic_name
)
}
)
############################################################
# STEP 8: Examine the Downloaded Daily Data
############################################################
head(topic_data)
glimpse(topic_data)
############################################################
# STEP 9: Convert Daily Counts to Weekly Counts
############################################################
weekly_counts <-
topic_data |>
mutate(
week = floor_date(
date,
unit = "week"
)
) |>
group_by(
topic,
week
) |>
summarise(
stories = sum(count),
.groups = "drop"
)
############################################################
# STEP 10: Examine Weekly Counts
############################################################
weekly_counts
############################################################
# STEP 11: Summarize Coverage by Topic
############################################################
topic_summary <-
weekly_counts |>
group_by(topic) |>
summarise(
Total_Stories = sum(stories),
Weekly_Minimum = min(stories),
Weekly_Maximum = max(stories),
Weekly_Median = median(stories),
Weekly_Mean = round(
mean(stories),
2
),
Weekly_SD = round(
sd(stories),
2
),
.groups = "drop"
) |>
arrange(
desc(Total_Stories)
)
Table <-
topic_summary |>
kbl(
caption =
"Media Cloud Topic Summary Statistics",
align = "lrrrrrr"
) |>
kable_styling(
full_width = FALSE,
bootstrap_options = c(
"striped",
"hover",
"condensed"
)
)
Table
############################################################
# STEP 12: Create an Interactive Plotly Graph
############################################################
weekly_counts <- weekly_counts |>
mutate(
stories_formatted = formatC(
stories,
format = "d",
big.mark = ","
)
)
Graph <- plot_ly(
data = weekly_counts,
x = ~week,
y = ~stories,
color = ~topic,
colors = "Set1",
type = "scatter",
mode = "lines+markers",
customdata = ~topic,
text = ~stories_formatted,
hovertemplate =
paste(
"%{customdata}
",
"Week: %{x|%Y-%m-%d}
",
"Stories: %{text}
",
""
)
) |>
layout(
title =
"Weekly U.S. Coverage Volume",
hovermode = "x unified",
xaxis = list(
title = "Week"
),
yaxis = list(
title = "Weekly Story Count",
separatethousands = TRUE
)
)
Graph
#############################################################
# Reshape the data
#############################################################
weekly_counts_wide <-
weekly_counts %>%
mutate(
topic = make.names(topic)
) %>%
select(week, topic, stories) %>%
pivot_wider(
names_from = topic,
values_from = stories
)
# ============================================================
# 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
# ============================================================
mydata <- weekly_counts_wide
# Specify the two variables involved
mydata$V1 <- mydata$NBA
mydata$V2 <- mydata$MLB
# ============================================================
# 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