WHITE BELT https://jafranceschini.quarto.pub/juan-franceschini-lab/posts/ An exploration of data, curiosity, and discovery. quarto-1.10.18 Sat, 10 Oct 2026 03:00:00 GMT Today’s Red Card Is Too Harsh on the Team, and Arbitrary Juan Franceschini https://jafranceschini.quarto.pub/juan-franceschini-lab/posts/post-with-code/ten-men/

Executive summary

Today’s red card is too harsh on the offending team. It strips the team of half its attack, keeps doing so until the final whistle, and charges a price set by the clock rather than the foul.

  1. It halves the team’s attack and hands the match to the opponent. In the 20 minutes after a red card, the ten-man side creates about half the chances of matched 11-v-11 games, and its share of the match’s chances falls from 44% to 27%.
  2. The punishment never ends. After 40 minutes a ten-man side is as outgunned as after ten, while the opponent’s advantage keeps growing.
  3. The price is set by the clock, not the foul. A red card costs the team 0.34 points per game on average: 0.91 points before half-time, 0.06 after the 75th minute.

Where we go from here: keep the sending-off and the ban for the player, and replace the team’s open-ended penalty with a 20-minute power play. The team is still punished, at about 0.21 points, but the punishment is limited, not perpetual.

The thesis: a red card punishes the team far more than the offence deserves

A red card is meant to punish a player for a serious offence. In practice the heavier punishment falls on his team: ten players who did nothing wrong play the rest of the match a man short, however long that is. The evidence below, drawn from 292 red cards in 1,140 matches across the 2015/16 Premier League, La Liga and Serie A, shows how large, how lasting and how arbitrary that team penalty is.

A red card halves the team’s attack and hands the match to the opponent

Show the code: chart 1, chances around the red card 
bins <- seq(-20, 15, 5)
tilt <- rbindlist(lapply(c("focal", "opponent"), function(r) rbindlist(lapply(bins, function(b) {
  e <- est(sets, "npxg", r, after = c(b, b + 5))
  data.table(role = r, start = b, mid = b + 2.5, treated = e$treated_after, control = e$control_after)
}))))
tilt[, role_lab := factor(ifelse(role == "focal", "The team down to ten", "Their opponent"), c("The team down to ten", "Their opponent"))]
tilt_long <- melt(tilt, id.vars = c("role", "role_lab", "start", "mid"), variable.name = "group", value.name = "rate")
tilt_long[, colour := fifelse(group == "control", GREY, fifelse(role == "focal", RED, BLUE))]
tilt_long[, tip := sprintf("<b>%s</b><br>%d to %d min from the red<br>%s: %s npxG per 20'", role_lab, start, start + 5,
                           ifelse(group == "control", "Matched 11-v-11 games", "Red-card games"), num(rate))]
p1 <- ggplot(tilt_long, aes(mid, rate, group = group)) +
  annotate("rect", xmin = 0, xmax = 20, ymin = -Inf, ymax = Inf, fill = "#fbeeec") +
  geom_vline(xintercept = 0, colour = RED, linewidth = .6) +
  geom_line(aes(colour = colour, linetype = group), linewidth = 1.1) +
  geom_point_interactive(aes(colour = colour, tooltip = tip, data_id = paste(role, group, start)), size = 2.8) +
  geom_text(data = tilt_long[start == 15], aes(label = ifelse(group == "control", "Twins", "With a red"), colour = colour),
            hjust = 0, nudge_x = .9, size = 3.4, fontface = "bold") +
  annotate("text", x = .6, y = Inf, label = "Red card", hjust = 0, vjust = 1.6, size = 3.3, colour = RED, fontface = "bold") +
  facet_wrap(~ role_lab) + scale_colour_identity() + scale_linetype_manual(values = c(treated = "solid", control = "22")) +
  scale_x_continuous(breaks = seq(-20, 20, 10), labels = function(x) ifelse(x > 0, paste0("+", x), x), expand = expansion(add = c(1, 7))) +
  scale_y_continuous(limits = c(0, NA), expand = expansion(mult = c(0, .12))) +
  labs(title = "The red card flips who is attacking",
       subtitle = sprintf("Non-penalty expected goals (npxG) per 20 minutes around the first red card (%d cases) vs matched 11-v-11 twins", length(sets)),
       x = "Minutes from the red card", y = "npxG per 20 minutes") +
  coord_cartesian(clip = "off") + theme_sb()
sb_chart(p1, 4.8)
Data: StatsBomb Open Data · 2015/16 Premier League, La Liga and Serie A StatsBomb

Before the card, the team that will be reduced to ten creates chances exactly like its matched 11-v-11 twins. In the 20 minutes after it, its non-penalty expected goals fall by 0.13 per 20 minutes [−0.17, −0.09], about half of what it would otherwise create, and the opponent’s rise by 0.10 [+0.05, +0.14]. The ten-man side’s share of the match’s chances drops from 44% to 27%.

So what One player’s offence turns an even contest into one-way traffic. Ten teammates carry the cost, and the opponent collects a reward it did nothing to earn.

The punishment never ends: after 40 minutes the gap is as wide as after ten

Show the code: chart 2, the 40-minute cohort 
per <- rbindlist(lapply(c("focal", "opponent"), function(r) rbindlist(lapply(list(c(0, 20), c(20, 40)), function(w) {
  e <- est(long, "npxg", r, after = w); cbind(role = r, window = sprintf("%d to %d minutes after", w[1], w[2]), e)
}))))
per[, role_lab := factor(c(focal = "Team down to ten", opponent = "Opponent")[role], c("Team down to ten", "Opponent"))]
per[, colour := c(focal = RED, opponent = BLUE)[role]]
per[, tip := sprintf("<b>%s</b>, %s the red<br>%s npxG per 20' vs twins<br>95%% interval %s<br>%d red cards", role_lab, window, signed(estimate), ci(lo, hi), n)]
p2 <- ggplot(per, aes(estimate, window, colour = colour)) +
  geom_vline(xintercept = 0, colour = "#bdbdbd") +
  geom_linerange(aes(xmin = lo, xmax = hi), linewidth = 1.3) +
  geom_point_interactive(aes(tooltip = tip, data_id = paste(role, window)), size = 3.8) +
  geom_text(aes(label = signed(estimate)), vjust = -1.1, size = 3.5, fontface = "bold") +
  facet_wrap(~ role_lab) + scale_colour_identity() + scale_y_discrete(limits = rev) + scale_x_continuous(labels = signed) +
  labs(title = "No recovery: the second 20 minutes are as lopsided as the first",
       subtitle = sprintf("Change in npxG per 20 minutes vs matched 11-v-11 twins, games that stayed 11-v-10 for 40+ minutes (%d cases)", length(long)),
       x = "npxG per 20 minutes vs twins (with 95% interval)", y = NULL) +
  theme_sb() + theme(panel.grid.major.y = element_blank(), panel.grid.major.x = element_line(colour = "#eeeeee"), axis.text.y = element_text(colour = INK))
