← 記事一覧へ

勝負強さとは

勝負強さが知りたいです. 点をとってくれる打者を評価したいです.

指標としてまず思いつくのは得点圏打率ですが, これには打点が反映されていません. かといって生の打点は打順に依存します. 勝負強くない打者でも, チャンスの場面で たくさん打席が回ってくれば勝手に打点が上がっていきます.

場面の有利さを差し引いた指標が要ります.

library(data.table)
library(dplyr)
library(ggplot2)
library(xtable)
source("../../R/retrosheet.R")

year = 2013
dat = fread(paste0("../../data/all", year, ".csv"))
names = fread("../../data/reference/retrosheet-columns.csv", header = FALSE) %>% unlist
setnames(dat, names)
fullname = fread("../../data/derived/player-names.csv")

打席あたりの打点平均では測れない

最初は「走者状況とアウトカウント別に, その打席で入る打点の平均」を出していました. ところがこれを満塁について見ると, おかしなことになります.

rbi_per_pa <-
  dat %>%
  mutate(base_state = base_state(dat)) %>%
  filter(base_state == 7) %>%          # 満塁
  group_by(OUTS_CT) %>%
  dplyr::summarise(打席 = n(), 打点平均 = mean(RBI_CT), .groups = "drop")
rbi_per_pa %>% as.data.frame %>% xtable(digits = 3) %>% print(type = "html")
OUTS_CT 打席 打点平均
1 0 630 0.708
2 1 1621 0.766
3 2 2008 0.532

0アウト満塁が0.708点, 1アウト満塁が0.766点で, アウトが1つ増えたほうが打点が多いという結果になります.

これは感覚と合いません. そして実際, 指標のほうが間違っています.

打点は「その打席で還った走者」しか数えません. 0アウトなら, その打席で 打点が付かなくてもイニングはまだ続き, 後続が返してくれます. 1アウトでは その機会が減るぶん, 「今この打席で返す」圧力が高くなり, 犠牲フライのように打点だけは付くプレーの比率が上がります.

つまり打点平均は, イニングの残りを見ていないのが問題です.

得点期待値

見るべきは「その場面から, イニングが終わるまでに平均何点入るか」です. 走者状況8通り × アウトカウント3通りの24状態について集計します.

re <- run_expectancy(dat)
re_tbl <- re %>%
  mutate(走者 = base_state_label(base_state)) %>%
  dcast(走者 ~ OUTS_CT, value.var = "RE")
setnames(re_tbl, c("走者", "0アウト", "1アウト", "2アウト"))
# 走者の少ない順に並べる
ord <- c("走者なし", "一塁", "二塁", "三塁", "一二塁", "一三塁", "二三塁", "満塁")
re_tbl <- re_tbl[match(ord, re_tbl$走者)]
re_tbl %>% as.data.frame %>% xtable(digits = 3) %>% print(type = "html")
走者 0アウト 1アウト 2アウト
1 走者なし 0.456 0.240 0.092
2 一塁 0.810 0.491 0.211
3 二塁 1.088 0.617 0.301
4 三塁 1.310 0.914 0.344
5 一二塁 1.377 0.836 0.400
6 一三塁 1.803 1.109 0.480
7 二三塁 1.997 1.364 0.543
8 満塁 2.182 1.565 0.710

今度は素直な表になりました. 満塁は0アウトで2.18点, 1アウトで1.56点, 2アウトで0.71点と, アウトが増えるほど下がります. どの走者状況でも同じです.

走者なし0アウト (イニングの先頭) は0.456点で, 公表されている近年のメジャーの値ともほぼ一致します.

re %>%
  mutate(走者 = factor(base_state_label(base_state), levels = ord),
         アウト = factor(OUTS_CT)) %>%
  ggplot(aes(x = 走者, y = RE, fill = アウト)) +
  geom_col(position = "dodge") +
  ylab("イニング終了までの期待得点") +
  ggtitle(paste0(year, "年 得点期待値")) +
  theme(axis.text.x = element_text(angle = 30, hjust = 1))

RE24: 打席で期待値をどれだけ動かしたか

場面の有利さを差し引くには, 打席の前後で期待値がどう変わったかを見ます.

\[ \mathrm{RE24} = (\text{打席後の期待値}) - (\text{打席前の期待値}) + (\text{その打席で入った得点}) \]

期待値どおりなら0, 上回れば正になります. 打順や出場機会の多さで 下駄を履かない指標です.

x <- re24(dat, re)
bat <- x %>%
  as_tibble() %>%
  group_by(BAT_ID) %>%
  dplyr::summarise(打席 = n(), RE24 = sum(re24), .groups = "drop") %>%
  filter(打席 >= 300) %>%
  inner_join(fullname, by = c("BAT_ID" = "retroID"))

