この球は振るべきだったのか
2026-08-18
選球眼は普通「見逃し率」や「ボール球に手を出した率」で測ります. これはその球を振るべきだったかどうかを問うていません. ゾーンの外でも打てる球はありますし, ゾーンの中でも見送ったほうがいい球はあります.
ここでは1球ごとに「振ったときの期待得点」と「見送ったときの期待得点」を出し, その差で選択を評価します.
反実仮想が本体です. 実際に見送った球について「振っていたらどうなったか」を 推定するので, その推定が観測に支えられているかを先に確かめます.
library(data.table)
library(dplyr)
library(ggplot2)
library(mgcv)
library(knitr)
source("../../R/plate.R")
source("../../R/retrosheet.R")
SEASON <- 2024
src <- sprintf("../../data/statcast_%d_all.csv", SEASON)
if (!file.exists(src)) {
stop("データがありません: ", src,
"\n Rscript data/build-statcast.R ", SEASON, " --all-pitch-types")
}
dat <- fread(src, select = c("game_pk", "at_bat_number", "pitch_number",
"description", "events", "delta_run_exp",
"balls", "strikes", "plate_x", "plate_z",
"sz_top", "sz_bot", "stand", "batter",
"player_name", "pitch_type"))得点の物差しをどこから取るか
得点期待値は作り直しません. Statcast の
delta_run_exp (その投球による得点期待値の変化,
打者側から見た値) をそのまま使います.
このリポジトリには R/retrosheet.R の
run_expectancy() がありますが,
これは塁状況×アウトの24状態の得点期待値です.
ここで要るのは「カウントが1つ進むといくら動くか」なので, 軸が違います.
そのまま代用はできません.
代わりに, 両者が同じ物差しになっているかを打席結果の価値で突き合わせます.
rs <- fread("../../data/all2013.csv")
setnames(rs, unlist(fread("../../data/reference/retrosheet-columns.csv",
header = FALSE)))
x24 <- re24(rs)
lab <- c("2" = "アウト(打球)", "3" = "三振", "14" = "四球", "16" = "死球",
"20" = "単打", "21" = "二塁打", "22" = "三塁打", "23" = "本塁打")
rw <- x24[EVENT_CD %in% as.integer(names(lab)),
.(retrosheet = mean(re24), n_rs = .N), by = EVENT_CD]
rw[, 結果 := lab[as.character(EVENT_CD)]]
ev_map <- c(field_out = "アウト(打球)", strikeout = "三振", walk = "四球",
hit_by_pitch = "死球", single = "単打", double = "二塁打",
triple = "三塁打", home_run = "本塁打")
sw <- dat[events %in% names(ev_map),
.(statcast = mean(delta_run_exp, na.rm = TRUE), n_sc = .N), by = events]
sw[, 結果 := ev_map[events]]
cmp <- merge(rw[, .(結果, retrosheet, n_rs)], sw[, .(結果, statcast, n_sc)],
by = "結果")
cmp[, 差 := statcast - retrosheet]
setorder(cmp, -retrosheet)kable(cmp, digits = 3, format.args = list(big.mark = ","),
col.names = c("結果", "retrosheet 2013 (RE24)", "件数",
"Statcast 2024 (delta_run_exp)", "件数", "差"))| 結果 | retrosheet 2013 (RE24) | 件数 | Statcast 2024 (delta_run_exp) | 件数 | 差 |
|---|---|---|---|---|---|
| 本塁打 | 1.367 | 4,661 | 1.524 | 5,453 | 0.157 |
| 三塁打 | 1.029 | 772 | 0.995 | 697 | -0.034 |
| 二塁打 | 0.738 | 8,222 | 0.730 | 7,771 | -0.008 |
| 単打 | 0.436 | 28,438 | 0.449 | 25,902 | 0.013 |
| 死球 | 0.301 | 1,536 | 0.367 | 2,020 | 0.066 |
| 四球 | 0.292 | 13,622 | 0.240 | 14,420 | -0.052 |
| アウト(打球) | -0.249 | 87,917 | -0.250 | 73,822 | -0.001 |
| 三振 | -0.252 | 36,710 | -0.219 | 41,086 | 0.033 |
相関は0.9947で, 同じ物差しとみなせます. 最も離れているのは本塁打 (0.157点) ですが, これは2013年と2024年で走者のいる頻度が違うためで, 定義の食い違いではありません.
振ったか見送ったか
SWING <- c("swinging_strike", "swinging_strike_blocked", "foul", "foul_tip",
"hit_into_play", "foul_bunt", "missed_bunt", "bunt_foul_tip")
TAKE <- c("called_strike", "ball", "blocked_ball", "hit_by_pitch", "pitchout")
# automatic_ball / automatic_strike はピッチクロック違反などで, 実際の投球ではない
n_auto <- dat[!description %in% c(SWING, TAKE), .N]
p <- dat[description %in% c(SWING, TAKE)]
p <- p[!is.na(plate_x) & !is.na(plate_z) & !is.na(sz_top) & !is.na(sz_bot) &
!is.na(delta_run_exp)]
p[, swing := as.integer(description %in% SWING)]
p[, z := (plate_z - (sz_top + sz_bot) / 2) / ((sz_top - sz_bot) / 2)]
p[, cnt := factor(paste0(balls, "-", strikes))]
# 打者の名前を引く。**Statcast の player_name は投手の名前**なので,
# by = batter で player_name を拾うと無関係な投手名が出る (最初これをやった)。
# batter は MLBAM の数値 ID なので data/derived/mlbam-names.csv で直す。
names_file <- "../../data/derived/mlbam-names.csv"
if (!file.exists(names_file)) {
stop("ありません: ", names_file,
"\n Rscript data/build-derived.R mlbam-names")
}
mlbam <- fread(names_file)
who <- function(id) mlbam[match(as.integer(id), key_mlbam), name]709,222球が対象です (投球でない2,387球を除外). スイング率は48%でした.
3つの部品を作る
部品1: 見送ったときの見逃しストライク確率
tk <- p[swing == 0]
m_cs <- bam(as.integer(description == "called_strike") ~
te(plate_x, z, k = c(12, 12)) + cnt,
data = tk, family = binomial, discrete = TRUE)部品2: 振ったときの結果分布
空振り / ファウル / インプレーの3つに分かれます. この3つを別々に推定すると合計が1になりません. 条件つきに分解して, 構造として1になるようにします.
sw3 <- p[swing == 1]
sw3[, out3 := fifelse(
description %in% c("swinging_strike", "swinging_strike_blocked", "missed_bunt"),
"whiff",
fifelse(description == "hit_into_play", "inplay", "foul"))]
sw3 |> count(out3) |> mutate(割合 = n / sum(n)) |>
kable(digits = 3, format.args = list(big.mark = ","))| out3 | n | 割合 |
|---|---|---|
| foul | 137,248 | 0.403 |
| inplay | 124,161 | 0.365 |
| whiff | 78,868 | 0.232 |
m_whiff <- bam(as.integer(out3 == "whiff") ~ te(plate_x, z, k = c(12, 12)) + cnt,
data = sw3, family = binomial, discrete = TRUE)
# 当たった球のうちインプレーになる割合 (空振りを除いた集合で推定する)
m_ip_c <- bam(as.integer(out3 == "inplay") ~ te(plate_x, z, k = c(12, 12)) + cnt,
data = sw3[out3 != "whiff"], family = binomial, discrete = TRUE)部品3: インプレーになったときの期待得点
m_ip_v <- bam(delta_run_exp ~ te(plate_x, z, k = c(10, 10)) + cnt,
data = sw3[out3 == "inplay"], discrete = TRUE)それぞれの結果はいくらか
カウントごとに, 各結果の得点価値をデータから出します.
V <- rbind(
tk[description == "called_strike", .(k = "strike", v = mean(delta_run_exp)), by = cnt],
tk[description != "called_strike", .(k = "ball", v = mean(delta_run_exp)), by = cnt],
sw3[out3 == "whiff", .(k = "whiff", v = mean(delta_run_exp)), by = cnt],
sw3[out3 == "foul", .(k = "foul", v = mean(delta_run_exp)), by = cnt])
# 先に走る estimate-rstan*.R の library(reshape2) が dcast をマスクする。
# reshape2 の dcast は data.frame を返すため、下の Vw[cnt == "0-2"] が
# 列選択と解釈されて "object 'cnt' not found" で落ちる。
Vw <- data.table::dcast(V, cnt ~ k, value.var = "v")
setorder(Vw, cnt)kable(Vw, digits = 4,
col.names = c("カウント", "ボール", "ファウル", "見逃しストライク", "空振り"))| カウント | ボール | ファウル | 見逃しストライク | 空振り |
|---|---|---|---|---|
| 0-0 | 0.0379 | -0.0399 | -0.0399 | -0.0404 |
| 0-1 | 0.0289 | -0.0562 | -0.0562 | -0.0567 |
| 0-2 | 0.0254 | -0.0093 | -0.1668 | -0.1670 |
| 1-0 | 0.0625 | -0.0489 | -0.0491 | -0.0492 |
| 1-1 | 0.0525 | -0.0606 | -0.0608 | -0.0612 |
| 1-2 | 0.0429 | -0.0108 | -0.1894 | -0.1889 |
| 2-0 | 0.1130 | -0.0603 | -0.0606 | -0.0594 |
| 2-1 | 0.1056 | -0.0730 | -0.0730 | -0.0738 |
| 2-2 | 0.0997 | -0.0125 | -0.2281 | -0.2273 |
| 3-0 | 0.1339 | -0.0619 | -0.0687 | -0.0616 |
| 3-1 | 0.2003 | -0.0822 | -0.0823 | -0.0826 |
| 3-2 | 0.2870 | -0.0159 | -0.3247 | -0.3230 |
2ストライクからのファウルは-0.009点とほぼ無害ですが, 同じカウントの空振りは-0.167点です. 同じ「当たらなかった」でも, 当てられるかどうかで意味が全く違います.
期待得点を組み立てる
p[, p_cs := predict(m_cs, p, type = "response")]
p[, p_wh := predict(m_whiff, p, type = "response")]
p[, p_ic := predict(m_ip_c, p, type = "response")]
p[, v_ip := predict(m_ip_v, p)]
probs <- swing_outcome_probs(p$p_wh, p$p_ic)
p[, `:=`(pw = probs$whiff, pf = probs$foul, pi = probs$inplay)]
# 検証: 各投球で3つの確率の合計が1
max_dev <- max(abs(p$pw + p$pf + p$pi - 1))
stopifnot(max_dev < 1e-10)
p <- merge(p, Vw, by = "cnt", sort = FALSE)
p[, ev_swing := ev_swing(data.table(whiff = pw, foul = pf, inplay = pi),
whiff, foul, v_ip)]
p[, ev_take := ev_take(p_cs, strike, ball)]
p[, gain := ev_swing - ev_take]結果分布の合計が1からずれる最大値は 2.2e-16でした.
ど真ん中と大きく外れた球
chk <- p[1][rep(1, 3)]
chk[, `:=`(plate_x = c(0, 1.6, -1.6), z = c(0, 0, 0),
cnt = factor("0-0", levels = levels(p$cnt)))]
chk <- merge(chk[, !c("strike", "ball", "whiff", "foul")], Vw, by = "cnt", sort = FALSE)
chk[, p_cs := predict(m_cs, chk, type = "response")]
chk[, p_wh := predict(m_whiff, chk, type = "response")]
chk[, p_ic := predict(m_ip_c, chk, type = "response")]
chk[, v_ip := predict(m_ip_v, chk)]
q <- swing_outcome_probs(chk$p_wh, chk$p_ic)
chk[, ev_swing := ev_swing(q, whiff, foul, v_ip)]
chk[, ev_take := ev_take(p_cs, strike, ball)]
chk[, 場所 := c("ど真ん中", "外に大きく外れる", "内に大きく外れる")]
kable(chk[, .(場所, `EV(振る)` = round(ev_swing, 4),
`EV(見送る)` = round(ev_take, 4),
差 = round(ev_swing - ev_take, 4))])| 場所 | EV(振る) | EV(見送る) | 差 |
|---|---|---|---|
| ど真ん中 | 0.0270 | -0.0399 | 0.0669 |
| 外に大きく外れる | -0.0404 | 0.0379 | -0.0783 |
| 内に大きく外れる | -0.0443 | 0.0379 | -0.0822 |
ど真ん中では振るほうが0.067点得, 大きく外れた球では見送るほうが得です. 向きは期待どおりでした.
反実仮想は観測に支えられているか
ここが一番大事です. 見送った球について「振っていたら」を推定する以上, その場所で実際に振った例が無ければ, 出てくる数字は外挿です.
sup <- swing_support(p$plate_x, p$z, p$swing, xlim = c(-2, 2), ylim = c(-3, 3))
thin <- sup[n_take >= 200 & n_swing < 30]ggplot(sup, aes(x_mid, y_mid, fill = n_swing)) +
geom_raster() +
scale_fill_viridis_c(trans = "log10", name = "スイング数") +
annotate("rect", xmin = -0.83, xmax = 0.83, ymin = -1, ymax = 1,
fill = NA, colour = "white", linewidth = 0.6) +
coord_fixed(ratio = 0.83) +
labs(x = "横位置 (フィート)", y = "縦位置 (1 = ゾーン上端)",
title = "各格子で実際に振られた球数") +
theme_minimal()
見送りが200球以上あるのにスイングが30球未満の格子が 70個あり, そこに19,515球 (全体の2.8%) の見送りが入っています. ここでの「振っていたら」は外挿です.
どれくらい効くかを見るために, 薄い格子を除いて集計し直します.
thin_key <- paste(thin$bx, thin$by)
sup_all <- swing_support(p$plate_x, p$z, p$swing, xlim = c(-2, 2), ylim = c(-3, 3))
p[, cell := paste(cut(plate_x, seq(-2, 2, length.out = 25), include.lowest = TRUE),
cut(z, seq(-3, 3, length.out = 25), include.lowest = TRUE))]
p[, thin_cell := cell %in% thin_key]薄い格子の見送りは, ゾーンから大きく外れた球に偏っています.
p[, .(球数 = .N,
`|plate_x|の中央値` = round(median(abs(plate_x)), 2),
`|z|の中央値` = round(median(abs(z)), 2)),
by = .(薄い格子 = thin_cell)] |>
kable(format.args = list(big.mark = ","))| 薄い格子 | 球数 | |plate_x|の中央値 | |z|の中央値 |
|---|---|---|---|
| FALSE | 688,679 | 0.55 | 0.71 |
| TRUE | 20,543 | 1.43 | 1.72 |
以降の集計はこれらを含めたままにしますが, 打者ごとの比較には薄い格子を除いた値も併記して, 結論が変わらないことを確かめます.
何と比べるか
「実際の選択でどれだけ得点を取り逃したか」を出す前に, 比較対象を決めます. 情報を使わない方針から順に並べ, 最後に真の位置を知っている方針を置きます.
p[, best := pmax(ev_swing, ev_take)]
p[, chosen := fifelse(swing == 1, ev_swing, ev_take)]
# ルールブック上のゾーン (横 ±0.83 ft, 縦は正規化して ±1)
p[, in_zone := abs(plate_x) <= 0.83 & abs(z) <= 1]
pol <- data.table(
方針 = c("常に見送る", "常に振る", "ゾーンなら振る", "実際の選択",
"毎球いいほうを選ぶ (上限)"),
期待得点 = c(mean(p$ev_take), mean(p$ev_swing),
mean(fifelse(p$in_zone, p$ev_swing, p$ev_take)),
mean(p$chosen), mean(p$best)))
pol[, `100球あたり(点)` := 100 * 期待得点]setorder(pol, 期待得点)
kable(pol[, .(方針, `100球あたり(点)` = round(`100球あたり(点)`, 2))])| 方針 | 100球あたり(点) |
|---|---|
| 常に振る | -3.80 |
| 常に見送る | -1.42 |
| 実際の選択 | 0.00 |
| ゾーンなら振る | 2.23 |
| 毎球いいほうを選ぶ (上限) | 2.36 |
v <- setNames(100 * pol$期待得点, pol$方針)並べてみて分かることが2つあります.
1. 実際の打者は, 情報を使わない方針を上回っています. 「常に振る」は-3.8点, 「常に見送る」は-1.42点で, 実際の選択 (0点) はどちらより上です. 選球そのものは効いています.
2. しかし「ゾーンなら振る」には2.23点負けています.
これを「打者はゾーンの内外すら見分けられていない」と読むのは誤りです. この方針は投球がどこを通ったかを正確に知っている前提だからです. 打者はボールが到達する前に振り始めるので, その情報を持っていません.
つまりこの2.23点は, 判断の下手さではなく位置が分からないことのコストです.
同じ理由で「毎球いいほうを選ぶ」 (2.36点) にも誰も到達できません. 意味があるのは水準ではなく打者どうしの差だけです.
ついでに分かるのは, 位置さえ分かれば 単純なゾーン則で上限の94%が取れる ことです. 「ゾーンの内か外か」以上の細かい判断が効く余地は, 見た目ほど大きくありません.
p[, lost := best - chosen]
MIN_PITCH <- 1000
bt <- p[, .(球数 = .N,
取り逃し = 100 * mean(lost),
取り逃し_厚い格子のみ = 100 * mean(lost[!thin_cell]),
スイング率 = mean(swing),
ゾーン外スイング率 = mean(swing[!in_zone])),
by = batter][球数 >= MIN_PITCH]
bt[, 打者 := who(batter)]
setorder(bt, 取り逃し)
r_thin <- cor(bt$取り逃し, bt$取り逃し_厚い格子のみ, method = "spearman")薄い格子を除いても打者の順位はほとんど変わりません (Spearman 0.997). 外挿の影響は結論を変えていません.
1,000球以上を見た323人が対象です.
bt_best <- bt[1]
bt_worst <- bt[.N]選択がいちばん良かったのは George Springer です (100球あたりの取り逃し 1.6点). いちばん悪かったのは Javier Báez で 3.66点でした.
rbind(head(bt, 6), tail(bt, 6))[
, .(打者, 球数, 取り逃し = round(取り逃し, 2),
厚い格子のみ = round(取り逃し_厚い格子のみ, 2),
スイング率 = round(スイング率, 3),
ゾーン外スイング率 = round(ゾーン外スイング率, 3))] |>
kable(format.args = list(big.mark = ","),
col.names = c("打者", "球数", "取り逃し(100球, 点)", "厚い格子のみ",
"スイング率", "ゾーン外スイング率"))| 打者 | 球数 | 取り逃し(100球, 点) | 厚い格子のみ | スイング率 | ゾーン外スイング率 |
|---|---|---|---|---|---|
| George Springer | 2,299 | 1.60 | 1.62 | 0.491 | 0.253 |
| Dylan Moore | 1,804 | 1.69 | 1.74 | 0.424 | 0.201 |
| Chris Taylor | 1,046 | 1.75 | 1.79 | 0.477 | 0.222 |
| Kyle Tucker | 1,349 | 1.75 | 1.80 | 0.418 | 0.197 |
| Jake Bauers | 1,512 | 1.81 | 1.86 | 0.458 | 0.216 |
| Geraldo Perdomo | 1,580 | 1.81 | 1.88 | 0.405 | 0.223 |
| Edmundo Sosa | 1,050 | 2.99 | 2.96 | 0.568 | 0.417 |
| Anthony Santander | 2,738 | 3.01 | 3.04 | 0.497 | 0.367 |
| Keibert Ruiz | 1,659 | 3.03 | 3.03 | 0.523 | 0.396 |
| Ceddanne Rafaela | 2,070 | 3.15 | 3.20 | 0.619 | 0.485 |
| Salvador Perez | 2,301 | 3.19 | 3.25 | 0.578 | 0.446 |
| Javier Báez | 1,020 | 3.66 | 3.68 | 0.525 | 0.440 |
最良と最悪の差は 2.06点 (100球あたり) です. 1シーズンでおよそ1089球を見るので, 22点, およそ2.2勝ぶんの幅になります.
従来の指標とどれくらい違うか
r_chase <- cor(bt$ゾーン外スイング率, bt$取り逃し)
ct_chase <- cor.test(bt$ゾーン外スイング率, bt$取り逃し)ggplot(bt, aes(ゾーン外スイング率, 取り逃し)) +
geom_point(alpha = 0.6, colour = "steelblue") +
geom_smooth(method = "lm", colour = "firebrick") +
labs(x = "ゾーン外スイング率 (従来の選球指標)",
y = "取り逃した得点 (100球あたり)") +
theme_minimal()
相関は r = 0.736 (95%信頼区間 0.682 〜 0.782) です. 同じ方向を向いてはいますが, 一致はしません. ゾーン外に手を出しても, それが打てる球なら損にはならないためです.
1打席を追う
p[, pa := paste(game_pk, at_bat_number)]
cand <- p[, .(n = .N, mx = max(abs(gain))), by = pa][n >= 6][order(-mx)]
one <- p[pa == cand[1]$pa][order(pitch_number)]one[, .(球目 = pitch_number, カウント = as.character(cnt), 球種 = pitch_type,
選択 = fifelse(swing == 1, "振った", "見送った"),
結果 = description,
`EV(振る)` = round(ev_swing, 3), `EV(見送る)` = round(ev_take, 3),
差 = round(gain, 3),
判定 = fifelse((gain > 0) == (swing == 1), "○", "×"))] |>
kable()| 球目 | カウント | 球種 | 選択 | 結果 | EV(振る) | EV(見送る) | 差 | 判定 |
|---|---|---|---|---|---|---|---|---|
| 1 | 0-0 | FF | 振った | swinging_strike | 0.012 | -0.040 | 0.052 | ○ |
| 2 | 0-1 | FF | 振った | foul | -0.009 | -0.053 | 0.044 | ○ |
| 3 | 0-2 | SL | 見送った | blocked_ball | -0.159 | 0.025 | -0.185 | ○ |
| 4 | 1-2 | FF | 振った | foul | 0.034 | -0.185 | 0.218 | ○ |
| 5 | 1-2 | FF | 見送った | ball | -0.078 | 0.042 | -0.121 | ○ |
| 6 | 2-2 | FF | 見送った | ball | -0.161 | 0.100 | -0.261 | ○ |
| 7 | 3-2 | FF | 振った | foul | -0.020 | -0.320 | 0.300 | ○ |
| 8 | 3-2 | FF | 見送った | ball | -0.323 | 0.287 | -0.610 | ○ |
打者は Donovan Solano, 投手は Otañez, Michel です. この打席で取り逃した得点は0点でした.
限界
- 反実仮想です. 「振っていたら」の推定は, 同じ場所・同じカウントで 実際に振った他の打席から作っています. その打者がその球を打てたかどうかは 分かりません
- 打者ごとの能力差を部品に入れていません. 全打者共通の 空振り確率・インプレー価値を使っているので, 取り逃しの大小には打者の技術ではなく選択の癖が出ます
- 球種を識別できたかはモデル化していません. 実際には打者は リリース直後の情報で判断しており, 「見てから決める」余地は ここで仮定しているほど大きくありません
- 部品はロジスティック回帰 + 平滑項です. issue が挙げていた BART は 使っていません. 非線形が効くと分かってから替えるべきで, まずは単純な形で通しました
- 2024年の1シーズンだけです
まとめ
- 得点期待値は作り直さず Statcast の
delta_run_expを使い,R/retrosheet.Rの RE24 と打席結果の価値で突き合わせた (相関 0.9947) - 3つの部品 (見逃しストライク確率 / 振ったときの結果分布 / インプレーの価値) を 条件つきに分解し, 結果分布の合計が各投球で1になるようにした
- ど真ん中では振るほうが0.067点得, 大きく外れた球では見送るほうが得. 向きは期待どおり
- 反実仮想はおおむね観測に支えられているが, 見送りの 2.8%は スイング例の薄い格子にある (外挿). 除いても打者の順位は変わらない (Spearman 0.997)
- 実際の打者は情報を使わない方針 (常に振る -3.8点 / 常に見送る -1.42点) を 上回る (0点)
- ただし「ゾーンなら振る」(2.23点) には負ける. これは判断の下手さではなく, 投球位置が事前に分からないことのコスト. この方針も上限も真の位置を知っている前提で, 誰にも到達できない
- 位置さえ分かれば単純なゾーン則で上限の 94%が取れる
- 打者間の幅は100球あたり2.06点 (シーズンおよそ2.2勝)
- 選択が最も良かったのは George Springer (1.6点), 最も悪かったのは Javier Báez (3.66点)
- 従来のゾーン外スイング率との相関は r = 0.736. 同じ方向だが一致しない