Competitive Fortnite: Prize Pools, Player Engagement, and Regional Fairness

How a video game’s esports spending relates to audience attention, who earns the money, and whether regions get a fair share

Author

Robert Kirby

Published

November 8, 2026

How to read this report. It is written so that you don’t need to know anything about Fortnite or R. Each chart has a title that states its main takeaway. The R code that produced every result is hidden under the Show code buttons; use the Code menu at the top right to show or hide all of it at once. New to Fortnite? Start with Section 1. Unsure about a statistical term? See the glossary in Section 2.4.

Executive summary

Fortnite is one of the world’s most popular video games, and its developer, Epic Games, runs one of the largest competitive gaming (“esports”) circuits. This project assembles $209.1M of recorded Fortnite prize money across 2,674 tournaments and 11,443 players, together with 113 months of Twitch viewership, weekly Google search interest and 26 seasons of regional prize pools from the Fortnite Champion Series. It uses them to answer four questions:

  1. Has prize money moved together with public interest in the game?
  2. Do major tournaments draw measurably more attention?
  3. As prize money changed, did more players earn a share, or did it concentrate at the top?
  4. Is prize money split between world regions in proportion to how many people play there?
Key findings
  1. Prize money and attention follow different paths. Twitch viewership and Google search interest have declined steadily since 2018. Prize money spiked with the 2019 World Cup, then held near its 2018 level through 2023. Month to month, changes in prize money are essentially unrelated to changes in viewership (correlation -0.05).
  2. Tournaments don’t move mainstream attention; game updates do. In the week of a regional championship final, Google searches for Fortnite are only 3% higher than in surrounding weeks (median), versus 28% higher when a new season of the game launches. A regression with controls finds no significant tournament effect.
  3. The money shrank faster than the player pool, and concentrated at the top. From 2019 to 2025 prize money fell 84% while the number of players earning anything fell 32%. The top 100 earners’ share of each year’s prize money rose from 44% to 65%.
  4. Europe is not under-allocated relative to North America Central. A common view among players is that Europe receives less prize money than its player base deserves. Measured by Google search interest weighted by internet users, Europe receives 1.14x its share of players and North America Central 0.99x in the current format (2025-2026): both close to proportional, with Europe slightly ahead.
  5. The largest gaps are in smaller regions. Asia receives about 0.37x its proxy share of players, while Oceania (2.15x) and North America West (1.62x) receive well above theirs. Asia, Oceania and the Middle East were given identical prize pools in every 2025-2026 season despite very different sizes, which points to a fixed amount per small region rather than a strictly per-player formula.

These are relationships, not proof of cause and effect. Epic sets prize money partly in response to the game’s popularity, so influence can run in both directions; Section 7 covers this and the other limitations.

1 Fortnite in two minutes

The game. Fortnite is a free-to-play online game made by Epic Games. Its main mode, Battle Royale, launched in September 2017: up to 100 players drop onto an island, collect equipment, and fight until one player or team is left. It is played on PC, consoles and phones.

Seasons and chapters. Fortnite changes on a fixed rhythm. A season lasts about 11 weeks (the median across 43 seasons since 2017) and brings new items, events and a new Battle Pass (a paid set of unlockable rewards). Every year or so a new chapter replaces the whole map; there have been 7 chapters so far. In November 2023 Epic ran an “OG” season that brought back the game’s original map; it drew the highest Twitch audience in this data (2.7 million people watching at once, in November 2023). Season launches matter for this analysis because they are by far the biggest driver of public attention.

Competitive play. Alongside the casual game, Epic runs online tournaments with cash prizes:

  • Cash cups are frequent online tournaments, usually paying small prizes.
  • The Fortnite Champion Series (FNCS) is Epic’s main championship, run since 2019. Each season, players compete in open online qualifiers within their region; the best teams reach that region’s regional finals, where most of the prize money is paid. Teams are one to three players depending on the season.
  • World-level finals bring the best players from every region together: the 2019 Fortnite World Cup (its finals paid $33.6M, still the largest in the game’s history) and, since 2023, the annual FNCS Global Championship.

Regions. Online games are played on regional server networks so that players have fast connections. FNCS uses seven regions, and players compete in the one closest to them:

Code Region Mostly covers
EU Europe Europe, Russia, Turkey, North Africa
NAC North America Central (earlier “NA East”) Central and eastern US, Canada, Mexico, Caribbean
NAW North America West Western US
BR Brazil South America
ASIA Asia East, South-East and South Asia
OCE Oceania Australia, New Zealand, Pacific
ME Middle East Gulf states and the wider Middle East

From 2023 to 2024 the two North American regions were merged into one (“NA (merged)” in the charts) before being split again in 2025.

Where the attention data come from. Twitch is the main live-streaming site for video games; its viewer counts measure how many people watch Fortnite being played. Google Trends reports how popular a search topic is relative to all Google searches, on a 0-100 scale (100 = the most popular point in the period requested). Neither measures how many people play, but both track public interest.

Why regional fairness is a question. Epic has described FNCS regional prize pools as depending on each region’s “player count and competitive participation” (Charlie Intel, 2021), but does not publish the player counts. Europe has always received the largest pool, and a common view among players is that Europe’s player base is even larger than its pool reflects. Section 6 tests that.

2 Data and methods

2.1 Sources

Source What it provides How it was collected Coverage
Esports Earnings Monthly and yearly prize totals, every event and tournament, player-level earnings Polite web scraping (allowed by the site’s robots.txt and terms of use), 3 seconds between requests, all pages cached Feb 2018 to Jun 2026
Liquipedia FNCS regional finals prize pools Liquipedia’s MediaWiki API, as its API terms require; content CC-BY-SA 3.0 2019 to 2026
Google Trends Search interest worldwide, by country and by US state gtrendsR R package, using the Fortnite topic (counts searches in every language) 2017 to Nov 2026
TwitchTracker Monthly average and peak viewers, hours watched Copied once by hand (the site’s data endpoint is closed to automated tools) Jun 2017 to Oct 2026
World Bank Internet users and population by country World Bank Indicators API 2017 to 2025
FRED US state populations (Census Bureau estimates) FRED CSV endpoint 2017 to 2025
Fortnite Wiki Season start and end dates MediaWiki API; content CC-BY-SA 2017 to 2026

Every request identifies the project and a contact address, waits at least 2 seconds, and is saved locally so nothing is ever downloaded twice. Sites that block automated access (Fortnite Tracker, Fortnite.gg, SullyGnome) were not collected, and their checks were not bypassed. Every data figure in this report is computed from these sources by the code; none is estimated or typed in by hand.

2.2 Validation

Each collection and cleaning step ends with automated checks that stop the pipeline if something is wrong. The main ones:

  • Monthly prize totals add up exactly to Esports Earnings’ published yearly totals, and the years add up to the site’s all-time total.
  • The tournament list (2,674 tournaments) matches the site’s own count, and player earnings plus unassigned team money match every published yearly total to within 0.6%.
  • The number of earning players per year matches the site’s own yearly count almost exactly.
  • FNCS prize shares sum to 100% in every season, and one value checked by hand (2025 Major 1 Europe, $816,000) is tested automatically.

The checks caught real problems in the sources, which are handled explicitly in the code: the site’s event list leaves out FNCS 2025 Major 3 ($2.0M), which is added from another page of the site; multi-game events (e.g. DreamHack) mix other games’ players into their totals, so they are read tournament by tournament; and 9 small tournament pages ($14,800 in total) are broken on the source’s server and are logged and skipped.

2.3 The player-count problem

Epic does not publish how many people play in each region, so the regional analysis needs a stand-in (“proxy”). Three were built:

  1. Search interest × internet users (main proxy). Google Trends gives each country’s share of searches that are about Fortnite. Multiplying by the number of internet users turns that share into an approximate volume of interest. Countries are assigned to Fortnite regions (assumptions documented in R/region_mapping.R), and the US is split between NA Central and NA West using state-level search interest and state populations. China is left out: Google is blocked there, and Fortnite’s Chinese version shut down in November 2021 (Engadget).
  2. The same, unambiguous countries only. Drops countries whose region is a judgement call (for example India, North Africa and Canada), as a robustness check.
  3. Earning players by nationality. How many players from each region earned prize money. This is partly circular: a region with a bigger prize pool pays more places and so creates more earners. It is used only as a robustness check.

The allocation ratio for a region is its share of the FNCS prize pool divided by its share of players. A ratio of 1.0 means proportional; above 1.0 means more prize money than its player base suggests; below 1.0, less.

2.4 Glossary

Term Meaning
Correlation (r) How closely two series move together, from -1 (opposite) through 0 (unrelated) to +1 (in lockstep).
Levels vs. changes Correlating the values themselves (“levels”) vs. their month-to-month changes. Two series that both trend down look correlated in levels even if unrelated; changes remove that shared trend.
p-value Roughly, how likely a result this strong would be by chance if there were no real relationship. Below 0.05 is the usual bar for “statistically significant”.
Regression with controls A model that estimates one effect (e.g. a tournament week) while holding other factors (e.g. season launches) fixed.
Fixed effect A separate baseline for each group (here, each game season), so comparisons are made within a season.
Newey-West standard errors Error margins adjusted for the fact that this week’s value is related to last week’s, which otherwise makes results look more certain than they are.
Gini coefficient Inequality on a 0-1 scale: 0 = everyone earns the same, 1 = one person earns everything.
Lorenz curve A chart of the share of money held by the bottom x% of earners; the further it bows below the diagonal, the more unequal.
Proxy A measurable stand-in for something that can’t be observed directly (here, regional player counts).
Allocation ratio A region’s share of prize money divided by its share of players; 1.0 = proportional.

3 Prize money and attention over time

Question: has prize money moved together with public interest in the game?

Show code
source(here::here("R", "00_setup.R"))
library(patchwork)

monthly <- read_csv(file.path(paths$processed, "monthly_panel.csv"), show_col_types = FALSE)
seasons <- read_csv(file.path(paths$processed, "season_dates.csv"), show_col_types = FALSE)
events  <- read_csv(file.path(paths$processed, "ee_events.csv"), show_col_types = FALSE)

# Months where TwitchTracker's hours watched and average viewers disagree
# (incomplete months) are excluded from Twitch measures.
monthly <- monthly |>
  mutate(across(c(avg_viewers, peak_viewers, hours_watched),
                \(x) if_else(coalesce(twitch_flag, FALSE), NA_real_, x)))
Show code
# Key moments to mark on the timeline, all taken from the collected data:
# chapter launches and the OG season from the Fortnite Wiki season list, and the
# World Cup and Global Championships from Esports Earnings' event list.
key_moments <- bind_rows(
  seasons |>
    filter(season == "Season 1" & chapter != "Chapter 1" | str_detect(season, "OG")) |>
    transmute(date = start_date,
              label = if_else(str_detect(season, "OG"), "OG season",
                              str_replace(chapter, "Chapter ", "Ch. ")),
              type = "Game update"),
  events |>
    filter(str_detect(name, regex("World Cup 2019|Global Championship", ignore_case = TRUE))) |>
    group_by(label = if_else(str_detect(name, "World Cup"), "World Cup",
                             paste("Global Champ.", year(start_date)))) |>
    # Mark the final weekend (the World Cup ran qualifiers from April)
    summarise(date = max(end_date), .groups = "drop") |>
    mutate(type = "Competitive event")
) |>
  filter(date >= as.Date("2018-01-01")) |>
  arrange(date)

key_moments

The timeline marks chapter launches, the OG season and the world-level finals. Viewership and search interest share a long decline from their 2018 peak, with spikes at major game updates such as the OG season, not at tournaments.

Show code
plot_window <- c(as.Date("2018-01-01"), max(monthly$month))

moment_lines <- function(show_labels = FALSE) {
  layers <- list(geom_vline(data = key_moments, aes(xintercept = date),
                            colour = pal$muted, linewidth = 0.3, linetype = "22"))
  if (show_labels) {
    # The OG season and Chapter 5 are a month apart, so they share one label
    labelled <- key_moments |>
      filter(type == "Game update" | label == "World Cup", label != "Ch. 5") |>
      mutate(label = if_else(label == "OG season", "OG season, then Ch. 5", label))
    layers <- c(layers, list(geom_text(
      data = labelled, aes(x = date, y = Inf, label = label),
      angle = 90, hjust = 1.05, vjust = -0.4, size = 2.6, colour = pal$ink_3)))
  }
  layers
}

p_prize <- monthly |>
  filter(!is.na(prize_usd)) |>
  ggplot(aes(month, prize_usd / 1e6)) +
  moment_lines(show_labels = TRUE) +
  geom_col(fill = pal$blue, width = 25) +
  scale_y_continuous(labels = label_dollar(suffix = "M"), expand = expansion(c(0, 0.05))) +
  labs(title = NULL, x = NULL, y = "Prize money\nawarded") +
  theme_fortnite()

p_twitch <- monthly |>
  ggplot(aes(month, avg_viewers / 1e3)) +
  moment_lines() +
  geom_line(colour = pal$blue, linewidth = 0.7, na.rm = TRUE) +
  scale_y_continuous(labels = label_number(suffix = "k"), limits = c(0, NA)) +
  labs(x = NULL, y = "Twitch average\nconcurrent viewers") +
  theme_fortnite()

p_trends <- monthly |>
  ggplot(aes(month, trends_index)) +
  moment_lines() +
  geom_line(colour = pal$blue, linewidth = 0.7, na.rm = TRUE) +
  scale_y_continuous(limits = c(0, 100)) +
  labs(x = NULL, y = "Google search\ninterest (0-100)") +
  theme_fortnite()

fig_timeseries <- (p_prize / p_twitch / p_trends) &
  scale_x_date(limits = plot_window, date_breaks = "1 year", date_labels = "%Y",
               expand = expansion(0.01))
fig_timeseries <- fig_timeseries +
  plot_annotation(
    title = "Prize money spiked once; attention has drifted down since 2018",
    subtitle = "Monthly Fortnite prize money, Twitch viewership and Google search interest.\nDashed lines mark chapter launches, the OG season and world/global finals.",
    caption = "Sources: Esports Earnings (prize money), TwitchTracker (viewers), Google Trends topic 'Fortnite' (search interest), Fortnite Wiki (season dates).",
    theme = theme_fortnite()
  )

save_fig(fig_timeseries, "fig01_timeseries", height = 8)
fig_timeseries

Three stacked monthly charts from 2018 to 2026: prize money awarded (one very large spike in mid-2019), Twitch average viewers and Google search interest (both declining from 2018 peaks with a spike in late 2023).

Putting each yearly series on a common index (2018 = 100) compares them on one scale without a misleading second axis. By 2025 Twitch viewership was at 30% and search interest at 34% of their 2018 levels. Prize money, after the 2019 World Cup spike, stayed near its 2018 level through 2023 before falling.

Show code
# Yearly averages indexed to 2018 = 100 put all three series on ONE axis without
# a misleading second y-scale. 2026 is partial (prize data ends in June).
yearly <- monthly |>
  filter(month >= as.Date("2018-01-01")) |>
  group_by(year = year(month)) |>
  summarise(
    prize_usd    = sum(prize_usd, na.rm = TRUE),
    last_prize_month = suppressWarnings(max(month(month[!is.na(prize_usd)]))),
    avg_viewers  = mean(avg_viewers, na.rm = TRUE),
    trends_index = mean(trends_index, na.rm = TRUE),
    .groups = "drop"
  ) |>
  # Prize data for 2026 covers January-June only, and most prize money is paid in
  # the second half of the year, so a partial-year total is not comparable.
  mutate(prize_usd = if_else(last_prize_month < 12, NA_real_, prize_usd))

indexed <- yearly |>
  transmute(year,
            `Prize money` = prize_usd,
            `Twitch viewers` = avg_viewers,
            `Search interest` = trends_index) |>
  pivot_longer(-year, names_to = "series") |>
  group_by(series) |>
  mutate(index = 100 * value / value[year == 2018]) |>
  ungroup()

series_colours <- c(`Prize money` = pal$blue, `Twitch viewers` = pal$orange,
                    `Search interest` = pal$aqua)

fig_indexed <- indexed |>
  ggplot(aes(year, index, colour = series)) +
  geom_hline(yintercept = 100, colour = pal$ink_3, linewidth = 0.3) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 2.4, colour = pal$surface, stroke = 0) +
  geom_point(size = 1.8) +
  ggrepel::geom_text_repel(data = \(d) slice_max(filter(d, !is.na(index)), year, by = series),
            aes(label = series), nudge_x = 0.25, direction = "y", hjust = 0, size = 3.3,
            segment.colour = NA, show.legend = FALSE) +
  scale_colour_manual(values = series_colours) +
  scale_x_continuous(breaks = 2018:2026, expand = expansion(c(0.02, 0.18))) +
  scale_y_continuous(labels = \(x) paste0(x)) +
  labs(title = "Attention fell steadily; prize money held up until 2024",
       subtitle = "Yearly level indexed to 2018 = 100. Prize money shown for full years only (2026 data ends in June).",
       x = NULL, y = "Index (2018 = 100)",
       caption = "Sources: Esports Earnings, TwitchTracker, Google Trends.") +
  theme_fortnite() +
  theme(legend.position = "none")

save_fig(fig_indexed, "fig02_indexed")
fig_indexed

Line chart of yearly prize money, Twitch viewers and search interest indexed to 2018 = 100. Prize money peaks above 400 in 2019 and stays near 100 until 2023; the two attention measures fall steadily to around 30 by 2025.

3.1 Are they correlated?

The table compares correlations in levels with correlations in month-to-month changes (see the glossary). Prize money uses a rolling 3-month total because a single large event can make one month’s figure very lumpy.

