勝負強さが知りたいです. 点をとってくれる打者を評価したいです.
勝負強さの指標としては, 得点圏打率があげられると思います.
しかし, 得点圏打率には, 打点が反映されていません. また, 生の打点の数字は, 打順に依存します. 勝負強くない打者でも, チャンスの場面でたくさん打席が回ってくれば, 勝手に打点が上がっていきます.
新しい指標が必要だと思っています.
なので, ランナー状況, アウトカウント別に, 打点の期待値を計算してみました.
たとえば,
「1アウト2, 3塁で迎えた打席では何点生まれることが期待できるか」
などの集計を行った, ということです.
そして, 各バッターが, 各打席で期待打点をどれくらい上回ったか…という計算を行うことによって, 得点能力が分かりませんかね?
ちょっとやってみます.
データ読み込み. 2013年の全打席結果.
library(data.table)
library(dplyr)
library(xtable)
year = 2013
file = paste("../../../../data/all", year, ".csv", sep="")
dat = fread(file)
Read 99.5% of 190907 rows Read 190907 rows and 97 (of 97) columns from 0.076 GB file in 00:00:03
names = fread("../names.csv", header = FALSE) %>% unlist
dat %>% setnames(names)
ランナー状況を確認. “100"なら, ランナー3塁です. 各バッターについて, アウトカウントとランナー状況別, 打席数と挙げた打点(RBI)を集計.
dat_rbi =
dat %>%
#dplyr::filter(AB_FL == "T") %>%
mutate(runner = (BASE3_RUN_ID != "")*100 + (BASE2_RUN_ID != "")*10 + (BASE1_RUN_ID != "")*1) %>%
mutate(runner = as.integer(runner)) %>%
select(BAT_ID, OUTS_CT, runner, RBI_CT) %>%
group_by(BAT_ID, OUTS_CT, runner) %>%
dplyr::summarise(atbat = n(), RBI = sum(RBI_CT))
dat_rbi %>% head %>% xtable %>% print("html")
| BAT_ID | OUTS_CT | runner | atbat | RBI | |
|---|---|---|---|---|---|
| 1 | abret001 | 0 | 0 | 30 | 0 |
| 2 | abret001 | 0 | 1 | 10 | 0 |
| 3 | abret001 | 0 | 10 | 1 | 0 |
| 4 | abret001 | 0 | 11 | 2 | 0 |
| 5 | abret001 | 0 | 100 | 1 | 0 |
| 6 | abret001 | 0 | 101 | 1 | 0 |
まずは全バッターで平均をとります. ランナー状況ごとにあげた打点を集計.
dat_rbi_all =
dat_rbi %>%
group_by(runner, OUTS_CT) %>%
dplyr::summarise(atbat = sum(atbat), RBI = sum(RBI)) %>%
mutate(RBI_mean = RBI / atbat)
dat_rbi_all %>% xtable(digits = 4) %>% print("html")
| runner | OUTS_CT | atbat | RBI | RBI_mean | |
|---|---|---|---|---|---|
| 1 | 0 | 0 | 45601 | 1347 | 0.0295 |
| 2 | 0 | 1 | 32877 | 831 | 0.0253 |
| 3 | 0 | 2 | 26180 | 633 | 0.0242 |
| 4 | 1 | 0 | 10996 | 695 | 0.0632 |
| 5 | 1 | 1 | 13071 | 831 | 0.0636 |
| 6 | 1 | 2 | 13385 | 963 | 0.0719 |
| 7 | 10 | 0 | 3357 | 443 | 0.1320 |
| 8 | 10 | 1 | 5653 | 832 | 0.1472 |
| 9 | 10 | 2 | 7307 | 1223 | 0.1674 |
| 10 | 11 | 0 | 2584 | 503 | 0.1947 |
| 11 | 11 | 1 | 4609 | 996 | 0.2161 |
| 12 | 11 | 2 | 5753 | 1343 | 0.2334 |
| 13 | 100 | 0 | 476 | 211 | 0.4433 |
| 14 | 100 | 1 | 1833 | 874 | 0.4768 |
| 15 | 100 | 2 | 2948 | 613 | 0.2079 |
| 16 | 101 | 0 | 977 | 477 | 0.4882 |
| 17 | 101 | 1 | 2088 | 1059 | 0.5072 |
| 18 | 101 | 2 | 2946 | 786 | 0.2668 |
| 19 | 110 | 0 | 601 | 399 | 0.6639 |
| 20 | 110 | 1 | 1525 | 847 | 0.5554 |
| 21 | 110 | 2 | 1881 | 609 | 0.3238 |
| 22 | 111 | 0 | 630 | 446 | 0.7079 |
| 23 | 111 | 1 | 1621 | 1242 | 0.7662 |
| 24 | 111 | 2 | 2008 | 1068 | 0.5319 |
なるほど. ためしに満塁だけ注目.
dat_rbi_all %>%
dplyr::filter(runner == 111) %>%
xtable(digits = 4) %>% print("html")
| runner | OUTS_CT | atbat | RBI | RBI_mean | |
|---|---|---|---|---|---|
| 1 | 111 | 0 | 630 | 446 | 0.7079 |
| 2 | 111 | 1 | 1621 | 1242 | 0.7662 |
| 3 | 111 | 2 | 2008 | 1068 | 0.5319 |
0アウト満塁だと, 1打席で0.708点. 1アウト満塁だと, 1打席で0.766点ですか. 0アウト満塁よりも, 1アウト満塁のほうが, 平均打点が高いみたいです.
ちょっと感覚と合いません. 1アウトなら, ゲッツーで終わっちゃいますもんね. 0アウトなら, ゲッツーの間に1点は入ります.
本当に1アウト満塁のほうが平均打点が高いのか… について検定します.
dat_rbi_atbat =
dat %>%
#dplyr::filter(AB_FL == "T") %>%
mutate(runner = (BASE1_RUN_ID != "")*1 + (BASE2_RUN_ID != "")*10 + (BASE3_RUN_ID != "")*100) %>%
mutate(runner = as.integer(runner)) %>%
select(BAT_ID, OUTS_CT, runner, RBI_CT) %>%
group_by(OUTS_CT, runner, RBI_CT, add = FALSE) %>%
dplyr::summarise(atbat = n())
dat_rbi_atbat_fullbase =
dat_rbi_atbat %>%
dplyr::filter(runner == 111, OUTS_CT < 2)
dat_rbi_atbat_fullbase %>%
xtable %>% print("html")
| OUTS_CT | runner | RBI_CT | atbat | |
|---|---|---|---|---|
| 1 | 0 | 111 | 0 | 307 |
| 2 | 0 | 111 | 1 | 232 |
| 3 | 0 | 111 | 2 | 72 |
| 4 | 0 | 111 | 3 | 6 |
| 5 | 0 | 111 | 4 | 13 |
| 6 | 1 | 111 | 0 | 734 |
| 7 | 1 | 111 | 1 | 647 |
| 8 | 1 | 111 | 2 | 167 |
| 9 | 1 | 111 | 3 | 31 |
| 10 | 1 | 111 | 4 | 42 |
0アウト, 1アウトで得られた打点ベクトルを作って, wilcox.testをかけてみます. 平均の差があるかどうか.
noout_fullbase =
dat_rbi_atbat_fullbase %>%
dplyr::filter(OUTS_CT == 0) %>%
do(vec = rep(RBI_CT, atbat)) %>%
dplyr::summarise(vec = vec) %>%
unlist
oneout_fullbase =
dat_rbi_atbat_fullbase %>%
dplyr::filter(OUTS_CT == 1) %>%
do(vec = rep(RBI_CT, atbat)) %>%
dplyr::summarise(vec = vec) %>%
unlist
noout_fullbase %>% table %>% xtable %>% print("html")
| noout_fullbase | |
|---|---|
| 0 | 307 |
| 1 | 232 |
| 2 | 72 |
| 3 | 6 |
| 4 | 13 |
oneout_fullbase %>% table %>% xtable %>% print("html")
| oneout_fullbase | |
|---|---|
| 0 | 734 |
| 1 | 647 |
| 2 | 167 |
| 3 | 31 |
| 4 | 42 |
ここのコードがダサいですね…
次. ウィルコックスの順位和検定をかけます.
wilcox.test(noout_fullbase, oneout_fullbase, conf.int = TRUE)
##
## Wilcoxon rank sum test with continuity correction
##
## data: noout_fullbase and oneout_fullbase
## W = 493634, p-value = 0.1809
## alternative hypothesis: true location shift is not equal to 0
## 95 percent confidence interval:
## -8.866e-06 6.953e-06
## sample estimates:
## difference in location
## -3.235e-06
0アウト満塁と1アウト満塁. 平均に差がない, という帰無仮説を棄却できませんでした(p-valueは0.18).
ありがとうございました.
打者ごとに期待打点をどの程度上回ったか,についてはまだ計算していません. 次にやります.
また, 今は2013年のデータだけを使っていますが, 他の年のデータも合併したものでチェックしてもいい気がします.