規定を285人 (300打席以上) として並べます.

期待値を上回った打者

bat %>% arrange(desc(RE24)) %>% head(15) %>%
  dplyr::select(name, 打席, RE24) %>%
  as.data.frame %>% xtable(digits = 1) %>% print(type = "html")
name 打席 RE24
1 Miguel Cabrera 667 80.7
2 Chris Davis 690 76.5
3 Mike Trout 736 69.6
4 Paul Goldschmidt 731 63.9
5 Freddie Freeman 644 57.2
6 David Ortiz 626 54.5
7 Robinson Cano 713 53.1
8 Joey Votto 747 48.7
9 Edwin Encarnacion 637 48.1
10 Matt Holliday 617 46.8
11 Matt Carpenter 723 46.4
12 Shin-Soo Choo 731 45.8
13 Allen Craig 576 45.4
14 Josh Donaldson 693 45.2
15 Michael Cuddyer 558 40.2

期待値を下回った打者

bat %>% arrange(RE24) %>% head(10) %>%
  dplyr::select(name, 打席, RE24) %>%
  as.data.frame %>% xtable(digits = 1) %>% print(type = "html")
name 打席 RE24
1 Darwin Barney 565 -33.5
2 B. J. Upton 456 -28.4
3 Adeiny Hechavarria 595 -27.9
4 Pete Kozma 466 -26.8
5 Starlin Castro 720 -24.4
6 Alcides Escobar 674 -24.0
7 Brendan Ryan 357 -22.2
8 Jose Molina 323 -20.5
9 Clete Thomas 330 -19.9
10 Placido Polanco 429 -18.7

「勝負強さ」は取り出せたのか

RE24 は打者の総合的な得点貢献です. これが大きいのは要するに良い打者で, 「チャンスに強い」かどうかとは別の話です.

チャンスでの上乗せを見たいなら, 走者がいる場面とそうでない場面の 打席あたり RE24 を比べます.

split_re24 <- x %>%
  as_tibble() %>%
  mutate(得点圏 = base_state >= 2) %>%      # 二塁または三塁に走者
  group_by(BAT_ID, 得点圏) %>%
  dplyr::summarise(pa = n(), re24_pa = mean(re24), .groups = "drop") %>%
  tidyr::pivot_wider(names_from = 得点圏, values_from = c(pa, re24_pa)) %>%
  filter(pa_FALSE >= 200, pa_TRUE >= 100) %>%
  mutate(差 = re24_pa_TRUE - re24_pa_FALSE) %>%
  inner_join(fullname, by = c("BAT_ID" = "retroID"))
split_re24 %>%
  ggplot(aes(x = 差)) +
  geom_histogram(bins = 30) +
  geom_vline(xintercept = 0, linetype = "dashed") +
  xlab("得点圏での打席あたりRE24 − それ以外") +
  ggtitle("チャンスでの上乗せ (1打席あたり)")

split_re24 %>% arrange(desc(差)) %>% head(10) %>%
  dplyr::select(name, pa_TRUE, 差) %>%
  setNames(c("name", "得点圏打席", "上乗せ")) %>%
  as.data.frame %>% xtable(digits = 3) %>% print(type = "html")
name 得点圏打席 上乗せ
1 Allen Craig 160 0.259
2 Freddie Freeman 171 0.257
3 Miguel Cabrera 209 0.179
4 John Buck 124 0.167
5 Yadier Molina 148 0.154
6 Robinson Cano 181 0.148
7 Chris Davis 178 0.148
8 Michael Bourn 111 0.147
9 Matt Holliday 155 0.144
10 Matt Carpenter 149 0.142

注意

ここで出た「上乗せ」の順位は, そのまま勝負強さの順位とは読めません.

上乗せの実際のばらつきは標準偏差0.072ですが, 打席数から見積もった偶然だけのばらつきは0.062です. 両者はほぼ同じ大きさで, つまり観測された散らばりの大半は偶然で説明できます. 「チャンスに強い打者」が安定して存在するなら, 実際のばらつきは 偶然の分よりはっきり大きくなるはずです.

その他の注意点:

  • 途中で終わったイニング (サヨナラ勝ちなど) は残り得点が切り詰められるので, 3アウトで終わった回だけで期待値を出しています.
  • 得点期待値はリーグ・年によって変わります. ここでは2013年の データから作った表を, 同じ2013年の打席に当てています.
  • RE24 は打者の貢献に走者の走塁も混ざります. 二塁走者が単打で還るかどうかは 走者の脚にもよります.