Show code
# Two series that both trend down will look correlated even if they have nothing
# to do with each other. So we compare correlations in LEVELS with correlations
# in month-over-month CHANGES, which strip out the shared trend.
#
# Monthly prize money is very lumpy (one big event can be most of a year), so we
# use a 3-month rolling total, and logs so that changes are percentages.
corr_data <- monthly |>
  filter(!is.na(prize_usd)) |>
  arrange(month) |>
  mutate(prize_3m = prize_usd + lag(prize_usd) + lag(prize_usd, 2)) |>
  transmute(month,
            log_prize   = log(prize_3m),
            log_viewers = log(avg_viewers),
            log_trends  = log(trends_index)) |>
  mutate(across(-month, \(x) x - lag(x), .names = "d_{.col}")) |>
  drop_na()

corr_pair <- function(x, y, label, measure) {
  test <- cor.test(corr_data[[x]], corr_data[[y]])
  tibble(comparison = label, measure, r = test$estimate, p_value = test$p.value,
         n_months = nrow(corr_data))
}

correlations <- bind_rows(
  corr_pair("log_prize", "log_viewers", "Prize money vs Twitch viewers", "Levels"),
  corr_pair("d_log_prize", "d_log_viewers", "Prize money vs Twitch viewers", "Monthly changes"),
  corr_pair("log_prize", "log_trends", "Prize money vs search interest", "Levels"),
  corr_pair("d_log_prize", "d_log_trends", "Prize money vs search interest", "Monthly changes"),
  corr_pair("log_viewers", "log_trends", "Twitch viewers vs search interest", "Levels"),
  corr_pair("d_log_viewers", "d_log_trends", "Twitch viewers vs search interest", "Monthly changes")
)

save_table(correlations, "tab01_correlations")
correlations
Correlations between prize money, Twitch viewers and Google search interest, May 2018 to June 2026.
Comparison Measured as Correlation (r) p-value Months
Prize money vs Twitch viewers Levels 0.12 0.226 98
Prize money vs Twitch viewers Monthly changes -0.05 0.613 98
Prize money vs search interest Levels 0.09 0.382 98
Prize money vs search interest Monthly changes -0.06 0.562 98
Twitch viewers vs search interest Levels 0.83 < 0.001 98
Twitch viewers vs search interest Monthly changes -0.05 0.653 98

Prize money is not meaningfully correlated with either attention measure, in levels or in changes. Twitch viewership and search interest are strongly correlated in levels, because they share the long decline, but not in month-to-month changes, which suggests their short-run swings have different drivers. (P-values for levels are optimistic for trending series and should be read with caution.)

The lead-lag chart asks whether prize money tends to change before or after viewership. No lag stands out from what chance alone would produce, so there is no evidence that either one leads the other month to month.

Show code
# Does prize money move before or after attention? Cross-correlations of monthly
# changes at leads and lags of up to 6 months. A positive lag k means prize
# money changes k months AFTER viewers change.
lead_lag <- map(-6:6, \(k) {
  x <- corr_data$d_log_viewers
  y <- if (k >= 0) lead(corr_data$d_log_prize, k) else lag(corr_data$d_log_prize, -k)
  tibble(lag = k, r = cor(x, y, use = "complete.obs"))
}) |> list_rbind()

# Approximate 95% band for "no correlation"
band <- 1.96 / sqrt(nrow(corr_data))

fig_leadlag <- lead_lag |>
  ggplot(aes(lag, r)) +
  annotate("rect", xmin = -Inf, xmax = Inf, ymin = -band, ymax = band,
           fill = pal$grid, alpha = 0.7) +
  geom_hline(yintercept = 0, colour = pal$ink_3, linewidth = 0.3) +
  geom_segment(aes(xend = lag, yend = 0), colour = pal$blue, linewidth = 0.8) +
  geom_point(colour = pal$blue, size = 2.2) +
  scale_x_continuous(breaks = -6:6, labels = \(x) if_else(x > 0, paste0("+", x), as.character(x))) +
  scale_y_continuous(limits = c(-0.4, 0.4)) +
  labs(title = "Month-to-month, prize money and viewership barely move together",
       subtitle = "Correlation between monthly % changes in Twitch viewers and in prize money (3-month total), by lead/lag.\nShaded band: range expected by chance alone (95%).",
       x = "Lag in months (negative: prize money moves first; positive: viewers move first)", y = "Correlation",
       caption = "Sources: Esports Earnings, TwitchTracker.") +
  theme_fortnite()

save_fig(fig_leadlag, "fig03_leadlag", height = 4.6)
fig_leadlag

Lollipop chart of correlations at lags from -6 to +6 months; every value lies inside the shaded band expected by chance.

4 Do tournaments move attention?

Question: do major competitive events produce measurable bumps in attention compared with normal weeks?

Twitch data are monthly, too coarse to isolate a weekend event, so this section uses weekly Google search interest. Google only provides weekly data for windows of up to five years, so three overlapping windows were collected and joined onto one scale using the weeks they share (the overlapping weeks agree almost perfectly, with correlations above 0.99).

Show code
source(here::here("R", "00_setup.R"))
library(sandwich)

weekly  <- read_csv(file.path(paths$processed, "weekly_trends.csv"), show_col_types = FALSE)
seasons <- read_csv(file.path(paths$processed, "season_dates.csv"), show_col_types = FALSE)
fncs    <- read_csv(file.path(paths$processed, "fncs_regional.csv"), show_col_types = FALSE)
events  <- read_csv(file.path(paths$processed, "ee_events.csv"), show_col_types = FALSE)
monthly <- read_csv(file.path(paths$processed, "monthly_panel.csv"), show_col_types = FALSE)

# Google Trends weeks start on Sunday
week_of <- \(d) floor_date(d, "week", week_start = 7)

The events are the FNCS regional finals of every season plus the world-level finals (World Cup 2019 finals, the Global Championships and the 2026 Summit), all dated from the collected data. Season launches are the main confounder: a new season moves search interest far more than any tournament, so every comparison excludes or controls for them.

Show code
# Competitive events, all dated from the collected data:
#   * FNCS regional finals: one date per season (all regions play the same weekend)
#   * Global/world finals: the World Cup 2019 finals and FNCS Global Championships
fncs_finals <- fncs |>
  distinct(season, series_type, date = season_start) |>
  transmute(event = paste("FNCS", season), type = "FNCS regional finals", date)

world_finals <- events |>
  filter(str_detect(name, regex("World Cup Finals 2019|Global Championship|Major 1 Summit",
                                ignore_case = TRUE)),
         !str_detect(name, regex("qualifier", ignore_case = TRUE))) |>
  # For multi-week events use the final weekend (the end date)
  transmute(event = name, type = "World / global finals", date = end_date)

comp_events <- bind_rows(fncs_finals, world_finals) |>
  mutate(week = week_of(date)) |>
  filter(week >= min(weekly$week) + weeks(4), week <= max(weekly$week) - weeks(4)) |>
  distinct(week, .keep_all = TRUE) |>
  arrange(week)

launch_weeks <- seasons |>
  transmute(season = label, week = week_of(start_date)) |>
  filter(week >= min(weekly$week))

comp_events

4.1 A simple before-and-after comparison

For each event, search interest in the event week is compared with the average of the weeks 2-4 before and 2-4 after (skipping the adjacent weeks and any season-launch weeks). The same calculation for season launches gives a benchmark for what a real attention spike looks like.

Show code
# Simple, transparent comparison: for each event, search interest in the event
# week relative to the average of the surrounding weeks (2-4 weeks before and
# after; the weeks right next to the event are skipped so build-up and
# afterglow don't contaminate the baseline). Weeks with a season launch are
# dropped from the baseline.
bump_at <- function(target_week, exclude_weeks) {
  offsets  <- c(-4:-2, 2:4)
  baseline <- weekly |>
    filter(week %in% (target_week + weeks(offsets)),
           !week %in% exclude_weeks) |>
    pull(trends_index)
  focal <- weekly$trends_index[weekly$week == target_week]
  if (length(focal) == 0 || length(baseline) < 3) return(NA_real_)
  focal / mean(baseline) - 1
}

launch_window <- c(launch_weeks$week, launch_weeks$week + weeks(1))

event_bumps <- comp_events |>
  mutate(
    near_launch = map_lgl(week, \(w) any(abs(as.numeric(w - launch_weeks$week)) <= 7)),
    bump = map_dbl(week, bump_at, exclude_weeks = launch_window)
  )

# Benchmark: the same calculation for season-launch weeks
launch_bumps <- launch_weeks |>
  filter(week >= min(weekly$week) + weeks(4), week <= max(weekly$week) - weeks(4)) |>
  mutate(bump = map_dbl(week, bump_at, exclude_weeks = comp_events$week))

bump_summary <- bind_rows(
  event_bumps |> filter(!near_launch) |> mutate(group = type),
  launch_bumps |> mutate(group = "Season launch (benchmark)")
) |>
  group_by(group) |>
  summarise(n = sum(!is.na(bump)),
            median_bump = median(bump, na.rm = TRUE),
            mean_bump = mean(bump, na.rm = TRUE),
            share_positive = mean(bump > 0, na.rm = TRUE), .groups = "drop")

save_table(event_bumps, "tab02_event_bumps")
save_table(bump_summary, "tab03_bump_summary")
bump_summary
Change in Google search interest in the event week compared with surrounding weeks.
Type of week Events Median change Mean change Share with any increase
FNCS regional finals 20 3.4% 0.4% 55%
Season launch (benchmark) 43 28.1% 34.9% 93%
World / global finals 3 -5.2% -8.3% 33%
Show code
fig_bumps <- bind_rows(
  event_bumps |> filter(!near_launch) |> transmute(group = type, bump, event),
  launch_bumps |> transmute(group = "Season launch (benchmark)", bump, event = season)
) |>
  filter(!is.na(bump)) |>
  mutate(group = fct_relevel(group, "Season launch (benchmark)", after = Inf)) |>
  ggplot(aes(bump, fct_rev(group))) +
  geom_vline(xintercept = 0, colour = pal$ink_3, linewidth = 0.3) +
  geom_jitter(aes(colour = group == "Season launch (benchmark)"),
              height = 0.15, width = 0, size = 2.2, alpha = 0.75) +
  stat_summary(fun = median, geom = "crossbar", width = 0.5, colour = pal$ink,
               linewidth = 0.4) +
  scale_colour_manual(values = c(`FALSE` = pal$blue, `TRUE` = pal$muted), guide = "none") +
  scale_x_continuous(labels = label_percent()) +
  labs(title = "Tournaments barely register next to a new season",
       subtitle = "Google search interest in the event week vs. the surrounding weeks. Each dot is one event; bars are medians.\nEvents within a week of a season launch are excluded.",
       x = "Change in search interest vs. surrounding weeks", y = NULL,
       caption = "Sources: Google Trends (weekly, chained), Liquipedia and Esports Earnings (event dates), Fortnite Wiki (season dates).") +
  theme_fortnite()

save_fig(fig_bumps, "fig04_event_bumps", height = 4.4)
fig_bumps

Dot plot: FNCS regional finals and world finals cluster around zero change in search interest, while season launches cluster around +30% with some above +100%.

4.2 Regression with controls

The regression estimates search interest in each of the 3 weeks before and after an event, compared with the rest of the same game season, while controlling for season-launch weeks and for how far into the season a week falls (interest fades through a season, and FNCS finals are usually held late in one). Error margins use Newey-West standard errors.

Show code
# Regression version: log search interest on event-time dummies (3 weeks before
# to 3 weeks after each event), with
#   * dummies for season-launch weeks (week 0 and week 1),
#   * a fixed effect for each season, so events are compared with their own season, and
#   * weeks since the season launched (and its square), because interest decays
#     through a season and FNCS finals are usually held late in it. Without this,
#     events would look "below average" simply because of when they happen.
# Standard errors are Newey-West (4 lags) because weekly series are autocorrelated.
season_of <- function(w) {
  idx <- findInterval(as.numeric(w), as.numeric(launch_weeks$week))
  launch_weeks$season[pmax(idx, 1)]
}

reg_data <- weekly |>
  mutate(log_trends = log(trends_index),
         season = season_of(week),
         weeks_in = as.numeric(week - launch_weeks$week[match(season, launch_weeks$season)]) / 7,
         launch0 = week %in% launch_weeks$week,
         launch1 = week %in% (launch_weeks$week + weeks(1)))

for (k in -3:3) {
  hit <- comp_events$week + weeks(k)
  reg_data[[paste0("ev_", if (k < 0) paste0("m", -k) else k)]] <- reg_data$week %in% hit
}

event_terms <- c("ev_m3", "ev_m2", "ev_m1", "ev_0", "ev_1", "ev_2", "ev_3")
es_formula  <- reformulate(c(event_terms, "launch0", "launch1", "weeks_in", "I(weeks_in^2)",
                              "factor(season)"), "log_trends")
es_model    <- lm(es_formula, data = reg_data)
es_vcov     <- NeweyWest(es_model, lag = 4, prewhite = FALSE)

coef_table <- tibble(
  term = names(coef(es_model)),
  estimate = coef(es_model),
  se = sqrt(diag(es_vcov))
) |>
  filter(term %in% c(paste0(event_terms, "TRUE"), "launch0TRUE", "launch1TRUE")) |>
  mutate(term = str_remove(term, "TRUE"),
         pct_effect = exp(estimate) - 1,
         ci_low = exp(estimate - 1.96 * se) - 1,
         ci_high = exp(estimate + 1.96 * se) - 1,
         p_value = 2 * pnorm(-abs(estimate / se)))

save_table(coef_table, "tab04_event_regression")
coef_table
Estimated difference in search interest around competitive events and season launches.
Week Estimated difference 95% confidence interval p-value
3 weeks before event -7.8% -13.6% to -1.5% 0.015
2 weeks before -7.5% -13.1% to -1.5% 0.015
1 week before -8.6% -14.7% to -2.1% 0.010
Event week -1.3% -8.0% to 5.8% 0.710
1 week after -2.9% -18.1% to 15.1% 0.735
2 weeks after 5.1% -4.4% to 15.6% 0.301
3 weeks after 8.6% 0.3% to 17.6% 0.042
Season launch week 38.5% 15.7% to 65.7% < 0.001
Week after launch 8.0% -3.9% to 21.4% 0.196
Show code
fig_es <- coef_table |>
  filter(str_starts(term, "ev_")) |>
  mutate(k = parse_number(str_replace(term, "m", "-"))) |>
  ggplot(aes(k, pct_effect)) +
  geom_hline(yintercept = 0, colour = pal$ink_3, linewidth = 0.3) +
  geom_vline(xintercept = 0, colour = pal$muted, linewidth = 0.3, linetype = "22") +
  geom_errorbar(aes(ymin = ci_low, ymax = ci_high), width = 0, colour = pal$blue,
                linewidth = 0.7) +
  geom_point(colour = pal$blue, size = 2.6) +
  scale_x_continuous(breaks = -3:3,
                     labels = \(x) case_when(x == 0 ~ "Event\nweek", x < 0 ~ paste0(x, "w"),
                                             .default = paste0("+", x, "w"))) +
  scale_y_continuous(labels = label_percent()) +
  labs(title = "No detectable bump in search interest during event weeks",
       subtitle = "Difference from the rest of the same season, controlling for season-launch weeks and how far into the season\nthe week falls. 95% confidence intervals (Newey-West).",
       x = NULL, y = "Difference in search interest",
       caption = "Sources: Google Trends (weekly), Liquipedia, Esports Earnings, Fortnite Wiki.") +
  theme_fortnite()

save_fig(fig_es, "fig05_event_study", height = 4.4)
fig_es

Coefficient plot for weeks -3 to +3 around events; the event-week estimate is about -1% with a confidence interval spanning zero.

The event-week estimate is small and not statistically significant (-1.3%, 95% interval -8.0% to 5.8%), while a season-launch week adds about 38%. The weeks before events sit slightly below the season average and the weeks after drift up; both patterns fit events being held near the end of a season, with the next launch approaching, rather than events causing anything.

4.3 A monthly check with Twitch

Show code
# Monthly check with Twitch: are months that contain a major competitive event
# watched more than other months in the same year? Peak viewers is the most
# event-sensitive measure (a single big broadcast can set the month's peak).
twitch_months <- monthly |>
  filter(!coalesce(twitch_flag, TRUE), month >= as.Date("2018-01-01")) |>
  mutate(year = year(month),
         event_month = month %in% floor_date(comp_events$date, "month"),
         launch_month = month %in% floor_date(seasons$start_date, "month"))

twitch_models <- list(
  `Average viewers` = lm(log(avg_viewers) ~ event_month + launch_month + factor(year), twitch_months),
  `Peak viewers`    = lm(log(peak_viewers) ~ event_month + launch_month + factor(year), twitch_months)
)

twitch_effects <- imap(twitch_models, \(m, outcome) {
  v <- NeweyWest(m, lag = 3, prewhite = FALSE)
  tibble(outcome,
         term = c("Month with a major event", "Month with a season launch"),
         estimate = coef(m)[c("event_monthTRUE", "launch_monthTRUE")],
         se = sqrt(diag(v))[c("event_monthTRUE", "launch_monthTRUE")])
}) |>
  list_rbind() |>
  mutate(pct_effect = exp(estimate) - 1,
         p_value = 2 * pnorm(-abs(estimate / se)))

save_table(twitch_effects, "tab05_twitch_monthly")
twitch_effects
Twitch viewership in months containing a major event or a season launch, compared with other months of the same year.
Outcome Month Estimated difference p-value
Average viewers Month with a major event -4.2% 0.394
Average viewers Month with a season launch -0.5% 0.877
Peak viewers Month with a major event 2.5% 0.844
Peak viewers Month with a season launch -21.3% 0.020

Months containing a major competitive event are not watched measurably more than other months of the same year, on average or at peak. A monthly comparison is a blunt tool, though: one large broadcast or in-game event can set a month’s peak.

5 Who earns the money?

