Mod11_AI Employment: AI Job Loss vs. AI Jobs

Rationale

Second-level agenda-setting theory looks at how the media focus on different sides of a topic. It also looks at how that coverage may influence what people think is important. In my project, I wanted to see whether news coverage focused more on AI taking jobs away or creating new AI jobs.

Hypothesis

I predict that 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 RStudio to retrieve daily story counts from MediaCloud’s United States-National news collection from 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 independent variable is the coverage topic, which is divided into two categories: AI Job Loss and AI Jobs. The dependent variable is weekly coverage volume, which is then measured by the number of news stories matching each search.

The AI Job Loss search used terms mentioning AI or artificial intelligence, replacing workers, displacement, layoffs, job losses, unemployment, or threatened jobs.

The AI Jobs search also used terms mentioning AI or artificial intelligence, but with terms related to job creation, hiring, opportunities, demand for skills, or employment growth.

The news stories could match both searches, but 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,894 stories, averaging 869.83 stories per week.

The AI Jobs search returned 67,151 stories, averaging 722.05 stories per week.

The AI Job Loss search also had the higher single-week peak (1,310 stories compared with 1,077 for AI Jobs). It had more week-to-week variation (standard deviation of 184.44 compared with 156.57 for AI Jobs).

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

A possible explanation for the higher coverage of AI job losses could be layoffs at major businesses. Researching the articles might point in that direction.

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	80894	458	1310	866	869.83	184.44
AI Jobs	67151	328	1077	711	722.05	156.57

count	mean	sd	min	max
Descriptive Statistics: Pair Differences
93.000	147.774	90.167	−94.000	352.000

statistic	p.value	method
Normality Test (Shapiro-Wilk)
0.9861	0.4343	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.

statistic	parameter	p.value	conf.low	conf.high	method
Paired-Samples t-Test
15.8050	92	0.0000	129.2046	166.3438	Paired t-test

V1_Mean	V2_Mean	V1_SD	V2_SD
Group Means and SDs (t-Test)
722.054	869.828	156.571	184.437

statistic	p.value	method
Wilcoxon Signed Rank Test
58.0000	0.0000	Wilcoxon signed rank test with continuity correction

V1_Mean	V2_Mean	V1_SD	V2_SD
Group Means and SDs (Wilcoxon)
722.054	869.828	156.571	184.437

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.17 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 = .4343) 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


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$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