殿堂入りは通算成績でどこまで説明できるか

殿堂入りは数字で決まるのか

アメリカ野球殿堂の選出は記者投票です. 明文化された基準はありません. それでも「通算3000安打なら当確」のような相場観は語られます.

通算成績だけでどこまで当てられるかを見ます.

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

# 選手としての選出のみ (監督・審判・功労者は除く)
hof <- HallOfFame %>%
  filter(category == "Player") %>%
  group_by(playerID) %>%
  dplyr::summarise(inducted = any(inducted == "Y"), .groups = "drop")

# 投手か野手かは, 通算出場のうち投手としての出場が半分を超えるかで決める
role <- Appearances %>%
  group_by(playerID) %>%
  dplyr::summarise(seasons = n_distinct(yearID),
                   G_all = sum(G_all, na.rm = TRUE),
                   G_p   = sum(G_p,   na.rm = TRUE), .groups = "drop") %>%
  mutate(投手 = G_p > 0.5 * G_all)

profile <- People %>%
  mutate(final_year = as.integer(substr(as.character(finalGame), 1, 4)),
         name = paste(nameFirst, nameLast)) %>%
  dplyr::select(playerID, name, final_year)

allstar <- AllstarFull %>% group_by(playerID) %>%
  dplyr::summarise(AS = n_distinct(yearID), .groups = "drop")
mvp <- AwardsPlayers %>% filter(grepl("Most Valuable Player", awardID)) %>%
  count(playerID, name = "MVP")
cy <- AwardsPlayers %>% filter(grepl("Cy Young", awardID)) %>%
  count(playerID, name = "CY")

対象は殿堂入りの資格を満たしうる選手に絞ります. 10シーズン以上出場し, 2019年までに引退した選手です (選出は引退5年後から, 記者投票は最長10年続きます).

LAST <- 2019     # これ以降の引退者はまだ投票が終わっていない
MINS <- 10       # 殿堂入りの資格は10シーズン以上

build <- function(is_pitcher, career) {
  role %>%
    filter(投手 == is_pitcher, seasons >= MINS) %>%
    inner_join(profile, by = "playerID") %>%
    filter(!is.na(final_year), final_year <= LAST) %>%
    inner_join(career, by = "playerID") %>%
    left_join(allstar, by = "playerID") %>%
    left_join(mvp, by = "playerID") %>%
    left_join(cy,  by = "playerID") %>%
    left_join(hof, by = "playerID") %>%
    mutate(AS  = ifelse(is.na(AS),  0, AS),
           MVP = ifelse(is.na(MVP), 0, MVP),
           CY  = ifelse(is.na(CY),  0, CY),
           y   = ifelse(is.na(inducted), 0L, as.integer(inducted)))
}

bat_career <- Batting %>%
  group_by(playerID) %>%
  dplyr::summarise(AB = sum(AB, na.rm = TRUE), H = sum(H, na.rm = TRUE),
                   HR = sum(HR, na.rm = TRUE), RBI = sum(RBI, na.rm = TRUE),
                   .groups = "drop") %>%
  filter(AB >= 1000) %>%
  mutate(AVG = H / AB)

pit_career <- Pitching %>%
  group_by(playerID) %>%
  dplyr::summarise(W = sum(W, na.rm = TRUE), SO = sum(SO, na.rm = TRUE),
                   SV = sum(SV, na.rm = TRUE), IPouts = sum(IPouts, na.rm = TRUE),
                   ER = sum(ER, na.rm = TRUE), .groups = "drop") %>%
  filter(IPouts >= 1500) %>%
  mutate(ERA = 27 * ER / IPouts)

batters  <- build(FALSE, bat_career)
pitchers <- build(TRUE,  pit_career)

野手2082人 (うち殿堂入り192人, 9.2%), 投手1212人 (同81人, 6.7%) が対象です. 当たりはごく少数なので, 「全員に『入らない』と答える」だけで正解率は 91%を超えます. 正解率で評価してはいけない問題です.

訓練と検証を時代で分ける

同じ選手で当てても意味がありません. 1994年までに引退した選手でモデルを作り, 1995年以降に引退した選手で試します.

SPLIT <- 1994