sb_chart(p2, 3)
Data: StatsBomb Open Data · 2015/16 Premier League, La Liga and Serie A StatsBomb
Show the code: chart 2, the 40-minute cohort 
own_20 <- per[role == "focal" & window == "0 to 20 minutes after", estimate]; own_40 <- per[role == "focal" & window == "20 to 40 minutes after", estimate]
opp_20 <- per[role == "opponent" & window == "0 to 20 minutes after", estimate]; opp_40 <- per[role == "opponent" & window == "20 to 40 minutes after", estimate]

Teams don’t adapt to playing with ten. In the 44 games that stayed 11-v-10 for at least 40 minutes, the ten-man side was 0.14 npxG per 20 minutes behind its twins in the first 20 minutes and 0.16 behind in the next 20. The opponent’s advantage grew, from +0.07 to +0.14.

So what The team penalty has no end point. Every extra minute at ten is another minute of the same handicap, and the opponent’s reward accumulates until the final whistle.

The price of a red card is set by the clock, not by the foul

Show the code: chart 3, points lost by minute of the red card 
by_time[, tip := sprintf("<b>Red card at %s</b><br>Ten-man side: %s points per game<br>Matched twins: %s<br>Cost: %s points, 95%% interval [%s, %s]<br>%d red cards",
                         bucket, num(ten), num(twins), num(cost), num(lo), num(hi), n)]
p3 <- ggplot(by_time, aes(bucket, cost)) +
  geom_hline(yintercept = 0, colour = "#bdbdbd") +
  geom_col_interactive(aes(tooltip = tip, data_id = bucket), fill = RED, width = .62) +
  geom_errorbar(aes(ymin = lo, ymax = hi), width = .12, colour = INK, linewidth = .5) +
  geom_text(aes(y = hi, label = num(cost)), vjust = -.7, fontface = "bold", size = 4, colour = INK) +
  scale_y_continuous(expand = expansion(mult = c(.02, .14))) +
  labs(title = sprintf("The same red card is %d times more expensive early than late", round(ratio)),
       subtitle = sprintf("Points lost per game by the ten-man side vs matched 11-v-11 games, by minute of the red card (%d red cards, 95%% intervals)", nrow(per_card)),
       x = "Minute of the red card", y = "Points lost per game") +
  theme_sb() + theme(axis.text.x = element_text(colour = INK, face = "bold", size = 11))
sb_chart(p3, 3.9)
Data: StatsBomb Open Data · 2015/16 Premier League, La Liga and Serie A StatsBomb

A team reduced to ten before half-time took 0.30 points per game, against 1.21 for matched games that stayed 11-v-11: a cost of 0.91 points. The same card after the 75th minute cost 0.06. Every ten minutes left on the clock adds 0.16 points to the bill.

So what The identical tackle in the 30th and the 80th minute carries a 15-fold difference in punishment. A sanction priced by the clock is arbitrary, and the arbitrariness lands on the team.

How the evidence was built

  • Data. StatsBomb event data for every match of the 2015/16 Premier League, La Liga and Serie A: 1,140 matches, 292 on-field red cards and every shot with its expected-goals value, plus pre-match bookmaker odds from Football-Data.co.uk.
  • Match states. From the raw events I rebuilt the score, the players on the pitch and each team’s chances, second by second, for every match.
  • Matched twins. Each red card is compared with up to five games from the same league that were still 11-v-11 at the same minute of the same half, with the same score difference, the same team at home or away, the same pre-match favourite (win probability within 0.15) and the most similar attacking output by both teams over the previous 20 minutes.
  • Effect. The effect of a red card is the change in the ten-man game minus the change in its twins over the same window, estimated by weighted least squares with standard errors clustered by match.
  • Cohorts. Chance creation: 99 first red cards with 20 clean minutes before and after. Persistence: the 44 of those that stayed 11-v-10 for 40 minutes. Points: all 212 first red cards from the 20th minute on, measured to the final whistle.

The results point the same way in every league, for straight reds and second yellows, with penalty and goalkeeper reds included, and under every alternative specification tested (appendix).

Where do we go from here? A 20-minute power play

The fix is to separate the two punishments. The player is sent off for the rest of the match and banned as he is today. The team serves a fixed 20-minute power play, a man short, then returns to eleven with a substitute.

Show the code: chart 4, the rule today vs the proposal 
seg <- data.table(
  rule = factor(rep(c("Today", "Proposed: 20-minute power play"), each = 3), c("Proposed: 20-minute power play", "Today")),
  from = c(0, 30, 30, 0, 30, 50), to = c(30, 95, 95, 30, 50, 95),
  state = c("11 v 11", "11 v 10", "11 v 10", "11 v 11", "11 v 10", "11 v 11 again"))
seg <- unique(seg)
seg[, fill := c("11 v 11" = "#e6e6e6", "11 v 10" = RED, "11 v 11 again" = "#bfbfbf")[state]]
seg[, tip := sprintf("<b>%s</b><br>Minutes %d to %d: %s", rule, from, to, state)]
p4 <- ggplot(seg) +
  geom_rect_interactive(aes(xmin = from, xmax = to, ymin = as.numeric(rule) - .32, ymax = as.numeric(rule) + .32, fill = fill, tooltip = tip, data_id = paste(rule, from)), colour = "white", linewidth = 1) +
  geom_text(aes(x = (from + to) / 2, y = as.numeric(rule), label = state, colour = ifelse(state == "11 v 10", "white", INK)), fontface = "bold", size = 3.8) +
  geom_vline(xintercept = 30, colour = INK, linetype = "22") +
  annotate("text", x = 30, y = 2.62, label = "Red card in the 30th minute", hjust = 0, nudge_x = .8, size = 3.4, fontface = "bold", colour = INK) +
  annotate("text", x = 72.5, y = .52, label = "Back to 11 · the offender stays off and is banned", hjust = .5, size = 3.2, colour = MUTED) +
  scale_fill_identity() + scale_colour_identity() +
  scale_y_continuous(breaks = 1:2, labels = levels(seg$rule), limits = c(.4, 2.75)) +
  scale_x_continuous(breaks = seq(0, 90, 15), labels = function(x) paste0(x, "'")) +
  labs(title = "A real punishment for the team, with an end point",
       subtitle = "How a 30th-minute red card plays out under today's rule and under a 20-minute power play",
       x = "Match minute", y = NULL) +
  theme_sb() + theme(panel.grid = element_blank(), axis.text.y = element_text(colour = INK, face = "bold", size = 11))
sb_chart(p4, 2.8, note = "Illustration of the proposed rule")
Illustration of the proposed rule StatsBomb

The power play still punishes the team, and meaningfully so. During those 20 minutes the offending side creates 0.13 fewer npxG and the opponent 0.10 more than in matched games. In points, a red card that leaves a team a man down for 20 minutes costs about 0.21 points (95% interval 0.10 to 0.33). The difference is that the punishment is limited, not perpetual, and identical for every foul, whether it happens in the 10th minute or the 80th.

This is how other major team sports already handle their most serious fouls: the offender is removed, the opponent is compensated, and the team’s penalty has an end point.