Question: as total prize money changed, did the scene get deeper (more players earning) or more top-heavy (money concentrated among a few)?

Show code
source(here::here("R", "00_setup.R"))
library(ineq)
library(patchwork)

ee_yearly    <- read_csv(file.path(paths$processed, "ee_yearly.csv"), show_col_types = FALSE)
player_year  <- read_csv(file.path(paths$processed, "player_year.csv"), show_col_types = FALSE)
tournaments  <- read_csv(file.path(paths$processed, "tournaments_clean.csv"), show_col_types = FALSE,
                         guess_max = 1e5)

# 2026 only covers January-June in the source, so it is kept but labelled partial.
last_full_year <- 2025
Show code
# Concentration is measured on prize money paid to NAMED players (the money
# Esports Earnings can attribute to individuals). Top-N shares use the full
# yearly prize total as the denominator, so unattributed money counts as
# "not top-N", which is the conservative choice.
concentration <- player_year |>
  group_by(year) |>
  arrange(desc(earnings_usd), .by_group = TRUE) |>
  summarise(
    named_players  = n(),
    gini           = Gini(earnings_usd),
    top10_usd      = sum(head(earnings_usd, 10)),
    top100_usd     = sum(head(earnings_usd, 100)),
    median_player  = median(earnings_usd),
    .groups = "drop"
  )

tournament_stats <- tournaments |>
  filter(!is.na(prize_usd), prize_usd > 0) |>
  group_by(year) |>
  summarise(n_tournaments  = n(),
            mean_prize     = mean(prize_usd),
            median_prize   = median(prize_usd), .groups = "drop")

ecosystem <- ee_yearly |>
  left_join(concentration, by = "year") |>
  left_join(tournament_stats, by = "year") |>
  mutate(top10_share  = top10_usd / prize_usd,
         top100_share = top100_usd / prize_usd,
         prize_per_earner = prize_usd / earning_players,
         partial_year = year > last_full_year) |>
  select(year, partial_year, prize_usd, earning_players, named_players, prize_per_earner,
         n_tournaments, mean_prize, median_prize, top10_share, top100_share, gini, median_player)

save_table(ecosystem, "tab06_ecosystem")
ecosystem
Fortnite prize money and its distribution by year. 2026 covers January to June only.
Year Prize money Players earning Tournaments Median tournament prize Top 10 share Top 100 share Gini Median earner
2018 $19.9M 1,443 179 $7,855 16% 53% 0.77 $2,500
2019 $80.8M 3,486 504 $25,000 19% 44% 0.88 $1,500
2020 $18.5M 2,635 377 $14,100 8% 34% 0.77 $1,150
2021 $23.0M 1,431 213 $19,035 14% 54% 0.80 $2,000
2022 $18.7M 1,702 404 $6,000 22% 58% 0.84 $1,000
2023 $19.7M 3,291 463 $9,600 18% 52% 0.87 $500
2024 $12.4M 1,430 201 $19,300 22% 64% 0.84 $1,115
2025 $12.9M 2,365 248 $6,098 18% 65% 0.86 $600
2026* $3.1M 1,277 85 $4,200 33% 73% 0.85 $250

5.1 Deeper or shallower?

Show code
year_scale <- scale_x_continuous(breaks = 2018:2026,
                                 labels = \(x) if_else(x == 2026, "2026*", as.character(x)))

p_money <- ecosystem |>
  ggplot(aes(year, prize_usd / 1e6)) +
  geom_col(aes(fill = partial_year), width = 0.7) +
  geom_text(aes(label = label_dollar(accuracy = 1, suffix = "M")(prize_usd / 1e6)),
            vjust = -0.4, size = 2.8, colour = pal$ink_2) +
  scale_fill_manual(values = c(`FALSE` = pal$blue, `TRUE` = pal$muted), guide = "none") +
  scale_y_continuous(labels = label_dollar(suffix = "M"), expand = expansion(c(0, 0.12))) +
  year_scale +
  labs(x = NULL, y = "Total prize money", subtitle = "Prize money awarded") +
  theme_fortnite()

p_players <- ecosystem |>
  ggplot(aes(year, earning_players)) +
  geom_col(aes(fill = partial_year), width = 0.7) +
  geom_text(aes(label = comma(earning_players)), vjust = -0.4, size = 2.8, colour = pal$ink_2) +
  scale_fill_manual(values = c(`FALSE` = pal$blue, `TRUE` = pal$muted), guide = "none") +
  scale_y_continuous(labels = comma, expand = expansion(c(0, 0.12))) +
  year_scale +
  labs(x = NULL, y = "Players", subtitle = "Players who earned any prize money") +
  theme_fortnite()

fig_depth <- (p_money | p_players) +
  plot_annotation(
    title = "Prize money fell 84% from 2019 to 2025; the number of earners fell only a third",
    caption = "* 2026 covers January-June only. Source: Esports Earnings.",
    theme = theme_fortnite())

save_fig(fig_depth, "fig06_depth", width = 10, height = 4.6)
fig_depth

Two bar charts by year: prize money peaks at $80.8M in 2019 then sits between $12M and $23M; players earning money peak at about 3,500 in 2019 and 3,300 in 2023.

Prize money and the number of earners do not move one-for-one. 2023 paid out about the same total as 2018 but to 2.3 times as many players, because Epic ran many small cash cups that year. How many people earn depends heavily on tournament format, not just on the size of the pool.

5.2 More top-heavy?

Show code
conc_long <- ecosystem |>
  select(year, partial_year, `Top 10` = top10_share, `Top 100` = top100_share) |>
  pivot_longer(starts_with("Top"), names_to = "group", values_to = "share")

p_share <- conc_long |>
  ggplot(aes(year, share, colour = group)) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 2) +
  geom_text(data = \(d) filter(d, year == max(year)), aes(label = group),
            hjust = -0.1, size = 3.2, show.legend = FALSE) +
  scale_colour_manual(values = c(`Top 10` = pal$blue, `Top 100` = pal$orange)) +
  scale_y_continuous(labels = label_percent(), limits = c(0, NA)) +
  scale_x_continuous(breaks = 2018:2026, expand = expansion(c(0.03, 0.2)),
                     labels = \(x) if_else(x == 2026, "2026*", as.character(x))) +
  coord_cartesian(clip = "off") +
  labs(x = NULL, y = "Share of the year's prize money",
       subtitle = "Share of all prize money won by the top earners") +
  theme_fortnite() + theme(legend.position = "none")

p_gini <- ecosystem |>
  ggplot(aes(year, gini)) +
  geom_line(colour = pal$blue, linewidth = 0.8) +
  geom_point(colour = pal$blue, size = 2) +
  scale_y_continuous(limits = c(0, 1)) +
  year_scale +
  labs(x = NULL, y = "Gini coefficient",
       subtitle = "Inequality among earners (0 = equal, 1 = one player takes all)") +
  theme_fortnite()

fig_concentration <- (p_share | p_gini) +
  plot_annotation(
    title = "The top 100 now take nearly two-thirds of all prize money",
    caption = "* 2026 covers January-June only. Gini computed over players Esports Earnings can name. Source: Esports Earnings.",
    theme = theme_fortnite())

save_fig(fig_concentration, "fig07_concentration", height = 4.6)
fig_concentration

Left: share of prize money won by the top 10 and top 100 players, rising since 2020 with the top 100 near 65% in 2024-2025. Right: Gini coefficient between about 0.77 and 0.88 every year.

Show code
# Lorenz curves show the whole distribution: the further a curve bows below the
# diagonal, the more unequal earnings are.
lorenz_years <- c(2019, 2021, 2023, last_full_year)
lorenz <- player_year |>
  filter(year %in% lorenz_years) |>
  group_by(year) |>
  arrange(earnings_usd, .by_group = TRUE) |>
  mutate(pop_share = row_number() / n(),
         earn_share = cumsum(earnings_usd) / sum(earnings_usd)) |>
  ungroup() |>
  mutate(year = factor(year))

lorenz_colours <- setNames(c(pal$blue, pal$orange, pal$aqua, pal$yellow), lorenz_years)

fig_lorenz <- lorenz |>
  ggplot(aes(pop_share, earn_share, colour = year)) +
  geom_abline(slope = 1, intercept = 0, colour = pal$ink_3, linewidth = 0.3, linetype = "22") +
  geom_line(linewidth = 0.8) +
  scale_colour_manual(values = lorenz_colours) +
  scale_x_continuous(labels = label_percent()) +
  scale_y_continuous(labels = label_percent()) +
  coord_equal() +
  labs(title = "The top 10% of earners take 70-85% of the money",
       subtitle = "Lorenz curves: cumulative share of prize money (y) held by the bottom x% of earners.\nThe further a curve bows below the diagonal, the more unequal the year.",
       x = "Earners, poorest to richest", y = "Share of prize money",
       caption = "Source: Esports Earnings (players Esports Earnings can name).") +
  theme_fortnite()

save_fig(fig_lorenz, "fig08_lorenz", width = 6.5, height = 6.2)
fig_lorenz

Lorenz curves for 2019, 2021, 2023 and 2025, all bowing far below the diagonal, with 2021 the least unequal.

Inequality among earners is high every year. The top 10% of earners take between 62% and 85% of a year’s prize money, the bottom half never more than 6%, and the Gini coefficient ranges from 0.77 to 0.88. Since 2020 the trend has been toward more concentration: the top-100 share has risen while the median earner’s yearly total has fallen from $2,500 in 2018 to $600 in 2025.

Show code
fig_pools <- ecosystem |>
  select(year, Mean = mean_prize, Median = median_prize) |>
  pivot_longer(-year) |>
  ggplot(aes(year, value, colour = name)) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 2) +
  geom_text(data = \(d) filter(d, year == max(year)), aes(label = name),
            hjust = -0.2, size = 3.2, show.legend = FALSE) +
  scale_colour_manual(values = c(Mean = pal$blue, Median = pal$orange)) +
  scale_y_log10(labels = label_dollar(scale_cut = cut_short_scale())) +
  scale_x_continuous(breaks = 2018:2026, expand = expansion(c(0.03, 0.12)),
                     labels = \(x) if_else(x == 2026, "2026*", as.character(x))) +
  labs(title = "The typical tournament stayed small while a few huge ones set the average",
       subtitle = "Mean and median prize pool per tournament (log scale)",
       x = NULL, y = "Prize pool per tournament",
       caption = "* 2026 covers January-June only. Source: Esports Earnings.") +
  theme_fortnite() + theme(legend.position = "none")

save_fig(fig_pools, "fig09_mean_median", height = 4.6)
fig_pools

Mean and median prize pool per tournament on a log scale; the mean sits several times above the median every year.

The average tournament prize pool sits far above the median every year: a few very large events (FNCS finals, Global Championships) pull the average up, while the typical tournament pays a few thousand dollars.

6 Regional fairness

Question: does each region’s share of FNCS prize money match its share of players? In particular, is Europe under-allocated relative to North America Central?

Show code
source(here::here("R", "00_setup.R"))
library(ggrepel)

fncs    <- read_csv(file.path(paths$processed, "fncs_regional.csv"), show_col_types = FALSE)
proxies <- read_csv(file.path(paths$processed, "region_proxies.csv"), show_col_types = FALSE)

proxy_labels <- c(
  trends_internet             = "Search interest x internet users",
  trends_internet_unambiguous = "Same, unambiguous countries only",
  earning_players             = "Earning players by nationality"
)
Show code
# Region sets differ over time: NA was one merged region from 2023 Major 2 to
# 2024, and earning-player counts cannot split the US into NAC and NAW. So we
# build each comparison at the finest level both sides support:
#   * "split" scheme: NAC and NAW separate (merged seasons use NA = NAC + NAW).
#     Used with the Trends proxies, which split the US by state.
#   * "combined" scheme: all of North America as one region. Used with every
#     proxy, so all three can be compared like for like.
to_combined <- \(r) if_else(r %in% c("NAC", "NAW", "NA (merged)", "US"), "NA (all)", r)

season_regions <- fncs |> distinct(season, region)
merged_seasons <- season_regions |> filter(region == "NA (merged)") |> pull(season)

prize_split <- fncs |>
  select(season, season_start, year, series_type, region, prize_pool_usd, prize_share)

prize_combined <- fncs |>
  mutate(region = to_combined(region)) |>
  group_by(season, season_start, year, series_type, region) |>
  summarise(prize_pool_usd = sum(prize_pool_usd), prize_share = sum(prize_share), .groups = "drop")

proxy_split <- proxies |>
  filter(proxy != "earning_players") |>
  select(proxy, year, region, player_share = share)

proxy_combined <- proxies |>
  mutate(region = to_combined(region)) |>
  group_by(proxy, year, region) |>
  summarise(player_share = sum(share), .groups = "drop")

allocation_split <- prize_split |>
  # In merged-NA seasons, compare the merged region's prize share with NAC + NAW players
  cross_join(tibble(proxy = unique(proxy_split$proxy))) |>
  left_join(
    bind_rows(
      proxy_split,
      proxy_split |> filter(region %in% c("NAC", "NAW")) |>
        group_by(proxy, year) |> summarise(player_share = sum(player_share), .groups = "drop") |>
        mutate(region = "NA (merged)")
    ),
    by = c("proxy", "year", "region")) |>
  mutate(scheme = "split")

allocation_combined <- prize_combined |>
  cross_join(tibble(proxy = unique(proxy_combined$proxy))) |>
  left_join(proxy_combined, by = c("proxy", "year", "region")) |>
  mutate(scheme = "combined")

allocation <- bind_rows(allocation_split, allocation_combined) |>
  mutate(allocation_ratio = prize_share / player_share,
         proxy_label = proxy_labels[proxy])

check(!anyNA(allocation$player_share), "a season-region has no proxy value")
save_table(allocation, "tab07_allocation_all")

allocation |>
  filter(scheme == "split", proxy == "trends_internet", season == last(fncs$season)) |>
  select(season, region, prize_pool_usd, prize_share, player_share, allocation_ratio)

6.1 How the prize pool has been divided

Show code
# How the prize pool itself has been divided over time
# complete() adds empty rows for regions absent in a season (e.g. NAC during the
# merged-NA seasons), so lines break there instead of bridging the gap.
fig_prize_split <- prize_split |>
  filter(series_type == "regular") |>
  complete(nesting(season, season_start), region) |>
  mutate(region = factor(region, region_order),
         highlight = region %in% c("EU", "NAC", "NA (merged)")) |>
  ggplot(aes(season_start, prize_share, group = region)) +
  geom_line(data = \(d) filter(d, !highlight), colour = pal$muted, linewidth = 0.5) +
  geom_line(data = \(d) filter(d, highlight), aes(colour = region), linewidth = 0.9) +
  geom_point(data = \(d) filter(d, highlight), aes(colour = region), size = 1.8) +
  geom_text_repel(data = \(d) slice_max(filter(d, !is.na(prize_share)), season_start, by = region),
                  aes(label = region, colour = if_else(highlight, as.character(region), NA)),
                  nudge_x = 60, direction = "y", hjust = 0, size = 3.2, segment.colour = NA,
                  show.legend = FALSE, na.rm = TRUE) +
  scale_colour_manual(values = region_colours, na.value = pal$ink_3, guide = "none") +
  scale_y_continuous(labels = label_percent(), limits = c(0, NA)) +
  scale_x_date(date_labels = "%Y", date_breaks = "1 year", expand = expansion(c(0.02, 0.08))) +
  labs(title = "Europe has always received the largest slice of the FNCS prize pool",
       subtitle = "Each region's share of the regional-finals prize pool, regular FNCS seasons. NAC includes its predecessor NA East;\nfrom 2023 Major 2 to 2024 North America was one merged region, NA (merged).",
       x = NULL, y = "Share of FNCS prize pool",
       caption = "Source: Liquipedia (CC-BY-SA 3.0), FNCS regional grand finals pages.") +
  theme_fortnite()

save_fig(fig_prize_split, "fig10_prize_shares")
fig_prize_split

Line chart of each region's share of the FNCS prize pool per season: Europe between about 36% and 48%, North America Central between about 21% and 28%, merged North America about 31-36% in 2023-2024, other regions below 15%.

6.2 Prize share vs. player share

Show code
# Prize share vs player share for the current format (2025 onward, when NAC and
# NAW are separate again), averaged over its regular seasons.
current <- allocation |>
  filter(scheme == "split", proxy == "trends_internet", series_type == "regular",
         year >= 2025) |>
  group_by(region) |>
  summarise(prize_share = mean(prize_share), player_share = mean(player_share),
            seasons = n_distinct(season), .groups = "drop") |>
  mutate(allocation_ratio = prize_share / player_share,
         highlight = region %in% c("EU", "NAC"))

lim <- max(c(current$prize_share, current$player_share)) * 1.1

fig_scatter <- current |>
  ggplot(aes(player_share, prize_share)) +
  geom_abline(slope = 1, intercept = 0, colour = pal$ink_3, linetype = "22", linewidth = 0.4) +
  annotate("text", x = lim * 0.5, y = lim * 0.44, label = "proportional allocation",
           angle = 45, size = 3, colour = pal$ink_3, hjust = 0.5) +
  geom_point(aes(colour = region), size = 3.6) +
  geom_text_repel(aes(label = glue("{region}  ({number(allocation_ratio, 0.01)}x)")),
                  size = 3.4, colour = pal$ink, point.padding = 6, seed = 1) +
  scale_colour_manual(values = region_colours, na.value = pal$muted, guide = "none") +
  scale_x_continuous(labels = label_percent(), limits = c(0, lim), expand = expansion(0)) +
  scale_y_continuous(labels = label_percent(), limits = c(0, lim), expand = expansion(0)) +
  coord_equal() +
  labs(title = "EU slightly above its share, NAC right on it, Asia far below",
       subtitle = "Above the line: more prize money than the player-base proxy suggests.\nLabels show the allocation ratio (prize share / player share).",
       x = "Share of players (search interest x internet users)",
       y = "Share of FNCS prize pool",
       caption = "Sources: Liquipedia; Google Trends; World Bank; US Census via FRED. Average of regular FNCS seasons 2025-2026.") +
  theme_fortnite()

