打者は何歳でピークを迎えるか

年齢別の平均を出すと何が起きるか

打者は何歳が一番良いのか. 素直に「年齢ごとに成績の平均を出す」と, おかしなことになります.

library(Lahman)
library(dplyr)
library(ggplot2)

SINCE <- 1970      # DH 導入以降. 記録の欠けが少なく, 162試合制で揃っている
QUAL  <- 300       # 「その年に主力だった」とみなす打席数

season <- Batting %>%
  filter(yearID >= SINCE) %>%
  group_by(playerID, yearID) %>%      # 移籍した年は stint が分かれるので合算する
  dplyr::summarise(across(c(AB, H, X2B, X3B, HR, BB, HBP, SF, SH), ~ sum(.x, na.rm = TRUE)),
                   .groups = "drop") %>%
  mutate(PA  = AB + BB + HBP + SF + SH,
         OBP = (H + BB + HBP) / (AB + BB + HBP + SF),
         SLG = (H + X2B + 2 * X3B + 3 * HR) / AB,
         OPS = OBP + SLG) %>%
  filter(AB > 0)

年齢は「そのシーズンの6月30日時点で何歳か」とします. 7月以降生まれは1つ引きます.

season <- season %>%
  inner_join(People %>% dplyr::select(playerID, birthYear, birthMonth), by = "playerID") %>%
  filter(!is.na(birthYear), !is.na(birthMonth)) %>%
  mutate(age = yearID - birthYear - (birthMonth > 6))

OPS の水準は時代で動きます. 1970年代と2000年前後を混ぜると, 年齢の効果に時代の効果が乗ってしまいます. そこでその年の主力打者の平均との差に直します. 以降の数値はすべて「同じ年の平均から OPS が何ポイント離れているか」です.

qual <- season %>% filter(PA >= QUAL)

league <- qual %>%
  group_by(yearID) %>%
  dplyr::summarise(OPS_mean = mean(OPS), .groups = "drop")

qual <- qual %>%
  inner_join(league, by = "yearID") %>%
  mutate(rel = OPS - OPS_mean)

naive <- qual %>%
  group_by(age) %>%
  dplyr::summarise(rel = mean(rel), n = n(), .groups = "drop") %>%
  filter(n >= 50)

ggplot(naive, aes(x = age, y = rel)) +
  geom_line() + geom_point() +
  geom_hline(yintercept = 0, linetype = "dashed") +
  xlab("年齢") + ylab("同年の平均との OPS 差") +
  ggtitle(paste0("年齢別の平均 (", SINCE, "年以降, ", QUAL, "打席以上)"))

高齢の側が若手より上に来ます. 39歳の平均は +0.023, 23歳は-0.010です.

これは「歳を取るとうまくなる」のではありません. 39歳まで300打席立てる打者は, そもそも良い打者しか残っていないからです. 成績が落ちた打者は途中で集団を抜けるので, 高齢の側は選抜された少数だけになり, 平均が上がります.

実際, ある年に300打席立った打者のうち, 翌年も300打席立った人のその年の成績は平均+0.015, 翌年に届かなかった人は-0.040です. 成績が落ちた打者から順に集団を抜けていきます.

同じ選手の前年との差だけを見る

集団の入れ替わりを避けるには, 同じ選手の連続する2年を比べます. 26歳→27歳の変化, 27歳→28歳の変化, というように1年ぶんの変化だけを集め, それをつなげて曲線にします (delta method).

pairs <- qual %>%
  arrange(playerID, yearID) %>%
  group_by(playerID) %>%
  mutate(next_year = lead(yearID), next_rel = lead(rel), next_PA = lead(PA)) %>%
  ungroup() %>%
  filter(!is.na(next_year), next_year == yearID + 1) %>%
  mutate(delta = next_rel - rel,
         # 両方の年で打席が多いペアほど信頼できるので, 調和平均で重みを付ける
         w = 2 * PA * next_PA / (PA + next_PA))

AGES <- 21:39
pairs <- pairs %>% filter(age %in% AGES[-length(AGES)])

# 各年齢での「1年ぶんの変化」を重み付き平均で出し, 若い順に積み上げる
chain <- function(d) {
  step <- d %>%
    group_by(age) %>%
    dplyr::summarise(delta = weighted.mean(delta, w), .groups = "drop") %>%
    arrange(age)
  data.frame(age = c(step$age, max(step$age) + 1),
             rel = c(0, cumsum(step$delta)))
}
curve <- chain(pairs)

積み上げた曲線は「21歳を0としたときに, 各年齢で何ポイント違うか」を表します. 絶対値ではなく形を見るものです.

# 選手ごと再標本化 (同じ選手の全ペアをまとめて抜き差しする)
set.seed(1)
players <- unique(pairs$playerID)
idx <- split(seq_len(nrow(pairs)), pairs$playerID)
B <- 400

boot <- replicate(B, {
  s <- sample(players, length(players), replace = TRUE)
  b <- pairs[unlist(idx[s], use.names = FALSE), ]
  c0 <- chain(b)
  c0$rel[match(curve$age, c0$age)]
})

ci <- t(apply(boot, 1, quantile, probs = c(0.025, 0.975), na.rm = TRUE))
curve$lo <- ci[, 1]
curve$hi <- ci[, 2]

both <- rbind(
  data.frame(age = curve$age, rel = curve$rel - max(curve$rel), 方法 = "前年との差を積み上げ"),
  data.frame(age = naive$age, rel = naive$rel - max(naive$rel), 方法 = "年齢別の平均"))