Sport Most serious foul The player The team The opponent gets
Basketball (NBA) Flagrant 2 foul Ejected, can be suspended Keeps 5 players Two free throws and possession
American football (NFL) Flagrant hit, e.g. on the quarterback Can be ejected and suspended Keeps 11 players A 15-yard penalty and an automatic first down
Ice hockey (NHL) Match penalty Ejected, suspension reviewed One player short for 5 minutes, then back to full strength A 5-minute power play
Rugby union Red card under the 20-minute trial Off for the rest of the match One short for 20 minutes, then a replacement A 20-minute numerical advantage
Football Red card Off for the match, banned for future matches One short until the final whistle An advantage of unlimited length

Ice hockey’s timed power play is the closest model, and rugby union’s 20-minute red card applies the same logic. In basketball and American football the team is never reduced at all; the opponent is compensated with free throws or field position. Football is the only one of these sports where a single foul can decide the remaining hour of a match.

The recommendation Keep the red card for the player. Cap it for the team. A 20-minute power play preserves a real punishment, removes the clock as the judge of how big it is, and brings football in line with the sports that already got this right.

Back to top

Appendix: robustness and code

Show the code: the five-minute gap and every sensitivity check 
donut_sets <- Filter(function(s) s$time >= 1500, lapply(sets, function(s) {
  s$donors <- Filter(function(d) d$time >= 1500, s$donors); if (length(s$donors) >= 3) s else list(time = 0) }))
broad <- match_design(f, broad = TRUE); three <- match_design(f, k = 3); narrow <- match_design(f, caliper = .10)
subset_sets <- function(cond) Filter(cond, sets)
checks <- list(
  "Main analysis" = list(sets, c(0, 20), c(-20, 0)),
  "5-minute gap before the card" = list(donut_sets, c(0, 20), c(-25, -5)),
  "Skip the first 2 minutes after" = list(sets, c(2, 20), c(-20, 0)),
  "England only" = list(subset_sets(function(s) s$game$league == "England"), c(0, 20), c(-20, 0)),
  "Spain only" = list(subset_sets(function(s) s$game$league == "Spain"), c(0, 20), c(-20, 0)),
  "Italy only" = list(subset_sets(function(s) s$game$league == "Italy"), c(0, 20), c(-20, 0)),
  "Second yellows only" = list(subset_sets(function(s) s$card$type == "Second Yellow"), c(0, 20), c(-20, 0)),
  "Straight reds only" = list(subset_sets(function(s) s$card$type == "Red Card"), c(0, 20), c(-20, 0)),
  "Include penalty and keeper reds" = list(broad, c(0, 20), c(-20, 0)),
  "3 twins instead of 5" = list(three, c(0, 20), c(-20, 0)),
  "Tighter strength match" = list(narrow, c(0, 20), c(-20, 0)))
rob <- rbindlist(lapply(names(checks), function(k) rbindlist(lapply(c("focal", "opponent", "total"), function(r) {
  x <- checks[[k]]; cbind(check = k, role = r, est(x[[1]], "npxg", r, after = x[[2]], before = x[[3]]))
}))))
rob[, check := factor(check, rev(names(checks)))]
rob[, role_lab := factor(c(focal = "Team down to ten", opponent = "Opponent", total = "Both teams combined")[role], c("Team down to ten", "Opponent", "Both teams combined"))]
rob[, colour := ifelse(check == "Main analysis", c(focal = RED, opponent = BLUE, total = INK)[role], GREY)]
rob[, tip := sprintf("<b>%s</b><br>%s: %s npxG per 20'<br>95%% interval %s<br>%d red cards", check, role_lab, signed(estimate), ci(lo, hi), n)]
donut_placebo <- est(donut_sets, "npxg", "opponent", before = c(-25, -15), after = c(-15, -5))
p5 <- ggplot(rob, aes(estimate, check, colour = colour)) +
  geom_vline(xintercept = 0, colour = "#bdbdbd") +
  geom_linerange(aes(xmin = lo, xmax = hi), linewidth = .9) +
  geom_point_interactive(aes(tooltip = tip, data_id = paste(check, role)), size = 2.8) +
  facet_wrap(~ role_lab, ncol = 3) + scale_colour_identity() + scale_x_continuous(labels = signed) +
  labs(title = "Every version of the analysis tells the same story",
       subtitle = "Change in npxG per 20 minutes after the red vs matched twins, with 95% intervals",
       x = "npxG per 20 minutes vs twins", y = NULL) +
  theme_sb() + theme(panel.grid.major.y = element_line(colour = "#f2f2f2"), axis.text.y = element_text(colour = INK, size = 10))
sb_chart(p5, 5.4)
Data: StatsBomb Open Data · 2015/16 Premier League, La Liga and Serie A StatsBomb

The ten-man side’s drop appears in every league, for straight reds and second yellows, with penalty and goalkeeper reds included, with three twins instead of five, with a tighter match on team strength, skipping the first two minutes after the card, and leaving a five-minute gap before it. Across every specification, the combined threat of both teams stays close to zero (−0.03 npxG per 20 minutes in the main analysis): a red card doesn’t change how much football is played, only who gets to play it.

The analysis was first written in Python and rebuilt here in R from the raw event files, reproducing every original estimate to four decimal places.

Data. Event data: StatsBomb Open Data (2015/16 Premier League, La Liga, Serie A). Pre-match odds: Football-Data.co.uk. fetch.R downloads the raw files and prep.R rebuilds the match states.

Show the code: setup and chart style 
library(data.table)
library(ggplot2)
library(ggiraph)

RED <- "#d7301f"; BLUE <- "#2b6cb0"; GREY <- "#8a8f98"; INK <- "#1d1d1f"; MUTED <- "#5f6368"

theme_sb <- function() {
  theme_minimal(base_family = "Helvetica", base_size = 12) +
    theme(plot.title = element_text(face = "bold", size = 16, colour = INK, margin = margin(b = 4)),
          plot.subtitle = element_text(colour = MUTED, size = 11.5, margin = margin(b = 12)),
          plot.title.position = "plot",
          panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(),
          panel.grid.major.y = element_line(colour = "#e8e8e8", linewidth = .35),
          axis.title = element_text(colour = MUTED, size = 10), axis.text = element_text(colour = MUTED),
          strip.text = element_text(face = "bold", size = 12, hjust = 0, colour = INK),
          legend.position = "none", plot.background = element_rect(fill = "white", colour = NA))
}