save_fig(fig_scatter, "fig11_share_scatter", width = 7, height = 7)
save_table(current, "tab08_current_allocation")
fig_scatter

Scatter plot of prize share against player share for 2025-2026 with a 45-degree line. Europe and NA Central sit close to the line, Asia far below it, Oceania and NA West above it.

Points above the diagonal receive more prize money than their share of players. In the current format (2025-2026) Europe is slightly above proportional (1.14x) and North America Central almost exactly on it (0.99x). The large gaps are among the smaller regions: Asia far below, and Oceania and NA West well above. Asia, Oceania and the Middle East each received exactly the same pool in every 2025-2026 season ($90,000 in 2025, $75,000 in 2026), so their ratios are driven by differences in player share rather than by any difference in prize money.

Show code
fig_ratio <- allocation |>
  filter(scheme == "split", proxy == "trends_internet", series_type == "regular") |>
  complete(nesting(season, season_start), region) |>
  mutate(highlight = region %in% c("EU", "NAC", "NA (merged)")) |>
  ggplot(aes(season_start, allocation_ratio, group = region)) +
  geom_hline(yintercept = 1, colour = pal$ink_3, linewidth = 0.4) +
  geom_line(data = \(d) filter(d, !highlight), colour = pal$muted, linewidth = 0.5) +
  geom_line(data = \(d) filter(d, highlight), aes(colour = region), linewidth = 0.9) +
  geom_point(data = \(d) filter(d, highlight), aes(colour = region), size = 1.8) +
  geom_text_repel(data = \(d) slice_max(filter(d, !is.na(allocation_ratio), region != "NA (merged)"),
                                         season_start, by = region),
                  aes(label = region), nudge_x = 60, direction = "y", hjust = 0,
                  size = 3.2, colour = pal$ink_2, segment.colour = NA) +
  # The merged-NA line ends mid-chart, so it is labelled where it sits
  geom_text(data = \(d) slice_max(filter(d, region == "NA (merged)", !is.na(allocation_ratio)), season_start),
            aes(label = "NA (merged)"), vjust = 2.2, hjust = 1, size = 3.2, colour = pal$ink_2) +
  scale_colour_manual(values = region_colours, guide = "none") +
  scale_y_log10(breaks = c(0.25, 0.5, 1, 2, 4), labels = \(x) paste0(x, "x")) +
  scale_x_date(date_labels = "%Y", date_breaks = "1 year", expand = expansion(c(0.02, 0.08))) +
  labs(title = "Europe has been paid slightly above its share in every season",
       subtitle = "Prize share / player share (log scale). 1x = proportional; below 1x = less prize money than the player-base proxy implies.",
       x = NULL, y = "Allocation ratio",
       caption = "Player share: Google search interest x internet users. Sources: Liquipedia, Google Trends, World Bank, FRED.") +
  theme_fortnite()

save_fig(fig_ratio, "fig12_ratio_over_time")
fig_ratio

Allocation ratio by region and season on a log scale. Europe sits between about 1.05x and 1.3x throughout; NA Central near 1x; Asia between about 0.3x and 0.75x; Oceania between about 1.3x and 3.7x.

6.3 Europe vs. North America Central, under three proxies

Show code
# Headline: EU vs NAC. Relative allocation = EU's allocation ratio divided by
# NAC's. Above 1 = EU gets more prize money per unit of player base than NAC.
# Computed for every proxy using the "combined" scheme for earning players (the
# only scheme that proxy supports, so it compares EU with all of NA) and the
# "split" scheme for the Trends proxies.
headline <- allocation |>
  filter(series_type == "regular",
         (scheme == "split" & proxy != "earning_players") | (scheme == "combined" & proxy == "earning_players")) |>
  mutate(region = if_else(region %in% c("NAC", "NA (merged)", "NA (all)"), "NAC/NA", region)) |>
  filter(region %in% c("EU", "NAC/NA")) |>
  select(season, season_start, year, proxy, proxy_label, region, prize_share, player_share, allocation_ratio) |>
  pivot_wider(names_from = region, values_from = c(prize_share, player_share, allocation_ratio)) |>
  mutate(prize_ratio_eu_vs_na  = `prize_share_EU` / `prize_share_NAC/NA`,
         player_ratio_eu_vs_na = `player_share_EU` / `player_share_NAC/NA`,
         relative_allocation   = `allocation_ratio_EU` / `allocation_ratio_NAC/NA`)

headline_summary <- headline |>
  group_by(proxy_label, era = if_else(year >= 2025, "2025-2026", "2019-2024")) |>
  summarise(seasons = n(),
            eu_prize_vs_na  = mean(prize_ratio_eu_vs_na),
            eu_players_vs_na = mean(player_ratio_eu_vs_na),
            relative_allocation = mean(relative_allocation),
            .groups = "drop") |>
  arrange(era, proxy_label)

save_table(headline, "tab09_eu_vs_nac_by_season")
save_table(headline_summary, "tab10_eu_vs_nac_summary")
headline_summary
Europe compared with North America under each player-base proxy (averages across regular FNCS seasons).
Player-base proxy Period Seasons EU prize ÷ NA prize EU players ÷ NA players EU relative allocation
Earning players by nationality 2019-2024 18 1.36 1.39 0.99
Same, unambiguous countries only 2019-2024 18 1.74 1.22 1.43
Search interest x internet users 2019-2024 18 1.74 1.38 1.26
Earning players by nationality 2025-2026 5 1.09 1.34 0.83
Same, unambiguous countries only 2025-2026 5 1.44 1.08 1.34
Search interest x internet users 2025-2026 5 1.44 1.26 1.15

Relative allocation divides Europe’s allocation ratio by North America’s: above 1 means Europe gets more prize money per unit of player base. The search-based proxies compare Europe with NA Central (with merged NA in 2023-2024); the earning-players proxy can only compare Europe with all of North America.

Show code
fig_robust <- headline |>
  mutate(proxy_label = factor(proxy_label, proxy_labels)) |>
  ggplot(aes(season_start, relative_allocation, colour = proxy_label)) +
  geom_hline(yintercept = 1, colour = pal$ink_3, linewidth = 0.4) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 1.8) +
  scale_colour_manual(values = setNames(c(pal$blue, pal$aqua, pal$orange), proxy_labels)) +
  scale_y_log10(breaks = c(0.7, 0.8, 0.9, 1, 1.25, 1.5, 1.75, 2), labels = \(x) paste0(x, "x")) +
  scale_x_date(date_labels = "%Y", date_breaks = "1 year") +
  guides(colour = guide_legend(nrow = 1)) +
  labs(title = "Whether Europe is underpaid depends on how you count players",
       subtitle = "EU's allocation ratio divided by North America's. Above 1x: EU gets more prize money per unit of player base; below 1x: less.\nSearch proxies compare EU with NAC (NA when merged); earning players compare EU with all of North America (NAC + NAW).",
       x = NULL, y = "EU relative allocation (log scale)",
       caption = "Sources: Liquipedia, Google Trends, World Bank, FRED, Esports Earnings.") +
  theme_fortnite()

save_fig(fig_robust, "fig13_robustness")
fig_robust

Europe's relative allocation by season under three proxies. Both search-based proxies stay above 1x in every season; the earning-players proxy moves between about 0.7x and 1.25x.

Both search-based proxies agree that Europe’s player base is larger than NA Central’s (1.26x in the main proxy for 2025-2026), but Europe’s prize pool is larger by more (1.44x). By these measures Europe is, if anything, slightly over-allocated relative to NA Central, in every season since 2019. Only the earning-players proxy puts Europe below North America, and that proxy is partly circular and compares Europe with all of North America. The view that Europe is under-allocated relative to NA Central is not supported by the available evidence.

7 Limitations

  • No direct player counts. Epic does not publish regional player numbers, and the sites that estimate them block automated collection. Every regional conclusion rests on proxies. The Europe result holds under both search-based proxies but not under the earning-players count.
  • Searching is not playing. The main proxy assumes that people in different countries use Google to a similar degree and that searching for Fortnite reflects playing it. Region assignment is a judgement call for some countries (tested by dropping them).
  • Cause and effect. Epic sets prize money partly based on popularity, and popularity may respond to prize money. Nothing here identifies a causal effect in either direction.
  • Limited power for the event study. About twenty FNCS finals in weekly data can detect a moderate bump but not a small one; “no detectable effect” does not mean “no effect”.
  • Coverage. Esports Earnings data end in June 2026, and about 19% of prize money cannot be assigned to named players (for example team prizes without rosters), so concentration measures cover named players only. 2026 figures are partial. Incomplete Twitch months (June-September 2017 and October 2026) are excluded.
  • Regional finals only. Epic’s regional allocation also includes qualifier rounds and cash cups that are not counted in the regional finals pools.

8 Next steps

  • Add open-qualifier participation counts by region if a source that allows automated access becomes available; this would be the most direct measure of each region’s competitive player base.
  • Use daily Google Trends data (available for windows under nine months) around events to sharpen the event study.
  • Separate cash cups from championship events to see whether the rise in concentration comes from changes in tournament format.

Reproducibility

The full pipeline is in the R/ folder, numbered in run order. Each script runs on its own, uses here::here() paths, skips downloads that are already saved, and ends with validation checks. With the saved data, the whole pipeline reruns in about a minute without any network access, and renv.lock records the exact package versions.

R/00_setup.R                     packages, paths, polite download helper, chart theme
R/01_collect_esports_earnings.R  monthly/yearly totals, top players, events list
R/01b_collect_ee_event_details.R every event and tournament page: tournaments + player earnings
R/02_collect_liquipedia_fncs.R   FNCS pages via the Liquipedia API
R/03_collect_google_trends.R     Google Trends, World Bank, US state populations
R/04_collect_twitch.R            reads the hand-copied TwitchTracker table
R/05_collect_season_dates.R      season dates from the Fortnite Wiki API
R/10_clean_merge.R               tidy analysis datasets + validation
R/20-23_analysis_*.R             one script per research question (shown above)
R/region_mapping.R               country-to-region assumptions, in one place
# 00_setup.R ------------------------------------------------------------------
# Shared packages, paths and helpers. Every other script sources this file
# first, so each script can run on its own from top to bottom.

suppressPackageStartupMessages({
  library(tidyverse)
  library(rvest)
  library(httr2)
  library(janitor)
  library(lubridate)
  library(scales)
  library(here)
  library(jsonlite)
  library(glue)
})

# Paths ------------------------------------------------------------------------
# here() anchors every path at the project root (where the .Rproj lives), so
# scripts work no matter which directory R was started from.
paths <- list(
  raw       = here("data", "raw"),
  processed = here("data", "processed"),
  figures   = here("output", "figures"),
  tables    = here("output", "tables")
)
walk(paths, dir.create, recursive = TRUE, showWarnings = FALSE)

# Polite HTTP --------------------------------------------------------------------
# A descriptive user agent with a contact address lets site operators see who
# we are and reach us. Liquipedia's API terms require this. The address is read
# from the project's .Renviron rather than written into the code. It is only
# required for live downloads, so the analysis re-runs from cached data without it.
if (file.exists(here(".Renviron"))) readRenviron(here(".Renviron"))

user_agent_string <- function() {
  contact_email <- Sys.getenv("SCRAPER_CONTACT_EMAIL")
  if (contact_email == "") {
    stop("Set SCRAPER_CONTACT_EMAIL in .Renviron (see .Renviron.example) before downloading.")
  }
  glue("fortnite-competitive-research/1.0 ",
       "(Xavier University student portfolio project; {contact_email})")
}

#' Download a URL once and cache the raw body on disk.
#'
#' If `cache_path` already exists the file is returned without touching the
#' network, so re-running a script never re-scrapes. Set `refresh = TRUE` to
#' force a new download. The `delay` pause happens only before a real request,
#' so cached runs stay fast while live runs stay gentle on the server.
#'
#' @param url Full URL to request.
#' @param cache_path Where to store the raw response body.
#' @param delay Seconds to wait before a live request (>= 2 by project rule).
#' @param refresh Ignore the cache and download again.
#' @param query Optional named list of query parameters.
#' @param headers Optional named list of extra request headers.
#' @return The cache path (invisibly).
cached_download <- function(url, cache_path, delay = 3, refresh = FALSE,
                            query = list(), headers = list()) {
  if (file.exists(cache_path) && !refresh) {
    return(invisible(cache_path))
  }
  stopifnot(delay >= 2)
  Sys.sleep(delay)

  dir.create(dirname(cache_path), recursive = TRUE, showWarnings = FALSE)
  resp <- request(url) |>
    req_url_query(!!!query) |>
    req_headers(!!!headers) |>
    req_user_agent(user_agent_string()) |>
    # Retry only on transient server errors, and back off slowly if we do
    req_retry(
      max_tries    = 3,
      is_transient = \(resp) resp_status(resp) %in% c(429, 500, 502, 503, 504),
      backoff      = \(attempt) 15 * attempt
    ) |>
    req_timeout(60) |>
    req_perform()

  writeBin(resp_body_raw(resp), cache_path)
  message("Downloaded: ", url)
  invisible(cache_path)
}

# Parsing helpers ----------------------------------------------------------------

#' Turn strings like "$1,234.56" or "816,000" into numbers.
parse_money <- function(x) {
  readr::parse_number(as.character(x), na = c("", "NA", "-"))
}

#' Stop with a clear message when a validation check fails.
#'
#' Validation is run after every collection and cleaning step, so problems in
#' the source data surface immediately instead of in a figure later on.
check <- function(condition, message) {
  if (!isTRUE(condition)) stop("Validation failed: ", message, call. = FALSE)
  invisible(TRUE)
}

# Study window -------------------------------------------------------------------
# Fortnite Battle Royale launched Sep 2017; competitive play started in 2018.
study_start <- as.Date("2017-01-01")

# Figure style -------------------------------------------------------------------------------
# One theme for every figure so the report reads as a single piece. Colours come
# from a colour-blind-checked palette; categorical colours follow the entity
# (e.g. EU is always blue), never its rank.
pal <- list(
  surface   = "#fcfcfb",
  ink       = "#0b0b0b",
  ink_2     = "#52514e",
  ink_3     = "#8a8984",
  grid      = "#e7e6e2",
  blue      = "#2a78d6",   # slot 1: primary series / EU
  orange    = "#eb6834",   # slot 2: secondary series / NAC
  aqua      = "#1baf7a",   # slot 3
  yellow    = "#eda100",   # slot 4
  muted     = "#b9b8b2"    # de-emphasised context (other regions, background events)
)

region_colours <- c("EU" = pal$blue, "NAC" = pal$orange, "NA (merged)" = pal$orange)  # NA (merged): 2023 M2-2024
region_order   <- c("EU", "NAC", "NA (merged)", "NAW", "BR", "ASIA", "OCE", "ME")

theme_fortnite <- function(base_size = 11) {
  theme_minimal(base_size = base_size, base_family = "") +
    theme(
      plot.background    = element_rect(fill = pal$surface, colour = NA),
      panel.background   = element_rect(fill = pal$surface, colour = NA),
      panel.grid.major.x = element_blank(),
      panel.grid.minor   = element_blank(),
      panel.grid.major.y = element_line(colour = pal$grid, linewidth = 0.3),
      axis.text          = element_text(colour = pal$ink_2),
      axis.title         = element_text(colour = pal$ink_2, size = rel(0.9)),
      axis.ticks.x       = element_line(colour = pal$grid),
      plot.title         = element_text(colour = pal$ink, face = "bold", size = rel(1.2),
                                        margin = margin(b = 4)),
      plot.subtitle      = element_text(colour = pal$ink_2, margin = margin(b = 10)),
      plot.caption       = element_text(colour = pal$ink_3, size = rel(0.75), hjust = 0,
                                        margin = margin(t = 10)),
      plot.caption.position = "plot",
      plot.title.position   = "plot",
      strip.text         = element_text(colour = pal$ink, face = "bold", hjust = 0),
      legend.position    = "top",
      legend.justification = "left",
      legend.title       = element_blank(),
      legend.text        = element_text(colour = pal$ink_2),
      plot.margin        = margin(12, 16, 10, 12)
    )
}

#' Save a figure as a high-resolution PNG in output/figures/.
save_fig <- function(plot, name, width = 9, height = 5.2) {
  path <- file.path(paths$figures, glue("{name}.png"))
  ggsave(path, plot, width = width, height = height, dpi = 300, bg = pal$surface)
  invisible(path)
}

#' Save a table as CSV in output/tables/.
save_table <- function(df, name) {
  write_csv(df, file.path(paths$tables, glue("{name}.csv")))
  invisible(df)
}
# 01_collect_esports_earnings.R ---------------------------------------------------
# Collects Fortnite (game ID 534) prize-money data from Esports Earnings.
#
# Access rules checked 2026-11-05:
#   * robots.txt has no Disallow rules for these pages.
#   * Terms of use: "You are granted permission to use the site's materials
#     for both personal and commercial use."
#   * API (https://www.esportsearnings.com/apidocs): key required, at most one
#     request per second. We wait 2+ seconds to stay well under that.
#
# Outputs (data/processed/):
#   ee_monthly.csv       Fortnite prize money, earning players, tournaments by month
#   ee_yearly.csv        same, by year
#   ee_top_players.csv   top 500 earners per year (player-level, for concentration)
#   ee_countries.csv     career Fortnite earnings and player counts by country
#   ee_events.csv        every Fortnite event / standalone tournament listed by the site
#   ee_tournaments.csv   tournament-level list from the API (only when a key is set)

source(here::here("R", "00_setup.R"))

