メジャーリーガーは何年で消えるか
2026-08-11
平均を出すと間違える
メジャーに上がった選手は, 何年もつのか.
単純に「デビューから最終出場までの平均」を出すと, 短く出ます. まだ現役の選手が, その時点までの年数で数えられてしまうからです. 2023年にデビューして今も現役の選手を「3年で終わった」とは数えられません.
こういう「まだ終わっていない観測」を打ち切り (censoring) と呼びます. 打ち切りを正しく扱うのが生存分析です.
library(Lahman)
library(dplyr)
library(ggplot2)
library(survival)
MAX <- max(Appearances$yearID)
FROM <- 1950 # これ以前のデビューは戦争や記録の事情が絡む
career <- Appearances %>%
group_by(playerID) %>%
dplyr::summarise(初年 = min(yearID), 最終年 = max(yearID),
出場 = sum(G_all, na.rm = TRUE),
投手回 = sum(G_p, na.rm = TRUE), .groups = "drop") %>%
filter(初年 >= FROM) %>%
mutate(在籍 = 最終年 - 初年 + 1,
# 直近2シーズンに出ている選手は「まだ終わっていない」とみなす
打ち切り = 最終年 >= MAX - 1,
event = as.integer(!打ち切り),
役割 = ifelse(投手回 > 0.5 * 出場, "投手", "野手"))career <- career %>%
inner_join(People %>% dplyr::select(playerID, birthYear, birthMonth, nameFirst, nameLast),
by = "playerID") %>%
filter(!is.na(birthYear), !is.na(birthMonth)) %>%
mutate(デビュー年齢 = 初年 - birthYear - (birthMonth > 6),
年齢層 = cut(デビュー年齢, breaks = c(-Inf, 21, 24, Inf),
labels = c("21歳以下", "22-24歳", "25歳以上"))) %>%
filter(!is.na(年齢層))1950年以降にデビューした12,949人が対象です. うち1798人 (14%) が打ち切り, つまりまだ現役です.
全体で見ると打ち切りは少数なので, 単純平均6.2年は それほどひどい数字ではありません. 歪みが効いてくるのは最近デビューした選手です.
recent <- career %>% filter(初年 >= MAX - 9) # 直近10年のデビュー組
fit_recent <- survfit(Surv(在籍, event) ~ 1, data = recent)直近10年のデビュー組では62%が現役です. この集団で「5年以上もった選手の割合」を素朴に数えると 32%にしかなりません. 2年前にデビューして活躍中の選手も「5年もたなかった」に数えられるからです.
打ち切りを考慮した Kaplan-Meier 推定では58%です. 素朴な数え方は26ポイントも過小評価します.
Kaplan-Meier 推定
「デビューから x 年後に, まだ在籍している割合」を打ち切りを考慮して推定します.
fit <- survfit(Surv(在籍, event) ~ 1, data = career)km <- data.frame(年 = fit$time, 残存 = fit$surv, lo = fit$lower, hi = fit$upper)
ggplot(km, aes(x = 年, y = 残存)) +
geom_ribbon(aes(ymin = lo, ymax = hi), alpha = 0.2) +
geom_step() +
scale_y_continuous(limits = c(0, 1)) +
xlab("デビューからの年数") + ylab("まだ在籍している割合") +
ggtitle("メジャー在籍の生存曲線")
半分が消えるまで6年です. 1年で16%が姿を消し, 5年後に残るのは53%, 10年後は26%です.
殿堂入りの資格は10シーズン以上なので, デビューした時点で資格に届くのは 26%程度ということになります.
デビューが早い選手は長く残るか
若くしてメジャーに上がる選手は, それだけ評価が高いはずです. 年齢層で分けます.
fit_age <- survfit(Surv(在籍, event) ~ 年齢層, data = career)
lr_age <- survdiff(Surv(在籍, event) ~ 年齢層, data = career)strata_df <- function(f) {
data.frame(年 = f$time, 残存 = f$surv,
群 = rep(sub(".*=", "", names(f$strata)), f$strata))
}
ggplot(strata_df(fit_age), aes(x = 年, y = 残存, colour = 群)) +
geom_step() +
scale_y_continuous(limits = c(0, 1)) +
xlab("デビューからの年数") + ylab("まだ在籍している割合") +
ggtitle("デビュー時の年齢別")
tab <- summary(fit_age)$table
data.frame(群 = sub(".*=", "", rownames(tab)),
人数 = tab[, "records"],
中央値 = tab[, "median"],
下限 = tab[, "0.95LCL"],
上限 = tab[, "0.95UCL"]) %>%
knitr::kable(row.names = FALSE, caption = "在籍年数の中央値 (95%信頼区間)")| 群 | 人数 | 中央値 | 下限 | 上限 |
|---|---|---|---|---|
| 21歳以下 | 1756 | 10 | 10 | 11 |
| 22-24歳 | 6125 | 7 | 7 | 7 |
| 25歳以上 | 5068 | 4 | 3 | 4 |
一番弱いベースラインは「年齢層で差は無い」です. log-rank 検定は χ² = 1738.4, p < 0.0001で, ベースラインは棄却されます.
投手と野手
fit_role <- survfit(Surv(在籍, event) ~ 役割, data = career)
lr_role <- survdiff(Surv(在籍, event) ~ 役割, data = career)ggplot(strata_df(fit_role), aes(x = 年, y = 残存, colour = 群)) +
geom_step() +
scale_y_continuous(limits = c(0, 1)) +
xlab("デビューからの年数") + ylab("まだ在籍している割合") +
ggtitle("投手と野手")
tab2 <- summary(fit_role)$table
data.frame(群 = sub(".*=", "", rownames(tab2)),
人数 = tab2[, "records"],
中央値 = tab2[, "median"],
下限 = tab2[, "0.95LCL"],
上限 = tab2[, "0.95UCL"]) %>%
knitr::kable(row.names = FALSE, caption = "在籍年数の中央値 (95%信頼区間)")| 群 | 人数 | 中央値 | 下限 | 上限 |
|---|---|---|---|---|
| 投手 | 6772 | 5 | 5 | 5 |
| 野手 | 6177 | 7 | 6 | 7 |
中央値は投手 5年, 野手 7年, log-rank 検定は p < 0.0001です.
注意
- 在籍年数はデビュー年から最終出場年までの年数です. 途中でマイナーに落ちて 1年空いた場合も, つながった1本のキャリアとして数えています. 出場したシーズン数を数えると, この曲線より短く出ます.
- 打ち切りの定義は「直近2シーズン (2024-2025年) に出場」です. 故障で長期離脱している選手は, 実際は現役でも引退として数えられます.
- 中央値の信頼区間は Kaplan-Meier 推定に基づくもので, 打ち切りの仕組みが 在籍年数と独立であることを仮定しています. 「衰えた選手ほど辞める」という 依存があるので, この仮定は厳密には成り立ちません.
- 年齢層の差は「若くデビューできる選手はもともと良い選手」という選抜の効果を含みます. デビュー年齢そのものの効果ではありません.
- 対象は1950年以降のデビューに限っています. 拡張期 (球団増加) の前後で メジャーの椅子の数が違うため, 時代をまたぐ比較には注意が要ります.