# Every chart: interactive SVG + the StatsBomb credit line their data terms require
sb_chart <- function(p, height = 4.6, note = "Data: StatsBomb Open Data · 2015/16 Premier League, La Liga and Serie A") {
  htmltools::tagList(
    girafe(ggobj = p, width_svg = 9, height_svg = height,
           options = list(opts_tooltip(css = "background:#1d1d1f;color:#fff;padding:6px 9px;border-radius:4px;font:12px Helvetica,Arial,sans-serif;", opacity = .96),
                          opts_hover(css = "stroke-width:3;"), opts_toolbar(saveaspng = FALSE), opts_sizing(rescale = TRUE))),
    htmltools::div(class = "sb-source", htmltools::span(note), htmltools::img(src = "statsbomb-logo.png", alt = "StatsBomb")))
}
pct <- function(x, d = 0) paste0(formatC(100 * x, format = "f", digits = d), "%")
num <- function(x, d = 2) formatC(x, format = "f", digits = d)
signed <- function(x, d = 2) { r <- round(x, d); paste0(ifelse(r > 0, "+", ifelse(r < 0, "−", "")), formatC(abs(r), format = "f", digits = d)) }
ci <- function(lo, hi, d = 2) paste0("[", signed(lo, d), ", ", signed(hi, d), "]")
fmt_p <- function(x) if (x < .001) "<0.001" else sprintf("%.3f", x)
Show the code: the matching and estimation engine (functions.R) 
# Red cards — matched event study in R.
# Re-implements red_card_matched_study/analyse.py (same eligibility, matching and
# clustered WLS inference). Shared by replicate.R and the White Belt article.

library(data.table)

load_features <- function(path = "data/features.rds") {
  f <- readRDS(path)
  # Fast lookup: per match x side x metric, sorted times and a cumulative sum
  parts <- split(f$metrics, by = c("match_id", "side", "metric"), keep.by = FALSE)   # names "<match>.<side>.<metric>"
  f$idx <- list2env(lapply(parts, function(d) list(t = d$time, cs = c(0, cumsum(d$value)))), hash = TRUE)
  f$goals <- split(f$metrics[metric == "goals", .(time, side)], f$metrics[metric == "goals", match_id])
  f
}

# Sum of a metric for one side in [left, right) seconds of elapsed match time
measure <- function(f, mid, side, metric, left, right) {
  z <- f$idx[[paste(mid, side, metric, sep = ".")]]
  if (is.null(z)) return(0)
  z$cs[findInterval(right, z$t, left.open = TRUE) + 1] - z$cs[findInterval(left, z$t, left.open = TRUE) + 1]
}

scores_at <- function(f, mid, t) {
  g <- f$goals[[as.character(mid)]]
  if (is.null(g)) return(c(0, 0))
  c(sum(g$time < t & g$side == 0), sum(g$time < t & g$side == 1))
}

win_prob <- function(game, side) if (side == 0) game$p_home else game$p_away

FEATURES  <- c("win_probability", "goals_at_index", "pre_npxg_focal", "pre_npxg_opponent",
               "pre_shots_focal", "pre_shots_opponent", "pre_passes_focal", "pre_passes_opponent")
MIN_SCALE <- c(.10, 1, .20, .20, 2, 2, 30, 30)

feature <- function(f, game, side, t, scores) {
  m <- function(s, k) measure(f, game$match_id, s, k, t - 1200, t)
  c(win_prob(game, side), sum(scores),
    m(side, "npxg"), m(1 - side, "npxg"), m(side, "np_shots"), m(1 - side, "np_shots"),
    m(side, "passes"), m(1 - side, "passes"))
}

first_red <- function(f, mid) { r <- f$reds[match_id == mid]; if (nrow(r)) r[order(time)] else NULL }

eligible <- function(f, game, horizon = 20, broad = FALSE) {
  r <- first_red(f, game$match_id)
  if (is.null(r)) return(list(why = "no_red"))
  c1 <- r[1]; t <- c1$time
  if (t < 1200) return(list(why = "under_20min_pre"))
  later <- if (nrow(r) > 1) r$time[-1] else numeric()
  if (min(c(game$end, later)) < t + horizon * 60) return(list(why = "insufficient_stable_followup"))
  po <- f$perm_off[match_id == game$match_id, time]
  if (any(po < t + horizon * 60)) return(list(why = "permanent_off"))
  if (!broad && c1$penalty) return(list(why = "penalty_linked"))
  if (!broad && c1$goalkeeper) return(list(why = "goalkeeper"))
  list(card = c1, why = NA)
}

# Build matched sets: same league, half, within-half clock, home/away orientation and score
# difference; caliper on pre-match win probability; up to k nearest donors by standardized RMS.
match_design <- function(f, horizon = 20, broad = FALSE, k = 5, caliper = .15) {
  games <- f$games; sets <- list(); reasons <- character()
  for (gi in seq_len(nrow(games))) {
    g <- games[gi]; el <- eligible(f, g, horizon, broad)
    if (!is.na(el$why)) { if (el$why != "no_red") reasons <- c(reasons, el$why); next }
    cd <- el$card; side <- cd$side; t <- cd$time
    score <- c(cd$home_before, cd$away_before); diff <- score[side + 1] - score[2 - side]
    xt <- feature(f, g, side, t, score)
    donors <- games[league == g$league & match_id != g$match_id]
    pool <- list()
    for (di in seq_len(nrow(donors))) {
      d <- donors[di]
      half_len <- if (cd$period == 1) d$half_end else d$end - d$half_end
      if (cd$half_time >= half_len) next
      anchor <- cd$half_time + if (cd$period == 2) d$half_end else 0
      if (anchor < 1200 || anchor + horizon * 60 > d$end) next
      dr <- first_red(f, d$match_id)
      if (!is.null(dr) && dr$time[1] < anchor + horizon * 60) next
      if (any(f$perm_off[match_id == d$match_id, time] < anchor + horizon * 60)) next
      ds <- scores_at(f, d$match_id, anchor)
      if (ds[side + 1] - ds[2 - side] != diff) next
      pool[[length(pool) + 1]] <- list(match_id = d$match_id, game = d, time = anchor, x = feature(f, d, side, anchor, ds))
    }
    if (!length(pool)) { reasons <- c(reasons, "no_exact_stratum"); next }
    X <- do.call(rbind, lapply(pool, `[[`, "x"))
    sdv <- apply(X, 2, function(v) sqrt(mean((v - mean(v))^2)))           # population SD, as numpy
    scale <- pmax(sdv, MIN_SCALE)
    dist <- sqrt(rowMeans(sweep(sweep(X, 2, xt), 2, scale, "/")^2))
    ok <- which(abs(X[, 1] - xt[1]) <= caliper & dist <= 1.5)
    ok <- ok[order(dist[ok], vapply(pool[ok], `[[`, 0, "match_id"))]
    if (length(ok) < 3) { reasons <- c(reasons, "fewer_than_3_donors"); next }
    chosen <- lapply(head(ok, k), function(j) c(pool[[j]], distance = dist[j]))
    sets[[length(sets) + 1]] <- list(game = g, card = cd, side = side, time = t, xt = xt, donors = chosen,
                                     pool_mean = colMeans(X), pool_second = colMeans(X^2))
  }
  attr(sets, "reasons") <- table(reasons)
  sets
}