refresh  <- FALSE   # TRUE re-downloads everything, ignoring the cache
game_id  <- 534
ee_base  <- "https://www.esportsearnings.com"
raw_dir  <- file.path(paths$raw, "esports_earnings")

# Last month with data. The site states its recorded date range on the game
# page, so we read it instead of guessing (it lags the calendar by months).
game_page <- cached_download(
  glue("{ee_base}/games/{game_id}-fortnite"),
  file.path(raw_dir, "game_page.html"), refresh = refresh
) |> read_html()

date_range <- game_page |>
  html_text2() |>
  str_extract("Recorded Date Range:\\s*[0-9-]+\\s*to\\s*[0-9-]+") |>
  str_extract_all("\\d{4}-\\d{2}-\\d{2}") |>
  unlist() |>
  as.Date()
check(length(date_range) == 2, "could not read the recorded date range")
message("Esports Earnings date range: ", date_range[1], " to ", date_range[2])

# Reads the Fortnite summary row ("$X | N Players | N Tournaments") at the top of
# a history page. Returns NA values when a period has no Fortnite results.
parse_history_summary <- function(page) {
  cells <- page |>
    html_element("div.detail_list_table .format_row") |>
    html_elements(".format_cell") |>
    html_text2()
  if (length(cells) < 4) {
    return(tibble(prize_usd = NA_real_, earning_players = NA_real_,
                  tournaments = NA_real_))
  }
  tibble(
    prize_usd       = parse_money(cells[2]),
    earning_players = parse_money(cells[3]),
    tournaments     = parse_money(cells[4])
  )
}

# 1. Monthly history ----------------------------------------------------------------
months <- seq(floor_date(date_range[1], "month"),
              floor_date(date_range[2], "month"), by = "month")

ee_monthly <- map(months, \(m) {
  slug <- format(m, "%Y-%m")
  path <- cached_download(
    glue("{ee_base}/history/{slug}/games/{game_id}-fortnite"),
    file.path(raw_dir, "history_monthly", glue("{slug}.html")),
    refresh = refresh
  )
  parse_history_summary(read_html(path)) |> mutate(month = m, .before = 1)
}) |>
  list_rbind()

# 2. Yearly history and top-500 players per year -----------------------------------
years <- year(date_range[1]):year(date_range[2])

# Player tables are paged 100 rows at a time: the base page, then top_players_100..400
page_suffixes <- c("", glue("/top_players_{seq(100, 400, 100)}"))

parse_player_table <- function(page) {
  rows <- page |> html_elements("table.detail_list_table tbody tr")
  tibble(
    rank        = rows |> html_element("td.detail_list_order") |> html_text2() |> parse_money(),
    player_id   = rows |> html_element("a[href^='/players/']") |> html_attr("href") |>
                    str_extract("(?<=/players/)\\d+") |> as.integer(),
    player      = rows |> html_element("a[href^='/players/']") |> html_text2(),
    country     = rows |> html_element("img") |> html_attr("title"),
    country_code = rows |> html_element("a[href^='/countries/']") |> html_attr("href") |>
                    str_extract("[a-z]+$"),
    earnings_year_usd = rows |> html_element("td.detail_list_prize") |> html_text2() |> parse_money()
  )
}

yearly_pages <- map(years, \(y) {
  pages <- map(page_suffixes, \(sfx) {
    cached_download(
      glue("{ee_base}/history/{y}/games/{game_id}-fortnite{sfx}"),
      file.path(raw_dir, "history_yearly",
                glue("{y}{str_replace_all(sfx, '/', '_')}.html")),
      refresh = refresh
    ) |> read_html()
  })
  list(
    summary = parse_history_summary(pages[[1]]) |> mutate(year = y, .before = 1),
    players = map(pages, parse_player_table) |> list_rbind() |> mutate(year = y, .before = 1)
  )
})

ee_yearly      <- map(yearly_pages, "summary") |> list_rbind()
ee_top_players <- map(yearly_pages, "players") |> list_rbind() |> filter(!is.na(rank))

# 3. Career earnings by country ------------------------------------------------------
countries_page <- cached_download(
  glue("{ee_base}/games/{game_id}-fortnite/countries"),
  file.path(raw_dir, "countries.html"), refresh = refresh
) |> read_html()

country_rows <- countries_page |> html_elements("table.detail_list_table tr")
ee_countries <- tibble(
  country_code = country_rows |> html_element("a[href*='/countries/']") |> html_attr("href") |>
                   str_extract("[a-z]+$"),
  # The name cell holds a flag image (no text) followed by the country name
  country      = country_rows |> html_element("td.detail_list_player") |> html_text2() |> str_trim(),
  prize_usd    = country_rows |> html_element("td.detail_list_prize") |> html_text2() |> parse_money(),
  players      = country_rows |> html_text2() |> str_extract("[0-9,]+(?= Players?)") |> parse_money()
) |>
  filter(!is.na(prize_usd), !is.na(country_code))

# 4. Event list ----------------------------------------------------------------------
# One page listing every Fortnite "event" (a group of tournaments, e.g. an FNCS
# season) and every standalone tournament, with dates and total prize money.
events_page <- cached_download(
  glue("{ee_base}/games/{game_id}-fortnite/events"),
  file.path(raw_dir, "events.html"), refresh = refresh
) |> read_html()

event_rows <- events_page |> html_elements("tr.format_row")
ee_events <- tibble(
  date_text = event_rows |> html_element("td.detail_list_date") |> html_text2(),
  name      = event_rows |> html_element("td.detail_list_tournament a") |> html_text2(),
  href      = event_rows |> html_element("td.detail_list_tournament a") |> html_attr("href"),
  prize_usd = event_rows |> html_element("td.detail_list_prize") |> html_text2() |> parse_money()
) |>
  filter(!is.na(href)) |>
  mutate(
    kind       = if_else(str_starts(href, "/events/"), "event", "tournament"),
    id         = as.integer(str_extract(href, "(?<=/(events|tournaments)/)\\d+")),
    start_date = as.Date(str_extract(date_text, "^\\d{4}-\\d{2}-\\d{2}")),
    end_date   = as.Date(coalesce(str_extract(date_text, "\\d{4}-\\d{2}-\\d{2}$"),
                                  str_extract(date_text, "^\\d{4}-\\d{2}-\\d{2}")))
  ) |>
  select(kind, id, name, start_date, end_date, prize_usd)

# The "Browse Events" list is not complete: it omits at least one major event
# (FNCS 2025 Major 3, $2.0M), which is still on the site's "Largest Prize Pools"
# page. So we also read that page and add any EVENT missing from the list.
# (Tournaments on that page are children of listed events, so adding them would
# double count.) Dates for added events are read from their own pages in 01b.
largest_page <- cached_download(
  glue("{ee_base}/games/{game_id}-fortnite/largest-tournaments"),
  file.path(raw_dir, "largest_tournaments.html"), refresh = refresh
) |> read_html()

# Each row there is a tournament with a "»" link to its parent event. We only
# take the event IDs; name, dates and prize total are read from the event's own
# page in 01b (the total is the sum of its Fortnite tournaments).
missing_events <- tibble(
  href = largest_page |> html_elements("a[href^='/events/']") |> html_attr("href")
) |>
  mutate(kind = "event", id = as.integer(str_extract(href, "(?<=/events/)\\d+"))) |>
  filter(!id %in% ee_events$id[ee_events$kind == "event"]) |>
  distinct(id, .keep_all = TRUE) |>
  mutate(name = NA_character_, start_date = as.Date(NA), end_date = as.Date(NA),
         prize_usd = NA_real_) |>
  select(kind, id, name, start_date, end_date, prize_usd)

if (nrow(missing_events) > 0) {
  message("Events missing from the events list, added from Largest Prize Pools:")
  print(missing_events)
}
ee_events <- bind_rows(ee_events, missing_events)

# 5. Tournament-level list via the official API (needs a key) -----------------------
# The API has no "tournaments for one game" method, so we page backwards through
# LookupRecentTournaments (all games, newest first, 100 per call) and keep
# GameId 534, stopping once we pass the first Fortnite tournament.
api_key <- Sys.getenv("ESPORTS_EARNINGS_API_KEY")

if (api_key == "") {
  message("ESPORTS_EARNINGS_API_KEY not set: skipping the API tournament list. ",
          "Add it to .Renviron and re-run to collect tournament-level data.")
} else {
  api_dir <- file.path(raw_dir, "api_recent_tournaments")
  offset  <- 0
  pages   <- list()
  repeat {
    path <- cached_download(
      "https://api.esportsearnings.com/v0/LookupRecentTournaments",
      file.path(api_dir, sprintf("offset_%06d.json", offset)),
      query = list(apikey = api_key, offset = offset),
      delay = 2, refresh = refresh
    )
    batch <- fromJSON(path)
    if (!is.data.frame(batch) || nrow(batch) == 0) break   # end of list or API error
    pages[[length(pages) + 1]] <- batch
    if (min(as.Date(batch$EndDate), na.rm = TRUE) < date_range[1]) break
    offset <- offset + 100
  }

  ee_tournaments <- list_rbind(pages) |>
    as_tibble() |>
    clean_names() |>
    filter(game_id == !!game_id) |>
    distinct(tournament_id, .keep_all = TRUE) |>
    mutate(across(c(start_date, end_date), as.Date))

  check(nrow(ee_tournaments) > 0, "API returned no Fortnite tournaments")
  write_csv(ee_tournaments, file.path(paths$processed, "ee_tournaments.csv"))
}

# Validation -------------------------------------------------------------------------
check(nrow(ee_monthly) == length(months), "one row per month")
check(!anyDuplicated(ee_monthly$month), "duplicate months")
check(nrow(ee_yearly) == length(years), "one row per year")
check(all(ee_top_players |> count(year, player_id) |> pull(n) == 1),
      "a player appears twice in one year's top list")
check(all(ee_top_players |> count(year) |> pull(n) <= 500), "more than 500 players in a year")
check(nrow(ee_countries) > 50 && !anyNA(ee_countries$country), "country table missing names")

# Monthly totals should add up to the yearly totals the site reports
reconcile <- ee_monthly |>
  group_by(year = year(month)) |>
  summarise(prize_from_months = sum(prize_usd, na.rm = TRUE)) |>
  left_join(ee_yearly, by = "year") |>
  mutate(gap_pct = (prize_from_months - prize_usd) / prize_usd)
print(reconcile |> select(year, prize_usd, prize_from_months, gap_pct))
check(all(abs(reconcile$gap_pct) < 0.01, na.rm = TRUE),
      "monthly prize money does not reconcile with yearly totals (>1% gap)")

# The game page total should match the sum of the yearly totals
game_total <- game_page |> html_text2() |>
  str_extract("Prize Money Awarded:\\s*\\$[0-9,.]+") |> parse_money()
check(abs(sum(ee_yearly$prize_usd, na.rm = TRUE) / game_total - 1) < 0.01,
      "yearly totals do not add up to the game's all-time total")

# Save --------------------------------------------------------------------------------
write_csv(ee_monthly,     file.path(paths$processed, "ee_monthly.csv"))
write_csv(ee_yearly,      file.path(paths$processed, "ee_yearly.csv"))
write_csv(ee_top_players, file.path(paths$processed, "ee_top_players.csv"))
write_csv(ee_countries,   file.path(paths$processed, "ee_countries.csv"))
write_csv(ee_events,      file.path(paths$processed, "ee_events.csv"))

message("Esports Earnings collection complete.")
# 01b_collect_ee_event_details.R ----------------------------------------------------------
# Visits every Fortnite event and standalone tournament page on Esports Earnings
# to build (a) a tournament-level list and (b) player-level earnings.
#
# Why this script exists: the Esports Earnings API (which offers the same data)
# was not available to us, so we read the public pages instead. Their robots.txt
# has no restrictions and the terms allow personal and commercial use. Each page
# is fetched once, 3 seconds apart, and cached in data/raw/.
#
# Page types (listed in ee_events.csv by 01_collect_esports_earnings.R):
#   /events/...       a group of tournaments (e.g. an FNCS season). Holds a
#                     "Tournaments" table and an "Awarded Players" table with
#                     each player's total from the event.
#   /tournaments/...  a single tournament. Holds location, date, prize pool and
#                     placement-by-placement results.
#
# Two kinds of event cannot use their "Awarded Players" totals directly:
#   * events spanning two calendar years (e.g. "DreamHack Open 2020-2021"), which
#     appear once per year in the events list; their totals can't be split by year;
#   * multi-game events (e.g. DreamHack), whose totals include other games.
# For those we visit each Fortnite child tournament page instead, which gives
# every tournament its own date and results.
#
# Outputs (data/processed/):
#   ee_tournaments.csv      one row per tournament
#   ee_player_earnings.csv  one row per player x source (event or tournament)
#   ee_unattributed.csv     prize money EE could not assign to named players
#   ee_failed_pages.csv     pages the site could not serve (logged, skipped)

source(here::here("R", "00_setup.R"))

refresh  <- FALSE
ee_base  <- "https://www.esportsearnings.com"
raw_dir  <- file.path(paths$raw, "esports_earnings")

# One row per (kind, id, calendar year) as listed by the site
ee_listing <- read_csv(file.path(paths$processed, "ee_events.csv"), show_col_types = FALSE)

# One row per page
page_list <- ee_listing |>
  group_by(kind, id, name) |>
  summarise(start_date = min(start_date), end_date = max(end_date),
            prize_usd = sum(prize_usd), n_years = n(), .groups = "drop")
multi_year_events <- page_list |> filter(kind == "event", n_years > 1) |> pull(id)

# Download helpers -----------------------------------------------------------------------
# A few pages are broken on the site itself (HTTP 500 every time). They are
# logged and skipped instead of stopping the run. A ".failed" marker remembers
# them so re-runs don't keep requesting a page the server cannot deliver.
fetch_page <- function(kind, id) {
  slug   <- glue("{kind}s/{id}")   # the site redirects /events/{id} to the full slug
  cache  <- file.path(raw_dir, glue("{kind}_pages"), glue("{id}.html"))
  marker <- paste0(cache, ".failed")
  if (file.exists(marker) && !refresh) return(NULL)
  tryCatch(
    cached_download(glue("{ee_base}/{slug}"), cache, refresh = refresh) |> read_html(),
    httr2_http = \(e) {
      message("Skipping ", slug, " (", conditionMessage(e), ")")
      write_file(conditionMessage(e), marker)
      NULL
    }
  )
}

player_id_from <- \(href) as.integer(str_extract(href, "(?<=/players/)\\d+"))

#' All tables in the section under an <h2> heading with this exact text.
#' Long lists (e.g. Awarded Players) are split across two side-by-side tables,
#' so we take every table whose nearest preceding <h2> is this heading.
table_after <- function(page, heading) {
  html_elements(page, xpath = glue("//h2[normalize-space()='{heading}']/following::table",
                                   "[preceding::h2[1][normalize-space()='{heading}']]"))
}

#' "€6,450.00 ($7,444.27 USD)" -> 7444.27 ; "$1,500.00" -> 1500
usd_amount <- function(txt) {
  usd <- str_extract(txt, "\\$[0-9,.]+(?= USD)")
  parse_money(coalesce(usd, str_extract(txt, "\\$[0-9,.]+")))
}

#' Value next to a label such as "Location:" in a page's info box.
info_value <- function(page, label) {
  page |>
    html_element(xpath = glue("//div[contains(@class,'info_text_header') and normalize-space()='{label}']",
                              "/following-sibling::div[1]")) |>
    html_text2()
}

#' Parse a tournament page: metadata plus one row per paid player.
#'
#' Each placement is a block holding a rank, the players and a prize. Team
#' prizes are split equally across the listed players (EE's own convention).
parse_tournament_page <- function(page) {
  dates <- str_extract_all(info_value(page, "Date:"), "\\d{4}-\\d{2}-\\d{2}")[[1]] |> as.Date()
  meta <- tibble(
    location   = info_value(page, "Location:"),
    prize_usd  = usd_amount(info_value(page, "Prize Pool:")),
    start_date = if (length(dates)) min(dates) else as.Date(NA),
    end_date   = if (length(dates)) max(dates) else as.Date(NA)
  )
  units <- html_elements(page, xpath = "//span[contains(@class,'_rank')]/..")
  players <- map(units, \(u) {
    links <- u |> html_elements("a[href^='/players/']")
    ids   <- links |> html_attr("href") |> player_id_from()
    # The flag image sits just before each player link; its title is the country
    flags <- links |> map_chr(\(a) a |> html_element(xpath = "preceding-sibling::a[1]/img") |> html_attr("title"))
    keep  <- !duplicated(ids)
    tibble(
      unit_prize = u |> html_element("span[class*='_prize']") |> html_text2() |> usd_amount(),
      n_players  = sum(keep),
      player_id  = ids[keep],
      country    = flags[keep]
    )
  }) |>
    list_rbind()
  if (nrow(players) == 0) players <- tibble(unit_prize = numeric(), n_players = integer(),
                                            player_id = integer(), country = character())
  players <- players |>
    mutate(prize_usd = unit_prize / n_players) |>
    group_by(player_id) |>
    summarise(country = first(country), prize_usd = sum(prize_usd), .groups = "drop")
  list(meta = meta, players = players)
}

# 1. Download every event and standalone tournament page ---------------------------------
pages_all <- page_list |>
  mutate(page = map2(kind, id, fetch_page, .progress = "Esports Earnings pages"))

# 2. Event pages ---------------------------------------------------------------------------
event_pages <- pages_all |> filter(kind == "event", !map_lgl(page, is.null))