# 順位付けの良さを見る. 殿堂入りした選手のほうが高いスコアを付けられた組の割合
auc <- function(score, y) {
  r <- rank(score)
  n1 <- sum(y == 1); n0 <- sum(y == 0)
  (sum(r[y == 1]) - n1 * (n1 + 1) / 2) / (n1 * n0)
}

evaluate <- function(d, full, base) {
  tr <- d %>% filter(final_year <= SPLIT)
  te <- d %>% filter(final_year >  SPLIT)
  m_full <- glm(full, data = tr, family = binomial())
  m_base <- glm(base, data = tr, family = binomial())
  te$p_full <- predict(m_full, te, type = "response")
  te$p_base <- predict(m_base, te, type = "response")
  list(train = tr, test = te, model = m_full,
       auc_full = auc(te$p_full, te$y), auc_base = auc(te$p_base, te$y))
}

b <- evaluate(batters,
              y ~ H + HR + AVG + seasons + AS + MVP,
              y ~ H)
p <- evaluate(pitchers,
              y ~ W + SO + ERA + SV + seasons + AS + CY,
              y ~ W)

data.frame(
  対象 = c("野手", "投手"),
  検証人数 = c(nrow(b$test), nrow(p$test)),
  殿堂入り = c(sum(b$test$y), sum(p$test$y)),
  ベースライン = sprintf("%.3f", c(b$auc_base, p$auc_base)),
  フルモデル   = sprintf("%.3f", c(b$auc_full, p$auc_full))) %>%
  knitr::kable(caption = "検証データでの AUC (ベースラインは野手が通算安打のみ, 投手が通算勝利のみ)")

検証データでの AUC (ベースラインは野手が通算安打のみ, 投手が通算勝利のみ)
対象	検証人数	殿堂入り	ベースライン	フルモデル
野手	662	36	0.978	0.990
投手	467	13	0.829	0.997

AUC は「殿堂入りした選手のほうに高い確率を付けられた組の割合」で, でたらめなら0.5です. 野手は通算安打だけで0.978, 説明変数を増やして0.990 (+0.012). 投手は通算勝利だけで0.829, フルモデルで0.997 (+0.168).

野手と投手で様子が違います. 野手は通算安打1本でほぼ説明がつきます. 上乗せは+0.012しかなく, 「3000安打なら当確」という相場観はよく当たっています.

投手は通算勝利だけでは足りません. 0.829は野手のベースラインよりはっきり低く, 奪三振・防御率・セーブを足すと 0.997まで上がります (+0.168). 勝利数は味方の得点に左右されるうえ, 抑え投手は勝利がほとんど付きません. 投票する側も勝利数だけを見てはいない, ということになります.

上位から何人当たるか

AUC は順位の指標なので, 実務的な見え方も出します. 確率の高い順に並べ, 上位から実際の殿堂入りが何人含まれるかを数えます.

topn <- function(d, k = 40) {
  o <- d %>% arrange(desc(p_full)) %>% head(k)
  data.frame(上位 = seq_len(k), 的中 = cumsum(o$y))
}
rbind(topn(b$test) %>% mutate(対象 = "野手"),
      topn(p$test) %>% mutate(対象 = "投手")) %>%
  ggplot(aes(x = 上位, y = 的中, colour = 対象)) +
  geom_step() +
  geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
  xlab("予測確率の高い順") + ylab("実際に殿堂入りした人数") +
  ggtitle("上位から数えた的中数 (破線は全員的中)")

上位20人のうち, 野手は16人, 投手は13人が実際に殿堂入りしています.

モデルが外した選手

面白いのは外れたほうです. 数字は揃っているのに選ばれていない選手を並べます.

b$test %>% filter(y == 0) %>% arrange(desc(p_full)) %>% head(10) %>%
  mutate(確率 = sprintf("%.2f", p_full), 打率 = sprintf("%.3f", AVG)) %>%
  dplyr::select(name, 確率, 安打 = H, 本塁打 = HR, 打率, オールスター = AS) %>%
  knitr::kable(caption = "野手: モデルは高く評価したが選ばれていない")

