Rationale

Second-level agenda-setting theory suggests that news coverage can influence which attributes of a topic become important in the public’s mind. My project uses this theory to compare how much attention U.S. news media give to two aspects of AI employment: job losses and job opportunities.

Hypothesis

The average weekly U.S. news coverage of AI job loss will be higher than coverage of AI jobs during the period studied.

Variables and Method

I used R and RStudio to retrieve daily story counts from MediaCloud’s United States–National news collection for January 5, 2025, through October 17, 2026. I combined the daily counts into weekly totals and created a graph and summary table using an adapted version of the script provided.

The AI Job Loss search looked for stories mentioning AI or artificial intelligence along with terms related to replacing workers, displacement, layoffs, job losses, unemployment, or threatened jobs.

The AI Jobs search looked for stories mentioning AI or artificial intelligence along with terms related to job creation, hiring, opportunities, demand for skills, or employment growth.

A news story could match both searches, so the counts measure coverage containing the selected terms rather than whether a story presents AI positively or negatively.

Initial Results and Discussion

The AI Job Loss search returned 80,892 stories, averaging 869.81 stories per week. The AI Jobs search returned 67,150 stories, averaging 722.04 stories per week.

AI Job Loss also had the higher single-week peak (1,310 stories compared with 1,077 for AI Jobs) and more week-to-week variation (standard deviation of 184.42 compared with 156.55 for AI Jobs).

Using agenda-setting theory, these results suggest that AI Job Loss received more news attention than AI Jobs during the period studied. Because the two searches use different terms, some stories may have matched both. Reading more of the articles would help me see whether the searches found the coverage I intended to measure.

Overall, these results supported my original hypothesis that AI job losses would receive more news coverage than AI job opportunities.

Media Cloud Topic Summary Statistics
topic Total_Stories Weekly_Minimum Weekly_Maximum Weekly_Median Weekly_Mean Weekly_SD
AI Job Loss 80892 458 1310 866 869.81 184.42
AI Jobs 67150 328 1077 711 722.04 156.55
Descriptive Statistics: Pair Differences
count mean sd min max
93.000 147.763 90.158 −94.000 352.000
Normality Test (Shapiro-Wilk)
statistic p.value method
0.9862 0.4357 Shapiro-Wilk normality test
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.
Paired-Samples t-Test
statistic parameter p.value conf.low conf.high method
15.8054 92 0.0000 129.1957 166.3312 Paired t-test
Group Means and SDs (t-Test)
V1_Mean V2_Mean V1_SD V2_SD
722.043 869.806 156.550 184.422
Wilcoxon Signed Rank Test
statistic p.value method
58.0000 0.0000 Wilcoxon signed rank test with continuity correction
Group Means and SDs (Wilcoxon)
V1_Mean V2_Mean V1_SD V2_SD
722.043 869.806 156.550 184.422

Paired-Samples t-Test Discussion

I used a paired-samples t-test to compare weekly news coverage of AI Job Loss and AI Jobs over 93 weeks.

The results showed a statistically significant difference between the two topics, t(92) = 15.805, p < .001. AI Job Loss averaged about 148 more stories per week than AI Jobs.

The standard deviation of the paired differences was 90.16 stories, showing how much the weekly differences varied around the average.

The box plot compares weekly coverage of AI Jobs (V1) and AI Job Loss (V2), showing the distribution of story counts for each topic.

The Shapiro-Wilk test (p = .4357) did not indicate a significant departure from normality in the paired differences.

These results support my hypothesis that AI job losses receive more news coverage than AI job opportunities. However, the results do not explain why the difference exists.

Code

library(tidyverse)
library(httr2)
library(lubridate)
library(plotly)
library(knitr)
library(kableExtra)
library(gt)
library(gtExtras)
library(broom)

mc_key <- Sys.getenv("MEDIACLOUD_KEY")

start_date <- "2025-01-05"
end_date <- "2026-10-17"
loss_query <-
  '((AI OR "artificial intelligence")
AND
(replace* OR displacement OR layoff* OR
"job loss" OR "job losses" OR
eliminat* OR unemployment OR
"threatened jobs" OR
"threatens jobs" OR
"threatening jobs"))'

hiring_query <-
  '((AI OR "artificial intelligence")
AND
("job creation" OR
"create jobs" OR
"creating jobs" OR
hiring OR
opportunity* OR
"demand for skills" OR
"workforce growth" OR
"employment growth"))'

topics <- c(
  "AI Job Loss" = loss_query,
  "AI Jobs" = hiring_query
)

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_body_json(resp)
  
  map_dfr(
    results$count_over_time$counts,
    as_tibble
  ) |>
    mutate(date = as.Date(date))
}

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)
    }
  )


weekly_counts <-
  topic_data |>
  mutate(
    week = floor_date(date, unit = "week")
  ) |>
  group_by(topic, week) |>
  summarise(
    stories = sum(count),
    .groups = "drop"
  )


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

Graph <- plot_ly(
  data = weekly_counts,
  width = 1000,          
  x = ~week,
  y = ~stories,
  color = ~topic,
  colors = "Set1",
  type = "scatter",
  mode = "lines+markers"
) |>
  plotly::layout(
    title = "Weekly U.S. News Coverage: AI Employment",
    hovermode = "x unified",
    xaxis = list(title = "Week"),
    yaxis = list(
      title = "Weekly Story Count",
      separatethousands = TRUE
    )
  )

Graph

Data Reshaping Code

weekly_counts_wide <-
  weekly_counts %>%
  mutate(topic = make.names(topic)) %>%
  select(week, topic, stories) %>%
  pivot_wider(names_from = topic, values_from = stories)

Paired-Samples t-Test Code

# Data Import
mydata <- weekly_counts_wide

# Specify the two variables involved
mydata$V1 <- mydata$AI.Jobs
mydata$V2 <- mydata$AI.Job.Loss

# 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 = list(
  text = "<b>Weekly News Coverage: AI Jobs vs. AI Job Loss</b>"
),
    xaxis = list(
  title = "Topic",
  tickvals = c("V1", "V2"),
  ticktext = c("AI Jobs", "AI Job Loss")
),
    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