# Events added from the "Largest Prize Pools" page (missing from the events list)
# have no listing data: read their name and dates from the event page itself.
page_dates <- \(p) as.Date(str_extract_all(info_value(p, "Date:"), "\\d{4}-\\d{2}-\\d{2}")[[1]])
event_pages <- event_pages |>
  mutate(
    from_page  = is.na(name) | is.na(start_date),
    name       = if_else(is.na(name), map_chr(page, \(p) html_text2(html_element(p, "h1"))), name),
    # Some event pages have no "Date:" field; their dates then come from the
    # child tournament pages (these events are read tournament by tournament)
    start_date = if_else(from_page, map_vec(page, \(p) suppressWarnings(min(page_dates(p)))), start_date),
    end_date   = if_else(from_page, map_vec(page, \(p) suppressWarnings(max(page_dates(p)))), end_date),
    across(c(start_date, end_date), \(d) if_else(is.finite(d), d, as.Date(NA)))
  )
page_list <- page_list |>
  rows_update(event_pages |> filter(from_page) |> select(kind, id, name, start_date, end_date),
              by = c("kind", "id"))

# The prize is the last ".detail_list_prize" cell in each row (the first one is
# usually an empty "-"), so rows are read one at a time.
event_children <- event_pages |>
  transmute(event_id = id, event_name = name, start_date, end_date,
            rows = map(page, \(p) table_after(p, "Tournaments") |> html_elements("tr"))) |>
  mutate(tbl = map(rows, \(rows) map(rows, \(r) tibble(
    tournament_id = r |> html_element("a[href^='/tournaments/']") |> html_attr("href") |>
                      str_extract("(?<=/tournaments/)\\d+") |> as.integer(),
    tournament    = r |> html_element("a[href^='/tournaments/']") |> html_text2(),
    prize_usd     = r |> html_elements("td.detail_list_prize") |> html_text2() |>
                      last() |> parse_money(),
    game_href     = r |> html_element("td.detail_list_game a") |> html_attr("href")
  )) |> list_rbind())) |>
  select(-rows) |>
  unnest(tbl) |>
  filter(!is.na(tournament_id))

# Multi-game events (e.g. DreamHack) list every game's tournaments, and their
# "Awarded Players" mixes players from all games. Keep only Fortnite tournaments,
# and treat these events like multi-year ones: read each Fortnite tournament page.
multi_game_events <- event_children |>
  filter(!str_detect(coalesce(game_href, ""), "^/games/534-")) |>
  distinct(event_id) |> pull(event_id)
event_children <- event_children |>
  filter(str_detect(coalesce(game_href, ""), "^/games/534-")) |>
  select(-game_href)

# Added events have no listed total: use the sum of their Fortnite tournaments
added_totals <- event_children |>
  filter(event_id %in% event_pages$id[event_pages$from_page]) |>
  group_by(id = event_id) |> summarise(prize_usd = sum(prize_usd, na.rm = TRUE)) |>
  mutate(kind = "event")
page_list <- page_list |> rows_update(added_totals, by = c("kind", "id"))
if (nrow(added_totals) > 0) {
  message("Events added from the Largest Prize Pools page:")
  print(page_list |> semi_join(added_totals, by = c("kind", "id")))
}

# Events whose player totals cannot be used directly
added_events <- event_pages$id[event_pages$from_page]
split_events <- reduce(list(multi_year_events, multi_game_events, added_events), union)
message(length(multi_year_events), " multi-year and ", length(multi_game_events),
        " multi-game events are read tournament by tournament.")

# Simple events: player totals straight from "Awarded Players"
event_players <- event_pages |>
  filter(!id %in% split_events) |>
  transmute(source_kind = "event", source_id = id, event_id = id, start_date, end_date,
            rows = map(page, \(p) table_after(p, "Awarded Players") |> html_elements("tr"))) |>
  mutate(tbl = map(rows, \(r) tibble(
    player_id  = r |> html_element("a[href^='/players/']") |> html_attr("href") |> player_id_from(),
    country    = r |> html_element("img") |> html_attr("title"),
    prize_usd  = r |> html_element("td.detail_list_prize") |> html_text2() |> parse_money()
  ))) |>
  select(-rows) |>
  unnest(tbl) |>
  filter(!is.na(player_id))

# 3. Tournament pages: standalone tournaments + children of multi-year events -----------
child_list <- event_children |>
  filter(event_id %in% split_events) |>
  transmute(kind = "tournament", id = tournament_id, name = tournament, event_id,
            listed_prize = prize_usd)

tournament_list <- bind_rows(
  page_list |> filter(kind == "tournament") |>
    transmute(kind, id, name, event_id = NA_real_, listed_prize = prize_usd,
              list_start = start_date, list_end = end_date),
  child_list
)

tournament_pages <- tournament_list |>
  mutate(page = map2(kind, id, fetch_page, .progress = "Tournament pages"))

parsed <- tournament_pages |>
  filter(!map_lgl(page, is.null)) |>
  mutate(res = map(page, parse_tournament_page))

tournament_meta <- parsed |>
  transmute(id, name, event_id, listed_prize, list_start, list_end,
            meta = map(res, "meta")) |>
  unnest(meta) |>
  # Prefer the page's own dates; fall back to the listing's
  mutate(start_date = coalesce(start_date, list_start),
         end_date   = coalesce(end_date, list_end))

tournament_players <- parsed |>
  left_join(tournament_meta |> select(id, start_date, end_date), by = "id") |>
  transmute(source_kind = "tournament", source_id = id, event_id, start_date, end_date,
            players = map(res, "players")) |>
  unnest(players)

failed_pages <- bind_rows(
  pages_all |> filter(map_lgl(page, is.null)) |> select(kind, id, name, prize_usd),
  tournament_pages |> filter(map_lgl(page, is.null)) |>
    select(kind, id, name, prize_usd = listed_prize) |> distinct()
) |> distinct(kind, id, .keep_all = TRUE)

if (nrow(failed_pages) > 0) {
  message(nrow(failed_pages), " page(s) could not be downloaded (",
          dollar(sum(failed_pages$prize_usd)), " of listed prize money):")
  print(failed_pages)
}

# 4. Combine -------------------------------------------------------------------------------
# Tournament list: children of single-year events take their event's dates;
# children of multi-year events and standalone tournaments take their own.
ee_tournaments <- bind_rows(
  event_children |>
    filter(!event_id %in% split_events) |>
    mutate(location = NA_character_),
  tournament_meta |>
    transmute(tournament_id = id, tournament = name,
              prize_usd = coalesce(listed_prize, prize_usd),
              location, start_date, end_date, event_id) |>
    left_join(page_list |> filter(kind == "event") |> select(event_id = id, event_name = name),
              by = "event_id"),
  # Standalone tournaments whose page failed: listing data only
  tournament_list |>
    filter(id %in% failed_pages$id[failed_pages$kind == "tournament"]) |>
    transmute(tournament_id = id, tournament = name, prize_usd = listed_prize,
              location = NA_character_, start_date = coalesce(list_start, NA),
              end_date = coalesce(list_end, NA), event_id)
) |>
  relocate(tournament_id, tournament, prize_usd, location, start_date, end_date)

ee_player_earnings <- bind_rows(event_players, tournament_players)

# Money each source lists but could not assign to named players (e.g. teams
# whose members are unknown). Kept so totals still reconcile.
sources <- bind_rows(
  page_list |> filter(kind == "event", !id %in% split_events) |>
    transmute(source_kind = "event", source_id = id, start_date, end_date, listed_prize = prize_usd),
  ee_tournaments |> filter(is.na(event_id) | event_id %in% split_events) |>
    transmute(source_kind = "tournament", source_id = tournament_id, start_date, end_date,
              listed_prize = prize_usd)
)

ee_unattributed <- sources |>
  left_join(ee_player_earnings |> group_by(source_kind, source_id) |>
              summarise(player_prize = sum(prize_usd), n_players = n(), .groups = "drop"),
            by = c("source_kind", "source_id")) |>
  mutate(player_prize = coalesce(player_prize, 0),
         unattributed = listed_prize - player_prize,
         page_failed  = paste(source_kind, source_id) %in% paste(failed_pages$kind, failed_pages$id))

# Validation --------------------------------------------------------------------------------
check(!anyDuplicated(ee_tournaments$tournament_id), "duplicate tournament IDs")
check(!anyDuplicated(ee_player_earnings[c("source_kind", "source_id", "player_id")]),
      "player listed twice for the same event/tournament")
check(!anyDuplicated(sources[c("source_kind", "source_id")]), "a source counted twice")
check(!anyNA(ee_tournaments$end_date), "tournament without a date")

# Each event's tournaments should add up to the event's listed total
event_recon <- event_children |>
  group_by(event_id) |> summarise(sum_tournaments = sum(prize_usd, na.rm = TRUE)) |>
  left_join(page_list |> filter(kind == "event") |> select(event_id = id, listed = prize_usd),
            by = "event_id") |>
  mutate(gap = abs(sum_tournaments - listed) / listed)
# A handful of events on EE list a total larger than the tournaments they show
# (the site's own inconsistency, e.g. Twitch Rivals 2024: $175k total, $100k of
# tournaments listed). We report them and require the gap to be small overall.
unreconciled <- event_recon |> filter(gap >= 0.01)
print(unreconciled)
check(sum(abs(unreconciled$listed - unreconciled$sum_tournaments)) / sum(page_list$prize_usd) < 0.01,
      "events whose tournaments don't add up hold more than 1% of prize money")

# Total tournament prize money should match the events list
total_listed <- sum(page_list$prize_usd)
check(abs(sum(ee_tournaments$prize_usd, na.rm = TRUE) / total_listed - 1) < 0.01,
      "tournament total does not reconcile with the events list")
check(abs(sum(sources$listed_prize) / total_listed - 1) < 0.01,
      "sources do not cover the listed prize money")
check(sum(failed_pages$prize_usd) / total_listed < 0.01,
      "pages that failed to download hold more than 1% of prize money")

# Players can never be paid more than was listed (allow cents of rounding)
check(all(ee_unattributed$unattributed > -1), "player earnings exceed listed prize money")

message(glue(
  "Tournaments: {nrow(ee_tournaments)} | player-source rows: {nrow(ee_player_earnings)} | ",
  "unique players: {n_distinct(ee_player_earnings$player_id)} | ",
  "share of prize money attributed to named players: ",
  "{percent(sum(ee_unattributed$player_prize) / total_listed, 0.1)}"
))

write_csv(ee_tournaments,     file.path(paths$processed, "ee_tournaments.csv"))
write_csv(ee_player_earnings, file.path(paths$processed, "ee_player_earnings.csv"))
write_csv(ee_unattributed,    file.path(paths$processed, "ee_unattributed.csv"))
write_csv(failed_pages,       file.path(paths$processed, "ee_failed_pages.csv"))
# 02_collect_liquipedia_fncs.R ------------------------------------------------------
# Collects FNCS (Fortnite Champion Series) tournament pages from Liquipedia and
# extracts each page's infobox: region, dates, format and prize pool.
#
# Access rules (https://liquipedia.net/api-terms-of-use, checked 2026-11-05):
#   * Automated access is allowed ONLY through the MediaWiki API (api.php);
#     scraping the HTML pages is not permitted.
#   * At most 1 request per 2 seconds (action=parse: 1 per 30 s, so we avoid
#     parse and read raw wikitext with action=query instead).
#   * Custom user agent with contact info; accept gzip; cache everything.
#   * Content is CC-BY-SA 3.0, so the report credits Liquipedia as the source.
#
# The paid LiquipediaDB (LPDB) API is deliberately not used.
#
# Output: data/processed/liquipedia_fncs_pages.csv (one row per FNCS page)

source(here::here("R", "00_setup.R"))

refresh  <- FALSE
api_url  <- "https://liquipedia.net/fortnite/api.php"
raw_dir  <- file.path(paths$raw, "liquipedia")
lp_delay <- 3   # seconds; terms allow 1 request / 2 s
lp_headers <- list(`Accept-Encoding` = "gzip")

# 1. List every page under "Fortnite Champion Series/" -------------------------------
# list=allpages returns up to 500 titles per call; `apcontinue` pages through
# the rest. Each page of results is cached separately.
titles    <- character()
cont      <- NULL
batch_num <- 1
repeat {
  path <- cached_download(
    api_url,
    file.path(raw_dir, "allpages", sprintf("batch_%02d.json", batch_num)),
    query = compact(list(
      action = "query", list = "allpages", format = "json",
      apprefix = "Fortnite Champion Series/", apnamespace = 0,
      aplimit = 500, apfilterredir = "nonredirects", apcontinue = cont
    )),
    headers = lp_headers, delay = lp_delay, refresh = refresh
  )
  res    <- fromJSON(path)
  titles <- c(titles, res$query$allpages$title)
  cont   <- res$continue$apcontinue
  if (is.null(cont)) break
  batch_num <- batch_num + 1
}
titles <- unique(titles)
message(length(titles), " FNCS pages listed")

# 2. Download wikitext, 50 titles per request (the API's limit) -----------------------
title_batches <- split(titles, ceiling(seq_along(titles) / 50))

wikitext <- imap(title_batches, \(batch, i) {
  path <- cached_download(
    api_url,
    file.path(raw_dir, "wikitext", sprintf("batch_%03d.json", as.integer(i))),
    query = list(
      action = "query", prop = "revisions", rvprop = "content",
      rvslots = "main", format = "json", formatversion = 2,
      titles = paste(batch, collapse = "|")
    ),
    headers = lp_headers, delay = lp_delay, refresh = refresh
  )
  pages <- fromJSON(path, simplifyVector = FALSE)$query$pages
  tibble(
    title = map_chr(pages, "title"),
    text  = map_chr(pages, \(p) p$revisions[[1]]$slots$main$content %||% NA_character_)
  )
}) |>
  list_rbind()

# 3. Parse the infobox -----------------------------------------------------------------
# Infobox fields are written one per line as "|field=value". We read only the
# block between "{{Infobox league" and its closing "}}".
infobox_fields <- c("name", "series", "country", "mode", "type", "liquipediatier",
                    "prizepoolusd", "prizepool", "localcurrency", "sdate", "edate", "date",
                    "team_number", "player_number")

parse_infobox <- function(text) {
  block <- str_extract(text, "(?s)\\{\\{Infobox league.*?\\n\\}\\}")
  if (is.na(block)) return(set_names(rep(NA_character_, length(infobox_fields)), infobox_fields))
  map_chr(infobox_fields, \(f) {
    str_match(block, glue("\\n\\|{f}=([^\\n]*)"))[, 2] |> str_trim() |> na_if("")
  }) |>
    set_names(infobox_fields)
}

fncs_pages <- wikitext |>
  mutate(info = map(text, parse_infobox)) |>
  unnest_wider(info) |>
  select(-text) |>
  mutate(
    prize_pool_usd = parse_money(prizepoolusd),
    # Older pages use a single `date` field instead of sdate/edate
    start_date     = coalesce(ymd(sdate, quiet = TRUE), ymd(date, quiet = TRUE)),
    end_date       = coalesce(ymd(edate, quiet = TRUE), ymd(date, quiet = TRUE)),
    team_number    = parse_money(team_number),
    player_number  = parse_money(player_number),
    url            = paste0("https://liquipedia.net/fortnite/", str_replace_all(title, " ", "_"))
  ) |>
  select(title, name, series, region_raw = country, mode, type, tier = liquipediatier,
         start_date, end_date, prize_pool_usd, prize_pool_local = prizepool,
         local_currency = localcurrency, team_number, player_number, url)

# Validation ---------------------------------------------------------------------------
check(nrow(fncs_pages) == length(titles), "one parsed row per listed page")
check(!anyDuplicated(fncs_pages$title), "duplicate page titles")
check(sum(!is.na(fncs_pages$prize_pool_usd)) > 50,
      "fewer than 50 pages have a USD prize pool, parser is probably broken")

# Spot check against a value read by hand from the live page during Phase 1
spot <- fncs_pages |> filter(title == "Fortnite Champion Series/2025/Major 1/Europe")
check(nrow(spot) == 1 && spot$prize_pool_usd == 816000,
      "2025 Major 1 Europe prize pool should be $816,000")

write_csv(fncs_pages, file.path(paths$processed, "liquipedia_fncs_pages.csv"))
message("Liquipedia collection complete: ", nrow(fncs_pages), " pages, ",
        sum(!is.na(fncs_pages$prize_pool_usd)), " with a USD prize pool.")
# 03_collect_google_trends.R ------------------------------------------------------------
# Collects Google Trends search interest for Fortnite, plus World Bank internet-user
# counts used later to turn Trends' country scores into rough regional shares.
#
# Why the Fortnite *topic* and not the search term "Fortnite":
#   The topic (/m/0k9bc90) groups searches in every language and script, so
#   searches written in Japanese or Cyrillic count too. That matters for the
#   regional comparison. The topic ID comes from Google Trends' own autocomplete
#   (checked 2026-11-06).
#
# Important caveats handled later in cleaning:
#   * Every Trends value is relative (0-100) and rescaled within each query, so
#     values from different queries are NOT on the same scale.
#   * Country scores measure the SHARE of a country's searches that are about
#     Fortnite (intensity), not the number of searches. To get a size-like
#     measure we multiply by the number of internet users (World Bank).
#
# Outputs (data/raw/google_trends/*.rds, data/processed/):
#   trends_monthly_world.csv     monthly worldwide interest, 2004-present
#   trends_weekly_world.csv      weekly worldwide interest in overlapping windows
#   trends_country_year.csv      interest by country, one query per year
#   trends_us_state_year.csv     interest by US state, one query per year
#   wb_internet_users.csv        World Bank internet users % and population
#   us_state_population.csv      US state populations (Census via FRED)

source(here::here("R", "00_setup.R"))
library(gtrendsR)

refresh       <- FALSE
fortnite_topic <- "/m/0k9bc90"
raw_dir       <- file.path(paths$raw, "google_trends")
trends_delay  <- 60   # Google rate-limits Trends aggressively (HTTP 429); go slowly