# Matched difference-in-differences: treated change minus mean donor change, per 20 minutes.
# Equivalent to WLS with matched-set intercepts; sandwich SEs clustered by source match.
estimate <- function(f, sets, metric, after = c(0, 20), before = c(-20, 0), role = "focal") {
  n <- length(sets)
  rate <- function(mid, side, t, w) {
    sides <- if (role == "total") 0:1 else side
    sum(vapply(sides, function(s) measure(f, mid, s, metric, t + w[1] * 60, t + w[2] * 60), 0)) / diff(w) * 20
  }
  yt <- tb <- ta <- cb <- ca <- numeric(n); yc <- vector("list", n); flat <- list()
  for (i in seq_len(n)) {
    s <- sets[[i]]; side <- if (role == "opponent") 1 - s$side else s$side
    pre <- rate(s$game$match_id, side, s$time, before); post <- rate(s$game$match_id, side, s$time, after)
    tb[i] <- pre; ta[i] <- post; yt[i] <- post - pre
    dv <- t(vapply(s$donors, function(d) c(rate(d$match_id, side, d$time, before), rate(d$match_id, side, d$time, after)), c(0, 0)))
    cb[i] <- mean(dv[, 1]); ca[i] <- mean(dv[, 2]); yc[[i]] <- dv[, 2] - dv[, 1]
    flat[[i]] <- data.table(set = i, cluster = c(s$game$match_id, vapply(s$donors, `[[`, 0, "match_id")),
                            w = c(1, rep(1 / nrow(dv), nrow(dv))), z = c(.5, rep(-.5, nrow(dv))), y = c(post - pre, yc[[i]]))
  }
  cm <- vapply(yc, mean, 0); beta <- mean(yt - cm); alpha <- (yt + cm) / 2
  fl <- rbindlist(flat); fl[, u := w * z * (y - alpha[set] - beta * z)]
  g <- fl[, .(u = sum(u)), by = cluster]
  N <- nrow(fl); p <- n + 1; ng <- nrow(g)
  correction <- ng / (ng - 1) * (N - 1) / (N - p)
  se <- sqrt(sum(g$u^2) / (.5 * n)^2 * correction); crit <- qt(.975, n - 1)
  data.table(n = n, estimate = beta, se = se, lo = beta - crit * se, hi = beta + crit * se,
             p = 2 * pt(abs(beta / se), n - 1, lower.tail = FALSE),
             treated_before = mean(tb), treated_after = mean(ta), control_before = mean(cb), control_after = mean(ca),
             benchmark_after = mean(tb) + mean(ca) - mean(cb))
}
Show the code: build the matched comparisons and every number quoted in the text 
f <- load_features("data/features.rds")
n_games <- nrow(f$games); n_reds <- nrow(f$reds)

# 1. Mechanism: 20 clean minutes before and after the first red (no penalty/keeper reds)
sets <- match_design(f)
est  <- function(s, metric = "npxg", role = "focal", ...) estimate(f, s, metric, role = role, ...)
own  <- est(sets, role = "focal"); opp <- est(sets, role = "opponent"); tot <- est(sets, role = "total")
pre_placebo <- est(sets, "npxg", "opponent", before = c(-20, -10), after = c(-10, 0))

# 2. Persistence: games that stay 11-v-10 for 40 minutes
long <- match_design(f, horizon = 40)

# 3. Cost and timing: every first red from minute 20, matched at the card, outcome = final points
all_sets <- match_design(f, horizon = 1, broad = TRUE)
points_of <- function(game, side) {
  gf <- if (side == 0) game$home_score else game$away_score; ga <- if (side == 0) game$away_score else game$home_score
  if (gf > ga) 3 else if (gf == ga) 1 else 0
}
points_gap <- function(S) {          # matched difference in final points, clustered by source match
  pl <- rbindlist(lapply(seq_along(S), function(i) { s <- S[[i]]
    rbind(data.table(set = i, cluster = s$game$match_id, w = 1, z = .5, y = points_of(s$game, s$side)),
          data.table(set = i, cluster = vapply(s$donors, `[[`, 0, "match_id"), w = 1 / length(s$donors), z = -.5,
                     y = vapply(s$donors, function(d) points_of(d$game, s$side), 0))) }))
  pt <- pl[, .(tr = y[z > 0], cm = sum(w[z < 0] * y[z < 0])), by = set]
  b <- mean(pt$tr - pt$cm); a <- (pt$tr + pt$cm) / 2
  pl[, u := w * z * (y - a[set] - b * z)]; g <- pl[, .(u = sum(u)), by = cluster]; n <- nrow(pt); N <- nrow(pl)
  se <- sqrt(sum(g$u^2) / (.5 * n)^2 * nrow(g) / (nrow(g) - 1) * (N - 1) / (N - n - 1)); cr <- qt(.975, n - 1)
  data.table(n = n, ten = mean(pt$tr), twins = mean(pt$cm), cost = -b, lo = -(b + cr * se), hi = -(b - cr * se))
}
card_min <- vapply(all_sets, function(s) s$time / 60, 0)
buckets  <- cut(card_min, c(20, 45, 60, 75, Inf), right = FALSE, labels = c("20–45 min", "45–60 min", "60–75 min", "75+ min"))
cost_all <- points_gap(all_sets)
by_time  <- rbindlist(lapply(levels(buckets), function(b) cbind(bucket = b, points_gap(all_sets[buckets == b]))))
by_time[, bucket := factor(bucket, levels(buckets))]

# Cost as a function of time left at the card -> what a 20-minute power play would cost
per_card <- rbindlist(lapply(all_sets, function(s) data.table(
  left = (s$game$end - s$time) / 60,
  gap = mean(vapply(s$donors, function(d) points_of(d$game, s$side), 0)) - points_of(s$game, s$side))))
fit <- lm(gap ~ left, per_card)
per10 <- 10 * coef(fit)[["left"]]
pp20  <- predict(fit, data.frame(left = 20), interval = "confidence")
ratio <- by_time[bucket == "20–45 min", cost] / by_time[bucket == "75+ min", cost]   # early vs late price