ggplot(both, aes(x = age, y = rel, colour = 方法)) +
  geom_line() + geom_point(size = 1) +
  xlab("年齢") + ylab("ピークからの OPS 差") +
  ggtitle("年齢曲線: 2つの出し方")

同じ選手を追いかけると, 山ははっきりします. ピークは26歳 (95%区間 25-26歳) で, そこから34歳までに OPS で0.092落ちます.

年齢は本当に効いているのか

一番弱いベースラインは「年齢では何も変わらない」, つまり平らな線です. 曲線の高さの幅 (最高点と最低点の差) がその証拠になりそうですが, 幅は差の絶対値なので, 中身がただのノイズでも必ず正の値になります. 「幅の信頼区間が0を含まない」は何の証拠にもなりません.

比べる相手を作ります. 前年との差はそのままに, 年齢のラベルだけを無作為に入れ替えて同じ手順で曲線を積み上げます. これが「年齢は無関係」の世界です.

set.seed(3)
perm <- replicate(500, {
  b <- pairs
  b$age <- sample(b$age)      # 年齢と変化の対応を壊す
  cv <- chain(b)
  max(cv$rel) - min(cv$rel)
})
p_amp <- (1 + sum(perm >= amp)) / (length(perm) + 1)

data.frame(幅 = perm) %>%
  ggplot(aes(x = 幅)) +
  geom_histogram(bins = 30) +
  geom_vline(xintercept = amp, colour = "red") +
  xlab("曲線の高低差 (OPS)") +
  ggtitle("年齢を無作為に入れ替えたときの高低差 (赤線は実際の値)")

年齢を壊すと高低差は中央値0.138, 最大でも0.186にしかなりません. 実際の0.197はその外側で, p < 0.002です. 平らなベースラインは棄却されます.

ただし, 帰無分布の中央値が0.138もあることには注意が要ります. 差を積み上げると, 偶然のずれも一緒に積み上がるためです. 年齢が完全に無関係でも, 積み上げた曲線はこれくらいの起伏を持ちます. 実際の値0.197はそれを超えていますが, 差は 0.059程度で, 見た目の山ほど劇的ではありません.

参考までに, 幅そのもののブートストラップ区間は 0.178-0.224です (推定の精度を表すだけで, ベースラインとの比較には使えません).

ggplot(curve, aes(x = age, y = rel)) +
  geom_ribbon(aes(ymin = lo, ymax = hi), alpha = 0.2) +
  geom_line() + geom_point() +
  geom_vline(xintercept = peak, linetype = "dashed") +
  xlab("年齢") + ylab("21歳を0としたときの OPS 差") +
  ggtitle(paste0("年齢曲線 (帯は選手単位のブートストラップ95%区間, B=", B, ")"))

閾値を変えても形は変わるか

300打席という線引きは恣意的です. 下げると出場機会の少ない選手が入り, 上げると主力だけになります. 形が変わらないかを確かめます.

curve_for <- function(q) {
  s <- season %>% filter(PA >= q)
  lg <- s %>% group_by(yearID) %>%
    dplyr::summarise(OPS_mean = mean(OPS), .groups = "drop")
  p <- s %>% inner_join(lg, by = "yearID") %>% mutate(rel = OPS - OPS_mean) %>%
    arrange(playerID, yearID) %>%
    group_by(playerID) %>%
    mutate(next_year = lead(yearID), next_rel = lead(rel), next_PA = lead(PA)) %>%
    ungroup() %>%
    filter(!is.na(next_year), next_year == yearID + 1, age %in% AGES[-length(AGES)]) %>%
    mutate(delta = next_rel - rel, w = 2 * PA * next_PA / (PA + next_PA))
  cv <- chain(p)
  data.frame(age = cv$age, rel = cv$rel - max(cv$rel), 閾値 = paste0(q, "打席"))
}

sens <- do.call(rbind, lapply(c(200, 300, 450), curve_for))
ggplot(sens, aes(x = age, y = rel, colour = 閾値)) +
  geom_line() + geom_point(size = 1) +
  xlab("年齢") + ylab("ピークからの OPS 差") +
  ggtitle("打席数の閾値を変えた場合")

ピークは26歳と, 閾値を変えても動きません. ピークから34歳までの落ち幅は0.087〜0.101で, 閾値が低いほど大きく出ます. 出場機会の少ない打者を入れるほど, 衰えが見えやすくなるためです.

注意

この曲線も生存バイアスから完全には自由ではありません. 前年との差を取るには「2年続けて300打席立つ」必要があり, 大きく崩れた打者は差を作れずに消えます. そのぶん, 実際の衰えは図より急なはずです. 年齢別の平均 (上向き) と前年との差 (下向き) は, 真の曲線を挟む2つの偏った推定と考えるのが安全です.
積み上げた値は21歳を0とした相対値です. 21歳で300打席立つ打者は少なく, 左端は不安定です. 帯の広さで確かめてください.
OPS は出塁率と長打率の単純和で, 出塁の価値を実際より軽く見ます. 年齢による内訳の変化 (四球は増え長打は減る) までは追っていません.
時代の補正は「その年の主力打者の平均との差」で行っています. 平均そのものを作る集団が年ごとに違うので, 完全な補正ではありません.

打者は何歳でピークを迎えるか

2026-08-11

年齢別の平均を出すと何が起きるか

同じ選手の前年との差だけを見る

年齢は本当に効いているのか

閾値を変えても形は変わるか

注意