野手: モデルは高く評価したが選ばれていない
name	確率	安打	本塁打	打率	オールスター
Barry Bonds	1.00	2935	762	0.298	14
Alex Rodriguez	1.00	3115	696	0.295	14
Manny Ramirez	0.97	2574	555	0.312	12
Gary Sheffield	0.91	2689	509	0.292	9
Rafael Palmeiro	0.77	3020	569	0.288	4
Carlos Beltran	0.76	2725	435	0.279	9
Julio Franco	0.74	2586	173	0.298	3
Don Mattingly	0.70	2153	222	0.307	6
Juan Gonzalez	0.69	1936	434	0.295	3
Sammy Sosa	0.64	2408	609	0.273	7

p$test %>% filter(y == 0) %>% arrange(desc(p_full)) %>% head(10) %>%
  mutate(確率 = sprintf("%.2f", p_full), 防御率 = sprintf("%.2f", ERA)) %>%
  dplyr::select(name, 確率, 勝利 = W, 奪三振 = SO, 防御率, オールスター = AS) %>%
  knitr::kable(caption = "投手: モデルは高く評価したが選ばれていない")

投手: モデルは高く評価したが選ばれていない
name	確率	勝利	奪三振	防御率	オールスター
Roger Clemens	1.00	354	4672	3.12	11
John Franco	0.78	90	975	2.89	4
Kevin Brown	0.56	211	2397	3.28	6
Dennis Martinez	0.54	245	2149	3.70	4
Curt Schilling	0.53	216	3116	3.46	6
Francisco Rodriguez	0.52	52	1142	2.86	6
Joe Nathan	0.48	64	976	2.87	6
Jonathan Papelbon	0.41	41	808	2.44	6
Bartolo Colon	0.30	247	2535	4.12	4
David Cone	0.28	194	2668	3.46	5

逆に, 数字が地味なのに選ばれた選手です.

b$test %>% filter(y == 1) %>% arrange(p_full) %>% head(8) %>%
  mutate(確率 = sprintf("%.2f", p_full), 打率 = sprintf("%.3f", AVG)) %>%
  dplyr::select(name, 確率, 安打 = H, 本塁打 = HR, 打率, オールスター = AS) %>%
  knitr::kable(caption = "野手: モデルは低く見たが選ばれた")

野手: モデルは低く見たが選ばれた
name	確率	安打	本塁打	打率	オールスター
Scott Rolen	0.35	2077	316	0.281	7
Alan Trammell	0.53	2365	185	0.285	6
Ozzie Smith	0.57	2460	28	0.262	15
Fred McGriff	0.57	2490	493	0.284	5
Jim Thome	0.58	2328	612	0.276	5
Jeff Bagwell	0.63	2314	449	0.297	4
Jeff Kent	0.67	2461	377	0.290	5
Joe Mauer	0.70	2123	143	0.306	6

注意

選出には成績以外の要因が入ります. 薬物疑惑や賭博による事実上の除外, 逆に守備や人望による選出があります. 上の「外した」表は, モデルの欠陥と投票側の事情が混ざったものです. どちらかは数字だけでは決められません.
通算成績は時代で意味が変わります. 打高投低の時代の通算本塁打と, 投高打低の時代のそれは同じ重みではありません. ここでは時代補正をしていません. 1994年で訓練と検証を切っているので, 時代がずれるぶん検証は不利に出ます.
対象を「10シーズン以上・2019年までに引退」で切り, さらに野手は通算1000打数以上, 投手は通算1500アウト (500イニング) 以上に絞っています. 代打専門や短命の投手を外すためですが, この線引きも恣意的です. ベテラン委員会による古い時代の選出は, 投票の仕組みが記者投票と違う点にも注意が要ります.
投手の判定は通算出場に占める投手出場の割合で決めています. 二刀流の選手はどちらか一方にしか入りません.
正解率 (accuracy) は使っていません. 殿堂入りは全体の 8.3%しかおらず, 「全員入らない」と答えるだけで高い正解率が出てしまうためです.

殿堂入りは通算成績でどこまで説明できるか

2026-08-11

殿堂入りは数字で決まるのか

訓練と検証を時代で分ける

上位から何人当たるか

モデルが外した選手

注意