# 4. Share of the match's chances, 20 minutes before and after the card
sh <- rbindlist(lapply(sets, function(s) {
  w <- function(mid, side, t, a, b) measure(f, mid, side, "npxg", t + a * 60, t + b * 60)
  tr <- c(w(s$game$match_id, s$side, s$time, -20, 0), w(s$game$match_id, 1 - s$side, s$time, -20, 0),
          w(s$game$match_id, s$side, s$time, 0, 20), w(s$game$match_id, 1 - s$side, s$time, 0, 20))
  dn <- rowMeans(vapply(s$donors, function(d) c(w(d$match_id, s$side, d$time, -20, 0), w(d$match_id, 1 - s$side, d$time, -20, 0),
                                                 w(d$match_id, s$side, d$time, 0, 20), w(d$match_id, 1 - s$side, d$time, 0, 20)), numeric(4)))
  data.table(t1 = tr[1], t2 = tr[2], t3 = tr[3], t4 = tr[4], c1 = dn[1], c2 = dn[2], c3 = dn[3], c4 = dn[4])
}))
share_before <- sum(sh$t1) / sum(sh$t1 + sh$t2); share_after <- sum(sh$t3) / sum(sh$t3 + sh$t4)
twin_before  <- sum(sh$c1) / sum(sh$c1 + sh$c2); twin_after  <- sum(sh$c3) / sum(sh$c3 + sh$c4)
Show the code: fetch.R (download the raw data) 
# Download the raw inputs used by prep.R (run once, from this folder).
# StatsBomb Open Data (hudl/open-data) and Football-Data.co.uk 2015/16 odds.
base <- "https://raw.githubusercontent.com/statsbomb/open-data/master/data/"
leagues <- c(England = 2, Spain = 11, Italy = 12)
odds <- c(England = "E0", Spain = "SP1", Italy = "I1")
dir.create("raw/events", recursive = TRUE, showWarnings = FALSE); dir.create("raw/sources", showWarnings = FALSE)
for (l in names(leagues)) {
  mf <- sprintf("raw/sources/matches_%s.json", l)
  if (!file.exists(mf)) download.file(sprintf("%smatches/%d/27.json", base, leagues[[l]]), mf, quiet = TRUE)
  of <- sprintf("raw/sources/odds_%s.csv", l)
  if (!file.exists(of)) download.file(sprintf("https://www.football-data.co.uk/mmz4281/1516/%s.csv", odds[[l]]), of, quiet = TRUE)
  for (id in jsonlite::fromJSON(mf)$match_id) {
    ef <- sprintf("raw/events/%d.json.gz", id)
    if (file.exists(ef)) next
    tmp <- tempfile(); download.file(sprintf("%sevents/%d.json", base, id), tmp, quiet = TRUE)
    con <- gzfile(ef, "wb"); writeBin(readBin(tmp, "raw", file.size(tmp)), con); close(con)
  }
}
cat(length(list.files("raw/events")), "event files ready\n")
Show the code: prep.R (rebuild match states and metrics from raw events) 
# Red cards — rebuild match states and event metrics from raw StatsBomb events.
# An R re-implementation of red_card_matched_study/build_features.py (same rules),
# reading raw/events/<match_id>.json.gz and raw/sources/. Writes data/features.rds.
#
# Run from this folder:  Rscript prep.R

suppressPackageStartupMessages({ library(jsonlite); library(data.table); library(parallel) })

ALIASES <- c(
  "AFC Bournemouth" = "Bournemouth", "Leicester City" = "Leicester", "Manchester City" = "Man City",
  "Manchester United" = "Man United", "Newcastle United" = "Newcastle", "Norwich City" = "Norwich",
  "Stoke City" = "Stoke", "Swansea City" = "Swansea", "Tottenham Hotspur" = "Tottenham",
  "West Bromwich Albion" = "West Brom", "West Ham United" = "West Ham",
  "AC Milan" = "Milan", "AS Roma" = "Roma", "Hellas Verona" = "Verona", "Inter Milan" = "Inter",
  "Athletic Club" = "Ath Bilbao", "Atlético Madrid" = "Ath Madrid", "Celta Vigo" = "Celta",
  "Espanyol" = "Espanol", "Levante UD" = "Levante", "Málaga" = "Malaga", "RC Deportivo La Coruña" = "La Coruna",
  "Rayo Vallecano" = "Vallecano", "Real Betis" = "Betis", "Real Sociedad" = "Sociedad", "Sporting Gijón" = "Sp Gijon")
alias <- function(x) ifelse(x %in% names(ALIASES), ALIASES[x], x)

secs <- function(ts) { p <- strsplit(ts, ":", fixed = TRUE); vapply(p, function(z) as.numeric(z[1]) * 3600 + as.numeric(z[2]) * 60 + as.numeric(z[3]), 0) }
col  <- function(e, name, default = NA) if (name %in% names(e)) e[[name]] else rep(default, nrow(e))
xy   <- function(lst, i) vapply(lst, function(v) if (length(v) >= i) as.numeric(v[i]) else NA_real_, 0)
in_box <- function(x, y) !is.na(x) & x >= 102 & y >= 18 & y <= 62

# ---- matches + odds ---------------------------------------------------------------
read_league <- function(league) {
  m <- fromJSON(sprintf("raw/sources/matches_%s.json", league), flatten = TRUE)
  o <- fread(sprintf("raw/sources/odds_%s.csv", league), encoding = "UTF-8")
  o <- o[HomeTeam != "" & Date != ""]
  o[, date := as.Date(Date, format = ifelse(nchar(sub(".*/", "", Date)) == 2, "%d/%m/%y", "%d/%m/%Y"))]
  stopifnot(!anyDuplicated(o[, .(date, HomeTeam, AwayTeam)]))
  m <- data.table(match_id = m$match_id, league = league, date = as.Date(m$match_date),
                  home = m$home_team.home_team_name, away = m$away_team.away_team_name,
                  home_id = m$home_team.home_team_id, away_id = m$away_team.away_team_id,
                  home_score = m$home_score, away_score = m$away_score)
  m[, `:=`(oh = alias(home), oa = alias(away))]
  j <- o[m, on = .(date, HomeTeam = oh, AwayTeam = oa)]
  stopifnot(!anyNA(j$FTHG), all(j$FTHG == j$home_score & j$FTAG == j$away_score))  # every join checked against the score
  use_avg <- !is.na(j$BbAvH) & j$BbAvH > 1 & j$BbAvD > 1 & j$BbAvA > 1
  ph <- ifelse(use_avg, j$BbAvH, j$B365H); pd <- ifelse(use_avg, j$BbAvD, j$B365D); pa <- ifelse(use_avg, j$BbAvA, j$B365A)
  inv <- cbind(1 / ph, 1 / pd, 1 / pa); inv <- inv / rowSums(inv)        # remove the overround
  j[, .(match_id, league, date, home, away, home_id, away_id, home_score, away_score,
        p_home = inv[, 1], p_draw = inv[, 2], p_away = inv[, 3])]
}
matches <- rbindlist(lapply(c("England", "Spain", "Italy"), read_league))

