The Optimal Amount of Suffering
The technical companion: how the index works, what the departure study can and cannot say, and how well the forecast does
Ethan Maddy
September 2026
- 1 The short version
- 2 Research questions
- 3 Reproduction and data
- 4 Defining the score
- 5 Does the index behave?
- 6 What the index says about suffering
- 7 Did the fans come back before the title?
- 8 Departures: a matched
difference-in-differences study
- 8.1 Estimand and design
- 8.2 Estimation code
- 8.3 Results
- 8.4 The big-move screen
- 8.5 Identification: what would make this causal?
- 8.6 Regression to the mean after the screen
- 8.7 Annual effects and the choice of baseline
- 8.8 A pre-period holdout
- 8.9 Sensitivity to design choices
- 8.10 Placebo reassignment
- 8.11 Sensitivity to nonparallel trends
- 8.12 Other famous exits
- 8.13 Recruiting after Riley
- 9 Forecasting the next season
- 10 Figures and interpretation
- 11 Decision log
- 12 What I would do next
- 13 Verification and provenance
- 14 References
1 The short version
- The index. The Fan Suffering Index (FSI) adds five ingredients: winning, improvement, title afterglow, unfinished business, and off-field ruptures, then caps the total at ±10. The weights are declared editorial choices, not fitted estimates. Win percentage alone explains about 68% of its variance (adjusted R² = 0.68), so it is not just the standings in disguise.
- What it says about suffering. For a stylized contender, a title after zero losing seasons scores 8.5. One losing season first pushes the same title to the +10 cap. Without the cap, the bonus stops growing after 4 losing seasons. Every losing season lowers the average. The index’s answer: suffer just long enough to reset expectations.
- Did Durant’s exit hurt OKC? Somewhere between about seven wins a season and nothing. My first comparison group was contaminated: all five of OKC’s closest matches lost a star of their own, which makes “lost a star” nearly collinear with the season effects. Screening out the 20 teams that lost or added a recent All-Star in 2016-19 leaves 8; against the five closest, OKC did 8.7 points worse (every screened design: -10.1 to -5.6; unscreened: +3.0). But none of the teams that stood pat was as good as OKC. Teams at OKC’s level usually fell 15.4 points over the next three seasons; OKC fell 8.2. The two comparisons rest on opposite assumptions and, under some conditions, bracket the truth. 3 of 8 teams that stood pat show a placebo “effect” at least as large as OKC’s.
- Did Riley’s exit hurt OU? At first. OU’s first comparison group had the same problem as OKC’s: its closest match, Notre Dame, lost Brian Kelly to LSU the day after Riley left. Screening out the 64 programs whose head coach left between the 2021 opener and the 2023 title game leaves 61; against the five closest, 2022 landed 31.0 points below expectation and 2023 landed on it. 2022 was a cliff under every design (27.4 to 35.7 points below). The 2023 rebound in the unscreened design (+9.2 points) came mostly from Cincinnati, which lost Luke Fickell after 2022 and went 3-9. The two-season average (-15.5) describes neither season. Recruiting held up: OU’s 2022 class still ranked #8 on the 247Sports Composite and its 2023 class #5.
- Did fans come back before the title? The Thunder’s did: average home attendance rose from 14,878 (2021-22) to 17,451 in 2023-24, a year before the title. League-wide, attendance tracks how good a team is (10 points of win percentage is worth about 2.3% more fans), and improvement adds nothing on its own (-0.0019 per momentum point).
- The forecast. Rolling-origin error of 2.15 (NBA) and 2.88 (football) FSI points, about a sixth better than “same as last year” (2.55, 3.49) but only slightly better than a one-line drift-to-average rule (2.22, 2.95). Rebuilt from past errors only, the 80% bands covered 78% and 81% of outcomes.
- Other famous exits. Run through the original, unscreened design, only LeBron James’s two exits from Cleveland (-34.7 and -30.4 points) fall far outside what ordinary teams do by chance.
- What this is not. Not a survey of fan feelings, and not a set of causal estimates. It is one fan’s assumptions, written down, applied consistently, and stress-tested.
How to read this report. Every section opens with a
short plain-English note. Code is folded; click Code to expand
any chunk. Comments marked WHY in the code explain judgment
calls. The decision log collects every major
decision in one table, and the references are at the end.
2 Research questions
In plain English: a winning season can still feel unfinished, and a losing season can still give you a reason to watch the next one. I want a consistent way to describe that, and then to test it from a few directions.
The Fan Suffering Index gives those ideas an explicit, reproducible definition, from -10 (alienation) through 0 (ambivalence) to +10 (fulfillment). It is a model of the experience, not a measurement of surveyed happiness. The report asks:
- How do records, improvement, and title history map onto the index, and does the index behave sensibly?
- What does the index itself imply about the “optimal amount of suffering”?
- Did team performance change after Kevin Durant and Lincoln Riley left, relative to teams with similar records beforehand?
- How well can information available at season’s end forecast next season’s FSI?
Question 3 uses win percentage, not FSI. Putting an assumed betrayal penalty in the outcome and then estimating a departure effect would build the answer into the calculation.
3 Reproduction and data
In plain English: everything here reruns from public data: game results, a historical scores archive for 1997-2000 football, and recruiting rankings. Nothing is typed in by hand except championship winners, which are checked against official lists.
Download the R scripts and keep their analysis/ folder.
From the project root, run Rscript analysis/download.R
(public data, about 40 MB), then Rscript analysis/fsi.R,
then Rscript analysis/render.R; or open this file in
RStudio and Knit with refresh_data: true. Install
tidyverse, jsonlite, svglite,
ragg, knitr, and rmarkdown first;
rendering HTML also requires Pandoc, which ships with RStudio.
Once fsi.R has run, the saved season panel lets the
report rebuild without touching the raw files. This R Markdown file is
assembled from the same R source files the website uses
(build-report.R pastes them in), so the report and the
website cannot drift apart. It regenerates the model output,
diagnostics, forecast evaluation, and SVG/PNG figures. The appendix
records package versions.
# fsi.R builds the Fan Suffering Index (FSI) from public game results, runs every
# analysis in the essay, and writes the model output.
#
# Run from the project root:
# Rscript analysis/fsi.R rebuild from the raw downloads (run download.R first)
# Rscript analysis/fsi.R --panel rebuild from the saved season panel (much faster)
# Both modes produce byte-identical output.
#
# Comments marked WHY explain a judgment call. Citations are expanded in the
# report's reference list (analysis/report-template.Rmd).
.libPaths(c('analysis/R-library', .libPaths()))
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(jsonlite))
# Keep x inside [a, b]. The index lives on a -10 to +10 scale.
clip <- function(x, a = -10, b = 10) pmax(a, pmin(b, x))
# The most common value, used to give each team-season one name and one conference.
mode_value <- function(x) names(sort(table(x), decreasing = TRUE))[1]input_files <- c('analysis/season-panel.csv', 'analysis/audit.json', 'analysis/recruiting-classes.csv')
input_checksums <- tibble(file = input_files,
md5 = unname(tools::md5sum(input_files)))
knitr::kable(input_checksums, caption = 'Checksums of the saved input snapshot')| file | md5 |
|---|---|
| analysis/season-panel.csv | f75f928b3b31e4dcfcd31373cbf2ff66 |
| analysis/audit.json | 2afa7c2b08752b1c5830a284a167479d |
| analysis/recruiting-classes.csv | 4d770f41455dff6db26ab4c71f165611 |
if (params$refresh_data) source('analysis/download.R')# WHY two modes: the raw archives are about 40 MB and slow to parse. After the first
# run, the saved season panel rebuilds everything else in seconds.
use_panel <- if (exists('use_saved_panel')) {
use_saved_panel # set by the R Markdown report
} else {
'--panel' %in% commandArgs(trailingOnly = TRUE) # set on the command line
}
dir.create('analysis/output/exports', showWarnings = FALSE, recursive = TRUE)
dir.create('EthanMaddyWebsite', showWarnings = FALSE) # absent when only the R scripts were downloaded
if (!use_panel) {
game_rows <- list() # one data frame per sport-season-side (home or away)
champions <- list() # NBA Finals winners read from ESPN's game notes
attendance <- list() # ESPN-reported NBA home attendance, game by game
audit <- list() # cross-source checks, saved to analysis/audit.json
# 1. Game results from SportsDataverse's ESPN archive ---------------------------
# WHY these years: the archive is consistent from 2001-02 on. NBA years are
# season-ending years; football years are starting years. Football 1997-2000
# comes from a second source below.
for (sport in c('nba', 'cfb')) {
for (year in if (sport == 'nba') 2002:2026 else 2001:2025) {
x <- readRDS(sprintf('analysis/raw/%s_%d.rds', sport, year))
if (sport == 'nba') {
x <- x[!duplicated(x$id), ]
# The champion won the last completed Finals game of the season.
finals <- x[x$status_type_completed %in% TRUE &
grepl('^NBA Finals', x$notes_headline, ignore.case = TRUE), ]
finals <- finals[order(finals$date, decreasing = TRUE), ]
if (nrow(finals)) {
winner <- if (finals$home_score[1] > finals$away_score[1]) finals$home_id[1] else finals$away_id[1]
champions[[length(champions) + 1]] <- data.frame(sport, year, id = as.character(winner))
}
# WHY regular season only: it is the one schedule every team plays. Playoff
# heartbreak (hello, 2016) is real but is exactly what a records-based index
# cannot see. NBA Cup championship games are excluded because they do not
# count in the standings.
x <- x[x$season_type == 2 & x$status_type_completed %in% TRUE &
x$home_id %in% 1:30 & x$away_id %in% 1:30 &
!grepl('Championship', x$notes_headline, ignore.case = TRUE), ]
for (side in c('home', 'away')) {
other <- if (side == 'home') 'away' else 'home'
points_for <- x[[paste0(side, '_score')]]
points_against <- x[[paste0(other, '_score')]]
game_rows[[length(game_rows) + 1]] <- data.frame(
sport, year,
id = as.character(x[[paste0(side, '_id')]]),
team = x[[paste0(side, '_display_name')]],
conference = 'NBA',
win = as.numeric(points_for > points_against),
loss = as.numeric(points_for < points_against))
}
# ESPN-reported home attendance. WHY keep it: it is the one measure of fan
# behavior in the data, used in the technical report's attendance section.
crowd <- suppressWarnings(as.numeric(x$attendance))
attendance[[length(attendance) + 1]] <-
data.frame(year, id = as.character(x$home_id), attendance = crowd)[!is.na(crowd) & crowd > 0, ]
} else {
# WHY football keeps bowls and games against lower divisions: a college season
# is only 12-15 games, and the bowl is often the game fans remember longest.
x <- x[!duplicated(x$game_id) & x$completed %in% TRUE & x$season_type_id %in% c(2, 3), ]
for (side in c('home', 'away')) {
other <- if (side == 'home') 'away' else 'home'
fbs <- x[x[[paste0(side, '_division')]] %in% 'fbs', ] # only FBS teams get a record
points_for <- fbs[[paste0(side, '_points')]]
points_against <- fbs[[paste0(other, '_points')]]
game_rows[[length(game_rows) + 1]] <- data.frame(
sport, year,
id = as.character(fbs[[paste0(side, '_id')]]),
team = fbs[[paste0(side, '_team')]],
conference = fbs[[paste0(side, '_conference')]],
win = as.numeric(points_for > points_against),
loss = as.numeric(points_for < points_against))
}
}
}
}
games <- bind_rows(game_rows)
stopifnot(!anyNA(games$win), !anyNA(games$loss))
panel <- games %>%
group_by(sport, id, year) %>%
summarise(team = mode_value(team), conference = mode_value(conference),
wins = sum(win), losses = sum(loss), .groups = 'drop')
# 2. Football 1997-2000 from James Howell's archive -------------------------------
# Season totals, bowls included. WHY: without 2000, OU's national title vanishes
# from the data; without 1997-1999, the 2000 season cannot be scored, because
# momentum needs three earlier seasons. Howell's index lists the years each school
# was FBS (Division I-A); only those seasons count.
index <- paste(readLines('analysis/raw/howell/byconf.htm', warn = FALSE, encoding = 'latin1'),
collapse = ' ')
links <- unique(gsub('\\s+', ' ',
regmatches(index, gregexpr('<a href="[^"]+\\.htm">[^<]+</a>', index))[[1]]))
fbs_years <- bind_rows(lapply(links, function(link) {
# A school link ends with its FBS years, e.g. "Oklahoma (1996-present)".
years <- sub('^.*\\(([0-9, -]+|[0-9, -]*present)\\)\\s*</a>$', '\\1', link)
if (years == link) return(NULL) # not a school link
ranges <- lapply(strsplit(strsplit(years, ',')[[1]], '-'), function(r) {
r <- trimws(r)
as.numeric(c(r[1], if (length(r) > 1) sub('present', '9999', r[2]) else r[1]))
})
in_fbs <- sapply(1997:2000, function(y) any(sapply(ranges, function(z) y >= z[1] & y <= z[2])))
data.frame(page = sub('^<a href="([^"]+)".*$', '\\1', link), year = 1997:2000)[in_fbs, ]
})) %>% distinct()
# One school's page becomes one row per season: team, conference, and W-L-T total.
read_howell <- function(page) {
html <- paste(readLines(file.path('analysis/raw/howell', page), warn = FALSE, encoding = 'latin1'),
collapse = ' ')
bind_rows(lapply(strsplit(html, '<a name=', fixed = TRUE)[[1]][-1], function(block) {
heading <- regmatches(block, regexpr('^[0-9]{4}>[0-9]{4}-[^<]+', block))
total <- tail(regmatches(block, gregexpr('>[0-9]+-[0-9]+-[0-9]+</td>', block))[[1]], 1)
if (!length(heading) || !length(total)) return(NULL)
title <- sub('^[0-9]{4}>[0-9]{4}-', '', heading)
wlt <- as.integer(strsplit(gsub('[^0-9-]', '', total), '-')[[1]])
data.frame(page,
year = as.integer(substr(heading, 1, 4)),
team = gsub('&', '&', trimws(sub('\\s*\\([^()]*\\)\\s*$', '', title))),
conference = sub('^.*\\(([^()]*)\\)\\s*$', '\\1', title),
wins = wlt[1], losses = wlt[2], ties = wlt[3])
}))
}
# Howell's school names and conference labels, translated to ESPN's.
alias <- c('Miami (Florida)' = 'Miami', 'North Carolina State' = 'NC State',
'Southern Methodist' = 'SMU', 'Alabama-Birmingham' = 'UAB',
'Brigham Young' = 'BYU', 'Central Florida' = 'UCF',
'Texas Christian' = 'TCU', 'Southern California' = 'USC',
'Middle Tennessee State' = 'Middle Tennessee', 'Connecticut' = 'UConn',
'Miami (Ohio)' = 'Miami (OH)', 'Nevada-Las Vegas' = 'UNLV',
'San Jose State' = 'San José State', 'Texas-El Paso' = 'UTEP',
'Louisiana State' = 'LSU', 'Mississippi' = 'Ole Miss',
'Louisiana-Monroe' = 'UL Monroe', 'Southern Mississippi' = 'Southern Miss',
'Hawaii' = "Hawai'i")
conferences <- c(CUSA = 'Conference USA', MAC = 'Mid-American', MWC = 'Mountain West',
'Pac 10' = 'Pac-10', WAC = 'Western Athletic', Independent = 'FBS Independents')
# Each school's ESPN id is the one it used most often in the ESPN archive.
espn_ids <- panel %>%
filter(sport == 'cfb') %>%
count(team, id) %>%
group_by(team) %>%
slice_max(n, n = 1, with_ties = FALSE) %>%
ungroup()
howell_all <- bind_rows(lapply(unique(fbs_years$page), read_howell)) %>%
mutate(team = coalesce(unname(alias[team]), team))
howell <- howell_all %>%
semi_join(fbs_years, by = c('page', 'year')) %>%
mutate(conference = coalesce(unname(conferences[conference]), conference)) %>%
left_join(espn_ids %>% select(team, id), by = 'team')
stopifnot(!anyNA(howell$id), all(howell$ties == 0))
# Cross-check the sources where they overlap: Howell's 2001 records must match ESPN's.
check <- howell_all %>%
filter(year == 2001) %>%
inner_join(panel %>% filter(sport == 'cfb', year == 2001), by = 'team', suffix = c('', '.espn'))
audit$howell2001 <- list(
teamsCompared = nrow(check),
recordMismatches = sum(check$wins != check$wins.espn | check$losses != check$losses.espn))
stopifnot(audit$howell2001$teamsCompared >= 110, audit$howell2001$recordMismatches == 0)
panel <- bind_rows(panel, howell %>%
filter(year <= 2000) %>%
transmute(sport = 'cfb', id, year, team, conference,
wins = as.numeric(wins), losses = as.numeric(losses)))
# 3. Champions -----------------------------------------------------------------------
# Football: trophy winners on the field, BCS/CFP (1998 on), not every selector's title.
# WHY 1997 counts twice: the AP picked Michigan and the coaches picked Nebraska, and
# both fan bases celebrated a title. WHY USC's vacated 2004 title stays: the index
# describes what fans lived through that January, not the NCAA's later ruling.
cfb_names <- tribble(
~year, ~team,
1997, 'Michigan', 1997, 'Nebraska', 1998, 'Tennessee', 1999, 'Florida State',
2000, 'Oklahoma', 2001, 'Miami', 2002, 'Ohio State', 2003, 'LSU',
2004, 'USC', 2005, 'Texas', 2006, 'Florida', 2007, 'LSU',
2008, 'Florida', 2009, 'Alabama', 2010, 'Auburn', 2011, 'Alabama',
2012, 'Alabama', 2013, 'Florida State', 2014, 'Ohio State', 2015, 'Alabama',
2016, 'Clemson', 2017, 'Alabama', 2018, 'Clemson', 2019, 'LSU',
2020, 'Alabama', 2021, 'Georgia', 2022, 'Georgia', 2023, 'Michigan',
2024, 'Ohio State', 2025, 'Indiana')
cfb_champs <- cfb_names %>%
inner_join(panel %>% filter(sport == 'cfb'), by = c('year', 'team')) %>%
transmute(sport, year, id)
stopifnot(nrow(cfb_champs) == nrow(cfb_names))
champs <- rbind(do.call(rbind, champions), as.data.frame(cfb_champs))
# NBA: earlier ESPN game notes do not consistently label the Finals, so the official
# winners (ESPN team ids for 2002-2026, in order) fill any season the notes missed.
nba_title_ids <- c(13, 24, 8, 24, 14, 24, 2, 13, 13, 6, 14, 14, 24,
9, 5, 9, 9, 28, 13, 15, 9, 7, 2, 25, 18)
missing_titles <- setdiff(2002:2026, champs$year[champs$sport == 'nba'])
if (length(missing_titles)) {
champs <- rbind(champs, data.frame(sport = 'nba', year = missing_titles,
id = as.character(nba_title_ids[missing_titles - 2001])))
}
stopifnot(sum(champs$sport == 'nba') == 25)
panel$champion <- paste(panel$sport, panel$id, panel$year) %in% paste(champs$sport, champs$id, champs$year)
panel$key <- paste(panel$sport, panel$id, sep = ':')
# Oklahoma City's history begins in 2008-09; Seattle is kept as a separate series.
# WHY: a relocation is the index's -10 scenario for the fans left behind. Splicing
# Seattle's history onto Oklahoma City's would hand OKC fans memories that belong
# to someone else.
panel$key[panel$sport == 'nba' & panel$id == '25' & panel$year < 2009] <- 'nba:SEA'
# Average home attendance per team-season (NBA only).
panel <- panel %>%
left_join(bind_rows(attendance) %>%
group_by(year, id) %>%
summarise(attendanceGames = n(), attendance = round(mean(attendance), 3),
.groups = 'drop') %>%
mutate(sport = 'nba'),
by = c('sport', 'id', 'year'))
# 4. Recruiting: 247Sports Composite rankings, the top 50 classes each year, 2017-2024 --
read_247 <- function(year) {
html <- paste(readLines(sprintf('analysis/raw/247/composite_%d.html', year),
warn = FALSE, encoding = 'UTF-8'),
collapse = ' ')
# First match of a pattern, with its HTML tags stripped.
grab <- function(s, pattern) {
m <- regmatches(s, regexpr(pattern, s, perl = TRUE))
if (length(m)) trimws(gsub('<[^>]+>', '', m)) else NA_character_
}
bind_rows(lapply(strsplit(html, '<li class="rankings-page__list-item">', fixed = TRUE)[[1]][-1],
function(s) {
stars <- regmatches(s, gregexpr('<h2>[345]-Star</h2>\\s*<div[^>]*>\\s*[0-9]+', s, perl = TRUE))[[1]]
n_star <- function(k) {
v <- stars[grepl(paste0('<h2>', k, '-Star'), stars)]
if (length(v)) as.integer(sub('.*>\\s*([0-9]+)$', '\\1', v)) else 0L
}
data.frame(class = year,
rank = as.integer(grab(s, '<div class="primary">\\s*[0-9]+')),
team = grab(s, '<a class="rankings-page__name-link"[^>]*>[^<]+'),
commits = as.integer(sub(' Commits', '', grab(s, '<div class="total">\\s*<a[^>]*>[0-9]+ Commits'))),
fiveStar = n_star(5), fourStar = n_star(4), threeStar = n_star(3),
points = as.numeric(grab(s, '<a class="number"[^>]*>[0-9.]+')))
}))
}
recruiting <- bind_rows(lapply(2017:2024, read_247))
stopifnot(all(count(recruiting, class)$n == 50), !anyNA(recruiting$rank))
write_csv(recruiting, 'analysis/recruiting-classes.csv')
} else {
panel <- read_csv('analysis/season-panel.csv', col_types = cols(id = col_character()),
show_col_types = FALSE)
audit <- fromJSON('analysis/audit.json', simplifyVector = FALSE)
recruiting <- read_csv('analysis/recruiting-classes.csv', show_col_types = FALSE)
}Records come from SportsDataverse’s public ESPN schedule archives. NBA years are season-ending years, 2002-2026, regular season only; NBA Cup championship games do not count in the standings and are excluded. Football years are starting years, 1997-2025, including completed FBS games, bowls, and games against lower divisions. The ESPN archive starts in 2001, so 1997-2000 come from James Howell’s historical scores archive, which lists the years each school was FBS. Where the two sources overlap (2001), Howell’s records match ESPN’s for all 116 teams compared, with 0 mismatches. Without 1997-2000, OU’s 2000 national title would vanish and the 2000 season could not be scored. Results are as played. Football titles are BCS/CFP winners, plus both 1997 poll champions (Michigan and Nebraska); USC’s later-vacated 2004 title stays, because the index describes what fans lived through. NBA home attendance (ESPN-reported) is kept for the attendance analysis, and 247Sports Composite recruiting rankings for 2017-2024 for the recruiting section. Seattle and Oklahoma City are separate series.
Set refresh_data to true to rebuild the
panel from the raw game files. The downloader reuses existing raw files
and otherwise downloads the public archives; compare the download
manifest’s checksums before replacing the saved snapshot, since the
provider can revise files.
panel %>% group_by(sport) %>%
summarise(first_year = min(year), last_year = max(year),
teams = n_distinct(key), team_seasons = n(), .groups = 'drop') %>%
knitr::kable(caption = 'Input coverage before the three-season scoring requirement')| sport | first_year | last_year | teams | team_seasons |
|---|---|---|---|---|
| cfb | 1997 | 2025 | 138 | 3575 |
| nba | 2002 | 2026 | 31 | 747 |
4 Defining the score
In plain English: start with the record, reward getting better, add a fading glow for titles, subtract a little for good seasons that fell short, and (for my two teams only) subtract for betrayals. Then cap the total at ±10.
Start with two declared anchors: a .500 record earns zero points for winning; a .750 record earns two. Two points recognize a strong season while leaving room for a championship to mean more. Linear interpolation gives a slope of , so . The four follows from the anchors; it is not an estimated coefficient.
| Component | Formula | Why this choice |
|---|---|---|
| Winning, W | 4(2p - 1) | .500 maps to 0; .750 to +2. Leaves headroom for titles. Symmetric by choice, although fans feel losses more than wins (Dolton and MacKerron 2018). |
| Momentum, M | 3 × clamp((p - prior three-season mean)/.20, -1, 1) | Reference dependence (Kahneman and Tversky 1979; Kőszegi and Rabin 2006). A 20-point swing earns the full ±3. |
| Title memory, C | 6 × Σ 2^(-years since title/2) | Hedonic adaptation (Brickman, Coates, and Janoff-Bulman 1978). Two-year half-life; titles stack. |
| Unfinished business, U | .4 × Σ clamp((p - .50)/.25, 0, 1), latest five seasons; title seasons count zero | Expectation-based disappointment (Kőszegi and Rabin 2006). Caps at 2. |
| Off-field events, O | Σ size × 2^(-years since event/2) | KD and Riley -5; Harden -2. Personal scenarios only (parasocial loss; Cohen 2004). |
The league-wide scores and the forecast set O to zero for every team, because no complete inventory of every fan base’s off-field heartbreaks exists. The two personal charts show O separately. Three prior seasons are required for momentum, so each team’s first three seasons are unscored. Early title memories are truncated by the archive’s start. Zero is a net balance and can conceal strong feelings in both directions.
# FSI = clip(W + M + C - U + O, -10, 10). Every number below is an editorial choice,
# written down so it can be argued with. None is fitted: no public dataset records how
# fans of every team felt, season by season, which is what fitting would require.
fsi_weights <- list(
# W, winning. Anchors: .500 -> 0 and .750 -> +2, so the slope is 2 / (.75 - .50) = 8.
# WHY only +2 for a great record: the scale still needs room above it for a title.
# WHY symmetric: simplicity. Fans feel defeats more than wins (Dolton & MacKerron 2018
# put the pain of losing at more than double the joy of winning), so this is generous
# to bad teams. An asymmetric W is listed as a future sensitivity check.
win_anchor_p = .75, win_anchor_points = 2,
# M, momentum: this season against the average of the previous three.
# WHY: fans judge a season against a reference point, not in a vacuum (Kahneman &
# Tversky 1979; Koszegi & Rabin 2006). Three seasons is roughly a roster cycle. A
# 20-point swing (about 16 NBA wins) is big enough to earn the full +/-3.
momentum_points = 3, momentum_full_swing = .20, momentum_window = 3,
# C, title memory: +6 per title, halving every two years; titles stack.
# WHY decay: joy fades as people adapt to good news (Brickman, Coates & Janoff-Bulman
# 1978). WHY six: with a strong record, a title reaches the +10 cap, so a first
# title and a dynasty can both max out. Two years is a judgment, not an estimate.
title_points = 6, title_half_life = 2,
# U, unfinished business: up to -.4 for each recent good season without a title.
# WHY: when expectations are the reference point, near-misses register as losses
# (Koszegi & Rabin 2006). A .750 season is a full near-miss; the five-season window
# caps the burden at -2 so it can dent, but never erase, a winning record.
unfinished_per_season = .4, unfinished_full_at = .25, unfinished_window = 5,
# O, off-field events, appears only in the two personal charts (see `events` below).
event_half_life = 2)
win_anchor_p <- fsi_weights$win_anchor_p
win_anchor_points <- fsi_weights$win_anchor_points
win_slope <- win_anchor_points / (win_anchor_p - .50)
# Score one team's seasons (one row per season, in any order) with the weights above.
score_team <- function(g, w = fsi_weights) {
g <- g %>% arrange(year) %>% mutate(p = wins / (wins + losses))
g %>% mutate(
# W: the record itself.
winning = win_slope * (p - .50),
# M: this season against the average of the previous three.
momentum = map_dbl(year, function(y) {
prior <- g %>% filter(year %in% (y - w$momentum_window:1))
# WHY NA instead of guessing: without three prior seasons there is no reference point.
if (nrow(prior) != w$momentum_window) return(NA_real_)
w$momentum_points * clip((g$p[g$year == y] - mean(prior$p)) / w$momentum_full_swing, -1, 1)
}),
# C: every title so far, each worth less the longer ago it was.
title = map2_dbl(year, momentum, function(y, m) {
if (is.na(m)) return(NA_real_)
past <- g %>% filter(year <= y, champion)
w$title_points * sum(2^(-(y - past$year) / w$title_half_life))
}),
# U: good seasons in the last five that ended without a title (stored as a negative).
unfinished = map2_dbl(year, momentum, function(y, m) {
if (is.na(m)) return(NA_real_)
recent <- g %>% filter(year <= y) %>% slice_tail(n = w$unfinished_window)
# A title season is the opposite of unfinished business, so it contributes zero.
-w$unfinished_per_season *
sum(if_else(recent$champion, 0, clip((recent$p - .50) / w$unfinished_full_at, 0, 1)))
}),
# WHY cap at +/-10: a bounded, readable scale. The cost is that it compresses
# extremes; in practice it only binds in title seasons (see index-diagnostics).
fsi = clip(winning + momentum + title + unfinished))
}panel <- panel %>%
group_by(key) %>%
group_modify(~score_team(.x)) %>%
ungroup() %>%
arrange(key, year) %>%
select(sport, id, year, team, conference, wins, losses, champion, key, p,
winning, momentum, title, unfinished, fsi, attendance, attendanceGames)5 Does the index behave?
In plain English: before trusting the index with feelings, check that it is not just the standings in disguise, that the cap is not doing all the work, and that its extremes make sense.
# Sanity checks on the index itself, in plain terms:
# 1. How much of the score is just the win-loss record? (Adjusted R^2 of FSI on win %.)
# Near 1 would make the other ingredients decoration; near 0 would ignore the scoreboard.
# WHY adjusted: it is R^2 charged for the number of predictors, the standard way to
# report fit. With one predictor and hundreds of seasons, the two differ only slightly.
# 2. How often does the +/-10 cap bind, and for whom?
# 3. What range can a team reach on the field alone, before any off-field event?
scored <- panel %>% filter(!is.na(fsi))
diagnostics <- map(c(nba = 'nba', cfb = 'cfb'), function(s) {
z <- filter(scored, sport == s)
list(seasons = nrow(z),
adjR2WinPct = summary(lm(fsi ~ p, z))$adj.r.squared,
champions = sum(z$champion),
championsAtCap = sum(z$champion & z$fsi >= 10),
atCap = sum(z$fsi >= 10),
atFloor = sum(z$fsi <= -10),
worst = z %>% slice_min(fsi, n = 3, with_ties = FALSE) %>%
select(key, team, year, wins, losses, fsi),
bestWithoutTitle = z %>% filter(!champion) %>% slice_max(fsi, n = 3, with_ties = FALSE) %>%
select(key, team, year, wins, losses, fsi))
})
# On-field floor: a winless season (W = -4) after a collapse (M = -3), following four
# .750+ seasons that each still count as unfinished business (U = -1.6). So -10 is only
# reachable with an off-field rupture, e.g. your team leaving town. (Sorry, Seattle.)
# Ceiling with no title in memory: unbeaten (+4), full momentum (+3), one near-miss (-.4).
diagnostics$bounds <- with(fsi_weights, list(
onFieldFloor = -win_slope * .5 - momentum_points - unfinished_per_season * (unfinished_window - 1),
ceilingWithoutTitles = win_slope * .5 + momentum_points - unfinished_per_season))imap_dfr(diagnostics[c('nba', 'cfb')], ~tibble(sport = .y, scored_seasons = .x$seasons,
adj_r2_on_win_pct = .x$adjR2WinPct, titles = .x$champions, titles_at_cap = .x$championsAtCap,
seasons_at_cap = .x$atCap, seasons_at_floor = .x$atFloor)) %>%
knitr::kable(digits = 3, caption = 'How much of the index is the record, and how often the cap binds')| sport | scored_seasons | adj_r2_on_win_pct | titles | titles_at_cap | seasons_at_cap | seasons_at_floor |
|---|---|---|---|---|---|---|
| nba | 654 | 0.677 | 22 | 14 | 14 | 0 |
| cfb | 3156 | 0.688 | 26 | 22 | 25 | 0 |
imap_dfr(diagnostics[c('nba', 'cfb')], ~bind_rows(mutate(.x$worst, list = 'Most miserable'),
mutate(.x$bestWithoutTitle, list = 'Happiest without a title')) %>% mutate(sport = .y)) %>%
select(sport, list, team, year, wins, losses, fsi) %>%
knitr::kable(digits = 2, caption = 'The extremes')| sport | list | team | year | wins | losses | fsi |
|---|---|---|---|---|---|---|
| nba | Most miserable | Charlotte Bobcats | 2012 | 7 | 59 | -6.21 |
| nba | Most miserable | Houston Rockets | 2021 | 17 | 55 | -6.20 |
| nba | Most miserable | Cleveland Cavaliers | 2011 | 19 | 63 | -6.19 |
| nba | Happiest without a title | Golden State Warriors | 2016 | 73 | 9 | 9.65 |
| nba | Happiest without a title | Boston Celtics | 2009 | 62 | 20 | 8.81 |
| nba | Happiest without a title | San Antonio Spurs | 2006 | 63 | 19 | 8.26 |
| cfb | Most miserable | UCF | 2015 | 0 | 12 | -8.05 |
| cfb | Most miserable | Southern Miss | 2012 | 0 | 12 | -7.71 |
| cfb | Most miserable | Baylor | 2017 | 1 | 11 | -7.59 |
| cfb | Happiest without a title | Alabama | 2013 | 11 | 2 | 10.00 |
| cfb | Happiest without a title | Alabama | 2016 | 14 | 1 | 10.00 |
| cfb | Happiest without a title | Alabama | 2018 | 14 | 1 | 10.00 |
Win percentage explains about 68% of the variance in both sports (adjusted R² of 0.68 in the NBA and 0.69 in football), so roughly a third of the index comes from improvement, titles, and unfinished business. The cap binds only in title seasons, plus three seasons of Alabama’s dynasty, when stacked title memory keeps non-title seasons at +10. The floor never binds: on the field alone the lowest reachable score is -8.6, so -10 requires an off-field rupture. Without any title in memory, the best possible season is +6.6.
The extremes pass a smell test. The most miserable NBA season is the 2011-12 Bobcats (the worst winning percentage in league history), followed by Houston the season it traded James Harden and Cleveland the season after LeBron James left. The biggest blind spot is the playoffs: the happiest NBA season without a title is the 73-9 Warriors, who lost the Finals after leading 3-1. A records-based index cannot see that.
6 What the index says about suffering
In plain English: take a pretend team that contends for years, give it some losing seasons, then let it win a title. Score it with the same code as every real team, and see how the title season and the average season change as the losing stretches out.
# What does the index itself say about the essay's title question?
# Stylized team: a contender (.650 for ten seasons) suffers k losing seasons (.300),
# then wins a title with a .750 record. It is scored by score_team(), the same code
# used for every real team. WHY stylized: real title runs differ in too many ways
# (rosters, luck, conferences) to isolate "suffering" from the data.
stylized_team <- function(k) {
rates <- c(rep(.65, 10), rep(.30, k), .75)
tibble(year = seq_along(rates),
wins = round(100 * rates), losses = 100 - round(100 * rates),
champion = c(rep(FALSE, length(rates) - 1), TRUE)) %>%
score_team()
}
suffering_curve <- map_dfr(0:6, function(k) {
s <- stylized_team(k)
n <- nrow(s)
window <- (n - 6):n
tibble(losingSeasons = k,
titleUncapped = with(s[n, ], winning + momentum + title + unfinished),
titleScore = s$fsi[n],
# The same seven seasons for every k: the title plus the six before it.
averageSevenSeasons = mean(s$fsi[window]),
worstSeason = min(s$fsi[window]))
})
# Season-by-season scores for the essay's small multiples: the title season (season 7)
# and the six seasons before it, for each number of losing seasons.
suffering_paths <- map_dfr(0:6, function(k) {
s <- stylized_team(k)
n <- nrow(s)
tibble(losingSeasons = k, season = 1:7,
winPct = s$p[(n - 6):n], fsi = s$fsi[(n - 6):n], titleSeason = season == 7)
})suffering_curve %>%
rename(`losing seasons` = losingSeasons, `title season, uncapped` = titleUncapped,
`title season, scored` = titleScore, `average of title + six before` = averageSevenSeasons,
`worst season in window` = worstSeason) %>%
knitr::kable(digits = 2, caption = 'The stylized suffering curve')| losing seasons | title season, uncapped | title season, scored | average of title + six before | worst season in window |
|---|---|---|---|---|
| 0 | 8.54 | 8.54 | 1.22 | 0.00 |
| 1 | 10.28 | 10.00 | 0.63 | -5.56 |
| 2 | 10.52 | 10.00 | -0.13 | -5.56 |
| 3 | 10.76 | 10.00 | -0.67 | -5.56 |
| 4 | 11.00 | 10.00 | -0.94 | -5.56 |
| 5 | 11.00 | 10.00 | -1.16 | -5.56 |
| 6 | 11.00 | 10.00 | -1.39 | -5.56 |
The mechanism is reference dependence. A losing season lowers the three-season baseline, so the title season earns the full momentum bonus, and it clears some unfinished business. With the published weights, one losing season is enough to reach the cap. Without the cap, the bonus stops growing after 4 losing seasons, when the losing stretch has pushed every contending season out of the momentum and unfinished-business windows. Meanwhile each losing season drags down the seven-season average, and the worst season in the window is equally bad whether the losing lasts one year or six.
This is a property of the declared weights, not an empirical finding. A wider momentum window or a larger full-swing threshold would move the optimum. It does connect to two empirical literatures: reference-dependent preferences (Kőszegi and Rabin 2006) and the peak-end rule with duration neglect, where people remember painful episodes by their worst moment and their ending rather than their length (Kahneman et al. 1993; Redelmeier and Kahneman 1996).
7 Did the fans come back before the title?
In plain English: attendance is the one piece of fan behavior in the data. The Thunder’s crowds came back during the 57-win season, a year before the title. Across the league, though, crowds follow how good a team is, not whether it just improved. That is a check on the essay’s claim, and a limit on the index’s improvement bonus.
# Did fans come back before the title? Attendance is behavior, not feelings, but it is
# the one fan-side measure in the data. Two looks (both in the technical report):
# 1. The Thunder's own home attendance (ESPN-reported average per home game).
# 2. League-wide: log attendance on this season's win %, last season's win %, improvement
# (the momentum ingredient) and title memory, with team and season fixed effects, so
# each team is compared with itself. The pandemic seasons (2019-20, 2020-21) are dropped.
# WHY cluster by team: a team's seasons are not independent draws.
okc_attendance <- panel %>%
filter(key == 'nba:25', !is.na(attendance)) %>%
select(year, wins, losses, attendance, attendanceGames)
att <- panel %>%
filter(sport == 'nba') %>%
arrange(key, year) %>%
group_by(key) %>%
mutate(prevWinPct = lag(p)) %>%
ungroup() %>%
filter(!is.na(attendance), !is.na(fsi), !is.na(prevWinPct), !year %in% c(2020, 2021))
attendance_fit <- lm(log(attendance) ~ p + prevWinPct + momentum + title + factor(key) + factor(year), att)
# Cluster-robust (by team) standard errors, written out so no extra package is needed.
cluster_se <- function(fit, cluster) {
X <- model.matrix(fit)
e <- resid(fit)
bread <- solve(crossprod(X))
meat <- Reduce(`+`, lapply(split(seq_along(e), cluster), function(i) {
s <- crossprod(X[i, , drop = FALSE], e[i])
s %*% t(s)
}))
G <- length(unique(cluster))
n <- nrow(X)
k <- ncol(X)
sqrt(diag(bread %*% meat %*% bread * (G / (G - 1)) * ((n - 1) / (n - k))))
}
se <- cluster_se(attendance_fit, att$key)
attendance_model <- tibble(
term = c('p', 'prevWinPct', 'momentum', 'title'),
label = c('This season\'s win %', 'Last season\'s win %', 'Improvement (momentum)', 'Title memory'),
estimate = coef(attendance_fit)[term],
se = se[term]) %>%
mutate(low = estimate - 1.96 * se, high = estimate + 1.96 * se)
attendance_summary <- list(okc = okc_attendance, capacity = 18203, model = attendance_model,
n = nobs(attendance_fit), teams = n_distinct(att$key),
seasons = paste(range(att$year), collapse = '-'))attendance_summary$okc %>%
transmute(season = paste0(year - 1, '-', substr(year, 3, 4)), wins, losses, attendance = round(attendance),
share_of_capacity = attendance / attendance_summary$capacity, home_games = attendanceGames) %>%
knitr::kable(digits = 3, caption = 'Thunder average home attendance, ESPN-reported (2020-21 omitted: pandemic restrictions)')| season | wins | losses | attendance | share_of_capacity | home_games |
|---|---|---|---|---|---|
| 2008-09 | 23 | 59 | 18693 | 1.027 | 40 |
| 2009-10 | 50 | 32 | 18004 | 0.989 | 41 |
| 2010-11 | 55 | 27 | 18144 | 0.997 | 38 |
| 2011-12 | 47 | 19 | 18203 | 1.000 | 33 |
| 2012-13 | 60 | 22 | 18203 | 1.000 | 41 |
| 2013-14 | 59 | 23 | 18203 | 1.000 | 41 |
| 2014-15 | 45 | 37 | 18203 | 1.000 | 41 |
| 2015-16 | 55 | 27 | 18203 | 1.000 | 41 |
| 2016-17 | 47 | 35 | 18203 | 1.000 | 41 |
| 2017-18 | 48 | 34 | 18203 | 1.000 | 41 |
| 2018-19 | 49 | 33 | 18204 | 1.000 | 41 |
| 2019-20 | 44 | 28 | 18203 | 1.000 | 33 |
| 2021-22 | 24 | 58 | 14878 | 0.817 | 40 |
| 2022-23 | 40 | 42 | 15534 | 0.853 | 41 |
| 2023-24 | 57 | 25 | 17451 | 0.959 | 41 |
| 2024-25 | 68 | 14 | 17972 | 0.987 | 42 |
| 2025-26 | 64 | 18 | 18211 | 1.000 | 42 |
attendance_model %>% transmute(term = label, estimate, cluster_se = se, low_95 = low, high_95 = high) %>%
knitr::kable(digits = 4, caption = sprintf('Log attendance on performance: %d team-seasons, %s, team and season fixed effects, team-clustered errors',
attendance_summary$n, attendance_summary$seasons))| term | estimate | cluster_se | low_95 | high_95 |
|---|---|---|---|---|
| This season’s win % | 0.2323 | 0.0517 | 0.1310 | 0.3335 |
| Last season’s win % | 0.1335 | 0.0254 | 0.0837 | 0.1833 |
| Improvement (momentum) | -0.0019 | 0.0032 | -0.0083 | 0.0044 |
| Title memory | -0.0021 | 0.0026 | -0.0073 | 0.0030 |
Holding the team and the season fixed, a 10-point better record this season goes with about 2.3% more fans, and a 10-point better record last season with about 1.3% more. Improvement over the previous three seasons adds nothing detectable once those are known (-0.0019, 95% interval -0.0083 to +0.0044), and neither does title afterglow. Two cautions: attendance is capped by capacity (the Thunder sold out every season from 2011-12 to 2019-20), and it measures behavior, not feelings. It supports the narrower claim that fans came back before the trophy; it does not validate the index’s bonus for improvement, which remains a declared assumption.
8 Departures: a matched difference-in-differences study
In plain English: great teams usually get worse anyway. So the question is not whether OKC or OU declined after the departure, but whether they declined more than similar teams did over the same seasons. Pick the closest matches using only the seasons before the departure, then compare what happened next. For Durant, first throw out every team that had a big move of its own, because a comparison team is supposed to show what happens without one.
8.1 Estimand and design
The target is the change in the former team’s seasonal win rate, relative to the change in a matched comparison group. Under the identification assumptions below, it could represent the effect of the departure and everything that followed from it: replacements, trades, recruiting. It cannot isolate the departing individual from those responses.
| Case | Baseline seasons | Post seasons | Exclusions and timing |
|---|---|---|---|
| Durant / OKC | 2013-2016 | 2017-2019 | Golden State received Durant; Seattle is a separate historical series; 20 teams that lost or added a recent All-Star between April 2016 and April 2019 are screened out. Ends before the 2019 Westbrook trade and the pandemic season. |
| Riley / OU | 2018-2021 | 2022-2023 | USC received Riley and transfers; 64 programs whose head coach left between the 2021 opener and the 2023 title game are screened out. Ends before OU’s 2024 move to the SEC. OU’s 2021 bowl came after Riley left. |
Both are retrospective case studies with one treated team each, estimated separately. Eligible comparison teams need complete records across the window. Within each sport, choose the five teams minimizing pre-departure root-mean-square win-rate differences and weight them equally. Five is an interpretability choice: enough teams to avoid relying on one, few enough to inspect. Other group sizes are also reported. In both cases the pool is screened first (next section). The Durant screen was added after the first version of this study, on design grounds rather than because of its answer. The Riley screen came later, to apply the same rule to both departures; its answer was already visible in the first version as a coach-stable check. Both unscreened designs are reported next to the screened ones.
Let be win percentage and the equal-weight comparison mean:
On the balanced matched sample, the same coefficient comes from the two-way fixed-effects regression
Team fixed effects absorb persistent level differences; season fixed effects absorb league-wide shocks. They do not absorb team-specific injuries, recruiting, schedules, or coaching changes. The code verifies that the regression and the four-mean calculation agree exactly (Card and Krueger 1994 is the classic four-mean design; Callaway 2022 reviews the modern literature).
8.2 Estimation code
# did.R: did a departure hurt the TEAM, or just me?
#
# Matched comparative case studies. The outcome is season win percentage. The emotional
# FSI penalty never enters, because testing a penalty I assigned myself would just hand
# my own assumption back to me.
#
# The plain-English version: great teams usually get worse anyway (regression to the
# mean). So the question is not "did OKC decline after KD left?" but "did OKC decline
# more than similar teams did over the same seasons?" That is difference-in-differences,
# the design Card & Krueger (1994) used for New Jersey's minimum wage.
#
# All matching uses pre-departure outcomes only, so post-departure results cannot
# influence which teams are chosen. Sourced by fsi.R, which defines `panel`.
# ---- 1. The comparison engine ---------------------------------------------------------
# Teams that can serve as comparisons: same sport, not the treated team, not excluded,
# and a complete record in every season of the window.
eligible_donors <- function(panel, key, pre, post, excluded = character()) {
sport_name <- panel %>% filter(.data$key == .env$key) %>% pull(sport) %>% first()
# WHY complete records: a comparison team missing a season would change the average
# it contributes from year to year, which looks like an effect but is just missing data.
panel %>%
filter(sport == sport_name, !.data$key %in% c(.env$key, excluded), year %in% c(pre, post)) %>%
group_by(key) %>%
filter(n_distinct(year) == length(unique(c(pre, post))), all(is.finite(p))) %>%
ungroup() %>%
distinct(key) %>%
arrange(key) %>%
pull(key)
}
# The k teams whose pre-departure win rates were closest to the treated team's.
# WHY match on win-rate levels: elite teams regress toward .500 (Galton 1886; Schall &
# Smith 2000), so comparison teams should face the same pull. The known risk is that
# matching on pre-period levels can itself manufacture regression to the mean when the
# treated and comparison teams come from different populations (Daw & Hatfield 2018).
# That is why "match changes, not levels" (match_shape = TRUE) is reported alongside.
# WHY five teams at equal weight: few enough to name and inspect one by one. Synthetic
# control would optimize the weights (Abadie, Diamond & Hainmueller 2010), but with four
# pre-seasons optimized weights mostly fit noise. Other group sizes are also reported.
match_donors <- function(panel, key, pre, pool, k = 5, match_shape = FALSE) {
target <- panel %>% filter(.data$key == .env$key, year %in% pre) %>% select(year, target = p)
distances <- panel %>%
filter(.data$key %in% pool, year %in% pre) %>%
inner_join(target, by = 'year') %>%
group_by(key) %>%
summarise(distance = sqrt(mean(if (match_shape) {
((p - mean(p)) - (target - mean(target)))^2 # same ups and downs
} else {
(p - target)^2 # same win rates
})), .groups = 'drop') %>%
arrange(distance, key)
stopifnot(nrow(distances) >= k)
distances %>% slice_head(n = k) %>% mutate(weight = 1 / k)
}
# The four-mean difference-in-differences, plus the season-by-season path behind it.
estimate_did <- function(panel, key, pre, post, donors) {
years <- sort(unique(c(pre, post)))
target <- panel %>% filter(.data$key == .env$key, year %in% years) %>% select(year, treated = p)
comparison <- panel %>%
filter(.data$key %in% donors$key, year %in% years) %>%
inner_join(donors %>% select(key, weight), by = 'key') %>%
group_by(year) %>%
summarise(control = sum(p * weight), .groups = 'drop')
path <- target %>% inner_join(comparison, by = 'year') %>% arrange(year)
# Shift the comparison line so it starts level with the treated team: DiD compares
# changes, so only the shapes of the two lines need to match before the departure.
baseline_gap <- path %>% filter(year %in% pre) %>% summarise(g = mean(treated - control)) %>% pull(g)
path <- path %>% mutate(
counterfactual = control + baseline_gap,
gap = treated - counterfactual,
event_time = year - min(post),
event_effect = (treated - control) - (treated - control)[year == max(pre)])
changes <- path %>% summarise(
treated_change = mean(treated[year %in% post]) - mean(treated[year %in% pre]),
control_change = mean(control[year %in% post]) - mean(control[year %in% pre]))
list(effect = changes$treated_change - changes$control_change,
treatedChange = changes$treated_change,
controlChange = changes$control_change,
# Level fit: how close the raw win rates were before the departure.
preRMSE = sqrt(mean((path$treated[path$year %in% pre] - path$control[path$year %in% pre])^2)),
# Shape fit: the same after removing the constant pre-period gap. DiD only needs
# the shapes to match, so this is the fit that matters for the design.
preGapRMSE = sqrt(mean(path$gap[path$year %in% pre]^2)),
postGapRMSE = sqrt(mean(path$gap[path$year %in% post]^2)),
firstPostGap = path$gap[path$year == min(post)],
preGapSlope = unname(coef(lm(I(treated - control) ~ year, filter(path, year %in% pre)))[2]),
path = path)
}
# How far do teams at the treated team's level usually fall, in the league's own history?
# WHY: when no comparison team is as good as the treated team, the difference-in-
# differences quietly assumes an elite team and a mediocre one would have moved in
# parallel, which regression to the mean says they would not. This benchmark makes the
# opposite assumption: absent the departure, the team would have changed like other
# teams that started at the same level. Under some conditions the two answers bracket
# the truth (Angrist & Pischke 2009, section 5.3; Ding & Li 2019).
level_benchmark <- function(panel, key, pre, post, band = .03) {
sport_name <- panel %>% filter(.data$key == .env$key) %>% pull(sport) %>% first()
n_pre <- length(pre)
span <- n_pre + length(post)
treated <- panel %>% filter(.data$key == .env$key)
treated_pre <- mean(treated$p[treated$year %in% pre])
treated_change <- mean(treated$p[treated$year %in% post]) - treated_pre
# Every stretch of the same length for every other team: n_pre seasons, then the rest.
windows <- map_dfr(sort(unique(panel$year[panel$sport == sport_name])), function(s) {
pre_s <- s:(s + n_pre - 1)
post_s <- (s + n_pre):(s + span - 1)
panel %>%
filter(sport == sport_name, .data$key != .env$key, year %in% c(pre_s, post_s)) %>%
group_by(key) %>%
filter(n_distinct(year) == span) %>%
summarise(start = s, preMean = mean(p[year %in% pre_s]), postMean = mean(p[year %in% post_s]),
.groups = 'drop')
}) %>% mutate(change = postMean - preMean)
# Stretches that started within `band` of the treated team's win rate.
near <- windows %>% filter(abs(preMean - treated_pre) <= band)
list(band = band, windows = nrow(near), teams = n_distinct(near$key),
nearLow = treated_pre - band, nearHigh = treated_pre + band,
meanChange = mean(near$change), treatedPre = treated_pre, treatedChange = treated_change,
difference = treated_change - mean(near$change),
# The same idea as a straight line through every stretch in the league's history.
slope = unname(coef(lm(change ~ preMean, windows))[2]), allWindows = nrow(windows))
}
# ---- 2. The big-move screen (NBA) ----------------------------------------------------
# WHY: a comparison team is supposed to show what would have happened WITHOUT the
# departure. My first comparison group for Durant could not: every one of OKC's five
# closest matches lost a star or a franchise icon in the same window (and Indiana traded
# Paul George to OKC itself). When every comparison team is also losing stars, "lost a
# star" moves together with "comparison team in those seasons", so the regression cannot
# tell the two apart: the treatment is nearly collinear with the season effects.
#
# The rule, applied the way I would have applied it by hand: a team is out if, after the
# baseline ended and before the comparison window closed, it lost or added a recent
# All-Star (named to either of the two All-Star Games before the move) by trade, free
# agency, or retirement. Injuries are not moves.
# Sources: Wikipedia's "List of 2016-17 NBA season transactions" (and the 2017-18 and
# 2018-19 lists) and its "List of NBA All-Stars", checked September 2026. The table also
# keeps moves that did NOT qualify, so the edge cases are visible.
# All-Star Game dates, named by season-ending year.
all_star_games <- c(`2014` = '2014-02-16', `2015` = '2015-02-15', `2016` = '2016-02-14',
`2017` = '2017-02-19', `2018` = '2018-02-18', `2019` = '2019-02-17')
# One row per move. all_star = the player's All-Star selections, 2012-2019. from = NA for a
# free agent who had been released; to = NA for a retirement.
# Team keys: 1 ATL, 2 BOS, 3 NOP, 4 CHI, 5 CLE, 6 DAL, 7 DEN, 8 DET, 9 GSW, 10 HOU,
# 11 IND, 12 LAC, 13 LAL, 14 MIA, 15 MIL, 16 MIN, 17 BKN, 18 NYK, 19 ORL, 20 PHI,
# 21 PHX, 22 POR, 23 SAC, 24 SAS, 25 OKC, 26 UTA, 27 WAS, 28 TOR, 29 MEM, 30 CHA.
nba_star_moves <- tribble(
~date, ~player, ~all_star, ~from, ~to, ~how,
'2016-04-14', 'Kobe Bryant', '2012,2013,2014,2015,2016', 'nba:13', NA, 'retired',
'2016-06-22', 'Derrick Rose', '2012', 'nba:4', 'nba:18', 'trade',
'2016-07-07', 'Kevin Durant', '2012,2013,2014,2015,2016,2017,2018,2019', 'nba:25', 'nba:9', 'signed',
'2016-07-07', 'Rajon Rondo', '2012,2013', 'nba:23', 'nba:4', 'signed',
'2016-07-07', 'Roy Hibbert', '2012,2014', 'nba:13', 'nba:30', 'signed',
'2016-07-08', 'Al Horford', '2015,2016,2018', 'nba:1', 'nba:2', 'signed',
'2016-07-08', 'Joakim Noah', '2013,2014', 'nba:4', 'nba:18', 'signed',
'2016-07-08', 'Joe Johnson', '2012,2014', 'nba:14', 'nba:26', 'signed',
'2016-07-08', 'Luol Deng', '2012,2013', 'nba:14', 'nba:13', 'signed',
'2016-07-08', 'Jeff Teague', '2015', 'nba:1', 'nba:11', 'trade',
'2016-07-11', 'Tim Duncan', '2013,2015', 'nba:24', NA, 'retired',
'2016-07-12', 'Dwight Howard', '2012,2013,2014', 'nba:10', 'nba:1', 'signed',
'2016-07-14', 'Pau Gasol', '2015,2016', 'nba:4', 'nba:24', 'signed',
'2016-07-15', 'Dwyane Wade', '2012,2013,2014,2015,2016,2019', 'nba:14', 'nba:4', 'signed',
'2016-09-23', 'Kevin Garnett', '2012,2013', 'nba:16', NA, 'retired',
'2017-01-07', 'Kyle Korver', '2015', 'nba:1', 'nba:5', 'trade',
'2017-02-02', 'Roy Hibbert', '2012,2014', 'nba:30', 'nba:15', 'trade',
'2017-02-20', 'DeMarcus Cousins', '2015,2016,2017,2018', 'nba:23', 'nba:3', 'trade',
'2017-06-20', 'Dwight Howard', '2012,2013,2014', 'nba:1', 'nba:30', 'trade',
'2017-06-22', 'Jimmy Butler', '2015,2016,2017,2018', 'nba:4', 'nba:16', 'trade',
'2017-06-22', 'Brook Lopez', '2013', 'nba:17', 'nba:13', 'trade',
'2017-06-28', 'Chris Paul', '2012,2013,2014,2015,2016', 'nba:12', 'nba:10', 'trade',
'2017-07-06', 'Paul George', '2013,2014,2016,2017,2018,2019', 'nba:11', 'nba:25', 'trade',
'2017-07-10', 'Jeff Teague', '2015', 'nba:11', 'nba:16', 'signed',
'2017-07-10', 'Zach Randolph', '2013', 'nba:29', 'nba:23', 'signed',
'2017-07-13', 'Paul Millsap', '2014,2015,2016,2017', 'nba:1', 'nba:7', 'signed',
'2017-07-14', 'Gordon Hayward', '2017', 'nba:26', 'nba:2', 'signed',
'2017-07-25', 'Derrick Rose', '2012', 'nba:18', 'nba:5', 'signed',
'2017-08-30', 'Kyrie Irving', '2013,2014,2015,2017,2018,2019', 'nba:5', 'nba:2', 'trade',
'2017-08-30', 'Isaiah Thomas', '2016,2017', 'nba:2', 'nba:5', 'trade',
'2017-09', 'Dwyane Wade', '2012,2013,2014,2015,2016,2019', 'nba:4', 'nba:5', 'signed',
'2017-09-25', 'Carmelo Anthony', '2012,2013,2014,2015,2016,2017', 'nba:18', 'nba:25', 'trade',
'2018-01-29', 'Blake Griffin', '2012,2013,2014,2015,2019', 'nba:12', 'nba:8', 'trade',
'2018-02-08', 'Isaiah Thomas', '2016,2017', 'nba:5', 'nba:13', 'trade',
'2018-02-08', 'Dwyane Wade', '2012,2013,2014,2015,2016,2019', 'nba:5', 'nba:14', 'trade',
'2018-07-06', 'DeAndre Jordan', '2017', 'nba:12', 'nba:6', 'signed',
'2018-07-06', 'DeMarcus Cousins', '2015,2016,2017,2018', 'nba:3', 'nba:9', 'signed',
'2018-07-06', 'Dwight Howard', '2012,2013,2014', 'nba:30', 'nba:17', 'trade',
'2018-07-09', 'LeBron James', '2012,2013,2014,2015,2016,2017,2018,2019', 'nba:5', 'nba:13', 'signed',
'2018-07-11', 'Dwight Howard', '2012,2013,2014', 'nba:17', 'nba:27', 'signed',
'2018-07-16', 'Isaiah Thomas', '2016,2017', 'nba:13', 'nba:7', 'signed',
'2018-07-18', 'Kawhi Leonard', '2016,2017,2019', 'nba:24', 'nba:28', 'trade',
'2018-07-18', 'DeMar DeRozan', '2014,2016,2017,2018', 'nba:28', 'nba:24', 'trade',
'2018-07-22', 'Tony Parker', '2012,2013,2014', 'nba:24', 'nba:30', 'signed',
'2018-07-25', 'Carmelo Anthony', '2012,2013,2014,2015,2016,2017', 'nba:25', 'nba:1', 'trade',
'2018-08', 'Carmelo Anthony', '2012,2013,2014,2015,2016,2017', NA, 'nba:10', 'signed', # released by Atlanta first
'2018-11', 'Tyson Chandler', '2013', 'nba:21', 'nba:13', 'signed',
'2018-11-12', 'Jimmy Butler', '2015,2016,2017,2018', 'nba:16', 'nba:20', 'trade',
'2019-01-22', 'Carmelo Anthony', '2012,2013,2014,2015,2016,2017', 'nba:10', 'nba:4', 'trade',
'2019-01-31', 'Kristaps Porzingis', '2018', 'nba:18', 'nba:6', 'trade',
'2019-01-31', 'DeAndre Jordan', '2017', 'nba:6', 'nba:18', 'trade',
'2019-02-07', 'Marc Gasol', '2012,2015,2017', 'nba:29', 'nba:28', 'trade',
'2019-03', 'Pau Gasol', '2015,2016', 'nba:24', 'nba:15', 'signed')
# Month-only dates ('2017-09') count as the middle of the month. Only the order relative
# to each February All-Star Game matters, and every February move has an exact date.
move_date <- function(x) as.Date(ifelse(nchar(x) == 7, paste0(x, '-15'), x))
# Was the player named to one of the last `games_back` All-Star Games before `when`?
recent_all_star <- function(all_star, when, games_back = 2) {
played <- as.integer(names(all_star_games))[as.Date(all_star_games) < when]
any(as.integer(strsplit(all_star, ',')[[1]]) %in% tail(played, games_back))
}
# Teams with a qualifying move between `first` (exclusive) and `last` (inclusive), and
# what the moves were. lost_only = TRUE keeps only the teams that lost a star.
star_move_screen <- function(moves, first, last, games_back = 2, lost_only = FALSE) {
month <- function(d) paste(month.abb[as.integer(format(d, '%m'))], format(d, '%Y'))
qualifying <- moves %>%
mutate(when = move_date(date)) %>%
filter(when > as.Date(first), when <= as.Date(last),
map2_lgl(all_star, when, recent_all_star, games_back = games_back))
lost <- qualifying %>%
filter(!is.na(from)) %>%
transmute(key = from, when, move = if_else(how == 'retired',
sprintf('%s retired (%s)', player, month(when)),
sprintf('lost %s (%s)', player, month(when))))
added <- qualifying %>%
filter(!is.na(to)) %>%
transmute(key = to, when, move = sprintf('added %s (%s)', player, month(when)))
bind_rows(lost, if (!lost_only) added) %>%
arrange(key, when) %>%
group_by(key) %>%
summarise(moves = paste(move, collapse = '; '), .groups = 'drop')
}
# ---- 2b. The coaching-change screen (FBS) ----------------------------------------------
# WHY: the Durant rule, translated to football. A program that changed head coaches in the
# same stretch got OU's treatment too, so it cannot show what OU would have looked like
# without it. The first Riley design kept those programs: its closest match, Notre Dame,
# lost Brian Kelly to LSU the day after Riley left, and Cincinnati lost Luke Fickell after
# 2022. This screen replaced that design after the first version of the study, so that one
# rule covers both departures; the unscreened original is still reported beside it.
#
# The rule: a program is out if a head coach left it (fired, resigned, retired, hired away,
# or died) between the first week of the 2021 season and the 2023 title game.
# WHY start at the 2021 opener, not at Riley's exit: football's hiring cycle runs during
# the season. A program that fired its coach in October 2021 began 2022 under a new one,
# which is exactly what happened to OU. Coordinators are not head coaches, the same way
# injuries are not moves; Clemson losing Brent Venables to OU is disclosed separately below.
# WHY a looser version is also reported: firings in 2022-23 often follow losing in 2022-23,
# so screening them can tilt the comparison group toward programs that did well. Screening
# only the 2021-22 cycle (the one Riley left in) avoids that.
# Source: the "Coaching changes" tables on Wikipedia's 2021, 2022 and 2023 NCAA Division I
# FBS football season pages, checked September 2026. Programs without complete 2018-23
# records (UConn, New Mexico State, James Madison) can never be comparisons, so they are
# left out. The table keeps departures just outside the window (Ohio's July 2021 change,
# Nick Saban retiring two days after the 2023 title game), so the edge cases are visible.
fbs_coach_window <- c('2021-08-28', '2024-01-08') # 2021's Week 0 through the 2023 CFP title game
fbs_cycle_end <- '2022-08-26' # the day before the 2022 season opened
# One row per head coach who left. Interim coaches who handed over to a permanent hire are
# not rows of their own: the departure that created the vacancy already counts.
fbs_coach_departures <- tribble(
~date, ~key, ~team, ~coach, ~reason,
'2021-07-14', 'cfb:195', 'Ohio', 'Frank Solich', 'Retired',
'2021-09-13', 'cfb:30', 'USC', 'Clay Helton', 'Fired',
'2021-09-26', 'cfb:290', 'Georgia Southern', 'Chad Lunsford', 'Fired',
'2021-10-18', 'cfb:265', 'Washington State', 'Nick Rolovich', 'Fired',
'2021-10-25', 'cfb:2641', 'Texas Tech', 'Matt Wells', 'Fired',
'2021-10-31', 'cfb:2628', 'TCU', 'Gary Patterson', 'Parted ways',
'2021-11-04', 'cfb:2006', 'Akron', 'Tom Arth', 'Fired',
'2021-11-07', 'cfb:113', 'Massachusetts', 'Walt Bell', 'Fired',
'2021-11-10', 'cfb:2229', 'Florida International', 'Butch Davis', 'Not retained',
'2021-11-14', 'cfb:264', 'Washington', 'Jimmy Lake', 'Fired',
'2021-11-16', 'cfb:259', 'Virginia Tech', 'Justin Fuente', 'Parted ways',
'2021-11-21', 'cfb:57', 'Florida', 'Dan Mullen', 'Fired',
'2021-11-21', 'cfb:2653', 'Troy', 'Chip Lindsey', 'Fired',
'2021-11-26', 'cfb:2348', 'Louisiana Tech', 'Skip Holtz', 'Fired',
'2021-11-26', 'cfb:2567', 'SMU', 'Sonny Dykes', 'Hired by TCU',
'2021-11-28', 'cfb:150', 'Duke', 'David Cutcliffe', 'Parted ways',
'2021-11-28', 'cfb:99', 'LSU', 'Ed Orgeron', 'Parted ways',
'2021-11-28', 'cfb:201', 'Oklahoma', 'Lincoln Riley', 'Hired by USC',
'2021-11-29', 'cfb:278', 'Fresno State', 'Kalen DeBoer', 'Hired by Washington',
'2021-11-29', 'cfb:87', 'Notre Dame', 'Brian Kelly', 'Hired by LSU',
'2021-11-29', 'cfb:218', 'Temple', 'Rod Carey', 'Fired',
'2021-12-02', 'cfb:36', 'Colorado State', 'Steve Addazio', 'Fired',
'2021-12-02', 'cfb:258', 'Virginia', 'Bronco Mendenhall', 'Resigned',
'2021-12-05', 'cfb:309', 'Louisiana', 'Billy Napier', 'Hired by Florida',
'2021-12-06', 'cfb:2390', 'Miami', 'Manny Diaz', 'Fired',
'2021-12-06', 'cfb:2440', 'Nevada', 'Jay Norvell', 'Hired by Colorado State',
'2021-12-06', 'cfb:2483', 'Oregon', 'Mario Cristobal', 'Hired by Miami (FL)',
'2022-01-14', 'cfb:62', "Hawai'i", 'Todd Graham', 'Resigned',
'2022-06-24', 'cfb:5', 'UAB', 'Bill Clark', 'Retired',
'2022-09-11', 'cfb:158', 'Nebraska', 'Scott Frost', 'Fired',
'2022-09-18', 'cfb:9', 'Arizona State', 'Herm Edwards', 'Fired',
'2022-09-25', 'cfb:59', 'Georgia Tech', 'Geoff Collins', 'Fired',
'2022-10-02', 'cfb:38', 'Colorado', 'Karl Dorrell', 'Fired',
'2022-10-02', 'cfb:275', 'Wisconsin', 'Paul Chryst', 'Fired',
'2022-10-23', 'cfb:2429', 'Charlotte', 'Will Healy', 'Fired',
'2022-10-31', 'cfb:2', 'Auburn', 'Bryan Harsin', 'Fired',
'2022-11-06', 'cfb:58', 'South Florida', 'Jeff Scott', 'Fired',
'2022-11-26', 'cfb:2226', 'Florida Atlantic', 'Willie Taggart', 'Fired',
'2022-11-27', 'cfb:2132', 'Cincinnati', 'Luke Fickell', 'Hired by Wisconsin',
'2022-11-27', 'cfb:24', 'Stanford', 'David Shaw', 'Resigned',
'2022-11-27', 'cfb:326', 'Texas State', 'Jake Spavital', 'Fired',
'2022-11-27', 'cfb:202', 'Tulsa', 'Philip Montgomery', 'Fired',
'2022-11-28', 'cfb:2335', 'Liberty', 'Hugh Freeze', 'Hired by Auburn',
'2022-11-28', 'cfb:2439', 'UNLV', 'Marcus Arroyo', 'Fired',
'2022-11-28', 'cfb:2711', 'Western Michigan', 'Tim Lester', 'Fired',
'2022-12-04', 'cfb:324', 'Coastal Carolina', 'Jamey Chadwell', 'Hired by Liberty',
'2022-12-04', 'cfb:249', 'North Texas', 'Seth Littrell', 'Fired',
'2022-12-05', 'cfb:2309', 'Kent State', 'Sean Lewis', 'Hired as offensive coordinator by Colorado',
'2022-12-05', 'cfb:97', 'Louisville', 'Scott Satterfield', 'Hired by Cincinnati',
'2022-12-07', 'cfb:2509', 'Purdue', 'Jeff Brohm', 'Hired by Louisville',
'2022-12-11', 'cfb:2426', 'Navy', 'Ken Niumatalolo', 'Fired',
'2022-12-12', 'cfb:344', 'Mississippi State', 'Mike Leach', 'Died',
'2023-07-10', 'cfb:77', 'Northwestern', 'Pat Fitzgerald', 'Fired',
'2023-09-27', 'cfb:127', 'Michigan State', 'Mel Tucker', 'Fired',
'2023-11-12', 'cfb:68', 'Boise State', 'Andy Avalos', 'Fired',
'2023-11-12', 'cfb:245', 'Texas A&M', 'Jimbo Fisher', 'Fired',
'2023-11-13', 'cfb:344', 'Mississippi State', 'Zach Arnett', 'Fired',
'2023-11-13', 'cfb:21', 'San Diego State', 'Brady Hoke', 'Retired',
'2023-11-19', 'cfb:183', 'Syracuse', 'Dino Babers', 'Fired',
'2023-11-25', 'cfb:167', 'New Mexico', 'Danny Gonzales', 'Fired',
'2023-11-25', 'cfb:204', 'Oregon State', 'Jonathan Smith', 'Hired by Michigan State',
'2023-11-26', 'cfb:248', 'Houston', 'Dana Holgorsen', 'Fired',
'2023-11-26', 'cfb:84', 'Indiana', 'Tom Allen', 'Fired',
'2023-11-26', 'cfb:2433', 'UL Monroe', 'Terry Bowden', 'Fired',
'2023-11-26', 'cfb:2638', 'UTEP', 'Dana Dimel', 'Fired',
'2023-11-27', 'cfb:150', 'Duke', 'Mike Elko', 'Hired by Texas A&M',
'2023-11-27', 'cfb:2393', 'Middle Tennessee', 'Rick Stockstill', 'Fired',
'2023-12-01', 'cfb:2440', 'Nevada', 'Ken Wilson', 'Fired',
'2023-12-03', 'cfb:2655', 'Tulane', 'Willie Fritz', 'Hired by Houston',
'2023-12-06', 'cfb:2751', 'Wyoming', 'Craig Bohl', 'Retired',
'2023-12-08', 'cfb:2653', 'Troy', 'Jon Sumrall', 'Hired by Tulane',
'2024-01-10', 'cfb:333', 'Alabama', 'Nick Saban', 'Retired',
'2024-01-12', 'cfb:264', 'Washington', 'Kalen DeBoer', 'Hired by Alabama',
'2024-01-14', 'cfb:12', 'Arizona', 'Jedd Fisch', 'Hired by Washington',
'2024-01-15', 'cfb:6', 'South Alabama', 'Kane Wommack', 'Hired as co-defensive coordinator by Alabama',
'2024-01-16', 'cfb:2084', 'Buffalo', 'Maurice Linguist', 'Hired as co-defensive coordinator by Alabama',
'2024-01-16', 'cfb:23', 'San Jose State', 'Brent Brennan', 'Hired by Arizona',
'2024-01-24', 'cfb:130', 'Michigan', 'Jim Harbaugh', 'Hired by Los Angeles Chargers',
'2024-01-31', 'cfb:103', 'Boston College', 'Jeff Hafley', 'Hired as defensive coordinator by Green Bay Packers',
'2024-02-09', 'cfb:26', 'UCLA', 'Chip Kelly', 'Hired as offensive coordinator by Ohio State',
'2024-02-15', 'cfb:2247', 'Georgia State', 'Shawn Elliott', 'Hired as tight ends coach by South Carolina')
# Programs that lost a head coach between `first` and `last` (both inclusive), and who left.
coach_change_screen <- function(departures, first, last) {
month <- function(d) paste(month.abb[as.integer(format(d, '%m'))], format(d, '%Y'))
departures %>%
mutate(when = as.Date(date)) %>%
filter(when >= as.Date(first), when <= as.Date(last)) %>%
arrange(key, when) %>%
transmute(key, move = sprintf('%s, %s%s (%s)', coach, tolower(substr(reason, 1, 1)),
substring(reason, 2), month(when))) %>%
group_by(key) %>%
summarise(moves = paste(move, collapse = '; '), .groups = 'drop')
}
# ---- 3. One case, every check --------------------------------------------------------
# A design choice to rerun: its own baseline seasons, group size, matching style, and
# the full list of teams it keeps out of the comparison pool.
design <- function(label, pre, excluded, k = 5, shape = FALSE) {
list(label = label, pre = pre, excluded = excluded, k = k, shape = shape)
}
# The full study for one departure. The first entry of `specs` is the primary design.
did_case <- function(panel, key, post, specs, donor_events = tibble(), screen = tibble()) {
primary <- specs[[1]]
pre <- primary$pre
excluded <- primary$excluded
pool <- eligible_donors(panel, key, pre, post, excluded)
donors <- match_donors(panel, key, pre, pool, primary$k)
fit <- estimate_did(panel, key, pre, post, donors)
team_names <- panel %>% arrange(year) %>% group_by(key) %>% summarise(team = last(team), .groups = 'drop')
team_name <- function(k) team_names$team[match(k, team_names$key)]
donor_table <- donors %>%
left_join(team_names, by = 'key') %>%
rename(preRMSE = distance) %>%
mutate(preMean = map_dbl(key, ~mean(panel$p[panel$key == .x & panel$year %in% pre])),
postMean = map_dbl(key, ~mean(panel$p[panel$key == .x & panel$year %in% post])),
change = postMean - preMean)
# The balanced, equally weighted matched panel gives the same answer by two-way
# fixed-effects OLS; checked here to machine precision.
regression_data <- panel %>%
filter(.data$key %in% c(.env$key, donors$key), year %in% c(pre, post)) %>%
mutate(treatment_post = as.integer(.data$key == .env$key & year %in% post))
regression <- lm(p ~ factor(key) + factor(year) + treatment_post, data = regression_data)
twfe <- unname(coef(regression)['treatment_post'])
stopifnot(abs(twfe - fit$effect) < 1e-10)
# Leave out the final pre-season during matching and level alignment. It is a
# forecast check, not another in-sample pre-trend fit.
held_year <- max(pre)
training_years <- setdiff(pre, held_year)
held_donors <- match_donors(panel, key, training_years, pool, primary$k)
held <- estimate_did(panel, key, training_years, held_year, held_donors)
# Drop one comparison team at a time and reweight the rest equally.
leave_one_out <- map_dfr(donors$key, function(omit) {
remaining <- donors %>% filter(.data$key != omit) %>% mutate(weight = 1 / n())
tibble(omitted = team_name(omit), effect = estimate_did(panel, key, pre, post, remaining)$effect)
})
# Rerun the matching from scratch under each design choice. These are exploratory
# checks, not a preregistered specification search. WHY the primary design stays
# primary even when a check looks "better": switching the headline after seeing the
# answer is how forking paths sneak into a result (Gelman & Loken 2014).
sensitivity <- map_dfr(specs, function(s) {
peers <- eligible_donors(panel, key, s$pre, post, s$excluded)
ds <- match_donors(panel, key, s$pre, peers, s$k, s$shape)
z <- estimate_did(panel, key, s$pre, post, ds)
tibble(specification = s$label, effect = z$effect, preRMSE = z$preRMSE,
preGapRMSE = z$preGapRMSE, firstPostGap = z$firstPostGap,
pre = paste(s$pre, collapse = ', '), poolSize = length(peers),
donors = paste(team_name(ds$key), collapse = ', '), path = list(z$path))
})
# Placebos: give the departure date to every team in the pool instead, and rematch
# each one from the rest of the pool. The treated and destination teams never serve.
placebos <- map_dfr(pool, function(pseudo_key) {
peers <- setdiff(pool, pseudo_key)
ds <- match_donors(panel, pseudo_key, pre, peers, primary$k)
z <- estimate_did(panel, pseudo_key, pre, post, ds)
tibble(key = pseudo_key, effect = z$effect, preRMSE = z$preRMSE, preGapRMSE = z$preGapRMSE,
postGapRMSE = z$postGapRMSE, firstPostGap = z$firstPostGap)
}) %>%
left_join(team_names, by = 'key') %>%
arrange(effect, key)
# Share of teams (the real one included) with a statistic at least this large.
# Deliberately called a descriptive rank, not a randomization p-value: departures
# were not randomly assigned and teams are not exchangeable.
rank_share <- function(placebo, observed) (1 + sum(placebo >= observed)) / (1 + length(placebo))
# Yardstick 1 (headline): size of the average effect.
placebo_rank <- rank_share(abs(placebos$effect), abs(fit$effect))
# Yardstick 2: post/pre fit ratio, as in Abadie, Diamond & Hainmueller (2010). It asks
# how far a team strayed from a path it had tracked closely. WHY report it: raw effect
# sizes let badly matched placebo teams look dramatic. Caveat: a near-perfect pre-fit
# makes the denominator tiny and the ratio huge, so read it next to yardstick 1.
ratio_rank <- rank_share(placebos$postGapRMSE / placebos$preGapRMSE, fit$postGapRMSE / fit$preGapRMSE)
# Yardstick 3: the first season after the departure, where the shock should be sharpest.
first_rank <- rank_share(abs(placebos$firstPostGap), abs(fit$firstPostGap))
# Assume an unobserved untreated gap drift of delta win-rate units per year. The bias
# in the pre/post contrast equals delta * (mean(post) - mean(pre)). A deterministic
# cousin of the Rambachan & Roth (2023) sensitivity idea, not their confidence sets.
elapsed <- mean(post) - mean(pre)
drift <- tibble(drift_per_year = seq(-.02, .02, by = .005)) %>%
mutate(adjusted_effect = fit$effect - drift_per_year * elapsed)
# Regression to the mean, measured two ways (see level_benchmark above).
benchmark <- level_benchmark(panel, key, pre, post)
benchmark$adjustedEffect <- fit$effect - benchmark$slope * (benchmark$treatedPre - mean(donor_table$preMean))
c(list(team = team_name(key), key = key, pre = pre, post = post, excluded = excluded,
poolSize = length(pool), donors = donor_table, donorEvents = donor_events, screen = screen),
fit,
list(twfe = twfe, regressionN = nrow(regression_data),
holdout = list(year = held_year, error = held$effect, donors = team_name(held_donors$key)),
leaveOneOut = range(leave_one_out$effect), leaveOneOutTable = leave_one_out,
sensitivity = sensitivity, placebos = placebos, placeboRankShare = placebo_rank,
ratioRankShare = ratio_rank, firstYearRankShare = first_rank,
drift = drift, tippingDrift = fit$effect / elapsed, benchmark = benchmark))
}
# ---- 4. The two cases ---------------------------------------------------------------
# Durant: baseline 2013-16 (after the Harden trade, including KD's 2015 injury season);
# comparison window 2017-19, ending before the 2019 Westbrook trade and the 2020 pandemic
# season. Golden State received Durant, so it cannot be a comparison team, and Seattle is
# a separate historical series.
kd_base <- c('nba:9', 'nba:SEA')
kd_window <- c('2016-04-13', '2019-04-10') # the last nights of the 2015-16 and 2018-19 seasons
screen_out <- function(...) {
union(kd_base, setdiff(star_move_screen(nba_star_moves, kd_window[1], kd_window[2], ...)$key, 'nba:25'))
}
kd_screen <- star_move_screen(nba_star_moves, kd_window[1], kd_window[2]) %>%
filter(!key %in% c('nba:25', kd_base)) %>% # the treated team and the teams already out
left_join(panel %>% arrange(year) %>% group_by(key) %>% summarise(team = last(team), .groups = 'drop'),
by = 'key') %>%
select(key, team, moves) %>%
arrange(team)
kd_excluded <- screen_out()
kd_stood_pat <- length(eligible_donors(panel, 'nba:25', 2013:2016, 2017:2019, kd_excluded))
# Riley: baseline 2018-21; comparison window 2022-23, ending before OU's 2024 move to the
# SEC. USC received Riley and the transfers, so it cannot be a comparison program.
riley_base <- 'cfb:30'
riley_screen_out <- function(last = fbs_coach_window[2]) {
union(riley_base, setdiff(coach_change_screen(fbs_coach_departures, fbs_coach_window[1], last)$key, 'cfb:201'))
}
riley_screen <- coach_change_screen(fbs_coach_departures, fbs_coach_window[1], fbs_coach_window[2]) %>%
filter(!key %in% c('cfb:201', riley_base)) %>% # the treated program and the one already out
left_join(panel %>% arrange(year) %>% group_by(key) %>% summarise(team = last(team), .groups = 'drop'),
by = 'key') %>%
select(key, team, moves) %>%
arrange(team)
riley_excluded <- riley_screen_out()
# Changes the screen does not catch, disclosed next to the comparison programs.
riley_donor_events <- tribble(
~key, ~team, ~date, ~event, ~source,
'cfb:228', 'Clemson', '2021-12-05', 'Defensive coordinator Brent Venables becomes OU head coach',
'https://www.espn.com/college-football/story/_/id/32800108/oklahoma-finalizes-deal-brent-venables-sooners-head-football-coach-sources-say')
did <- list(
kd = did_case(panel, 'nba:25', 2017:2019, donor_events = tibble(), screen = kd_screen, specs = list(
design('Primary: 5 closest teams that stood pat', 2013:2016, kd_excluded),
design('3 closest teams that stood pat', 2013:2016, kd_excluded, k = 3),
design(sprintf('All %d teams that stood pat', kd_stood_pat), 2013:2016, kd_excluded, k = kd_stood_pat),
design('6 baseline seasons', 2011:2016, kd_excluded),
design('Match changes, not levels', 2013:2016, kd_excluded, shape = TRUE),
design('Stricter screen: any of the last 3 All-Star Games', 2013:2016, screen_out(games_back = 3)),
design('Looser screen: only teams that lost a star', 2013:2016, screen_out(lost_only = TRUE)),
# WHY keep the unscreened design: it is the version I ran first, and showing it
# makes the effect of the screen visible instead of hiding it.
design('No screen (the original design)', 2013:2016, kd_base))),
riley = did_case(panel, 'cfb:201', 2022:2023, donor_events = riley_donor_events, screen = riley_screen, specs = list(
design('Primary: 5 closest programs that kept their coach', 2018:2021, riley_excluded),
design('3 closest programs that kept their coach', 2018:2021, riley_excluded, k = 3),
design('10 closest programs that kept their coach', 2018:2021, riley_excluded, k = 10),
design('6 baseline seasons', 2016:2021, riley_excluded),
design('Match changes, not levels', 2018:2021, riley_excluded, shape = TRUE),
design('Omit COVID 2020', c(2018, 2019, 2021), riley_excluded),
design('End baseline before 2021', 2017:2020, riley_excluded),
design('Looser screen: only the 2021-22 coaching cycle', 2018:2021, riley_screen_out(fbs_cycle_end)),
# WHY keep the unscreened design: it is the version I ran first (Notre Dame and
# Cincinnati were in it), and showing it makes the effect of the screen visible.
design('No coach screen (the original design)', 2018:2021, riley_base)))
)
# ---- 5. The departure board ---------------------------------------------------------
# Other stars who left, run through the ORIGINAL (unscreened) matching: four seasons
# before, three after, five closest matches, destination excluded. WHY unscreened:
# screening every row would need a hand-built inventory of star moves for 2010-2022.
# The board lives in the technical report, and its Durant row reproduces the
# "No screen" check above exactly.
# WHY these departures: franchise stars who left by choice (free agency or a requested
# trade), plus Harden, the Thunder's own; each has four seasons before and three after.
# Each row also gets a placebo range: the 10th-90th percentile of "effects" for teams
# that lost nobody special in those same seasons.
board_events <- tribble(
~label, ~key, ~destination, ~last, ~source,
'LeBron James, Cleveland 2010', 'nba:5', 'nba:14', 2010,
'https://www.nba.com/news/legendary-moments-lebron-james-decision-miami-heat',
'James Harden, Oklahoma City 2012', 'nba:25', 'nba:10', 2012,
'https://www.espn.com/nba/story/_/id/8562868/oklahoma-city-thunder-trade-james-harden-houston-rockets',
'LeBron James, Miami 2014', 'nba:14', 'nba:5', 2014,
'https://www.espn.com/nba/story/_/id/11203027/lebron-james-says-returning-cleveland-cavaliers',
'Kevin Durant, Oklahoma City 2016', 'nba:25', 'nba:9,nba:SEA', 2016,
'https://www.theplayerstribune.com/articles/kevin-durant-nba-free-agency-announcement',
'Paul George, Indiana 2017', 'nba:11', 'nba:25', 2017,
'https://www.espn.com/nba/story/_/id/19778834/paul-george-traded-indiana-pacers-oklahoma-city-thunder',
'LeBron James, Cleveland 2018', 'nba:5', 'nba:13', 2018,
'https://www.espn.com/nba/story/_/id/23967725/lebron-james-joining-los-angeles-lakers-4-year-1533-million-deal',
'Kawhi Leonard, San Antonio 2018', 'nba:24', 'nba:28', 2018,
'https://www.espn.com/nba/story/_/id/24128461/toronto-raptors-agree-deal-acquire-kawhi-leonard-trade-involves-demar-derozan',
'Kevin Durant, Golden State 2019', 'nba:9', 'nba:17', 2019,
'https://www.cbc.ca/sports/basketball/nba/nba-free-agency-kevin-durant-brooklyn-nets-1.5195979',
'Kawhi Leonard, Toronto 2019', 'nba:28', 'nba:12', 2019,
'https://www.cbc.ca/sports/basketball/nba/kawhi-leonard-free-agency-decision-nba-los-angeles-clippers-1.5198431',
'Paul George and Russell Westbrook, Oklahoma City 2019', 'nba:25', 'nba:12,nba:10', 2019,
'https://www.nba.com/news/report-russell-westbrook-traded-chris-paul-rockets-thunder',
'Anthony Davis, New Orleans 2019', 'nba:3', 'nba:13', 2019,
'https://www.nba.com/news/report-anthony-davis-lakers')
departure_board <- pmap_dfr(board_events, function(label, key, destination, last, source) {
pre <- (last - 3):last
post <- (last + 1):(last + 3)
excluded <- strsplit(destination, ',')[[1]]
pool <- eligible_donors(panel, key, pre, post, excluded)
fit <- estimate_did(panel, key, pre, post, match_donors(panel, key, pre, pool))
placebo <- map_dbl(pool, function(k) {
estimate_did(panel, k, pre, post, match_donors(panel, k, pre, setdiff(pool, k)))$effect
})
tibble(label, key, lastSeason = last, effect = fit$effect, teamChange = fit$treatedChange,
comparisonChange = fit$controlChange, firstPostGap = fit$firstPostGap,
placeboLow = unname(quantile(placebo, .1)), placeboHigh = unname(quantile(placebo, .9)),
rankShare = (1 + sum(abs(placebo) >= abs(fit$effect))) / (1 + length(placebo)),
placebos = length(placebo), source)
}) %>% arrange(effect)
no_screen <- did$kd$sensitivity %>% filter(specification == 'No screen (the original design)')
stopifnot(abs(departure_board$effect[departure_board$label == 'Kevin Durant, Oklahoma City 2016'] -
no_screen$effect) < 1e-12)8.3 Results
did_summary <- imap_dfr(did, ~tibble(
case = if (.y == 'kd') 'KD / OKC' else 'Riley / OU',
team_change_pp = 100 * .x$treatedChange,
comparison_change_pp = 100 * .x$controlChange,
did_pp = 100 * .x$effect,
twfe_pp = 100 * .x$twfe,
observations = .x$regressionN))
knitr::kable(did_summary, digits = 2, caption = 'Absolute declines and relative comparisons')| case | team_change_pp | comparison_change_pp | did_pp | twfe_pp | observations |
|---|---|---|---|---|---|
| KD / OKC | -8.23 | 0.43 | -8.66 | -8.66 | 42 |
| Riley / OU | -22.93 | -7.43 | -15.50 | -15.50 | 36 |
OKC’s win percentage changed by -8.2 points; the five teams that stood pat changed by +0.4 points, so the difference is -8.7 points, about 7.1 wins a season. OU changed by -22.9 points against a comparison change of -7.4, a -15.5-point relative estimate.
for (case in names(did)) {
cat('\n\n### ', if (case == 'kd') 'OKC comparison teams' else 'OU comparison teams', '\n\n', sep = '')
did[[case]]$donors %>%
transmute(team, weight, pre_fit_rmse_pp = preRMSE * 100,
pre_win_pct = preMean * 100, post_win_pct = postMean * 100,
change_pp = change * 100) %>%
knitr::kable(digits = 2) %>% print()
}8.3.1 OKC comparison teams
| team | weight | pre_fit_rmse_pp | pre_win_pct | post_win_pct | change_pp |
|---|---|---|---|---|---|
| Portland Trail Blazers | 0.2 | 18.40 | 55.49 | 58.13 | 2.64 |
| Washington Wizards | 0.2 | 22.68 | 48.78 | 50.41 | 1.63 |
| Brooklyn Nets | 0.2 | 24.01 | 46.34 | 36.59 | -9.76 |
| Charlotte Hornets | 0.2 | 27.06 | 44.21 | 45.12 | 0.91 |
| Detroit Pistons | 0.2 | 28.28 | 40.85 | 47.56 | 6.71 |
8.3.2 OU comparison teams
| team | weight | pre_fit_rmse_pp | pre_win_pct | post_win_pct | change_pp |
|---|---|---|---|---|---|
| Georgia | 0.2 | 5.71 | 84.40 | 96.43 | 12.02 |
| Ohio State | 0.2 | 5.79 | 89.46 | 84.62 | -4.84 |
| App State | 0.2 | 8.26 | 80.98 | 57.14 | -23.83 |
| Clemson | 0.2 | 8.99 | 88.40 | 73.90 | -14.50 |
| Alabama | 0.2 | 9.93 | 91.15 | 85.16 | -5.99 |
8.4 The big-move screen
In plain English: my first comparison group for Durant was a support group. The summer Durant left, Tim Duncan retired and Dwyane Wade left Miami; a year later the Clippers traded Chris Paul, Memphis lost Zach Randolph, and Indiana traded Paul George to Oklahoma City itself. A team going through the same thing cannot show what would have happened without it, so those teams are out.
The problem is sharper than contamination. Suppose every comparison team lost a star in some season of the window. Then a “lost a star” indicator for the comparison teams would move almost one for one with the season fixed effects: the two are nearly collinear, the regression cannot separate them, and the difference-in-differences ends up comparing Durant’s departure with the average star departure rather than with none. That biases the estimate toward zero. In the limit, if every team lost a star in the same season, the indicator would equal that season’s dummy exactly and neither could be estimated (Wooldridge 2020, ch. 3). Indiana adds a second violation: it traded George to the treated team, a direct spillover (SUTVA; Imbens and Rubin 2015). Dropping units that received a similar intervention is also the standard advice for synthetic controls (Abadie 2021).
The rule, applied the way I would have applied it by hand: a team is
out if, between the end of the 2015-16 season and the end of 2018-19, it
lost or added a player named to either of the two All-Star Games before
the move, by trade, free agency, or retirement. Injuries are not moves.
The move table in did.R also keeps near-misses (Blake
Griffin’s January 2018 trade to Detroit, whose last All-Star Game had
been in 2015; Roy Hibbert’s 2016-17 moves), so the stricter and looser
rules below can be computed rather than asserted. verify.R
rebuilds the screen from the move table with a separate
implementation.
did$kd$screen %>%
transmute(team, `qualifying moves` = moves) %>%
knitr::kable(caption = sprintf('Teams screened out of the Durant comparison pool (%d of 28; Golden State is out as the destination)',
nrow(did$kd$screen)))| team | qualifying moves |
|---|---|
| Atlanta Hawks | lost Al Horford (Jul 2016); lost Jeff Teague (Jul 2016); lost Kyle Korver (Jan 2017); lost Paul Millsap (Jul 2017); added Carmelo Anthony (Jul 2018) |
| Boston Celtics | added Al Horford (Jul 2016); added Gordon Hayward (Jul 2017); lost Isaiah Thomas (Aug 2017); added Kyrie Irving (Aug 2017) |
| Chicago Bulls | lost Pau Gasol (Jul 2016); added Dwyane Wade (Jul 2016); lost Jimmy Butler (Jun 2017); lost Dwyane Wade (Sep 2017); added Carmelo Anthony (Jan 2019) |
| Cleveland Cavaliers | added Kyle Korver (Jan 2017); lost Kyrie Irving (Aug 2017); added Isaiah Thomas (Aug 2017); added Dwyane Wade (Sep 2017); lost Isaiah Thomas (Feb 2018); lost Dwyane Wade (Feb 2018); lost LeBron James (Jul 2018) |
| Dallas Mavericks | added DeAndre Jordan (Jul 2018); lost DeAndre Jordan (Jan 2019); added Kristaps Porzingis (Jan 2019) |
| Denver Nuggets | added Paul Millsap (Jul 2017); added Isaiah Thomas (Jul 2018) |
| Houston Rockets | added Chris Paul (Jun 2017); added Carmelo Anthony (Aug 2018); lost Carmelo Anthony (Jan 2019) |
| Indiana Pacers | added Jeff Teague (Jul 2016); lost Paul George (Jul 2017) |
| LA Clippers | lost Chris Paul (Jun 2017); lost DeAndre Jordan (Jul 2018) |
| Los Angeles Lakers | Kobe Bryant retired (Apr 2016); added Isaiah Thomas (Feb 2018); added LeBron James (Jul 2018); lost Isaiah Thomas (Jul 2018) |
| Memphis Grizzlies | lost Marc Gasol (Feb 2019) |
| Miami Heat | lost Dwyane Wade (Jul 2016); added Dwyane Wade (Feb 2018) |
| Minnesota Timberwolves | added Jimmy Butler (Jun 2017); lost Jimmy Butler (Nov 2018) |
| New Orleans Pelicans | added DeMarcus Cousins (Feb 2017); lost DeMarcus Cousins (Jul 2018) |
| New York Knicks | lost Carmelo Anthony (Sep 2017); lost Kristaps Porzingis (Jan 2019); added DeAndre Jordan (Jan 2019) |
| Philadelphia 76ers | added Jimmy Butler (Nov 2018) |
| Sacramento Kings | lost DeMarcus Cousins (Feb 2017) |
| San Antonio Spurs | Tim Duncan retired (Jul 2016); added Pau Gasol (Jul 2016); lost Kawhi Leonard (Jul 2018); added DeMar DeRozan (Jul 2018) |
| Toronto Raptors | lost DeMar DeRozan (Jul 2018); added Kawhi Leonard (Jul 2018); added Marc Gasol (Feb 2019) |
| Utah Jazz | lost Gordon Hayward (Jul 2017) |
That leaves 8 teams: Brooklyn Nets, Charlotte Hornets, Detroit Pistons, Milwaukee Bucks, Orlando Magic, Phoenix Suns, Portland Trail Blazers, Washington Wizards. The five closest to OKC’s 2013-16 records are Portland Trail Blazers, Washington Wizards, Brooklyn Nets, Charlotte Hornets, Detroit Pistons.
8.4.1 The coaching-change screen (OU)
For OU, the analogous shock is a coaching change, and the first
comparison group had the same problem: OU’s closest match, Notre Dame,
lost Brian Kelly to LSU about a day after Riley left, and Cincinnati
lost Luke Fickell after the 2022 season. The rule: a program is out if a
head coach left it (fired, resigned, retired, hired away, or died)
between the first week of the 2021 season and the 2023 title game. The
window opens at the 2021 opener rather than at Riley’s exit because
football’s hiring cycle runs during the season: a program that fired its
coach in October 2021 began 2022 under a new one, exactly as OU did.
Coordinators are not head coaches, just as injuries are not moves.
Departures come from the coaching-change tables on Wikipedia’s 2021,
2022, and 2023 FBS season pages; the table in did.R also
keeps departures just outside the window (Ohio’s July 2021 change, Nick
Saban’s retirement two days after the 2023 title game), and
verify.R rebuilds the screen with a separate
implementation.
The rule has a cost the NBA screen mostly avoids. Coaches fired in 2022 or 2023 were often fired for losing in 2022 or 2023, so screening their programs conditions on post-period outcomes and can tilt the comparison group toward programs that did well, which would exaggerate OU’s decline. The looser check screens only the 2021-22 hiring cycle, the one Riley left in, which avoids that; it lets Cincinnati back in.
did$riley$screen %>%
transmute(team, `head coaches who left` = moves) %>%
knitr::kable(caption = sprintf('Programs screened out of the Riley comparison pool (%d of 125; USC is out as the destination)',
nrow(did$riley$screen)))| team | head coaches who left |
|---|---|
| Akron | Tom Arth, fired (Nov 2021) |
| Arizona State | Herm Edwards, fired (Sep 2022) |
| Auburn | Bryan Harsin, fired (Oct 2022) |
| Boise State | Andy Avalos, fired (Nov 2023) |
| Charlotte | Will Healy, fired (Oct 2022) |
| Cincinnati | Luke Fickell, hired by Wisconsin (Nov 2022) |
| Coastal Carolina | Jamey Chadwell, hired by Liberty (Dec 2022) |
| Colorado | Karl Dorrell, fired (Oct 2022) |
| Colorado State | Steve Addazio, fired (Dec 2021) |
| Duke | David Cutcliffe, parted ways (Nov 2021); Mike Elko, hired by Texas A&M (Nov 2023) |
| Florida | Dan Mullen, fired (Nov 2021) |
| Florida Atlantic | Willie Taggart, fired (Nov 2022) |
| Florida International | Butch Davis, not retained (Nov 2021) |
| Fresno State | Kalen DeBoer, hired by Washington (Nov 2021) |
| Georgia Southern | Chad Lunsford, fired (Sep 2021) |
| Georgia Tech | Geoff Collins, fired (Sep 2022) |
| Hawai’i | Todd Graham, resigned (Jan 2022) |
| Houston | Dana Holgorsen, fired (Nov 2023) |
| Indiana | Tom Allen, fired (Nov 2023) |
| Kent State | Sean Lewis, hired as offensive coordinator by Colorado (Dec 2022) |
| LSU | Ed Orgeron, parted ways (Nov 2021) |
| Liberty | Hugh Freeze, hired by Auburn (Nov 2022) |
| Louisiana | Billy Napier, hired by Florida (Dec 2021) |
| Louisiana Tech | Skip Holtz, fired (Nov 2021) |
| Louisville | Scott Satterfield, hired by Cincinnati (Dec 2022) |
| Massachusetts | Walt Bell, fired (Nov 2021) |
| Miami | Manny Diaz, fired (Dec 2021) |
| Michigan State | Mel Tucker, fired (Sep 2023) |
| Middle Tennessee | Rick Stockstill, fired (Nov 2023) |
| Mississippi State | Mike Leach, died (Dec 2022); Zach Arnett, fired (Nov 2023) |
| Navy | Ken Niumatalolo, fired (Dec 2022) |
| Nebraska | Scott Frost, fired (Sep 2022) |
| Nevada | Jay Norvell, hired by Colorado State (Dec 2021); Ken Wilson, fired (Dec 2023) |
| New Mexico | Danny Gonzales, fired (Nov 2023) |
| North Texas | Seth Littrell, fired (Dec 2022) |
| Northwestern | Pat Fitzgerald, fired (Jul 2023) |
| Notre Dame | Brian Kelly, hired by LSU (Nov 2021) |
| Oregon | Mario Cristobal, hired by Miami (FL) (Dec 2021) |
| Oregon State | Jonathan Smith, hired by Michigan State (Nov 2023) |
| Purdue | Jeff Brohm, hired by Louisville (Dec 2022) |
| SMU | Sonny Dykes, hired by TCU (Nov 2021) |
| San Diego State | Brady Hoke, retired (Nov 2023) |
| South Florida | Jeff Scott, fired (Nov 2022) |
| Stanford | David Shaw, resigned (Nov 2022) |
| Syracuse | Dino Babers, fired (Nov 2023) |
| TCU | Gary Patterson, parted ways (Oct 2021) |
| Temple | Rod Carey, fired (Nov 2021) |
| Texas A&M | Jimbo Fisher, fired (Nov 2023) |
| Texas State | Jake Spavital, fired (Nov 2022) |
| Texas Tech | Matt Wells, fired (Oct 2021) |
| Troy | Chip Lindsey, fired (Nov 2021); Jon Sumrall, hired by Tulane (Dec 2023) |
| Tulane | Willie Fritz, hired by Houston (Dec 2023) |
| Tulsa | Philip Montgomery, fired (Nov 2022) |
| UAB | Bill Clark, retired (Jun 2022) |
| UL Monroe | Terry Bowden, fired (Nov 2023) |
| UNLV | Marcus Arroyo, fired (Nov 2022) |
| UTEP | Dana Dimel, fired (Nov 2023) |
| Virginia | Bronco Mendenhall, resigned (Dec 2021) |
| Virginia Tech | Justin Fuente, parted ways (Nov 2021) |
| Washington | Jimmy Lake, fired (Nov 2021) |
| Washington State | Nick Rolovich, fired (Oct 2021) |
| Western Michigan | Tim Lester, fired (Nov 2022) |
| Wisconsin | Paul Chryst, fired (Oct 2022) |
| Wyoming | Craig Bohl, retired (Dec 2023) |
That leaves 61 programs. The five closest to OU’s 2018-21 records are Georgia, Ohio State, App State, Clemson, Alabama. One change the rule does not catch:
as_tibble(did$riley$donorEvents) %>%
mutate(primary_comparison_program = key %in% did$riley$donors$key) %>%
transmute(team, date, event, primary_comparison_program, source = sprintf('[link](%s)', source)) %>%
knitr::kable(caption = "A coordinator move among OU's comparison programs (source linked)")| team | date | event | primary_comparison_program | source |
|---|---|---|---|---|
| Clemson | 2021-12-05 | Defensive coordinator Brent Venables becomes OU head coach | TRUE | link |
8.5 Identification: what would make this causal?
A causal reading requires that, without the departure, the team’s win rate would have moved in parallel with its comparison group, with no anticipation and no differential simultaneous shocks. A good historical fit does not establish those claims. Matching on four seasons mechanically improves fit on those seasons, so a small pre-period gap is not independent evidence of parallel trends; nor would passing a pre-trend test prove it (Roth 2022). Matching on pre-period outcomes can also manufacture regression to the mean when the treated and comparison teams come from different populations (Daw and Hatfield 2018), which is why matching on changes is reported too. With one treated team, conventional clustered standard errors would manufacture precision (Conley and Taber 2011), so none are reported.
8.6 Regression to the mean after the screen
In plain English: the screen fixed one problem and exposed another. None of the teams that stood pat was as good as OKC, and great teams fall back toward .500 on their own. So compare OKC with every team in league history that started at OKC’s level, too.
The screened difference-in-differences assumes OKC would have moved in parallel with its comparison teams, even though OKC won 67% of its games before Durant left and they won 47%. The benchmark makes the opposite assumption: absent the departure, OKC would have changed like other teams that started at its level. It takes every stretch of four seasons followed by three, for every other NBA team from 2002 on, that started within 3 points of OKC’s pre-departure win rate. A second version fits a straight line through every stretch in league history and adjusts the difference-in-differences for the level gap. The difference-in-differences and the lagged-outcome adjustment bracket the true effect under some conditions (Angrist and Pischke 2009, section 5.3; Ding and Li 2019), not always.
imap_dfr(did, ~tibble(case = if (.y == 'kd') 'KD / OKC' else 'Riley / OU',
stretches = .x$benchmark$windows, teams = .x$benchmark$teams,
treated_pre_pct = 100 * .x$benchmark$treatedPre,
typical_change_pp = 100 * .x$benchmark$meanChange,
treated_change_pp = 100 * .x$benchmark$treatedChange,
treated_minus_typical_pp = 100 * .x$benchmark$difference,
slope = .x$benchmark$slope,
did_pp = 100 * .x$effect,
level_adjusted_did_pp = 100 * .x$benchmark$adjustedEffect)) %>%
knitr::kable(digits = 2, caption = 'How far do teams this good usually fall? Stretches that started within three points of the treated team')| case | stretches | teams | treated_pre_pct | typical_change_pp | treated_change_pp | treated_minus_typical_pp | slope | did_pp | level_adjusted_did_pp |
|---|---|---|---|---|---|---|---|---|---|
| KD / OKC | 41 | 16 | 66.77 | -15.44 | -8.23 | 7.20 | -0.76 | -8.66 | 6.28 |
| Riley / OU | 69 | 28 | 84.47 | -10.46 | -22.93 | -12.47 | -0.42 | -15.50 | -16.51 |
For OKC the two approaches disagree in sign: -8.7 points against teams that stood pat, but +7.2 points relative to teams at OKC’s level (+6.3 with the straight-line adjustment). The honest summary is a bracket, not a point. For OU the two agree: its matched comparison programs were already at its level, and OU also fell 12.5 points more than programs that good usually do.
8.7 Annual effects and the choice of baseline
The main chart subtracts the average pre-departure gap:
Its post-period mean equals the headline estimate. The event-study chart instead uses the last pre-season, event time -1, as the reference:
These are the saturated event-time interaction coefficients on the balanced matched sample. The two normalizations answer slightly different questions, so their post-period averages need not match. Neither shows confidence intervals.
imap_dfr(did, ~as_tibble(.x$path) %>%
transmute(case = .y, year, event_time, gap_pp = 100 * gap,
event_study_pp = 100 * event_effect)) %>%
knitr::kable(digits = 2)| case | year | event_time | gap_pp | event_study_pp |
|---|---|---|---|---|
| kd | 2013 | -4 | 14.27 | 15.12 |
| kd | 2014 | -3 | 0.12 | 0.98 |
| kd | 2015 | -2 | -13.54 | -12.68 |
| kd | 2016 | -1 | -0.85 | 0.00 |
| kd | 2017 | 0 | -6.95 | -6.10 |
| kd | 2018 | 1 | -8.66 | -7.80 |
| kd | 2019 | 2 | -10.37 | -9.51 |
| riley | 2018 | -4 | -1.75 | -6.18 |
| riley | 2019 | -3 | -1.75 | -6.18 |
| riley | 2020 | -2 | -0.94 | -5.37 |
| riley | 2021 | -1 | 4.43 | 0.00 |
| riley | 2022 | 0 | -30.99 | -35.43 |
| riley | 2023 | 1 | -0.01 | -4.44 |
8.8 A pre-period holdout
Select comparison teams using the first three baseline seasons only, align their average level on those seasons, and predict the fourth. This checks one season the matching never saw, rather than celebrating fit to the seasons used for selection. For OU the held-out season is 2021, with the bowl-timing caveat. One season is a limited check.
imap_dfr(did, ~tibble(case = .y, held_out_year = .x$holdout$year,
prediction_gap_pp = 100 * .x$holdout$error,
comparison_teams = paste(.x$holdout$donors, collapse = ', '))) %>%
knitr::kable(digits = 2)| case | held_out_year | prediction_gap_pp | comparison_teams |
|---|---|---|---|
| kd | 2016 | 5.77 | Brooklyn Nets, Portland Trail Blazers, Washington Wizards, Phoenix Suns, Charlotte Hornets |
| riley | 2021 | 5.91 | Georgia, App State, Ohio State, Clemson, Alabama |
8.9 Sensitivity to design choices
In plain English: change one design choice at a time, rerun the matching from scratch, and see whether the answer survives.
The checks for OKC: three teams, all 8 teams that stood pat, a six-season baseline, matching on changes instead of levels, a stricter screen (any of the three previous All-Star Games, which also removes Charlotte, Milwaukee, and Detroit), a looser screen (only teams that lost a star, which lets Denver and Philadelphia back in), and the original unscreened design. For OU: three or ten programs, a six-season baseline, matching on changes, omitting 2020, ending the baseline before 2021, a looser screen (only the 2021-22 hiring cycle, which lets Cincinnati back in), and the original unscreened design. Matching is rerun in each using only its own baseline seasons and its own pool. The post-period stays fixed. These are exploratory, not preregistered, and each primary design stays primary: switching the headline after seeing the answers is how forking paths creep in (Gelman and Loken 2014).
imap_dfr(did, ~as_tibble(.x$sensitivity) %>%
mutate(first_post_gap_pp = 100 * firstPostGap) %>%
transmute(case = .y, specification, effect_pp = 100 * effect, first_post_gap_pp,
shape_fit_pp = 100 * preGapRMSE, pre, comparison_teams = donors)) %>%
knitr::kable(digits = 2)| case | specification | effect_pp | first_post_gap_pp | shape_fit_pp | pre | comparison_teams |
|---|---|---|---|---|---|---|
| kd | Primary: 5 closest teams that stood pat | -8.66 | -6.95 | 9.84 | 2013, 2014, 2015, 2016 | Portland Trail Blazers, Washington Wizards, Brooklyn Nets, Charlotte Hornets, Detroit Pistons |
| kd | 3 closest teams that stood pat | -6.40 | -3.96 | 10.80 | 2013, 2014, 2015, 2016 | Portland Trail Blazers, Washington Wizards, Brooklyn Nets |
| kd | All 8 teams that stood pat | -10.14 | -8.46 | 9.90 | 2013, 2014, 2015, 2016 | Portland Trail Blazers, Washington Wizards, Brooklyn Nets, Charlotte Hornets, Detroit Pistons, Phoenix Suns, Milwaukee Bucks, Orlando Magic |
| kd | 6 baseline seasons | -8.57 | -7.76 | 9.68 | 2011, 2012, 2013, 2014, 2015, 2016 | Portland Trail Blazers, Phoenix Suns, Brooklyn Nets, Detroit Pistons, Washington Wizards |
| kd | Match changes, not levels | -10.00 | -7.80 | 9.34 | 2013, 2014, 2015, 2016 | Orlando Magic, Detroit Pistons, Brooklyn Nets, Washington Wizards, Portland Trail Blazers |
| kd | Stricter screen: any of the last 3 All-Star Games | -5.63 | -4.57 | 10.57 | 2013, 2014, 2015, 2016 | Portland Trail Blazers, Washington Wizards, Brooklyn Nets, Phoenix Suns, Orlando Magic |
| kd | Looser screen: only teams that lost a star | -9.19 | -6.34 | 7.49 | 2013, 2014, 2015, 2016 | Portland Trail Blazers, Denver Nuggets, Washington Wizards, Brooklyn Nets, Charlotte Hornets |
| kd | No screen (the original design) | 3.02 | -2.83 | 3.50 | 2013, 2014, 2015, 2016 | LA Clippers, Miami Heat, San Antonio Spurs, Indiana Pacers, Memphis Grizzlies |
| riley | Primary: 5 closest programs that kept their coach | -15.50 | -30.99 | 2.58 | 2018, 2019, 2020, 2021 | Georgia, Ohio State, App State, Clemson, Alabama |
| riley | 3 closest programs that kept their coach | -17.38 | -31.57 | 2.50 | 2018, 2019, 2020, 2021 | Georgia, Ohio State, App State |
| riley | 10 closest programs that kept their coach | -15.22 | -31.84 | 1.16 | 2018, 2019, 2020, 2021 | Georgia, Ohio State, App State, Clemson, Alabama, Iowa, UCF, Utah, Oklahoma State, Marshall |
| riley | 6 baseline seasons | -17.03 | -32.52 | 3.03 | 2016, 2017, 2018, 2019, 2020, 2021 | Ohio State, Clemson, Alabama, App State, Georgia |
| riley | Match changes, not levels | -29.59 | -35.66 | 1.86 | 2018, 2019, 2020, 2021 | Ohio State, Florida State, Iowa, Boston College, Missouri |
| riley | Omit COVID 2020 | -15.81 | -31.31 | 2.91 | 2018, 2019, 2021 | Alabama, Ohio State, Georgia, App State, Clemson |
| riley | End baseline before 2021 | -15.41 | -30.91 | 2.43 | 2017, 2018, 2019, 2020 | Georgia, Ohio State, Clemson, App State, Alabama |
| riley | Looser screen: only the 2021-22 coaching cycle | -8.82 | -28.85 | 1.43 | 2018, 2019, 2020, 2021 | Georgia, Ohio State, Cincinnati, App State, Clemson |
| riley | No coach screen (the original design) | -9.09 | -27.41 | 0.24 | 2018, 2019, 2020, 2021 | Notre Dame, Georgia, Ohio State, Cincinnati, App State |
Every screened OKC design is negative (-10.1 to -5.6); only the unscreened design is positive. OU’s average stays negative everywhere, but its size varies a lot; the 2022 gap is large in every design, while the 2023 gap changes sign. Leave-one-out estimates below hold the remaining comparison teams fixed and reweight them equally; the range describes dependence on individual teams, not sampling uncertainty.
imap_dfr(did, ~as_tibble(.x$leaveOneOutTable) %>%
transmute(case = .y, omitted, effect_pp = effect * 100)) %>%
knitr::kable(digits = 2)| case | omitted | effect_pp |
|---|---|---|
| kd | Portland Trail Blazers | -8.10 |
| kd | Washington Wizards | -8.36 |
| kd | Brooklyn Nets | -11.20 |
| kd | Charlotte Hornets | -8.54 |
| kd | Detroit Pistons | -7.09 |
| riley | Georgia | -10.64 |
| riley | Ohio State | -14.85 |
| riley | App State | -19.60 |
| riley | Clemson | -17.27 |
| riley | Alabama | -15.14 |
8.10 Placebo reassignment
In plain English: pretend every other eligible team suffered the departure instead, rerun everything, and see where the real case ranks. If lots of ordinary teams show “effects” this big, the real one is not special.
Assign the same departure date to each team in the comparison pool, rebuild its matched group from the rest of the pool (the real treated team and the destination team never serve), and repeat the estimator. For OKC the pool is the 8 teams that stood pat, so each placebo team is matched from the other seven; for OU it is the 61 programs that kept their head coach. Three yardsticks are reported, each as the share of teams, the real one included, with a statistic at least as large:
- Size of the average effect (the headline yardstick).
- Post/pre fit ratio: how far a team strayed after the date, relative to how closely it tracked its comparison group before, as in synthetic-control inference (Abadie, Diamond, and Hainmueller 2010). It stops badly matched placebo teams from looking dramatic, but a near-perfect pre-fit makes the ratio’s denominator tiny and the ratio huge.
- The first post-departure season, where a shock should be sharpest.
Departures were not randomly assigned, teams are not exchangeable, and placebo comparison groups overlap. These ranks are descriptive benchmarks, not randomization p-values, and no significance threshold is attached.
imap_dfr(did, ~tibble(case = .y, placebo_teams = nrow(.x$placebos),
effect_size_rank = .x$placeboRankShare, fit_ratio_rank = .x$ratioRankShare,
first_season_rank = .x$firstYearRankShare,
median_placebo_shape_fit_pp = median(.x$placebos$preGapRMSE) * 100,
actual_shape_fit_pp = .x$preGapRMSE * 100)) %>% knitr::kable(digits = 3)| case | placebo_teams | effect_size_rank | fit_ratio_rank | first_season_rank | median_placebo_shape_fit_pp | actual_shape_fit_pp |
|---|---|---|---|---|---|---|
| kd | 8 | 0.444 | 0.778 | 0.556 | 7.627 | 9.843 |
| riley | 61 | 0.452 | 0.048 | 0.048 | 5.775 | 2.581 |
OKC is unremarkable on all three yardsticks: 3 of 8 teams that stood pat show an average effect at least as large, partly because the placebo teams are matched to each other just as loosely. OU’s average effect is unremarkable (27 of 61 programs that kept their coach show one at least as large), but its first season stands out: OU ranks 3 of 62 on the first-season gap and 3 on the fit ratio.
8.11 Sensitivity to nonparallel trends
Suppose the team’s untreated gap from its comparison group would have drifted by win-rate units per year. The bias in the pre/post contrast would then be . Subtract that from the estimate. The drift that erases the point estimate is .
For OKC, a -2.5-point annual drift would erase the estimate; for OU it would take -5.2 points per year. These are hypothetical trends, not observed ones. The plotted -2 to +2 point range is a declared scenario range, not a bound justified by the data. This is a deterministic cousin of the Rambachan and Roth (2023) sensitivity analysis, not an implementation of their confidence sets.
8.12 Other famous exits
In plain English: run the exact same comparison on other stars who left, and ask which departures look unusual compared with teams that lost no one special over the same seasons.
The board uses the original, unscreened design for every row: four
seasons before, three after, the five closest matches on pre-departure
win percentage, and the destination team excluded. Screening every row
would need a hand-built inventory of star moves for 2010-2022, so the
board stays unscreened and stays in this report. Its Durant row
therefore reproduces the “No screen” check (+3.0), not the screened
headline, which did.R checks. The placebo range is the 10th
to 90th percentile of the same calculation for every other eligible team
over the same seasons.
departure_board %>%
transmute(departure = label, team_change_pp = 100 * teamChange, comparison_change_pp = 100 * comparisonChange,
relative_change_pp = 100 * effect, placebo_10th = 100 * placeboLow, placebo_90th = 100 * placeboHigh,
effect_size_rank = rankShare) %>%
knitr::kable(digits = 2, caption = 'Famous NBA departures through the same matched design')| departure | team_change_pp | comparison_change_pp | relative_change_pp | placebo_10th | placebo_90th | effect_size_rank |
|---|---|---|---|---|---|---|
| LeBron James, Cleveland 2010 | -39.60 | -4.86 | -34.74 | -15.20 | 16.07 | 0.04 |
| LeBron James, Cleveland 2018 | -36.68 | -6.30 | -30.38 | -15.92 | 16.03 | 0.03 |
| Kevin Durant, Golden State 2019 | -30.45 | -11.30 | -19.16 | -16.86 | 18.60 | 0.17 |
| Paul George and Russell Westbrook, Oklahoma City 2019 | -20.36 | -5.42 | -14.94 | -14.74 | 18.07 | 0.32 |
| LeBron James, Miami 2014 | -20.47 | -8.81 | -11.66 | -22.07 | 14.95 | 0.41 |
| Kawhi Leonard, San Antonio 2018 | -20.31 | -15.22 | -5.09 | -19.27 | 15.95 | 0.69 |
| Kawhi Leonard, Toronto 2019 | -11.74 | -14.46 | 2.71 | -16.51 | 18.49 | 0.90 |
| Kevin Durant, Oklahoma City 2016 | -8.23 | -11.26 | 3.02 | -13.04 | 13.32 | 0.79 |
| Anthony Davis, New Orleans 2019 | -1.33 | -4.96 | 3.63 | -16.86 | 16.94 | 0.83 |
| James Harden, Oklahoma City 2012 | 9.84 | 4.41 | 5.43 | -15.50 | 15.34 | 0.76 |
| Paul George, Indiana 2017 | 4.39 | -9.01 | 13.40 | -14.78 | 20.73 | 0.41 |
Only LeBron James’s two exits from Cleveland fall far outside the placebo range, with effect-size ranks near 3%. Golden State after Durant left in 2019 and OKC after Paul George and Russell Westbrook left together in 2019 sit just outside it; Durant’s 2016 exit sits in the middle under this unscreened design. The same caveats apply to every row: one treated team, comparison teams with upheavals of their own (the problem the Durant screen addresses), and no causal inference.
8.13 Recruiting after Riley
In plain English: a coach’s exit is supposed to hurt recruiting first. Riley flipped several recruits to USC, but OU’s recruiting class rankings barely moved.
# 247Sports Composite class rankings, top 50 per year. Descriptive only: with the top 50
# visible, a matched comparison would silently drop programs that fell out of the table.
recruiting_summary <- as_tibble(recruiting) %>%
filter(team %in% c('Oklahoma', 'USC')) %>%
mutate(blueChips = fiveStar + fourStar) %>%
arrange(team, class)recruiting_summary %>%
transmute(team, class, rank, commits, five_star = fiveStar, four_star = fourStar, blue_chips = blueChips, points) %>%
knitr::kable(digits = 1, caption = '247Sports Composite class rankings, 2017-2024 (top 50 per year; USC missing when outside the top 50)')| team | class | rank | commits | five_star | four_star | blue_chips | points |
|---|---|---|---|---|---|---|---|
| Oklahoma | 2017 | 8 | 28 | 0 | 18 | 18 | 270.8 |
| Oklahoma | 2018 | 9 | 24 | 1 | 12 | 13 | 276.6 |
| Oklahoma | 2019 | 6 | 24 | 3 | 13 | 16 | 280.7 |
| Oklahoma | 2020 | 12 | 24 | 0 | 15 | 15 | 261.3 |
| Oklahoma | 2021 | 10 | 16 | 1 | 12 | 13 | 269.0 |
| Oklahoma | 2022 | 8 | 22 | 0 | 17 | 17 | 266.7 |
| Oklahoma | 2023 | 5 | 26 | 3 | 14 | 17 | 289.0 |
| Oklahoma | 2024 | 8 | 28 | 1 | 18 | 19 | 275.6 |
| USC | 2017 | 4 | 24 | 2 | 12 | 14 | 297.1 |
| USC | 2018 | 4 | 18 | 4 | 13 | 17 | 291.2 |
| USC | 2019 | 19 | 24 | 0 | 8 | 8 | 244.6 |
| USC | 2021 | 7 | 23 | 1 | 16 | 17 | 281.9 |
| USC | 2023 | 8 | 25 | 3 | 10 | 13 | 280.4 |
| USC | 2024 | 17 | 25 | 0 | 13 | 13 | 253.8 |
Riley left on November 28, 2021, in the middle of the 2022 recruiting cycle. Five-star quarterback Malachi Nelson (class of 2023) flipped his commitment from OU to USC within two days, and running back Raleek Brown and receiver Makai Lemon also ended up at USC. Even so, OU’s 2022 class finished #8 and its 2023 class #5, the best in this window. USC’s 2022 class fell outside the top 50; Riley’s first roster leaned on transfers, including Caleb Williams. A matched comparison is not attempted: with only the top 50 visible, programs that fell out of the table would silently drop from the comparison group. Per-recruit files checked for this project had wrong star ratings and class years for OU’s key 2022-23 recruits, so they are not used.
9 Forecasting the next season
In plain English: at the end of each season, guess next season’s score using only what was known then. Test that honestly, year by year, and compare it with lazy alternatives. It beats “same as last year” comfortably, but mostly because sports regress to the mean.
Separate pooled OLS regressions by sport predict next season’s results-only FSI from this season’s win percentage, momentum, title memory, and unfinished business. Every test year is predicted by a model fit only on seasons whose outcomes were already known: an expanding-window, rolling-origin evaluation, with no random train/test split (Tashman 2000; Hyndman and Athanasopoulos 2021). The benchmarks are the league average, persistence (“same as last season”), and a one-variable AR(1) drift-to-average rule, the same idea as FiveThirtyEight’s NBA Elo pulling every team a quarter of the way back to average each offseason.
An earlier version also included the total FSI as a predictor. Below the cap, FSI is exactly the sum of the other predictors, so the predictors were nearly collinear (multicollinearity; Wooldridge 2020, ch. 3) and the regression was nearly singular:
# Variance inflation factors for the earlier specification, which included FSI itself.
old_formula <- target ~ fsi + p + momentum + title + unfinished
vif_table <- map_dfr(c('nba', 'cfb'), function(s) {
d <- panel %>% filter(sport == s, !is.na(fsi)) %>% mutate(targetYear = year + 1) %>%
left_join(panel %>% transmute(key, targetYear = year, target = fsi), by = c('key', 'targetYear')) %>%
filter(!is.na(target))
X <- as.data.frame(model.matrix(old_formula, d)[, -1])
tibble(sport = s, term = names(X),
vif = map_dbl(names(X), function(v) 1 / (1 - summary(lm(reformulate(setdiff(names(X), v), v), X))$r.squared)))
}) %>% pivot_wider(names_from = sport, values_from = vif)
knitr::kable(vif_table, digits = 1, caption = 'Earlier specification, with FSI as a predictor: variance inflation factors (above 10 is usually a warning sign)')| term | nba | cfb |
|---|---|---|
| fsi | 225.6 | 427.8 |
| p | 33.8 | 113.0 |
| momentum | 72.8 | 155.2 |
| title | 53.8 | 19.7 |
| unfinished | 5.6 | 13.1 |
Dropping FSI leaves backtest accuracy unchanged and makes each coefficient readable.
# Question: using only what is known when a season ends, how well can we guess next
# season's on-field FSI? Honest test = rolling origin (Tashman 2000; Hyndman &
# Athanasopoulos 2021): for each test year, fit only on seasons that were already over.
# WHY components only: FSI is (below the cap) exactly the sum of its components, so
# an earlier version of the model, which used both, was nearly collinear (variance
# inflation above 200) and its coefficients were unreadable. Dropping FSI leaves backtest accuracy unchanged.
forecast_formula <- target ~ p + momentum + title + unfinished
# Benchmarks a forecast should beat, from lazy to less lazy:
# league average - ignore the team entirely;
# persistence - "same score as last season";
# drift to average - one-variable AR(1), i.e. regression to the mean. Same idea as
# FiveThirtyEight's NBA Elo pulling every team a quarter of the way
# back to average each offseason.
ar1_formula <- target ~ fsi
# WHY an 80% band from the 10th/90th percentile of past errors: "four seasons out of
# five" is readable, and it needs no normality assumption (it is a split-conformal
# style interval; Angelopoulos & Bates 2023).
band <- c(.1, .9)
forecasts <- list()
validations <- list()
for (s in c('nba', 'cfb')) {
# One row per scored season, with next season's score attached as the target.
d <- panel %>%
filter(sport == .env$s, !is.na(fsi)) %>%
mutate(targetYear = year + 1) %>%
left_join(panel %>% transmute(key, targetYear = year, target = fsi), by = c('key', 'targetYear'))
# Rolling-origin backtest. WHY start in 2012: leaves at least five seasons of scored
# history to train on.
tests <- list()
for (y in 2012:max(d$year)) {
train <- d[!is.na(d$target) & d$targetYear < y, ]
test <- d[!is.na(d$target) & d$targetYear == y, ]
if (!nrow(test)) next
fit <- lm(forecast_formula, train)
pred <- clip(predict(fit, test))
tests[[length(tests) + 1]] <- data.frame(
year = y, key = test$key, actual = test$target, predicted = pred,
persistence = test$fsi,
ar1 = clip(predict(lm(ar1_formula, train), test)),
leagueMean = mean(train$target))
}
bt <- bind_rows(tests)
err <- bt$actual - bt$predicted
q <- unname(quantile(err, band))
# Honest coverage: rebuild the band each year from errors in EARLIER test years only,
# then count how often the actual score landed inside it. (Using all errors, as the
# published band does, would make in-sample coverage 80% by construction.)
coverage <- map_dfr(sort(unique(bt$year))[-(1:2)], function(y) {
past <- quantile(err[bt$year < y], band)
now <- bt$year == y
tibble(year = y,
share = mean(bt$actual[now] >= clip(bt$predicted[now] + past[1]) &
bt$actual[now] <= clip(bt$predicted[now] + past[2])))
})
# The published forecast: fit on every completed season, predict the next one.
fit <- lm(forecast_formula, d[!is.na(d$target), ])
latest <- d[d$year == max(d$year), ]
pred <- clip(predict(fit, latest))
forecasts[[s]] <- data.frame(key = latest$key, team = latest$team, origin = latest$year,
year = latest$year + 1, forecast = pred,
low = clip(pred + q[1]), high = clip(pred + q[2]))
validations[[s]] <- list(
start = min(bt$year), end = max(bt$year), n = nrow(bt),
mae = mean(abs(err)),
persistenceMAE = mean(abs(bt$actual - bt$persistence)),
ar1MAE = mean(abs(bt$actual - bt$ar1)),
leagueMeanMAE = mean(abs(bt$actual - bt$leagueMean)),
rmse = sqrt(mean(err^2)),
residualQuantiles = q,
coverage = list(nominal = diff(band), rolling = mean(coverage$share), byYear = coverage),
coefficients = as.list(coef(fit)),
ar1Coefficients = as.list(coef(lm(ar1_formula, d[!is.na(d$target), ]))),
byYear = aggregate(cbind(model = abs(err),
persistence = abs(bt$actual - bt$persistence),
ar1 = abs(bt$actual - bt$ar1)),
list(year = bt$year), mean))
write_csv(bt, paste0('analysis/backtest-', s, '.csv'))
}imap_dfr(validations, ~tibble(sport = .y, test_years = paste(.x$start, .x$end, sep = '-'), forecasts = .x$n,
model_MAE = .x$mae, drift_to_average_MAE = .x$ar1MAE, persistence_MAE = .x$persistenceMAE,
league_average_MAE = .x$leagueMeanMAE,
gain_vs_persistence_pct = 100 * (1 - .x$mae / .x$persistenceMAE),
gain_vs_drift_pct = 100 * (1 - .x$mae / .x$ar1MAE))) %>%
knitr::kable(digits = 2, caption = 'Rolling-origin accuracy (mean absolute error in FSI points; smaller is better)')| sport | test_years | forecasts | model_MAE | drift_to_average_MAE | persistence_MAE | league_average_MAE | gain_vs_persistence_pct | gain_vs_drift_pct |
|---|---|---|---|---|---|---|---|---|
| nba | 2012-2026 | 449 | 2.15 | 2.22 | 2.55 | 2.67 | 15.69 | 3.26 |
| cfb | 2012-2025 | 1740 | 2.88 | 2.95 | 3.49 | 3.07 | 17.34 | 2.31 |
imap_dfr(validations, ~tibble(sport = .y, nominal = .x$coverage$nominal, rolling_coverage = .x$coverage$rolling,
worst_year = min(.x$coverage$byYear$share), best_year = max(.x$coverage$byYear$share))) %>%
knitr::kable(digits = 3, caption = 'Honest coverage of the 80% band: rebuilt each year from earlier errors only')| sport | nominal | rolling_coverage | worst_year | best_year |
|---|---|---|---|---|
| nba | 0.8 | 0.779 | 0.633 | 0.867 |
| cfb | 0.8 | 0.809 | 0.702 | 0.867 |
imap_dfr(validations, ~tibble(sport = .y, term = names(.x$coefficients), coefficient = unlist(.x$coefficients))) %>%
pivot_wider(names_from = sport, values_from = coefficient) %>%
knitr::kable(digits = 3, caption = 'Final forecast coefficients (predictive associations, not causal effects)')| term | nba | cfb |
|---|---|---|
| (Intercept) | 2.461 | -0.033 |
| p | -6.281 | -0.923 |
| momentum | 1.122 | 0.432 |
| title | 0.912 | 0.998 |
| unfinished | -0.618 | 0.039 |
The forecast is a baseline conditioned on past results. It omits rosters, recruiting, injuries, betting markets, and games already played this season. The 80% band adds the 10th and 90th percentiles of pooled rolling-test errors to each forecast, a distribution-free, split-conformal-style interval (Angelopoulos and Bates 2023). It is not team-specific and ignores uncertainty in the index’s own weights. Predicting the index well would not show that the index measures feelings.
10 Figures and interpretation
# O, off-field ruptures, for the two personal charts only. Magnitudes are my feelings,
# not estimates. WHY KD and Riley both -5: each took the future with them (a franchise
# star to the team that had just beaten us; a coach plus a future Heisman winner). WHY
# Harden only -2: it hurt, but Durant and Westbrook stayed. Timing: an NBA offseason
# event enters the next annual score; Riley enters 2021 because OU's bowl game came after.
# WHY not league-wide: there is no complete inventory of every fan base's heartbreaks.
events <- list(
list(key = 'nba:25', year = 2012, magnitude = -2, label = 'Harden traded', timing = 'offseason'),
list(key = 'nba:25', year = 2016, magnitude = -5, label = 'Durant leaves', timing = 'offseason'),
list(key = 'cfb:201', year = 2021, magnitude = -5, label = 'Riley leaves; transfers follow',
timing = 'after regular season'))
# WHY the model output lives in analysis/output, not the website folder: the site only
# needs suffering-data.js; everything else stays out of what gets published.
result <- list(
version = '0.8', generated = '2026-09-23',
status = 'Model-based emotional proxy; not a fan survey',
weights = fsi_weights,
winningAnchors = list(neutralWinRate = .5, positiveWinRate = win_anchor_p,
positivePoints = win_anchor_points, slope = win_slope),
diagnostics = diagnostics,
sufferingCurve = suffering_curve, sufferingPaths = suffering_paths,
attendance = attendance_summary, recruiting = recruiting_summary,
records = panel, events = events,
forecasts = forecasts, validation = validations,
did = did, departureBoard = departure_board,
audit = audit)
write_json(result, 'analysis/output/suffering-model-data.json', auto_unbox = TRUE, digits = 6, na = 'null')
writeLines(paste0('window.FSIData=', toJSON(result, auto_unbox = TRUE, digits = 6, na = 'null'), ';'),
'EthanMaddyWebsite/suffering-data.js')
write_csv(panel, 'analysis/season-panel.csv')
write_json(audit, 'analysis/audit.json', auto_unbox = TRUE, digits = 6)
# Last guards: the scale's bounds, and three records every reader of the essay knows.
stopifnot(all(panel$fsi[!is.na(panel$fsi)] <= 10), all(panel$fsi[!is.na(panel$fsi)] >= -10))
stopifnot(with(subset(panel, key == 'nba:25' & year == 2025), wins == 68 & losses == 14 & champion),
with(subset(panel, key == 'cfb:201' & year == 2024), wins == 6 & losses == 7),
with(subset(panel, key == 'cfb:201' & year == 2000), wins == 13 & losses == 0 & champion & fsi == 10))
# A console summary for whoever is running this.
cat('Seasons:', nrow(panel), 'Scored:', sum(!is.na(panel$fsi)), '\n')
print(lapply(validations, function(v) unlist(v[c('mae', 'ar1MAE', 'persistenceMAE', 'leagueMeanMAE', 'n')])))
print(lapply(validations, function(v) v$coverage$rolling))
print(lapply(did, function(d) d[c('effect', 'leaveOneOut', 'preGapRMSE', 'placeboRankShare',
'ratioRankShare', 'firstYearRankShare')]))
print(suffering_curve)
print(attendance_model)
print(okc_attendance, n = 30)
print(recruiting_summary, n = 30)
print(departure_board %>% select(label, effect, teamChange, comparisonChange, placeboLow, placeboHigh, rankShare), n = 30)
print(audit)# plots.R: the technical report's figures, drawn with ggplot2 and saved as SVG and PNG.
#
# Run by fsi.R, or on its own after fsi.R has written the model output.
# WHY every chart reads the saved JSON instead of in-memory objects: the website, the
# report and these files then show exactly the same numbers.
# WHY SVG + PNG: SVG stays editable and sharp; PNG embeds anywhere.
.libPaths(c('analysis/R-library', .libPaths()))
suppressPackageStartupMessages(library(tidyverse))
d <- jsonlite::fromJSON('analysis/output/suffering-model-data.json')
r <- as_tibble(d$records)
export_dir <- 'analysis/output/exports'
dir.create(export_dir, showWarnings = FALSE, recursive = TRUE)
# Colors: team identity for team lines; green and red for the sign of a score (the
# essay's convention); gray for comparison lines and reference marks.
okc_blue <- '#007AC1'
ou_crimson <- '#841617'
positive <- '#349d62'
negative <- '#902731'
reference <- '#99958a'
case_label <- function(case) if (case == 'kd') 'KD leaves OKC' else 'Riley leaves OU'
theme_fsi <- theme_minimal(base_size = 12, base_family = 'sans') +
theme(plot.background = element_rect(fill = '#FDFDF8', colour = NA),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
plot.title = element_text(face = 'bold', size = 18),
plot.subtitle = element_text(colour = '#615f55', margin = margin(b = 15)),
legend.position = 'bottom',
legend.title = element_blank(),
plot.caption = element_text(hjust = 0, colour = '#615f55', size = 9),
plot.margin = margin(20, 25, 15, 20))
save_fsi <- function(p, name, width = 9, height = 5.2) {
ggsave(file.path(export_dir, paste0(name, '.svg')), plot = p, device = svglite::svglite,
width = width, height = height, bg = '#FDFDF8')
ggsave(file.path(export_dir, paste0(name, '.png')), plot = p, device = ragg::agg_png,
width = width, height = height, dpi = 180, bg = '#FDFDF8')
}
# ---- The two personal charts ----------------------------------------------------------
# Off-field penalties for one team-season, with the same timing rule as the website:
# NBA offseason events count from the next season; Riley counts in 2021.
event_adjustment <- function(key, y) {
d$events %>%
as_tibble() %>%
filter(.data$key == .env$key, year < y | (.data$key == 'cfb:201' & year == y)) %>%
summarise(total = sum(magnitude * 2^(-(y - year) / 2))) %>%
pull(total)
}
for (k in c('cfb:201', 'nba:25')) {
is_ou <- k == 'cfb:201'
story <- r %>%
filter(key == k, year >= if (is_ou) 2000 else 2012, year <= if (is_ou) 2024 else 2025) %>%
mutate(personal = pmax(-10, pmin(10, winning + momentum + title + unfinished +
map_dbl(year, ~event_adjustment(k, .x))))) %>%
select(year, `On-field score` = fsi, `With assumed departure effects` = personal) %>%
pivot_longer(-year, names_to = 'series', values_to = 'score')
p <- ggplot(story, aes(year, score, colour = series, linetype = series)) +
geom_hline(yintercept = 0, colour = '#aaa79b', linewidth = .4) +
geom_line(linewidth = .9) +
geom_point(size = 1.6) +
scale_colour_manual(values = c('On-field score' = reference,
'With assumed departure effects' = if (is_ou) ou_crimson else okc_blue)) +
scale_linetype_manual(values = c('On-field score' = 'dashed', 'With assumed departure effects' = 'solid')) +
scale_y_continuous(limits = c(-10, 10), breaks = seq(-10, 10, 5)) +
scale_x_continuous(breaks = scales::breaks_pretty(7)) +
labs(title = if (is_ou) 'OU: winning does not erase a departure' else 'Thunder: hope returns before the title',
subtitle = 'Fan Suffering Index | -10 alienation to +10 fulfillment',
x = if (is_ou) 'Football season' else 'NBA season ending year', y = 'FSI',
caption = paste0('Source: SportsDataverse records. Emotional weights and departure penalties are assumptions.\n',
'NBA offseason shocks enter the next annual endpoint; Riley enters 2021.')) +
theme_fsi
save_fsi(p, if (is_ou) 'fsi-ou' else 'fsi-thunder')
}
# ---- Departure studies -----------------------------------------------------------------
paths <- imap_dfr(d$did, ~as_tibble(.x$path) %>% mutate(case = case_label(.y), after = min(.x$post) - .5))
did_long <- paths %>%
select(case, year, Team = treated, `Matched comparison` = counterfactual) %>%
pivot_longer(c(Team, `Matched comparison`), names_to = 'series', values_to = 'win_rate')
departures <- ggplot(did_long, aes(year, win_rate, colour = series, linetype = series)) +
geom_vline(data = distinct(paths, case, after), aes(xintercept = after), colour = reference, linetype = 'dotted') +
geom_line(linewidth = .8) +
geom_point(size = 1.7) +
facet_wrap(~case, scales = 'free_x') +
scale_y_continuous(limits = c(0, 1), labels = scales::label_percent()) +
scale_x_continuous(breaks = scales::breaks_pretty(4)) +
scale_colour_manual(values = c(Team = okc_blue, 'Matched comparison' = reference)) +
scale_linetype_manual(values = c(Team = 'solid', 'Matched comparison' = 'dashed')) +
labs(title = 'Performance after a departure',
subtitle = 'Matched difference-in-differences | season win percentage',
x = 'Season', y = NULL,
caption = paste0('Comparison paths aligned to pre-departure team averages. Dotted line marks the departure.\n',
'OKC is compared with the five closest teams that did not lose or add a recent All-Star.')) +
theme_fsi
save_fsi(departures, 'fsi-departures', 10, 5.3)
gap_plot <- ggplot(paths, aes(year, gap * 100)) +
geom_hline(yintercept = 0, colour = reference) +
geom_vline(data = distinct(paths, case, after), aes(xintercept = after), colour = reference, linetype = 'dotted') +
geom_segment(aes(xend = year, yend = 0, colour = gap >= 0), linewidth = 1) +
geom_point(aes(colour = gap >= 0), size = 2.4) +
scale_colour_manual(values = c(`TRUE` = positive, `FALSE` = negative), guide = 'none') +
facet_wrap(~case, scales = 'free_x') +
labs(title = 'Season by season',
subtitle = 'Annual gap from the matched path, centered on the average pre-period gap',
x = 'Season', y = 'Percentage points',
caption = paste0('Post-period gaps average to the headline DiD. Pre-period gaps average to zero by construction.\n',
'These are descriptive point estimates, without causal confidence intervals.')) +
theme_fsi
save_fsi(gap_plot, 'fsi-departure-gaps', 10, 5.3)
event_plot <- ggplot(paths, aes(event_time, event_effect * 100)) +
geom_hline(yintercept = 0, colour = reference) +
geom_vline(xintercept = -.5, colour = reference, linetype = 'dotted') +
geom_line(colour = okc_blue, linewidth = .7) +
geom_point(colour = okc_blue, size = 2.4) +
facet_wrap(~case) +
scale_x_continuous(breaks = -4:2) +
labs(title = 'Dynamic comparisons around departure',
subtitle = 'Event-study normalization: the last pre-season is zero',
x = 'Seasons relative to first full season after departure', y = 'Percentage points',
caption = paste0('These coefficients use a different baseline from the average-pre-period DiD.\n',
'They describe the matched sample; conventional inference with one treated team is not reported.')) +
theme_fsi
save_fsi(event_plot, 'fsi-event-study', 10, 5.3)
specs <- imap_dfr(d$did, ~as_tibble(.x$sensitivity) %>% mutate(case = case_label(.y)))
sensitivity_plot <- ggplot(specs, aes(effect * 100, forcats::fct_rev(forcats::fct_inorder(specification)))) +
geom_vline(xintercept = 0, colour = reference) +
geom_point(aes(colour = effect >= 0), size = 3) +
scale_colour_manual(values = c(`TRUE` = positive, `FALSE` = negative), guide = 'none') +
facet_wrap(~case, ncol = 1, scales = 'free_y') +
labs(title = 'How much does the research design matter?',
subtitle = 'Alternative comparison groups and baseline windows; post-periods unchanged',
x = 'Relative change in win percentage (points)', y = NULL,
caption = paste0('Exploratory specification checks. Dots are separate estimates, not confidence intervals.\n',
'Matching choices are never selected using post-period outcomes.')) +
theme_fsi
save_fsi(sensitivity_plot, 'fsi-did-sensitivity', 10, 7.6)
placebos <- imap_dfr(d$did, ~as_tibble(.x$placebos) %>% mutate(case = case_label(.y)))
actual <- imap_dfr(d$did, ~tibble(case = case_label(.y), effect = .x$effect))
placebo_plot <- ggplot(placebos, aes(effect * 100)) +
geom_histogram(binwidth = 5, boundary = 0, fill = '#b8cdd6', colour = '#FDFDF8') +
geom_vline(data = actual, aes(xintercept = effect * 100), colour = negative, linewidth = .9) +
facet_wrap(~case, scales = 'free') +
labs(title = 'Could this pattern appear elsewhere?',
subtitle = 'Give the same departure date to every team in the comparison pool and repeat the matching',
x = 'Placebo relative change (percentage points)', y = 'Teams',
caption = paste0('Red line: actual case estimate. OKC\'s pool is the eight teams that stood pat; OU\'s is every eligible program.\n',
'Descriptive reference distribution, not a randomization test or a causal p-value.')) +
theme_fsi
save_fsi(placebo_plot, 'fsi-did-placebos', 10, 5.3)
drifts <- imap_dfr(d$did, ~as_tibble(.x$drift) %>% mutate(case = case_label(.y)))
drift_plot <- ggplot(drifts, aes(drift_per_year * 100, adjusted_effect * 100)) +
geom_hline(yintercept = 0, colour = reference) +
geom_vline(xintercept = 0, colour = reference, linetype = 'dashed') +
geom_line(colour = okc_blue, linewidth = .9) +
geom_point(colour = okc_blue, size = 1.6) +
facet_wrap(~case) +
labs(title = 'Allow the untreated trends to differ',
subtitle = 'A transparent bias calculation for an assumed linear gap drift',
x = 'Assumed untreated gap drift (percentage points per year)', y = 'Adjusted DiD (points)',
caption = paste0('Adjusted estimate = DiD - drift x (mean post year - mean pre year).\n',
'A deterministic scenario analysis, not an HonestDiD confidence interval.')) +
theme_fsi
save_fsi(drift_plot, 'fsi-did-drift', 10, 5.3)
# How far do teams this good usually fall? Every stretch in league history that started
# within three points of the treated team's win rate, with the treated team marked.
benchmarks <- imap_dfr(d$did, function(case, name) {
b <- case$benchmark
tibble(case = case_label(name), typical = b$meanChange * 100, treated = b$treatedChange * 100,
label = sprintf('%d stretches, %d teams', b$windows, b$teams))
})
benchmark_plot <- ggplot(benchmarks) +
geom_vline(xintercept = 0, colour = reference) +
geom_segment(aes(x = typical, xend = treated, y = case, yend = case), colour = '#d4d0c2', linewidth = 3) +
geom_point(aes(typical, case), colour = reference, size = 4) +
geom_point(aes(treated, case), colour = negative, size = 4) +
geom_text(aes(typical, case, label = label), vjust = -1.4, size = 3.2, colour = '#615f55') +
labs(title = 'How far do teams this good usually fall?',
subtitle = 'Gray: average change for teams that started within 3 points of the same win rate. Red: the real team.',
x = 'Change in win percentage, before vs. after (points)', y = NULL,
caption = paste0('Regression to the mean measured in each league\'s own history (NBA 2002-2026; FBS 1997-2025).\n',
'OKC fell less than teams that good usually do; OU fell more.')) +
theme_fsi
save_fsi(benchmark_plot, 'fsi-level-benchmark', 10, 4.2)
# ---- Forecasts --------------------------------------------------------------------------
f <- bind_rows(d$forecasts) %>% filter(key %in% c('nba:25', 'cfb:201'))
history <- r %>%
inner_join(f %>% select(key, origin), by = 'key') %>%
filter(year <= origin, year >= origin - 5)
forecast_plot <- ggplot(history, aes(year, fsi)) +
geom_hline(yintercept = 0, colour = '#aaa79b', linewidth = .4) +
geom_line(colour = okc_blue, linewidth = .9) +
geom_point(colour = okc_blue, size = 1.7) +
geom_errorbar(data = f, aes(x = year, ymin = low, ymax = high), inherit.aes = FALSE,
width = .15, colour = reference, linewidth = .8) +
geom_point(data = f, aes(year, forecast), inherit.aes = FALSE, colour = '#20201d', size = 3) +
facet_wrap(~team, scales = 'free_x') +
scale_y_continuous(limits = c(-10, 10), breaks = seq(-10, 10, 5)) +
scale_x_continuous(breaks = function(limits) seq(ceiling(limits[1]), floor(limits[2]), by = 1)) +
labs(title = 'A baseline for next season',
subtitle = 'Blue: observed on-field FSI | Black dot and gray bar: forecast and empirical error band',
x = 'Season (NBA ending year; football starting year)', y = 'FSI',
caption = sprintf(paste0('NBA origin: completed 2026 season. Football origin: completed 2025 season. No future departure penalties.\n',
'80%% bands from pooled past errors. Rebuilt each year from earlier errors only, they caught %.0f%% (NBA) and %.0f%% (football) of outcomes.'),
100 * d$validation$nba$coverage$rolling, 100 * d$validation$cfb$coverage$rolling)) +
theme_fsi
save_fsi(forecast_plot, 'fsi-forecasts', 10, 5.3)
# ---- The essay's title question, answered by the index's own arithmetic ------------------
curve <- as_tibble(d$sufferingCurve) %>%
select(losingSeasons,
`Title season, as scored` = titleScore,
`Title season, if there were no cap` = titleUncapped,
`Average season, title year + six before` = averageSevenSeasons) %>%
pivot_longer(-losingSeasons, names_to = 'series', values_to = 'score')
curve_order <- c('Title season, as scored', 'Title season, if there were no cap',
'Average season, title year + six before')
curve_plot <- ggplot(curve, aes(losingSeasons, score, colour = series, linetype = series)) +
geom_hline(yintercept = c(0, 10), colour = '#aaa79b', linewidth = .4) +
geom_line(linewidth = .9) +
geom_point(size = 2) +
scale_colour_manual(breaks = curve_order,
values = c('Title season, as scored' = okc_blue,
'Title season, if there were no cap' = reference,
'Average season, title year + six before' = ou_crimson)) +
scale_linetype_manual(breaks = curve_order,
values = c('Title season, as scored' = 'solid',
'Title season, if there were no cap' = 'dashed',
'Average season, title year + six before' = 'solid')) +
scale_x_continuous(breaks = 0:6) +
scale_y_continuous(limits = c(-2, 12), breaks = seq(0, 10, 5)) +
guides(colour = guide_legend(nrow = 2), linetype = guide_legend(nrow = 2)) +
labs(title = 'The index says: suffer briefly',
subtitle = 'A stylized contender loses for a few seasons, then wins a title',
x = 'Losing seasons (.300) before the title season (.750)', y = 'FSI',
caption = paste0('One losing season lifts the title season to the +10 cap; without the cap, the bonus stops growing after four.\n',
'Every extra losing season lowers the average. Stylized team: .650 for ten seasons first.')) +
theme_fsi
save_fsi(curve_plot, 'fsi-suffering-curve')
# ---- Other famous exits (technical report only) -----------------------------------------
# The original, unscreened design for every row. Gray bars: what ordinary teams did over
# the same seasons (10th-90th percentile of placebo "effects").
board <- as_tibble(d$departureBoard) %>%
mutate(label = forcats::fct_inorder(label), featured = grepl('Durant, Oklahoma City 2016', label))
board_plot <- ggplot(board, aes(y = label)) +
geom_vline(xintercept = 0, colour = reference) +
geom_linerange(aes(xmin = placeboLow * 100, xmax = placeboHigh * 100), colour = '#d4d0c2', linewidth = 5) +
geom_point(aes(x = effect * 100, colour = featured), size = 3) +
scale_colour_manual(values = c(`TRUE` = okc_blue, `FALSE` = ou_crimson), guide = 'none') +
labs(title = 'How other famous exits compare',
subtitle = "Team's change minus its five closest matches' change: three seasons after vs. four before",
x = 'Relative change in win percentage (points)', y = NULL,
caption = paste0('Unscreened design: comparison teams may have had big moves of their own. Gray bar: the middle 80%\n',
'of "effects" for other teams over the same seasons. Descriptive comparisons, not causal estimates.')) +
theme_fsi
save_fsi(board_plot, 'fsi-departure-board', 10, 6.2)
# ---- Did the fans come back before the trophy? (technical report only) -------------------
okc_att <- as_tibble(d$attendance$okc)
attendance_plot <- ggplot(okc_att, aes(year, attendance)) +
geom_hline(yintercept = d$attendance$capacity, colour = '#aaa79b', linetype = 'dashed') +
geom_col(fill = okc_blue, width = .7) +
annotate('text', x = min(okc_att$year), y = d$attendance$capacity + 400, label = 'Capacity 18,203',
hjust = 0, size = 3.2, colour = '#615f55') +
scale_y_continuous(labels = scales::label_comma(), limits = c(0, 19500)) +
scale_x_continuous(breaks = okc_att$year, labels = function(y) paste0(substr(y - 1, 3, 4), '-', substr(y, 3, 4))) +
labs(title = 'The fans came back before the trophy',
subtitle = 'Thunder average home attendance per game (ESPN-reported)', x = NULL, y = NULL,
caption = '2020-21 omitted: pandemic restrictions. The title came in 2024-25.') +
theme_fsi +
theme(axis.text.x = element_text(size = 8))
save_fsi(attendance_plot, 'fsi-thunder-attendance', 10, 5)
writeLines(capture.output(sessionInfo()), 'analysis/session-info.txt')
cat('ggplot2 exports: narrative, forecasts, departure paths, annual gaps, event study, sensitivity,',
'placebos, drift, level benchmark, suffering curve, departure board and attendance.\n')
The gap between each pair of lines is the declared off-field assumption, not an estimate. OU shows how a strong record can coexist with disaffection; OKC shows the index rewarding recovery before a championship. These histories motivate the score; they do not prove that suffering causes later happiness.
OU’s average mixes a large negative 2022 gap with a positive 2023 gap, which is more informative than treating the two-season average as a permanent loss. OKC declined in absolute terms while the teams that stood pat held steady, although they started far below OKC.
The design checks limit the conclusion: OKC’s estimate is negative under every screened design but positive without the screen, and the level benchmark points the other way; OU’s negative average conceals a sharp 2022 drop followed by a return to the expected path. The data support a careful description of each transition, not a numerical price for betrayal.
11 Decision log
| Decision | Choice | Why | What if it is wrong? |
|---|---|---|---|
| Unit of analysis | Team-season. NBA regular season; football including bowls and lower-division games | The one schedule every NBA team plays; football seasons are short and bowls are memorable | Playoff heartbreak is invisible (see the 73-9 Warriors) |
| Winning anchors | .500 → 0, .750 → +2, linear | Leaves headroom for titles | Losses probably hurt about twice as much as wins help; an asymmetric W is future work |
| Momentum | Last three seasons, full ±3 at a 20-point swing | Reference-dependent preferences; roughly a roster cycle | Drives the suffering curve; a wider window moves the “optimal” amount |
| Title memory | +6, two-year half-life, stacking | Hedonic adaptation; first titles and dynasties can both reach +10 | The cap then hides differences among titles |
| Unfinished business | Up to .4 per good non-title season, five seasons, capped at 2 | Expectations as the reference point | Win percentage is a crude proxy for contention |
| Off-field events | KD -5, Riley -5, Harden -2; two-year half-life; personal charts only | No league-wide inventory of heartbreak exists | Purely personal; never used in comparisons or forecasts |
| Titles | BCS/CFP winners, both 1997 poll champions; USC 2004 kept | Describes what fans lived through | UCF’s 2017 “title” is not counted |
| Football before 2001 | 1997-2000 from Howell’s archive, FBS seasons only | Keeps OU’s 2000 title and lets 2000 be scored | Cross-checked: 2001 records match ESPN’s exactly |
| Franchise history | Seattle and Oklahoma City separate | A relocation is the -10 scenario for the fans left behind | Early OKC seasons lack title memory |
| Departure outcome | Win percentage, not FSI | Avoids testing an assumed penalty against itself | Says nothing about fan feelings |
| Comparison teams | Five nearest on pre-departure levels, equal weights | Readable; the comparison group faces the same regression pull | Reported alternatives: other group sizes, match changes, looser and unscreened designs |
| Big-move screen (OKC) | Drop teams that lost or added a recent All-Star, 2016-19 | A comparison team must not share the treatment; otherwise “lost a star” is nearly collinear with the season effects | Leaves eight teams, none as good as OKC; stricter and looser rules and the unscreened design are reported |
| Coaching screen (OU) | Drop programs whose head coach left, 2021 opener to 2023 title game | The same logic as the Durant screen; Notre Dame and Cincinnati had shared the treatment | Firings after losing can flatter the comparison group; the 2021-22-cycle-only and unscreened designs are reported |
| Regression to the mean (OKC) | Level benchmark from league history, reported beside the DiD | The screened comparison teams start far below OKC | The two answers bracket the truth only under some conditions |
| Windows | KD 2013-16 vs 2017-19; Riley 2018-21 vs 2022-23 | Avoid the Westbrook trade, the pandemic season, and the SEC move | Six-season baselines and COVID/bowl variants reported |
| Inference | No p-values or confidence intervals; descriptive placebo ranks | One treated team per case | Conley-Taber-style inference is future work |
| Headline | The primary design stays primary | Avoids choosing after seeing results | The two screens were adopted on design grounds after first versions; all alternatives, including the unscreened designs, are shown next to them |
| Forecast | Components-only OLS, expanding window from 2012, 80% empirical band | Honest time ordering; readable coefficients | Beats drift-to-average only narrowly |
| Attendance test | Log attendance, team and season fixed effects, pandemic seasons dropped | Compares each team with itself | Capacity caps sellout teams; behavior is not feelings |
| Departure board | Stars who left by choice, plus Harden; the unscreened design | Puts one case in context | Unscreened, so comparison teams may have had big moves; technical report only |
| Recruiting | 247Sports Composite ranks, descriptive only | Official class rankings | Top 50 only, so no matched comparison |
12 What I would do next
- Validate against real fan behavior. Relate the index to attendance, local TV ratings, search interest, or a short seasonal survey using an established fan-identification scale (Wann and Branscombe 1993). That is the only way to estimate weights instead of declaring them.
- Make winning asymmetric. Replace the linear W with a loss-averse version (losses weighted roughly two times wins, in line with Dolton and MacKerron 2018) and report how the rankings move.
- Upgrade the departure design. Synthetic difference-in-differences (Arkhangelsky et al. 2021) with Conley-Taber inference; and a star-move inventory built from box-score minutes for every NBA season, so the departure board can be screened by rule instead of by hand.
- See the playoffs. Code playoff series wins and blown leads so the index can tell a 73-9 heartbreak from a 73-9 triumph.
- Forecast with partial pooling. A hierarchical model would share strength across teams and give team-specific intervals.
13 Verification and provenance
# verify.R: independent checks on everything fsi.R wrote.
#
# Each block recomputes something the model claims from the raw pieces, so a silent bug
# or a stale file fails loudly. Run from the project root after fsi.R.
.libPaths(c('analysis/R-library', .libPaths()))
library(jsonlite)
d <- fromJSON('analysis/output/suffering-model-data.json')
p <- read.csv('analysis/season-panel.csv', colClasses = c(id = 'character'))
clip <- function(x, a = -10, b = 10) pmax(a, pmin(b, x))
# ---- Records ------------------------------------------------------------------------
# No duplicate team-seasons, complete 82-game NBA seasons, and records everyone knows.
stopifnot(!anyDuplicated(paste(p$key, p$year)), all(p$wins >= 0), all(p$losses >= 0))
stopifnot(nrow(subset(p, sport == 'nba' & year == 2026)) == 30)
stopifnot(all(with(subset(p, sport == 'nba' & year %in% 2022:2026), wins + losses) == 82))
stopifnot(with(subset(p, key == 'nba:25' & year == 2022), wins == 24 & losses == 58))
stopifnot(with(subset(p, key == 'nba:25' & year == 2025), wins == 68 & losses == 14 & fsi == 10 & champion))
stopifnot(with(subset(p, key == 'nba:9' & year == 2018), fsi == 10 & champion))
stopifnot(with(subset(p, key == 'cfb:201' & year == 2021), wins == 11 & losses == 2))
stopifnot(with(subset(p, key == 'cfb:201' & year == 2024), wins == 6 & losses == 7))
stopifnot(min(p$year[p$key == 'nba:25']) == 2009, all(p$year[p$key == 'nba:SEA'] <= 2008))
# Football 1997-2000 (Howell archive): OU's 2000 title is in, scored, and at the cap.
stopifnot(min(p$year[p$sport == 'cfb']) == 1997,
with(subset(p, key == 'cfb:201' & year == 2000), wins == 13 & losses == 0 & champion & fsi == 10),
with(subset(p, key == 'cfb:201' & year == 1997), wins == 4 & losses == 8),
sum(p$champion[p$sport == 'cfb' & p$year == 1997]) == 2)
a <- fromJSON('analysis/audit.json')
stopifnot(a$howell2001$teamsCompared >= 110, a$howell2001$recordMismatches == 0)
# ---- Scores -------------------------------------------------------------------------
# The saved FSI equals the capped sum of its saved components.
scored <- p[!is.na(p$fsi), ]
stopifnot(max(abs(scored$fsi - clip(scored$winning + scored$momentum + scored$title + scored$unfinished))) < 1e-10)
# Index diagnostics: adjusted R^2 on win %, rebuilt from its textbook formula, and the
# documented on-field bounds (-8.6, +6.6).
for (s in c('nba', 'cfb')) {
z <- scored[scored$sport == s, ]
n <- nrow(z)
r2 <- cor(z$fsi, z$p)^2 # one predictor: R^2 is the squared correlation
adjusted <- 1 - (1 - r2) * (n - 1) / (n - 2) # n observations, one predictor plus the intercept
stopifnot(abs(adjusted - d$diagnostics[[s]]$adjR2WinPct) < 1e-6)
}
stopifnot(abs(d$diagnostics$bounds$onFieldFloor + 8.6) < 1e-9,
abs(d$diagnostics$bounds$ceilingWithoutTitles - 6.6) < 1e-9,
min(scored$fsi) >= d$diagnostics$bounds$onFieldFloor)
# Suffering curve, checked against a hand calculation for a title with no losing seasons:
# W = 8(.75 - .50) = 2; M = 3(.75 - .65)/.20 = 1.5; C = 6; U = -.4 x 4 x (.65 - .50)/.25 = -.96.
curve <- d$sufferingCurve
paths <- d$sufferingPaths
stopifnot(all(sapply(0:6, function(k) {
abs(paths$fsi[paths$losingSeasons == k & paths$titleSeason] - curve$titleScore[curve$losingSeasons == k]) < 1e-6
})))
stopifnot(abs(curve$titleUncapped[curve$losingSeasons == 0] - (2 + 1.5 + 6 - .96)) < 1e-6,
all(curve$titleScore[curve$losingSeasons >= 1] == 10),
all(diff(curve$averageSevenSeasons) < 0))
# ---- Forecasts ----------------------------------------------------------------------
# Time alignment, a real rolling refit, benchmarks, and honest coverage.
for (s in c('nba', 'cfb')) {
bt <- read.csv(paste0('analysis/backtest-', s, '.csv'))
target <- p$fsi[match(paste(bt$key, bt$year), paste(p$key, p$year))]
previous <- p$fsi[match(paste(bt$key, bt$year - 1), paste(p$key, p$year))]
stopifnot(max(abs(target - bt$actual)) < 1e-10, max(abs(previous - bt$persistence)) < 1e-10)
v <- d$validation[[s]]
stopifnot(abs(mean(abs(bt$actual - bt$predicted)) - v$mae) < 1e-6,
abs(mean(abs(bt$actual - bt$ar1)) - v$ar1MAE) < 1e-6,
abs(mean(abs(bt$actual - bt$leagueMean)) - v$leagueMeanMAE) < 1e-6)
# Refit the 2020 test by hand using only seasons whose outcome was known before 2020.
g <- p[p$sport == s & !is.na(p$fsi), ]
g$target <- p$fsi[match(paste(g$key, g$year + 1), paste(p$key, p$year))]
train <- g[!is.na(g$target) & g$year + 1 < 2020, ]
test <- g[!is.na(g$target) & g$year + 1 == 2020, ]
fit <- lm(target ~ p + momentum + title + unfinished, train)
expected <- clip(predict(fit, test))
observed <- bt$predicted[match(paste(test$key, 2020), paste(bt$key, bt$year))]
stopifnot(max(abs(expected - observed)) < 1e-9, max(train$year + 1) < 2020)
# Coverage for 2020 must use errors from 2012-2019 only.
# (JSON stores 6 significant digits, hence the 1e-6 tolerance.)
err <- bt$actual - bt$predicted
q <- quantile(err[bt$year < 2020], c(.1, .9))
now <- bt$year == 2020
share <- mean(bt$actual[now] >= clip(bt$predicted[now] + q[1]) & bt$actual[now] <= clip(bt$predicted[now] + q[2]))
stopifnot(abs(share - v$coverage$byYear$share[v$coverage$byYear$year == 2020]) < 1e-6)
f <- d$forecasts[[s]]
stopifnot(all(f$origin == max(g$year)), all(f$year == f$origin + 1),
all(f$low <= f$forecast), all(f$forecast <= f$high))
}
# ---- Departure studies ---------------------------------------------------------------
# The four-mean arithmetic, rebuilt from the saved path.
for (case in d$did) {
z <- case$path
manual <- mean(z$treated[z$year %in% case$post]) - mean(z$treated[z$year %in% case$pre]) -
mean(z$control[z$year %in% case$post]) + mean(z$control[z$year %in% case$pre])
stopifnot(abs(manual - case$effect) < 2e-6)
}
suppressPackageStartupMessages(library(tidyverse))
panel <- read_csv('analysis/season-panel.csv', col_types = cols(id = col_character()), show_col_types = FALSE)
if (!exists('match_donors')) source('analysis/did.R')
for (case in d$did) {
stopifnot(abs(sum(case$donors$weight) - 1) < 1e-10,
abs(case$twfe - case$effect) < 1e-6,
abs(mean(case$path$gap[case$path$year %in% case$post]) - case$effect) < 2e-6,
abs(sqrt(mean(case$path$gap[case$path$year %in% case$pre]^2)) - case$preGapRMSE) < 2e-6)
pool <- eligible_donors(panel, case$key, case$pre, case$post, case$excluded)
original <- match_donors(panel, case$key, case$pre, pool)
# Flip every post-period result; if matching peeked at the future, the donors would change.
changed <- panel %>% mutate(p = if_else(year %in% case$post, 1 - p, p))
stopifnot(identical(original, match_donors(changed, case$key, case$pre, pool)))
stopifnot(!case$key %in% case$placebos$key,
!any(case$excluded %in% case$donors$key),
!any(case$excluded %in% case$placebos$key),
nrow(case$placebos) == case$poolSize,
length(pool) == case$poolSize)
# Dynamic gaps agree with saturated team-by-event-year interaction coefficients.
z <- panel %>% filter(key %in% c(case$key, case$donors$key), year %in% c(case$pre, case$post))
years <- setdiff(c(case$pre, case$post), max(case$pre))
terms <- paste0('event_', years)
for (i in seq_along(years)) z[[terms[i]]] <- as.integer(z$key == case$key & z$year == years[i])
fit <- lm(reformulate(c('factor(key)', 'factor(year)', terms), response = 'p'), z)
expected <- case$path$event_effect[match(years, case$path$year)]
stopifnot(max(abs(unname(coef(fit)[terms]) - expected)) < 2e-6)
# A constant treated-comparison gap must imply a zero DiD.
fake <- panel
j <- match(paste(case$key, case$path$year), paste(fake$key, fake$year))
fake$p[j] <- case$path$control + .01
null <- estimate_did(fake, case$key, case$pre, case$post, original)
stopifnot(abs(null$effect) < 2e-6)
# Regression to the mean, recomputed with plain loops: every other team's stretches of
# the same shape, and the ones that started near the treated team's win rate.
sport_panel <- p[p$sport == p$sport[p$key == case$key][1] & p$key != case$key, ]
n_pre <- length(case$pre)
span <- n_pre + length(case$post)
starts <- sort(unique(p$year[p$sport == p$sport[p$key == case$key][1]]))
rows <- list()
for (team in unique(sport_panel$key)) {
seasons <- sport_panel[sport_panel$key == team, ]
for (s in starts) {
window <- seasons[seasons$year %in% s:(s + span - 1), ]
if (nrow(window) < span) next
before <- mean(window$p[window$year < s + n_pre])
rows[[length(rows) + 1]] <- c(before, mean(window$p[window$year >= s + n_pre]) - before)
}
}
stretches <- do.call(rbind, rows)
treated_pre <- mean(p$p[p$key == case$key & p$year %in% case$pre])
near <- abs(stretches[, 1] - treated_pre) <= case$benchmark$band
stopifnot(nrow(stretches) == case$benchmark$allWindows,
sum(near) == case$benchmark$windows,
abs(mean(stretches[near, 2]) - case$benchmark$meanChange) < 1e-6,
abs(unname(coef(lm(stretches[, 2] ~ stretches[, 1]))[2]) - case$benchmark$slope) < 1e-6)
}
# The Durant screen, recomputed from the move table with a separate implementation:
# a team is out if it lost or added a player named to either of the two All-Star Games
# before the move, between the end of 2015-16 and the end of 2018-19.
asg_dates <- as.Date(all_star_games)
asg_years <- as.integer(names(all_star_games))
qualifies <- function(i, games_back = 2) {
m <- nba_star_moves[i, ]
when <- as.Date(if (nchar(m$date) == 7) paste0(m$date, '-15') else m$date)
in_window <- when > as.Date('2016-04-13') && when <= as.Date('2019-04-10')
recent <- tail(asg_years[asg_dates < when], games_back)
in_window && any(as.integer(strsplit(m$all_star, ',')[[1]]) %in% recent)
}
screened_teams <- function(games_back = 2, lost_only = FALSE) {
out <- character()
for (i in seq_len(nrow(nba_star_moves))) {
if (!qualifies(i, games_back)) next
if (!is.na(nba_star_moves$from[i])) out <- c(out, nba_star_moves$from[i])
if (!lost_only && !is.na(nba_star_moves$to[i])) out <- c(out, nba_star_moves$to[i])
}
sort(setdiff(unique(out), 'nba:25'))
}
kd <- d$did$kd
stopifnot(setequal(setdiff(kd$excluded, c('nba:9', 'nba:SEA')), setdiff(screened_teams(), 'nba:9')),
setequal(kd$screen$key, setdiff(screened_teams(), 'nba:9')),
kd$poolSize == 8,
!any(c(kd$donors$key, kd$placebos$key) %in% screened_teams()))
# Every check reruns the matching inside its own pool.
sens <- kd$sensitivity
stopifnot(sens$poolSize[sens$specification == 'Stricter screen: any of the last 3 All-Star Games'] ==
30 - 1 - length(union(c('nba:9', 'nba:SEA'), screened_teams(3))) + 1,
sens$poolSize[sens$specification == 'Looser screen: only teams that lost a star'] ==
30 - 1 - length(union(c('nba:9', 'nba:SEA'), screened_teams(lost_only = TRUE))) + 1,
sens$poolSize[sens$specification == 'No screen (the original design)'] == 28)
# Spot checks against what every NBA fan remembers: Blake Griffin's 2018 trade to Detroit
# does not count (his last All-Star Game had been 2015), Chris Paul's 2017 trade does.
stopifnot(!'nba:8' %in% screened_teams(), 'nba:8' %in% screened_teams(3),
all(c('nba:12', 'nba:10') %in% screened_teams()))
# ---- Attendance (technical report) ---------------------------------------------------
# The Thunder's series and the league model both rebuild from the season panel.
okc <- subset(panel, key == 'nba:25' & !is.na(attendance))
stopifnot(abs(okc$attendance[okc$year == 2022] - d$attendance$okc$attendance[d$attendance$okc$year == 2022]) < 1e-3,
abs(okc$attendance[okc$year == 2022] - 14877.8) < 1)
att <- panel %>%
filter(sport == 'nba') %>%
arrange(key, year) %>%
group_by(key) %>%
mutate(prevWinPct = lag(p)) %>%
ungroup() %>%
filter(!is.na(attendance), !is.na(fsi), !is.na(prevWinPct), !year %in% c(2020, 2021))
refit <- coef(lm(log(attendance) ~ p + prevWinPct + momentum + title + factor(key) + factor(year), att))
stopifnot(max(abs(refit[d$attendance$model$term] - d$attendance$model$estimate)) < 1e-6,
nrow(att) == d$attendance$n)
# ---- Departure board (technical report) -----------------------------------------------
# Its Durant row is the unscreened design, and LeBron 2010 rebuilds independently.
board <- d$departureBoard
stopifnot(abs(board$effect[board$label == 'Kevin Durant, Oklahoma City 2016'] -
sens$effect[sens$specification == 'No screen (the original design)']) < 1e-6)
lebron <- estimate_did(panel, 'nba:5', 2007:2010, 2011:2013,
match_donors(panel, 'nba:5', 2007:2010,
eligible_donors(panel, 'nba:5', 2007:2010, 2011:2013, 'nba:14')))
stopifnot(abs(lebron$effect - board$effect[board$label == 'LeBron James, Cleveland 2010']) < 1e-6)
# ---- Recruiting and the Riley donor screen --------------------------------------------
rec <- d$recruiting
stopifnot(rec$rank[rec$team == 'Oklahoma' & rec$class == 2022] == 8,
rec$rank[rec$team == 'Oklahoma' & rec$class == 2023] == 5)
# The Riley screen, recomputed from the departure table with a separate implementation:
# a program is out if a head coach left it between the 2021 opener and the 2023 title game.
coach_screened <- function(last = '2024-01-08') {
when <- as.Date(fbs_coach_departures$date)
hit <- when >= as.Date('2021-08-28') & when <= as.Date(last)
sort(setdiff(unique(fbs_coach_departures$key[hit]), c('cfb:201', 'cfb:30')))
}
riley <- d$did$riley
rsens <- riley$sensitivity
stopifnot(setequal(setdiff(riley$excluded, 'cfb:30'), coach_screened()),
setequal(riley$screen$key, coach_screened()),
riley$poolSize == 125 - length(coach_screened()),
!any(c(riley$donors$key, riley$placebos$key) %in% c(coach_screened(), 'cfb:30')),
rsens$poolSize[rsens$specification == 'Looser screen: only the 2021-22 coaching cycle'] ==
125 - length(coach_screened('2022-08-26')),
rsens$poolSize[rsens$specification == 'No coach screen (the original design)'] == 125)
# Spot checks: Notre Dame (Kelly, November 2021) and Cincinnati (Fickell, November 2022) are
# out, and only Notre Dame falls in the 2021-22 cycle; Ohio (July 2021, before the window)
# and Alabama (Saban, January 10, 2024, after it) stay in.
stopifnot(all(c('cfb:87', 'cfb:2132') %in% coach_screened()), 'cfb:87' %in% coach_screened('2022-08-26'),
!'cfb:2132' %in% coach_screened('2022-08-26'), !any(c('cfb:195', 'cfb:333') %in% coach_screened()))
cat('PASS: records (incl. 1997-2000 football and the Howell/ESPN overlap), scores, index diagnostics,',
'suffering-curve hand check and paths, forecast time alignment, rolling refits, benchmarks and',
'past-only coverage; DiD reconstruction, fixed-effects equivalence, event-study coefficients,',
'pre-only matching, donor weights, the star-move and coaching screens (rebuilt independently), placebo',
'eligibility, the constant-gap null and the regression-to-the-mean benchmark; attendance,',
'the departure board and recruiting anchors.\n')## PASS: records (incl. 1997-2000 football and the Howell/ESPN overlap), scores, index diagnostics, suffering-curve hand check and paths, forecast time alignment, rolling refits, benchmarks and past-only coverage; DiD reconstruction, fixed-effects equivalence, event-study coefficients, pre-only matching, donor weights, the star-move and coaching screens (rebuilt independently), placebo eligibility, the constant-gap null and the regression-to-the-mean benchmark; attendance, the departure board and recruiting anchors.## R version 4.5.2 (2025-10-31 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=English_United States.utf8
## [2] LC_CTYPE=English_United States.utf8
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United States.utf8
##
## time zone: America/Chicago
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] jsonlite_2.0.0 lubridate_1.9.5 forcats_1.0.1 stringr_1.6.0
## [5] dplyr_1.2.1 purrr_1.2.2 readr_2.2.0 tidyr_1.3.2
## [9] tibble_3.3.1 ggplot2_4.0.3 tidyverse_2.0.0
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.10 utf8_1.2.6 generics_0.1.4 stringi_1.8.9
## [5] hms_1.1.4 digest_0.6.39 magrittr_2.0.5 evaluate_1.0.5
## [9] grid_4.5.2 timechange_0.4.0 RColorBrewer_1.1-3 fastmap_1.2.0
## [13] scales_1.4.0 textshaping_1.0.5 jquerylib_0.1.4 cli_3.6.6
## [17] rlang_1.3.0 crayon_1.5.3 bit64_4.8.6 withr_3.0.3
## [21] cachem_1.1.0 yaml_2.3.12 otel_0.2.0 tools_4.5.2
## [25] parallel_4.5.2 tzdb_0.5.0 vctrs_0.7.3 R6_2.6.1
## [29] lifecycle_1.0.5 bit_4.6.0 vroom_1.7.1 ragg_1.5.2
## [33] pkgconfig_2.0.3 pillar_1.11.1 bslib_0.12.0 gtable_0.3.6
## [37] glue_1.8.1 systemfonts_1.3.2 xfun_0.61 tidyselect_1.2.1
## [41] knitr_1.52 farver_2.1.2 htmltools_0.5.9 labeling_0.4.3
## [45] rmarkdown_2.32 svglite_2.2.2 compiler_4.5.2 S7_0.2.214 References
Fans, feelings, and behavioral economics
- Brickman, P., Coates, D., and Janoff-Bulman, R. (1978). Lottery winners and accident victims: Is happiness relative? Journal of Personality and Social Psychology 36(8), 917-927. doi:10.1037/0022-3514.36.8.917
- Cialdini, R. B., et al. (1976). Basking in reflected glory: Three (football) field studies. Journal of Personality and Social Psychology 34(3), 366-375. doi:10.1037/0022-3514.34.3.366
- Cohen, J. (2004). Parasocial break-up from favorite television characters. Journal of Social and Personal Relationships 21(2), 187-202. doi:10.1177/0265407504041374
- Dolton, P., and MacKerron, G. (2018). Is football a matter of life and death - or is it more important than that? NIESR Discussion Paper 493.
- Kahneman, D., Fredrickson, B. L., Schreiber, C. A., and Redelmeier, D. A. (1993). When more pain is preferred to less: Adding a better end. Psychological Science 4(6), 401-405. doi:10.1111/j.1467-9280.1993.tb00589.x
- Kahneman, D., and Tversky, A. (1979). Prospect theory: An analysis of decision under risk. Econometrica 47(2), 263-291. doi:10.2307/1914185
- Kőszegi, B., and Rabin, M. (2006). A model of reference-dependent preferences. Quarterly Journal of Economics 121(4), 1133-1165. doi:10.1093/qje/121.4.1133
- Parducci, A. (1968). The relativism of absolute judgments. Scientific American 219(6), 84-90.
- Redelmeier, D. A., and Kahneman, D. (1996). Patients’ memories of painful medical treatments. Pain 66(1), 3-8. doi:10.1016/0304-3959(96)02994-6
- Wann, D. L., and Branscombe, N. R. (1993). Sports fans: Measuring degree of identification with their team. International Journal of Sport Psychology 24(1), 1-17.
- Wilder, C. Sports dynasties are good. The Wilder Things. Inspiration for the essay, including her Fandom Romance Index.
- ESPN (2019). Sports Misery Index: How miserable is each NBA fan base? FSI uses a different scale, explicit improvement and departure components, and no rivalry term.
Causal inference and difference-in-differences
- Abadie, A. (2021). Using synthetic controls: Feasibility, data requirements, and methodological aspects. Journal of Economic Literature 59(2), 391-425. doi:10.1257/jel.20191450
- Abadie, A., Diamond, A., and Hainmueller, J. (2010). Synthetic control methods for comparative case studies. Journal of the American Statistical Association 105(490), 493-505. doi:10.1198/jasa.2009.ap08746
- Angrist, J. D., and Pischke, J.-S. (2009). Mostly Harmless Econometrics: An Empiricist’s Companion. Princeton University Press. Section 5.3, fixed effects versus lagged dependent variables.
- Arkhangelsky, D., Athey, S., Hirshberg, D. A., Imbens, G. W., and Wager, S. (2021). Synthetic difference-in-differences. American Economic Review 111(12), 4088-4118. doi:10.1257/aer.20190159
- Callaway, B. (2022). Difference-in-differences for policy evaluation. In Handbook of Labor, Human Resources and Population Economics. Springer.
- Card, D., and Krueger, A. B. (1994). Minimum wages and employment: A case study of the fast-food industry in New Jersey and Pennsylvania. American Economic Review 84(4), 772-793. NBER working paper
- Conley, T. G., and Taber, C. R. (2011). Inference with “difference in differences” with a small number of policy changes. Review of Economics and Statistics 93(1), 113-125. doi:10.1162/REST_a_00049
- Daw, J. R., and Hatfield, L. A. (2018). Matching and regression to the mean in difference-in-differences analysis. Health Services Research 53(6), 4138-4156. doi:10.1111/1475-6773.12993
- Ding, P., and Li, F. (2019). A bracketing relationship between difference-in-differences and lagged-dependent-variable adjustment. Political Analysis 27(4), 605-615. doi:10.1017/pan.2019.25
- Gelman, A., and Loken, E. (2014). The statistical crisis in science. American Scientist 102(6).
- Imbens, G. W., and Rubin, D. B. (2015). Causal Inference for Statistics, Social, and Biomedical Sciences. Cambridge University Press.
- Rambachan, A., and Roth, J. (2023). A more credible approach to parallel trends. Review of Economic Studies 90(5), 2555-2591. doi:10.1093/restud/rdad018
- Roth, J. (2022). Pretest with caution: Event-study estimates after testing for parallel trends. American Economic Review: Insights 4(3), 305-322. doi:10.1257/aeri.20210236
- Wooldridge, J. M. (2020). Introductory Econometrics: A Modern Approach, 7th ed. Cengage. Chapter 3, on multicollinearity.
Regression to the mean and forecasting
- Angelopoulos, A. N., and Bates, S. (2023). A gentle introduction to conformal prediction and distribution-free uncertainty quantification. arXiv:2107.07511.
- FiveThirtyEight. How we calculate NBA Elo ratings (Internet Archive copy; the original site now redirects).
- Galton, F. (1886). Regression towards mediocrity in hereditary stature. Journal of the Anthropological Institute of Great Britain and Ireland 15, 246-263.
- Hyndman, R. J., and Athanasopoulos, G. (2021). Forecasting: Principles and Practice, 3rd ed. OTexts.
- Schall, T., and Smith, G. (2000). Do baseball players regress toward the mean? The American Statistician 54(4), 231-235. doi:10.1080/00031305.2000.10474553
- Tashman, L. J. (2000). Out-of-sample tests of forecasting accuracy: An analysis and review. International Journal of Forecasting 16(4), 437-450.
Data and events
- SportsDataverse. Public
ESPN schedule archives. Snapshot downloaded September 23, 2026; URLs
and checksums in
download-manifest.csv. - Howell, J. Historical college football scores. FBS seasons 1997-2000.
- Wikipedia. List of 2016-17 NBA season transactions, 2017-18, 2018-19, and List of NBA All-Stars, checked September 2026, for the big-move screen; the coaching-change tables on its 2021, 2022, and 2023 NCAA Division I FBS football season pages, checked September 2026, for the coaching-change screen.
- 247Sports. Composite team rankings, classes 2017-2024.
- NBA. Championship history. College Football Playoff. Championship history.
- Comparison-team events are sourced individually in the table in the departure section; essay-specific sources (games, trades, attendance) are in the essay’s notes.