4月の首位打者は, 首位打者になるのか
2026-08-10
4月20日時点の成績を見て, その年の首位打者を当てられるかを考えます.
打率の推定では, 序盤の打率をどう縮小すれば シーズン打率に近づくかを見ました. ここでは一歩進めて, 「誰が一番打つか」という順位の問題を扱います.
点推定では答えられません. 事後分布が要ります.
library(data.table)
library(dplyr)
library(ggplot2)
library(knitr)
panel <- fread("../../data/derived/batters-through-apr20.csv")
draws <- fread("../../data/derived/posterior-samples.csv")
est <- fread("../../data/derived/batting-estimates.csv")139人 (2013年に規定打席に到達した打者) の,
4月20日までの成績とシーズン打率です. draws
は階層ベイズの事後分布から取った 4,000サンプル × 139人です. 作り方は
estimate-rstanarm.R にあります.
## 列と打者の対応を確かめておく。draws の j 列目は panel の j 行目の打者。
## ずれていると以降が全部おかしくなるので、中央値で突き合わせる。
stopifnot(identical(panel$BAT_ID, est$BAT_ID))
stopifnot(max(abs(apply(draws, 2, median) - est$MCMC)) < 1e-9)4月の首位打者
dat <- data.table(
選手 = est$FULLNAME,
打数 = panel$ATBAT,
安打 = panel$HITS,
四月打率 = panel$AVG,
推定打率 = est$MCMC,
シーズン打率 = panel$AVG_SEASON
)
dat[order(-四月打率)][1:6] |> kable(digits = 3)| 選手 | 打数 | 安打 | 四月打率 | 推定打率 | シーズン打率 |
|---|---|---|---|---|---|
| David Ortiz | 4 | 2 | 0.500 | 0.271 | 0.309 |
| Chris Johnson | 55 | 23 | 0.418 | 0.284 | 0.321 |
| Freddie Freeman | 17 | 7 | 0.412 | 0.274 | 0.319 |
| Torii Hunter | 70 | 28 | 0.400 | 0.285 | 0.304 |
| Jed Lowrie | 66 | 26 | 0.394 | 0.284 | 0.290 |
| Joe Mauer | 61 | 24 | 0.393 | 0.283 | 0.324 |
首位はDavid Ortizの0.500です. ただし4打数しかありません. 2本打っただけでこの位置に来ています.
打数はばらついています (4から79, 中央値60). 打率の順位表は, 打数の少ない打者が上に来やすい仕組みになっています.
点推定では順位を付けられない
階層ベイズの推定値を見ます.
dat |>
ggplot(aes(x = 四月打率, y = 推定打率, size = 打数)) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
geom_point(alpha = 0.6) +
ggtitle("縮小すると, 推定値はほとんど同じ値に潰れる")
推定打率は0.253 〜 0.285の範囲に収まっています. 幅は0.032しかありません.
この順に並べても意味がありません. 1位と10位の差が 打率にして数厘では, 順位は誤差で入れ替わります. 縮小推定は「値」を良くしますが, 「誰が一番か」には答えていません.
事後分布なら確率が出せる
点推定を1つ選ぶ代わりに, サンプルごとに誰が最高かを数えます.
事後分布から取った1回のサンプルは「あり得た世界」1つぶんです. その世界で真の打率が一番高いのが誰かを見て, 4,000回ぶん集計すれば, その打者がリーグ最高である確率になります.
M <- as.matrix(draws)
winner <- max.col(M, ties.method = "first") # 各サンプルでの最高打率の打者
dat[, 最高である確率 := tabulate(winner, ncol(M)) / nrow(M)]
dat[order(-最高である確率)][1:10] |> kable(digits = 3)| 選手 | 打数 | 安打 | 四月打率 | 推定打率 | シーズン打率 | 最高である確率 |
|---|---|---|---|---|---|---|
| Torii Hunter | 70 | 28 | 0.400 | 0.285 | 0.304 | 0.043 |
| Chris Johnson | 55 | 23 | 0.418 | 0.284 | 0.321 | 0.034 |
| Joe Mauer | 61 | 24 | 0.393 | 0.283 | 0.324 | 0.032 |
| Jed Lowrie | 66 | 26 | 0.394 | 0.284 | 0.290 | 0.032 |
| Adrian Gonzalez | 61 | 23 | 0.377 | 0.281 | 0.293 | 0.030 |
| Jean Segura | 57 | 22 | 0.386 | 0.281 | 0.294 | 0.027 |
| Jose Altuve | 70 | 27 | 0.386 | 0.284 | 0.283 | 0.025 |
| Chris Davis | 58 | 22 | 0.379 | 0.280 | 0.286 | 0.022 |
| Miguel Cabrera | 72 | 25 | 0.347 | 0.278 | 0.348 | 0.020 |
| Chris Denorfia | 48 | 18 | 0.375 | 0.278 | 0.279 | 0.020 |
最も高い打者でも4.2%です (Torii Hunter).
dat |>
ggplot(aes(x = reorder(選手, -最高である確率), y = 最高である確率)) +
geom_col() +
scale_y_continuous(labels = scales::percent) +
theme(axis.text.x = element_blank(), axis.ticks.x = element_blank()) +
xlab(sprintf("%d人の打者 (確率順)", nrow(dat))) +
ggtitle("誰も抜け出していない")
確率を半分集めるのに26人, 9割集めるのに93人必要です. 139人全員に0でない確率が付いています.
4月20日の時点では, 首位打者はほとんど絞り込めていません. これが正直な答えです.
打数が確率を決める
4月打率が高い打者を, 打数と一緒に並べます.
dat[四月打率 >= 0.35][order(-四月打率)][
, .(選手, 打数, 四月打率, 推定打率, 最高である確率)] |>
head(8) |> kable(digits = 3)| 選手 | 打数 | 四月打率 | 推定打率 | 最高である確率 |
|---|---|---|---|---|
| David Ortiz | 4 | 0.500 | 0.271 | 0.012 |
| Chris Johnson | 55 | 0.418 | 0.284 | 0.034 |
| Freddie Freeman | 17 | 0.412 | 0.274 | 0.010 |
| Torii Hunter | 70 | 0.400 | 0.285 | 0.043 |
| Jed Lowrie | 66 | 0.394 | 0.284 | 0.032 |
| Joe Mauer | 61 | 0.393 | 0.283 | 0.032 |
| Jean Segura | 57 | 0.386 | 0.281 | 0.027 |
| Jose Altuve | 70 | 0.386 | 0.284 | 0.025 |
David Ortizは打率0.500で全体1位ですが, 確率は1.1%です. 一方Torii Hunterは打率0.400と下ですが, 70打数あるので確率は4.2%, 3.7倍あります.
打率だけ見るとDavid Ortizが上, 確率で見るとTorii Hunterが上です. 順位表は打数を見ていませんが, 事後分布は見ています.
dat |>
ggplot(aes(x = 打数, y = 最高である確率, colour = 四月打率)) +
geom_point(size = 2) +
scale_colour_viridis_c() +
scale_y_continuous(labels = scales::percent) +
ggtitle("同じ打率でも, 打数が少ないと確率は上がらない")
実際は誰だったか
dat[, `:=`(四月順位 = frank(-四月打率), 確率順位 = frank(-最高である確率))]
dat[order(-シーズン打率)][1:5,
.(選手, シーズン打率, 四月打率, 四月順位, 最高である確率, 確率順位)] |>
kable(digits = 3)| 選手 | シーズン打率 | 四月打率 | 四月順位 | 最高である確率 | 確率順位 |
|---|---|---|---|---|---|
| Miguel Cabrera | 0.348 | 0.347 | 17.0 | 0.020 | 9 |
| Michael Cuddyer | 0.331 | 0.357 | 14.0 | 0.017 | 14 |
| Joe Mauer | 0.324 | 0.393 | 6.0 | 0.032 | 3 |
| Mike Trout | 0.323 | 0.304 | 43.5 | 0.004 | 79 |
| Chris Johnson | 0.321 | 0.418 | 2.0 | 0.034 | 2 |
首位打者はMiguel Cabreraの0.348でした.
4月20日時点では打率0.347で 17位, 確率で見ると9位 (2.0%) です.
4月の首位だったDavid Ortizのシーズン打率は 0.309で, 首位打者ではありませんでした.
確率は順位予測ではない
ここで欲張ってはいけません. 「確率のほうが当たる」と言えるかを確かめます.
tibble::tibble(
指標 = c("4月打率", "推定打率 (階層ベイズ)", "最高である確率"),
`シーズン打率との順位相関` = c(
cor(dat$四月打率, dat$シーズン打率, method = "spearman"),
cor(dat$推定打率, dat$シーズン打率, method = "spearman"),
cor(dat$最高である確率, dat$シーズン打率, method = "spearman"))
) |> kable(digits = 3)| 指標 | シーズン打率との順位相関 |
|---|---|
| 4月打率 | 0.483 |
| 推定打率 (階層ベイズ) | 0.449 |
| 最高である確率 | 0.343 |
確率の順位相関は0.343で, 4月打率の0.483より低いです.
意外ではありません. 確率はほとんどの打者で0に近い値に潰れるので, 下位の並び順に情報が残りません. 順位を当てる道具ではないのです.
事後分布から得られるのは順位ではなく, 「どれくらい分からないか」です. 「最も有力な打者でも4%」という言い方は, 点推定からは出てきません.
まとめ
- 4月20日の打率順位表の首位は4打数の選手でした. 順位表は打数を見ていません.
- 階層ベイズの点推定は0.032の幅に潰れるので, 並べても順位にはなりません.
- 事後分布なら「その打者がリーグ最高である確率」が出せます. 最大でも4.2%, 半分集めるのに26人でした. 4月では絞り込めていません.
- ただし確率は順位予測としては優れていません (順位相関 0.343 対 0.483). 得られるのは不確かさの定量化です.
注意
- 2013年の1シーズンだけです. 「4月では分からない」がどの年でも成り立つかは 確かめていません.
- 対象は規定打席に到達した139人です. 4月時点では誰が 規定打席に届くか分からないので, 結果を見てから対象を選んでいます. 実際の予想問題より易しい設定です.
- モデルは打者ごとの変量効果だけで, 球場・相手投手・打順を見ていません.
- 「真の打率がリーグ最高」と「シーズン打率が最高」は別物です. 後者には残り5か月ぶんの偶然が乗ります. ここで出した確率は前者のものです.