# ---- one match --------------------------------------------------------------------
parse_match <- function(mid) {
  meta <- matches[match_id == mid]
  path <- sprintf("raw/events/%d.json.gz", mid)
  e <- fromJSON(rawToChar(memDecompress(readBin(path, "raw", file.size(path)), "gzip")), flatten = TRUE)
  e <- e[order(e$index), ]
  e <- e[e$period %in% 1:2, ]
  type <- e$type.name; ts <- secs(e$timestamp)
  half_end <- c(max(ts[e$period == 1 & type == "Half End"]), max(ts[e$period == 2 & type == "Half End"]))
  t <- ts + ifelse(e$period == 2, half_end[1], 0)
  side <- ifelse(e$team.id == meta$home_id, 0L, 1L)

  # Walk events in order to track who is on the pitch and the score
  active <- list(); sc <- c(0L, 0L); sent <- c(0L, 0L)
  card <- col(e, "foul_committed.card.name"); bb <- col(e, "bad_behaviour.card.name")
  card[is.na(card)] <- bb[is.na(card)]
  pen <- col(e, "foul_committed.penalty", FALSE); pen[is.na(pen)] <- FALSE
  pos <- col(e, "position.id"); pid <- col(e, "player.id")
  repl <- col(e, "substitution.replacement.id")
  shot_out <- col(e, "shot.outcome.name"); perm <- col(e, "player_off.permanent", FALSE); perm[is.na(perm)] <- FALSE
  lineup <- col(e, "tactics.lineup", list(NULL))
  end <- sum(half_end)
  reds <- list(); goals <- list(); perm_off <- numeric()
  for (i in seq_len(nrow(e))) {
    tm <- as.character(e$team.id[i])
    if (type[i] == "Starting XI") active[[tm]] <- lineup[[i]]$player.id
    if (!is.na(card[i]) && card[i] %in% c("Red Card", "Second Yellow")) {
      onfield <- !is.na(pid[i]) && pid[i] %in% active[[tm]] && t[i] < end
      if (onfield) {
        reds[[length(reds) + 1]] <- data.table(time = t[i], half_time = ts[i], period = e$period[i], minute = e$minute[i],
          side = side[i], player = col(e, "player.name")[i], type = card[i], penalty = pen[i],
          goalkeeper = isTRUE(pos[i] == 1), home_before = sc[1], away_before = sc[2])
        active[[tm]] <- setdiff(active[[tm]], pid[i]); sent[side[i] + 1] <- sent[side[i] + 1] + 1L
      }
    }
    if (type[i] == "Substitution") active[[tm]] <- c(setdiff(active[[tm]], pid[i]), repl[i])
    if (type[i] == "Player Off" && isTRUE(perm[i])) perm_off <- c(perm_off, t[i])
    if (type[i] == "Shot" && isTRUE(shot_out[i] == "Goal")) { sc[side[i] + 1] <- sc[side[i] + 1] + 1L; goals[[length(goals) + 1]] <- data.table(time = t[i], side = side[i]) }
    if (type[i] == "Own Goal Against") { s <- 1L - side[i]; sc[s + 1] <- sc[s + 1] + 1L; goals[[length(goals) + 1]] <- data.table(time = t[i], side = s) }
  }
  stopifnot(identical(sc, c(meta$home_score, meta$away_score)))      # reconstructed score must match the source

  # Metric events: one row per counted event (time, side, metric, value)
  is_shot <- type == "Shot"; xg <- as.numeric(col(e, "shot.statsbomb_xg", 0)); is_pen <- col(e, "shot.type.name") %in% "Penalty"
  pass_ok <- type == "Pass" & is.na(col(e, "pass.outcome.name"))
  loc <- col(e, "location", list(NULL)); pend <- col(e, "pass.end_location", list(NULL)); cend <- col(e, "carry.end_location", list(NULL))
  sx <- xy(loc, 1); sy <- xy(loc, 2); px <- xy(pend, 1); py <- xy(pend, 2); cx <- xy(cend, 1); cy <- xy(cend, 2)
  box_pass  <- pass_ok & in_box(px, py) & !in_box(sx, sy)
  box_carry <- type == "Carry" & in_box(cx, cy) & !in_box(sx, sy)
  m <- rbind(
    data.table(time = t[is_shot], side = side[is_shot], metric = "xg", value = xg[is_shot]),
    data.table(time = t[is_shot & !is_pen], side = side[is_shot & !is_pen], metric = "npxg", value = xg[is_shot & !is_pen]),
    data.table(time = t[is_shot & !is_pen], side = side[is_shot & !is_pen], metric = "np_shots", value = 1),
    data.table(time = t[pass_ok], side = side[pass_ok], metric = "passes", value = 1),
    data.table(time = t[pass_ok & !is.na(px) & px >= 80], side = side[pass_ok & !is.na(px) & px >= 80], metric = "final_third", value = 1),
    data.table(time = t[box_pass | box_carry], side = side[box_pass | box_carry], metric = "box_entries", value = 1))
  if (length(goals)) m <- rbind(m, rbindlist(goals)[, .(time, side, metric = "goals", value = 1)])
  m[, match_id := mid]
  list(match = data.table(match_id = mid, half_end = half_end[1], end = end, n_events = nrow(e)),
       reds = if (length(reds)) rbindlist(reds)[, match_id := mid] else NULL,
       perm_off = if (length(perm_off)) data.table(match_id = mid, time = perm_off) else NULL,
       metrics = m)
}

t0 <- Sys.time()
parsed <- mclapply(matches$match_id, function(mid) tryCatch(parse_match(mid), error = function(err) stop(mid, ": ", conditionMessage(err))),
                   mc.cores = max(1, detectCores() - 1))
bad <- vapply(parsed, inherits, TRUE, "try-error"); if (any(bad)) stop(parsed[bad][[1]])

clock    <- rbindlist(lapply(parsed, `[[`, "match"))
reds     <- rbindlist(lapply(parsed, `[[`, "reds"))
perm_off <- rbindlist(lapply(parsed, `[[`, "perm_off"))
metrics  <- rbindlist(lapply(parsed, `[[`, "metrics"))
games    <- clock[matches, on = "match_id"]
setkey(metrics, match_id, side, metric, time)

saveRDS(list(games = games, reds = reds, perm_off = perm_off, metrics = metrics), "data/features.rds", compress = "xz")
cat(sprintf("%d matches, %s events, %d on-field reds in %d games, %d shots | %.0fs\n",
            nrow(games), format(sum(games$n_events), big.mark = ","), nrow(reds), uniqueN(reds$match_id),
            metrics[metric == "xg", .N], as.numeric(difftime(Sys.time(), t0, units = "secs"))))
]]> football StatsBomb red cards rules https://jafranceschini.quarto.pub/juan-franceschini-lab/posts/post-with-code/ten-men/ Sat, 10 Oct 2026 03:00:00 GMT Why You Can No Longer Win the Premier League With a Weak Defence Juan Franceschini https://jafranceschini.quarto.pub/juan-franceschini-lab/posts/post-with-code/pl-champions/

In 1997, Manchester United won the league with the eighth-best defence. They conceded more goals than seven other teams — including fifth-place Liverpool.

In 2024, that would be impossible.

Since Pep Guardiola arrived at Manchester City in 2016, no champion has finished worse than second in defence. Not third. Not fourth. Second, at worst. The window for defensive weakness has closed.

The question isn’t whether attack or defence wins titles. It’s why the old formula stopped working — and what replaced it.

To understand this shift, I examined every Premier League champion from 1992-93 through Liverpool’s 2024-25 triumph. For each, I ranked their attacking output (goals scored) and defensive record (goals conceded) against the full 20-team field. The data spans 32 seasons, seven different champions, and a structural transformation in what it takes to win.

The Numbers

32

Seasons analysed

9

Champions: #1 in both

15

Attack-led titles

5

Defence-led titles

The Visual Proof

The chart below is the argument. Every title winner plotted by their attack rank (yellow) and defence rank (green). Pink dots mark balanced teams — identical rankings in both.

Two patterns emerge immediately. First, every green dot sits in the top third of the chart. No exceptions. Second, the gap between yellow and green dots shrinks over time. Champions of the 1990s could survive with one excellence. Modern champions cannot.

The Champion Zone