#' Run one Trends query, caching the full result as RDS.
#'
#' On a rate-limit error we wait progressively longer (2, 4, 8 minutes) before
#' trying again, rather than hammering the service. Finished queries are cached,
#' so an interrupted run resumes where it stopped.
cached_gtrends <- function(name, ..., max_tries = 4) {
  path <- file.path(raw_dir, glue("{name}.rds"))
  if (file.exists(path) && !refresh) return(read_rds(path))
  for (attempt in seq_len(max_tries)) {
    Sys.sleep(trends_delay)
    res <- tryCatch(
      gtrends(keyword = fortnite_topic, gprop = "web", ...),
      error = \(e) if (str_detect(conditionMessage(e), "429")) NULL else stop(e)
    )
    if (!is.null(res)) break
    if (attempt == max_tries) stop("Google Trends kept rate-limiting; try again later.")
    wait <- 120 * 2^(attempt - 1)
    message("Rate-limited on ", name, "; waiting ", wait, " s")
    Sys.sleep(wait)
  }
  write_rds(res, path)
  message("Downloaded Trends query: ", name)
  res
}

today <- Sys.Date()

# 1. Monthly worldwide interest -------------------------------------------------------
# time = "all" returns monthly values from 2004, all on one scale.
monthly <- cached_gtrends("world_monthly_all", time = "all")
trends_monthly_world <- monthly$interest_over_time |>
  as_tibble() |>
  transmute(month = as.Date(date),
            # "<1" means below 1 on the 0-100 scale; treat as 0.5
            hits = parse_number(if_else(hits == "<1", "0.5", as.character(hits))))

# 2. Weekly worldwide interest (for the event study) -----------------------------------
# Trends returns weekly data only for windows of 5 years or less, so we pull
# overlapping ~4-year windows. Cleaning chains them onto one scale using the
# overlapping weeks.
weekly_windows <- tribble(
  ~window, ~from,                  ~to,
  "w1",    as.Date("2017-07-01"),  as.Date("2021-06-30"),
  "w2",    as.Date("2020-07-01"),  as.Date("2024-06-30"),
  "w3",    as.Date("2023-07-01"),  today
)

trends_weekly_world <- pmap(weekly_windows, \(window, from, to) {
  res <- cached_gtrends(glue("world_weekly_{window}"), time = glue("{from} {to}"))
  res$interest_over_time |>
    as_tibble() |>
    transmute(window, week = as.Date(date),
              hits = parse_number(if_else(hits == "<1", "0.5", as.character(hits))))
}) |>
  list_rbind()

# 3. Interest by country and by US state, one query per calendar year -------------------
# One query per year keeps every country inside a year on the same scale, so
# within-year shares are valid. The US state queries let us split North America
# into the NA-East/Central and NA-West server regions.
trend_years <- 2018:year(today)
year_window <- \(y) glue("{y}-01-01 {min(as.Date(glue('{y}-12-31')), today)}")

trends_country_year <- map(trend_years, \(y) {
  res <- cached_gtrends(glue("country_{y}"), time = year_window(y), low_search_volume = TRUE)
  res$interest_by_country |> as_tibble() |> mutate(year = y)
}) |>
  list_rbind() |>
  transmute(year, country = location, hits = parse_number(as.character(hits)))

trends_us_state_year <- map(trend_years, \(y) {
  res <- cached_gtrends(glue("us_states_{y}"), geo = "US", time = year_window(y))
  res$interest_by_region |> as_tibble() |> mutate(year = y)
}) |>
  list_rbind() |>
  transmute(year, state = location, hits = parse_number(as.character(hits)))

# 4. World Bank internet users and population -------------------------------------------
# Official, free API (no key). Internet users = population x share using the internet.
wb_indicator <- function(indicator) {
  path <- cached_download(
    glue("https://api.worldbank.org/v2/country/all/indicator/{indicator}"),
    file.path(paths$raw, "world_bank", glue("{indicator}.json")),
    query = list(format = "json", date = "2017:2025", per_page = 20000),
    refresh = refresh
  )
  fromJSON(path)[[2]] |>
    as_tibble() |>
    transmute(iso3 = countryiso3code, country = country$value,
              year = as.integer(date), value)
}

wb_internet_users <- wb_indicator("IT.NET.USER.ZS") |>
  rename(internet_pct = value) |>
  full_join(wb_indicator("SP.POP.TOTL") |> rename(population = value),
            by = c("iso3", "country", "year")) |>
  filter(iso3 != "")   # drops aggregate rows that lack an ISO code

# 5. US state populations (to weight state-level Trends scores) --------------------------
# Census Bureau estimates, read through FRED (St. Louis Fed), which serves them as
# CSV without a key. Series IDs are the state's postal code + "POP"; values are
# in thousands of people. (The Census API itself now requires a key.) FRED
# returns at most 12 series per request, so states are fetched in batches.
state_codes <- c(state.abb, "DC")
state_names <- c(state.name, "District of Columbia")
state_batches <- split(state_codes, ceiling(seq_along(state_codes) / 12))

us_state_population <- imap(state_batches, \(codes, i) {
  path <- cached_download(
    "https://fred.stlouisfed.org/graph/fredgraph.csv",
    file.path(paths$raw, "fred", glue("state_population_{i}.csv")),
    query = list(id = paste0(codes, "POP", collapse = ",")),
    refresh = refresh
  )
  read_csv(path, show_col_types = FALSE) |>
    rename(date = 1) |>
    pivot_longer(-date, names_to = "series", values_to = "pop_thousands")
}) |>
  list_rbind() |>
  transmute(year = year(date),
            state = state_names[match(str_remove(series, "POP$"), state_codes)],
            population = pop_thousands * 1000) |>
  filter(year >= 2017)

# Validation ---------------------------------------------------------------------------
check(n_distinct(us_state_population$state) == 51 && !anyNA(us_state_population$state),
      "state population should cover 50 states + DC")
check(nrow(trends_monthly_world) > 200, "monthly series too short")
check(max(trends_monthly_world$hits, na.rm = TRUE) == 100, "monthly series should peak at 100")
check(all(trends_weekly_world |> count(window, week) |> pull(n) == 1), "duplicate weeks")
check(all(trend_years %in% trends_country_year$year), "a year is missing from country data")
check(n_distinct(trends_us_state_year$state) >= 50, "fewer than 50 US states/DC")
check(!anyDuplicated(wb_internet_users[c("iso3", "year")]), "duplicate country-years in World Bank data")

write_csv(trends_monthly_world, file.path(paths$processed, "trends_monthly_world.csv"))
write_csv(trends_weekly_world,  file.path(paths$processed, "trends_weekly_world.csv"))
write_csv(trends_country_year,  file.path(paths$processed, "trends_country_year.csv"))
write_csv(trends_us_state_year, file.path(paths$processed, "trends_us_state_year.csv"))
write_csv(wb_internet_users,    file.path(paths$processed, "wb_internet_users.csv"))
write_csv(us_state_population,  file.path(paths$processed, "us_state_population.csv"))

message("Google Trends and World Bank collection complete.")
# 04_collect_twitch.R --------------------------------------------------------------------
# Reads monthly Fortnite Twitch viewership from a manually copied TwitchTracker table.
#
# Why manual: TwitchTracker loads its monthly table from /api/, which its
# robots.txt disallows, and SullyGnome asks people not to scrape it ("Can I
# scrape your data? Please don't."). Copying the visible table once by hand
# respects both. Steps and the download log are in data/raw/README.md.
#
# Output: data/processed/twitch_monthly.csv

source(here::here("R", "00_setup.R"))

manual_file <- file.path(paths$raw, "manual", "twitchtracker_fortnite_monthly.tsv")

if (!file.exists(manual_file)) {
  stop("Missing ", manual_file, ". Follow the TwitchTracker steps in data/raw/README.md.",
       call. = FALSE)
}

#' TwitchTracker abbreviates large numbers ("12.9M", "7.04M", "850K").
parse_abbrev <- function(x) {
  mult <- case_when(str_detect(x, "B$") ~ 1e9, str_detect(x, "M$") ~ 1e6,
                    str_detect(x, "K$") ~ 1e3, .default = 1)
  parse_money(x) * mult
}

twitch_monthly <- read_tsv(manual_file, col_types = cols(.default = "c"),
                           name_repair = "unique_quiet") |>
  clean_names() |>
  # The table repeats "Gain" / "% Gain" for viewers and streams. Gains can be
  # recomputed from levels, so we keep only the levels.
  select(month, avg_viewers, peak_viewers, avg_streams, peak_streams, hours_watched) |>
  mutate(
    month         = my(month),               # "Nov 2026" -> 2026-11-01
    across(c(avg_viewers, peak_viewers, avg_streams, peak_streams), parse_money),
    hours_watched = parse_abbrev(hours_watched)
  ) |>
  arrange(month)

# Consistency flag ------------------------------------------------------------------------
# Hours watched should be about average viewers x hours in the month. Where the
# two disagree by more than 15%, one of TwitchTracker's numbers is likely
# incomplete (e.g. a month that was still being tracked). January and February
# routinely sit ~10% apart in opposite directions, a month-boundary quirk on
# TwitchTracker's side, so the tolerance is 15%. We flag rather than
# drop, so the analysis can decide and the choice stays visible.
twitch_monthly <- twitch_monthly |>
  mutate(
    hours_ratio = hours_watched / (avg_viewers * days_in_month(month) * 24),
    hours_inconsistent = abs(hours_ratio - 1) > 0.15
  )

flagged <- twitch_monthly |> filter(hours_inconsistent)
if (nrow(flagged) > 0) {
  message("Months where hours watched and average viewers disagree by >15% (flagged):")
  print(flagged |> select(month, avg_viewers, hours_watched, hours_ratio))
}

# Validation ---------------------------------------------------------------------------
check(!any(is.na(twitch_monthly$month)), "unparseable month labels")
check(!anyDuplicated(twitch_monthly$month), "duplicate months")
check(all(diff(twitch_monthly$month) %in% 28:31), "gaps in the monthly series")
check(all(twitch_monthly$peak_viewers >= twitch_monthly$avg_viewers), "peak viewers below average")
check(!anyNA(select(twitch_monthly, avg_viewers:hours_watched)), "unparsed numbers")
check(mean(twitch_monthly$hours_inconsistent) < 0.1,
      "more than 10% of months inconsistent: the columns were probably copied wrongly")

write_csv(twitch_monthly, file.path(paths$processed, "twitch_monthly.csv"))
message("Twitch: ", nrow(twitch_monthly), " months, ",
        min(twitch_monthly$month), " to ", max(twitch_monthly$month))
# 05_collect_season_dates.R -------------------------------------------------------------------
# Collects Fortnite Battle Royale season start/end dates from the Fortnite Wiki
# (fortnite.fandom.com), via its MediaWiki API. Content is CC-BY-SA.
#
# Why we need them: a new season brings a new map and Battle Pass and is by far
# the biggest driver of viewership and search spikes. The event study must
# control for season launches, or it would credit them to tournaments.
#
# Why not player counts: the original plan was to use Fortnite.gg / Fortnite
# Tracker player counts here. Both sites block automated access with a
# Cloudflare check, and we do not bypass such checks, so player counts are not
# part of this project (see README, "Limitations").
#
# Output: data/processed/season_dates.csv

source(here::here("R", "00_setup.R"))

refresh  <- FALSE
api_url  <- "https://fortnite.fandom.com/api.php"

path <- cached_download(
  api_url,
  file.path(paths$raw, "fortnite_wiki", "seasons_battle_royale.json"),
  query = list(action = "query", prop = "revisions", rvprop = "content", rvslots = "main",
               format = "json", formatversion = 2, titles = "Template:Seasons/Battle Royale"),
  refresh = refresh
)
wikitext <- fromJSON(path)$query$pages$revisions[[1]]$slots$main$content

# The template is a set of tabs ("|-|Chapter 1=") each holding a table whose rows
# start with "|-". Each row's first cell names the season; the duration cell
# reads "October 26th 2017<br>—<br>December 13th 2017".
tabs <- str_split(wikitext, "\\|-\\|")[[1]][-1]

parse_wiki_date <- \(x) mdy(str_remove(x, "(?<=\\d)(st|nd|rd|th)"), quiet = TRUE)

season_dates <- map(tabs, \(tab) {
  chapter <- str_extract(tab, "^[^=]+") |> str_trim()
  rows    <- str_split(tab, "\\n\\|-\\n")[[1]][-1]
  map(rows, \(row) {
    season <- str_match(row, "\\[\\[(?:[^|\\]]*\\|)?([^\\]]+)\\]\\]<br><small>|<br>\\[\\[(?:[^|\\]]*\\|)?([^\\]]+)\\]\\]")
    name   <- coalesce(season[, 2], season[, 3])
    dates  <- str_extract_all(row, "[A-Z][a-z]+ \\d{1,2}(?:st|nd|rd|th)? \\d{4}")[[1]]
    tibble(chapter, season = name,
           start_date = parse_wiki_date(dates[1]),
           end_date   = parse_wiki_date(dates[2]))
  }) |> list_rbind()
}) |>
  list_rbind() |>
  filter(!is.na(start_date)) |>
  mutate(label = if_else(str_detect(season, "^Chapter"), season,
                         glue("{chapter} {season}")) |> as.character()) |>
  arrange(start_date)

# Validation ---------------------------------------------------------------------------
check(nrow(season_dates) >= 35, "fewer seasons than expected")
check(!anyDuplicated(season_dates$start_date), "two seasons share a start date")
check(min(season_dates$start_date) < as.Date("2017-11-01"), "Chapter 1 seasons missing")
check(all(diff(season_dates$start_date) > 0), "seasons not in date order")
gaps <- season_dates |> mutate(gap = as.numeric(lead(start_date) - end_date)) |> filter(abs(gap) > 7)
if (nrow(gaps) > 0) { message("Seasons with >7 day gaps/overlaps to the next season:"); print(gaps) }

write_csv(season_dates, file.path(paths$processed, "season_dates.csv"))
message("Season dates: ", nrow(season_dates), " seasons, ",
        min(season_dates$start_date), " to ", max(season_dates$start_date))
# region_mapping.R ------------------------------------------------------------------------
# Definitions that map places and labels to Fortnite competitive regions.
#
# These are modelling assumptions, not data, so they live in one file where a
# reader can check and change them. Epic does not publish which countries play
# on which servers; the rules below follow FNCS regional eligibility and common
# server choice. Places marked `ambiguous = TRUE` could reasonably be assigned
# elsewhere, and the regional analysis is re-run without them as a robustness check.

library(countrycode)

fncs_regions <- c("EU", "NAC", "NAW", "BR", "ASIA", "OCE", "ME")

# Countries left out of the Google-search proxy entirely:
#   CHN: Google is blocked in China, so its Trends score reflects only VPN users,
#        and multiplying it by 1.3 billion internet users would make China alone
#        ~45% of "Asia". Fortnite's separate Chinese version also shut down in 2021.
search_proxy_excluded <- c("CHN")

# US states on Pacific or Mountain time play NA West; the rest play NA Central
# (formerly NA East).
naw_states <- c("Washington", "Oregon", "California", "Nevada", "Arizona", "Utah",
                "Idaho", "Montana", "Wyoming", "Colorado", "New Mexico", "Alaska", "Hawaii")

#' Map ISO3 country codes to a Fortnite region using the UN geoscheme.
#'
#' The United States is returned as "US" because it is split between NAC and NAW
#' using state-level data elsewhere.
country_to_region <- function(iso3) {
  un_region <- countrycode(iso3, "iso3c", "un.regionsub.name", warn = FALSE)
  un_inter  <- countrycode(iso3, "iso3c", "un.regionintermediate.name", warn = FALSE)

  case_when(
    iso3 == "USA" ~ "US",
    # Places the UN geoscheme leaves unclassified
    iso3 == "TWN" ~ "ASIA",
    iso3 %in% c("XKX", "ESH") ~ "EU",
    # Western Asian countries that play on EU servers
    iso3 %in% c("TUR", "CYP", "GEO", "ARM", "AZE", "ISR") ~ "EU",
    # Maghreb players usually play EU; Egypt and Sudan play ME
    iso3 %in% c("MAR", "DZA", "TUN") ~ "EU",
    iso3 %in% c("EGY", "LBY", "SDN", "IRN") ~ "ME",
    str_detect(un_region, "Europe") ~ "EU",
    un_region == "Central Asia" ~ "EU",
    un_region == "Western Asia" ~ "ME",
    un_region %in% c("Eastern Asia", "South-eastern Asia", "Southern Asia") ~ "ASIA",
    un_region %in% c("Australia and New Zealand", "Melanesia", "Micronesia", "Polynesia") ~ "OCE",
    un_inter == "South America" ~ "BR",
    un_inter %in% c("Central America", "Caribbean") ~ "NAC",
    un_region == "Northern America" ~ "NAC",          # Canada, Greenland, Bermuda...
    un_region == "Sub-Saharan Africa" ~ "EU",           # no African servers
    .default = NA_character_
  )
}

#' Flags countries whose server assignment is a judgement call.
country_region_ambiguous <- function(iso3) {
  un_region <- countrycode(iso3, "iso3c", "un.regionsub.name", warn = FALSE)
  iso3 %in% c("MAR", "DZA", "TUN", "EGY", "LBY", "SDN", "IRN", "ISR", "CAN") |
    un_region %in% c("Sub-Saharan Africa", "Central Asia", "Southern Asia")
}

#' Standardise region labels used by Liquipedia, Esports Earnings and Fortnite Tracker.
#'
#' "NA East" and "NA Central" are the same eastern North American region (Epic
#' renamed it), so both map to NAC. "North America" on its own means the merged
#' NA region used from 2023 Major 2 through 2024, kept separate as "NA (merged)". (Not plain "NA",
#' which read_csv would read back as a missing value.)
standardise_region <- function(x) {
  x <- str_squish(x)
  case_when(
    str_detect(x, regex("^(europe|eu)$", ignore_case = TRUE)) ~ "EU",
    str_detect(x, regex("^(north america east|na east|nae|north america central|na central|nac)$",
                        ignore_case = TRUE)) ~ "NAC",
    str_detect(x, regex("^(north america west|na west|naw)$", ignore_case = TRUE)) ~ "NAW",
    str_detect(x, regex("^(north america|na)$", ignore_case = TRUE)) ~ "NA (merged)",
    str_detect(x, regex("^(brazil|br|south america)$", ignore_case = TRUE)) ~ "BR",
    str_detect(x, regex("^(asia)$", ignore_case = TRUE)) ~ "ASIA",
    str_detect(x, regex("^(oceania|oce)$", ignore_case = TRUE)) ~ "OCE",
    str_detect(x, regex("^(middle east|me)$", ignore_case = TRUE)) ~ "ME",
    .default = NA_character_
  )
}

#' Find a region named anywhere inside a tournament title, e.g.
#' "FNCS: Chapter 3 Season 3 - Grand Finals: NA East" -> "NAC".
region_from_title <- function(title) {
  pattern <- regex(paste0(
    "\\b(north america east|north america west|north america central|north america|",
    "na east|na west|na central|europe|brazil|asia|oceania|middle east|",
    # Short codes, except "ME" (matches the word "me") and "BR" (also "Battle Royale")
    "nae|naw|nac|eu|oce)\\b"), ignore_case = TRUE)
  # Take the LAST region mentioned: titles end with the region they are for
  hits <- str_extract_all(title, pattern)
  standardise_region(map_chr(hits, \(h) if (length(h)) last(h) else NA_character_))
}
# 10_clean_merge.R -------------------------------------------------------------------------
# Turns the collected data into the tidy datasets used by the analysis scripts.
#
# Inputs:  data/processed/ files written by the 0x collection scripts
# Outputs (data/processed/):
#   monthly_panel.csv     one row per month: prize money, Twitch, Google Trends
#   weekly_trends.csv     weekly Google Trends, chained onto one scale
#   tournaments_clean.csv one row per tournament, with year and region tags
#   player_year.csv       one row per player x year: total earnings
#   fncs_regional.csv     one row per FNCS season x region: prize pool and share
#   region_proxies.csv    one row per year x region x proxy: player-base share
#
# Every section ends with validation checks so problems surface here, not in a chart.

source(here::here("R", "00_setup.R"))
source(here::here("R", "region_mapping.R"))

read_processed <- \(name) read_csv(file.path(paths$processed, name), show_col_types = FALSE,
                                       guess_max = 1e5)  # sparse columns need a full scan

# ==========================================================================================
# 1. Weekly Google Trends, chained onto one scale
# ==========================================================================================
# Each ~4-year window is scaled 0-100 on its own. Windows overlap by a year, so
# window 2 is rescaled to window 1 by the ratio of their means over the shared
# weeks, then window 3 to (rescaled) window 2. Finally the whole series is set
# so its maximum is 100.
trends_w <- read_processed("trends_weekly_world.csv")

chain_windows <- function(df) {
  windows <- sort(unique(df$window))
  out <- df |> filter(window == windows[1]) |> select(week, hits)
  link_cor <- c()
  for (w in windows[-1]) {
    nxt     <- df |> filter(window == w) |> select(week, hits)
    overlap <- inner_join(out, nxt, by = "week", suffix = c("_old", "_new"))
    check(nrow(overlap) >= 26, glue("window {w} overlaps by fewer than 26 weeks"))
    link_cor <- c(link_cor, cor(overlap$hits_old, overlap$hits_new))
    ratio   <- mean(overlap$hits_old) / mean(overlap$hits_new)
    out <- bind_rows(out, nxt |> filter(week > max(out$week)) |> mutate(hits = hits * ratio))
  }
  attr(out, "link_cor") <- link_cor
  out
}

weekly_chained <- chain_windows(trends_w)
link_cor <- attr(weekly_chained, "link_cor")
message("Correlation between overlapping Trends windows: ", paste(round(link_cor, 3), collapse = ", "))
check(all(link_cor > 0.9), "overlapping Trends windows disagree; chaining would be unreliable")

weekly_trends <- weekly_chained |>
  transmute(week, trends_index = 100 * hits / max(hits))

check(!anyDuplicated(weekly_trends$week), "duplicate weeks after chaining")
check(all(diff(weekly_trends$week) == 7), "gap in weekly Trends series")

# ==========================================================================================
# 2. Monthly panel
# ==========================================================================================
ee_monthly <- read_processed("ee_monthly.csv")
twitch     <- read_processed("twitch_monthly.csv")
trends_m   <- read_processed("trends_monthly_world.csv")

# A month with no Fortnite tournaments has no summary row on Esports Earnings,
# which the collector records as NA. That means zero, not unknown.
ee_monthly <- ee_monthly |>
  mutate(across(c(prize_usd, earning_players, tournaments), \(x) replace_na(x, 0)))

panel_months <- tibble(month = seq(as.Date("2017-07-01"),
                                   floor_date(max(weekly_trends$week), "month"), by = "month"))

monthly_panel <- panel_months |>
  left_join(ee_monthly, by = "month") |>
  left_join(twitch |> select(month, avg_viewers, peak_viewers, hours_watched,
                             twitch_flag = hours_inconsistent), by = "month") |>
  # Monthly search interest = average of the chained weekly series. The monthly
  # "all time" Trends query is rounded to whole numbers on a 0-100 scale; since
  # recent values sit around 10-20, that rounding swamps month-to-month changes.
  # The weekly windows are each scaled to their own peak, so they keep far more
  # precision.
  left_join(weekly_trends |>
              group_by(month = floor_date(week + days(3), "month")) |>
              summarise(trends_index = mean(trends_index), .groups = "drop"),
            by = "month") |>
  mutate(
    # Prize data starts Feb 2018 and stops at EE's last recorded month; outside
    # that window the value is unknown, not zero.
    across(c(prize_usd, earning_players, tournaments),
           \(x) if_else(month < min(ee_monthly$month) | month > max(ee_monthly$month), NA, x))
  )

check(!anyDuplicated(monthly_panel$month), "duplicate months in panel")
check(all(diff(monthly_panel$month) %in% 28:31), "gap in monthly panel")
check(abs(sum(monthly_panel$prize_usd, na.rm = TRUE) - sum(ee_monthly$prize_usd)) < 1,
      "prize money lost when building the panel")

# ==========================================================================================
# 3. Tournaments, tagged by year and region
# ==========================================================================================
tournaments <- read_processed("ee_tournaments.csv")
ee_events   <- read_processed("ee_events.csv")

tournaments_clean <- tournaments |>
  mutate(
    year   = year(end_date),
    region = coalesce(region_from_title(tournament), standardise_region(location)),
    is_fncs = str_detect(tournament, regex("\\bFNCS\\b|Fortnite Champion Series", ignore_case = TRUE))
  )

check(!anyDuplicated(tournaments_clean$tournament_id), "duplicate tournaments")
check(!anyNA(tournaments_clean$year), "tournament without a date")
message("Tournaments with a region tag: ",
        percent(mean(!is.na(tournaments_clean$region)), 0.1), " of tournaments, ",
        percent(with(tournaments_clean, sum(prize_usd[!is.na(region)], na.rm = TRUE) /
                       sum(prize_usd, na.rm = TRUE)), 0.1), " of prize money")

# ==========================================================================================
# 4. Player earnings by year
# ==========================================================================================
player_earnings <- read_processed("ee_player_earnings.csv")
unattributed    <- read_processed("ee_unattributed.csv")
ee_yearly       <- read_processed("ee_yearly.csv")

# Standalone-tournament rows have no country; borrow it from the same player's
# event rows (a player's country does not change between pages).
player_country <- player_earnings |>
  filter(!is.na(country)) |>
  count(player_id, country) |>
  slice_max(n, by = player_id, with_ties = FALSE) |>
  select(player_id, country)

player_year <- player_earnings |>
  mutate(year = year(end_date)) |>
  group_by(player_id, year) |>
  summarise(earnings_usd = sum(prize_usd), .groups = "drop") |>
  left_join(player_country, by = "player_id") |>
  mutate(iso3 = countrycode(country, "country.name", "iso3c", warn = FALSE))

# Reconcile with EE's own yearly totals. Event children carry their event's
# dates, so an event spanning New Year can land in a different year than EE uses;
# we therefore allow a small gap.
yearly_recon <- player_year |>
  group_by(year) |>
  summarise(named_players = n(), named_prize = sum(earnings_usd)) |>
  left_join(unattributed |> mutate(year = year(end_date)) |>
              group_by(year) |> summarise(unattributed = sum(unattributed)), by = "year") |>
  left_join(ee_yearly, by = "year") |>
  mutate(prize_gap = (named_prize + unattributed) / prize_usd - 1)
print(yearly_recon |> select(year, prize_usd, named_prize, unattributed, prize_gap,
                             named_players, earning_players))
check(all(abs(yearly_recon$prize_gap) < 0.03),
      "player earnings + unattributed money differ from EE's yearly totals by >3%")
check(!anyDuplicated(player_year[c("player_id", "year")]), "duplicate player-years")

# ==========================================================================================
# 5. FNCS regional prize pools (Liquipedia)
# ==========================================================================================
fncs_pages <- read_processed("liquipedia_fncs_pages.csv")

# Regional finals pages, by title pattern (anchored with [^/]+$ so sub-pages
# such as "Grand Royale/Victory Path 1/Europe" are not picked up). "series_type" separates the regular
# seasons from one-off events (Invitational, Grand Royale, All-Star Showdown).
fncs_regional <- fncs_pages |>
  mutate(
    t = str_remove(title, "^Fortnite Champion Series/"),
    season = case_when(
      str_detect(t, "^Season X/Grand Finals/[^/]+$")                ~ "Season X",
      str_detect(t, "^Chapter \\d/Season \\d+/Grand Finals/[^/]+$") ~ str_extract(t, "^Chapter \\d/Season \\d+") |>
                                                                  str_replace("/", " "),
      str_detect(t, "^20\\d\\d/Major \\d/[^/]+$")             ~ str_extract(t, "^20\\d\\d/Major \\d") |>
                                                                  str_replace("/", " "),
      str_detect(t, "^Invitational/Grand Finals/[^/]+$")            ~ "Invitational 2020",
      str_detect(t, "^2021/Grand Royale/[^/]+$")                    ~ "Grand Royale 2021",
      str_detect(t, "^All-Star Showdown/Solo/Grand Finals/[^/]+$")  ~ "All-Star Showdown 2021",
      .default = NA_character_
    ),
    region_label = str_extract(t, "[^/]+$"),
    region = standardise_region(region_label),
    series_type = if_else(str_detect(season, "Invitational|Grand Royale|All-Star"), "special", "regular")
  ) |>
  filter(!is.na(season), !is.na(region)) |>   # drops Summit, Rankings, etc.
  select(season, series_type, region, region_label, start_date, end_date,
         prize_pool_usd, team_number, mode, title, url)

# Order seasons by date and compute each region's share of that season's pool
fncs_regional <- fncs_regional |>
  group_by(season) |>
  mutate(season_start = min(start_date, na.rm = TRUE),
         season_total = sum(prize_pool_usd),
         prize_share  = prize_pool_usd / season_total,
         n_regions    = n()) |>
  ungroup() |>
  mutate(year = year(season_start)) |>
  arrange(season_start, region)

check(!anyDuplicated(fncs_regional[c("season", "region")]), "region listed twice in a season")
check(!anyNA(fncs_regional$prize_pool_usd), "regional final without a prize pool")
check(all(fncs_regional |> count(season) |> pull(n) %in% 6:7), "season without 6-7 regions")
check(all(abs(fncs_regional |> group_by(season) |> summarise(s = sum(prize_share)) |> pull(s) - 1) < 1e-9),
      "prize shares do not sum to 1 within a season")
message("FNCS seasons: ", n_distinct(fncs_regional$season), " (",
        min(fncs_regional$season_start), " to ", max(fncs_regional$season_start), ")")

# ==========================================================================================
# 6. Regional player-base proxies
# ==========================================================================================
# 6a. Google Trends x internet users -------------------------------------------------------
# Trends gives each country's search INTENSITY (share of its searches about
# Fortnite, scaled 0-100 within the year). Multiplying by the number of internet
# users turns intensity into a rough VOLUME, assuming people in different
# countries search Google about equally often overall.
wb <- read_processed("wb_internet_users.csv")
trends_country <- read_processed("trends_country_year.csv")
trends_states  <- read_processed("trends_us_state_year.csv")
state_pop      <- read_processed("us_state_population.csv")

# World Bank figures lag (2025 is sparse), so each year uses the latest value
# available up to that year, carried forward.
proxy_years <- sort(unique(trends_country$year))
internet_users <- wb |>
  filter(!is.na(internet_pct), !is.na(population)) |>
  mutate(internet_users = population * internet_pct / 100) |>
  select(iso3, data_year = year, internet_users) |>
  cross_join(tibble(year = proxy_years)) |>
  filter(data_year <= year) |>
  slice_max(data_year, by = c(iso3, year), with_ties = FALSE)

trends_iso <- trends_country |>
  mutate(iso3 = countrycode(country, "country.name", "iso3c", warn = FALSE,
                            custom_match = c("Kosovo" = "XKX", "Micronesia" = "FSM",
                                             "St. Martin" = "MAF"))) |>
  filter(!is.na(hits))

unmatched <- trends_iso |> filter(is.na(iso3)) |> distinct(country)
if (nrow(unmatched) > 0) message("Trends countries with no ISO code (dropped): ",
                                 paste(unmatched$country, collapse = ", "))

country_volume <- trends_iso |>
  filter(!is.na(iso3), !iso3 %in% search_proxy_excluded) |>   # see region_mapping.R
  inner_join(internet_users, by = c("iso3", "year")) |>
  mutate(volume = hits * internet_users,
         region = country_to_region(iso3),
         ambiguous = country_region_ambiguous(iso3))

# Antarctica and the U.S. Outlying Islands have no internet-user data and drop
# out in the join above; every remaining country must have a region.
check(!anyNA(country_volume$region), "a country could not be mapped to a region")
coverage <- country_volume |> group_by(year) |> summarise(n = n())
message("Countries with both Trends and internet-user data per year: ",
        paste(range(coverage$n), collapse = "-"))

# Split the US between NAC and NAW using state search intensity x state population.
# (State-level internet use is assumed equal across states.)
us_split <- trends_states |>
  left_join(state_pop |> rename(pop_year = year), by = "state", relationship = "many-to-many") |>
  filter(pop_year <= year) |>
  slice_max(pop_year, by = c(state, year), with_ties = FALSE) |>
  mutate(region = if_else(state %in% naw_states, "NAW", "NAC"),
         volume = hits * population) |>
  group_by(year, region) |>
  summarise(volume = sum(volume, na.rm = TRUE), .groups = "drop_last") |>
  mutate(us_fraction = volume / sum(volume)) |>
  ungroup()

check(nrow(us_split) == 2 * length(proxy_years), "US split should give NAC and NAW for every year")

us_volume <- country_volume |> filter(region == "US") |> select(year, us_volume = volume)

trends_regions <- function(include_ambiguous = TRUE) {
  non_us <- country_volume |>
    filter(region != "US", include_ambiguous | !ambiguous) |>
    group_by(year, region) |>
    summarise(value = sum(volume), .groups = "drop")
  us <- us_split |>
    left_join(us_volume, by = "year") |>
    transmute(year, region, value = us_fraction * us_volume)
  bind_rows(non_us, us) |>
    group_by(year, region) |> summarise(value = sum(value), .groups = "drop")
}

proxy_trends <- bind_rows(
  trends_regions(TRUE)  |> mutate(proxy = "trends_internet"),
  trends_regions(FALSE) |> mutate(proxy = "trends_internet_unambiguous")
)

# 6b. Earning players by nationality (Esports Earnings) --------------------------------------
# Counts players who earned prize money that year, by the country EE lists.
# CAUTION: this is partly circular. A region with a bigger prize pool pays more
# places and so creates more earners. It is a robustness check, not the main proxy.
proxy_earners <- player_year |>
  filter(!is.na(iso3)) |>
  mutate(region = country_to_region(iso3)) |>
  filter(!is.na(region)) |>
  group_by(year, region) |>
  summarise(value = n_distinct(player_id), .groups = "drop") |>
  mutate(proxy = "earning_players")
# US earners cannot be split by state, so they stay as "US" (NA combined).

# Combine and compute shares -------------------------------------------------------------------
region_proxies <- bind_rows(proxy_trends, proxy_earners) |>
  group_by(proxy, year) |>
  mutate(share = value / sum(value)) |>
  ungroup() |>
  arrange(proxy, year, region)

check(all(abs(region_proxies |> group_by(proxy, year) |> summarise(s = sum(share), .groups = "drop") |>
                pull(s) - 1) < 1e-9), "proxy shares do not sum to 1")
check(!anyDuplicated(region_proxies[c("proxy", "year", "region")]), "duplicate proxy rows")

# ==========================================================================================
# Save
# ==========================================================================================
write_csv(monthly_panel,     file.path(paths$processed, "monthly_panel.csv"))
write_csv(weekly_trends,     file.path(paths$processed, "weekly_trends.csv"))
write_csv(tournaments_clean, file.path(paths$processed, "tournaments_clean.csv"))
write_csv(player_year,       file.path(paths$processed, "player_year.csv"))
write_csv(fncs_regional,     file.path(paths$processed, "fncs_regional.csv"))
write_csv(region_proxies,    file.path(paths$processed, "region_proxies.csv"))

message("Cleaning complete.")

Data credits: Esports Earnings; Liquipedia (CC-BY-SA 3.0); Google Trends; TwitchTracker; World Bank; U.S. Census Bureau via FRED; Fortnite Wiki (CC-BY-SA).