The scatter plot below reveals the same data from a different angle. Each dot is a title-winning season, positioned by attack rank (x-axis) and defence rank (y-axis). The green shaded area marks the top-5 in both metrics.

The clustering is striking: every champion since 2004 sits inside or at the edge of this zone. The outliers — Ferguson’s attack-dominant sides with seventh and eighth-ranked defences — are relics of a different era.

The pattern is clear: early champions scatter across the space, while recent seasons crowd the top-right corner. The number inside each dot shows how many champions share that exact position — a stack of nine at #1/#1 tells its own story. The feasible region has shrunk.

The Tightening Window

The raw numbers suggest attack wins. 15 of 32 champions ranked higher in attack than defence. Only 5 leaned more heavily on defensive prowess. Case closed?

Not quite. Because the range of acceptable defensive positions has collapsed.

Early Premier League champions could survive with middling defences — 4 titles went to teams ranked fifth or worse in goals conceded. Ferguson’s United won with an eighth-ranked defence. Blackburn won with the fifth-best. These teams compensated with overwhelming attacking firepower.

That path is now closed. Since 2017, every champion has ranked first or second in defence. No exceptions.

The era of acceptable trade-offs is ending.

The Ferguson Formula

Sir Alex Ferguson won 13 Premier League titles. Only one saw United finish first in both attack and defence.

This was a feature, not a bug. Ferguson operated in an era when defensive weakness was survivable. In 1996-97, United conceded 44 goals — eighth-best in the league. They won anyway because they scored the most. In 1999-00, United’s defence ranked only seventh; their attack compensated with 97 goals.

Ferguson’s genius was understanding the exchange rate. In his era, one rank in attack was worth roughly two ranks in defence. His teams weren’t imbalanced by accident — they were optimized for their environment.

That environment no longer exists.

The Leicester Exception

Leicester 2015-16: third in attack, third in defence. No elite dimension. Perfect balance.

This title shouldn’t exist by the usual rules. Leicester weren’t the best at anything. But they were the only team that season to be top-three in both metrics. Chelsea imploded. Manchester City couldn’t sustain form. Arsenal faded in March. Every rival had a fatal weakness. Leicester’s balance became, by default, supremacy.

The Leicester principle: When no team dominates both ends of the pitch, the most consistent team across both wins.

The Guardiola Reset

Guardiola didn’t optimize within the old constraints. He rewrote them.

Manchester City have won 8 Premier League titles. In 5 of those seasons, they finished first in both attack and defence. This isn’t balance — it’s total dominance across every dimension.

The numbers tell the story. 2017-18: 106 goals scored (best), 27 conceded (best). 2018-19: 95 scored (best), 23 conceded (second). 2020-21, 2021-22, 2022-23: first in both, every time.

When one team occupies both poles, the competitive landscape shifts for everyone else. Ferguson’s seventh-ranked defence was viable because no rival combined elite attack and elite defence. Against Guardiola’s City, a fifth-ranked defence means conceding 10-15 more goals per season than the team you’re chasing. Even a brilliant attack can’t close that gap.

Liverpool’s Two Routes

Liverpool prove you can reach the summit from different directions — if you stay within the constraint.

2019-20: First in defence, second in attack. Van Dijk and Alisson anchored the league’s best backline. The attack finished second. Title secured.

2024-25: First in attack, second in defence. Arne Slot’s side flipped the emphasis. Different ratio, same result.

Both campaigns respected the constraint. Neither defence ranked lower than second. Liverpool didn’t choose attack or defence — they chose attack and defence, with different weightings.

The Process Test

Goals measure outcomes. Expected Goals (xG) measures process — the quality of chances created and conceded, independent of finishing luck.

The distinction matters. A team can win a title by outperforming their xG — clinical finishing, goalkeeper heroics, fortunate bounces. But that’s not repeatable. The champions who dominate year after year don’t rely on overperformance. They win at the process level.

Season Champion Goals xG +/- xG Rank GA xGA +/- xGA Rank
2017-18 Manchester City 103 78.6 +24.4 #1 25 23.8 +1.2 #1
2018-19 Manchester City 91 84.3 +6.7 #1 23 24.7 -1.7 #1
2019-20 Liverpool 83 68.9 +14.1 #3 32 37.7 -5.7 #2
2020-21 Manchester City 82 68.2 +13.8 #1 31 30.2 +0.8 #1
2021-22 Manchester City 96 88.7 +7.3 #1 26 24.6 +1.4 #1
2022-23 Manchester City 92 78.7 +13.3 #1 32 32.1 -0.1 #1
2023-24 Manchester City 94 80.5 +13.5 #2 33 35.6 -2.6 #2

What xG Confirms

5 of 7 recent champions ranked first in xG — best chances created. 5 ranked first in both xG and xGA. These titles weren’t stolen through finishing luck. They were earned at the process level.

Manchester City’s xG dominance is structural. Season after season: first in xG, first in xGA. They don’t just score more — they create better chances. They don’t just concede fewer — they allow worse chances. The outcome and the process align.

Liverpool 2019-20 is the exception that tests the rule. Klopp’s side ranked only third in xG — not the best chances created. But they ranked first in xGA (fewest quality chances conceded) and overperformed their expected goals by a significant margin. The title was real; the process was less dominant. Liverpool couldn’t replicate it the following season.

Note: 2024-25 xG data will be added when the season’s FBref data is fully released.

The Answer

The question was never attack or defence.

It was: how much defensive weakness can your attack compensate for?

In 1997, the answer was: quite a lot. Ferguson’s United won with an eighth-ranked defence. Today, the answer is: almost none. Since 2017, no champion has ranked worse than second in defence.

The data reveals not a fixed rule, but a shrinking window. Attack still wins titles — 47% of champions ranked higher in attack than defence. But the minimum defensive threshold has risen dramatically. What was once a wide corridor has become a narrow path.

In the Ferguson era, attack was the multiplier. In the Guardiola era, defence became the filter.

This explains everything:

Ferguson’s United exploited a lenient era. Elite attack, acceptable defence. The exchange rate favoured goalscorers.

Leicester 2015-16 found a window between eras. Third in both metrics — balance as a survival strategy when no rival dominated both ends.

Guardiola’s City closed the window entirely. By setting the standard in both attack and defence, they forced every competitor to match both or fall short.

28% of Premier League champions have finished first in both attack and defence. That percentage has accelerated in the modern era. The old trade-off is obsolete.

The teams that win now don’t ask whether to prioritize attack or defence. They refuse the question. They dominate both — because against City, that’s the only math that works.

Data sources: Goals data from football-data.co.uk (1992-93 to 2024-25). xG data from FBref via the worldfootballR package (2017-18 to 2023-24).

Methodology: Teams ranked 1-20 each season by goals scored (attack) and goals conceded (defence). Rank 1 = best. “Balanced” champions achieved identical ranks in both metrics.

Back to top ]]> football data visualization Premier League analytics https://jafranceschini.quarto.pub/juan-franceschini-lab/posts/post-with-code/pl-champions/ Mon, 17 Mar 2025 03:00:00 GMT