Win-probability

「2点ビハインドの7回裏, 2アウト満塁から勝つ確率は何%か」を知りたいです.

やることは単純で, 過去の試合で同じ場面を全部集めて, そのうち何割が勝ちで終わったかを数えます. モデルは要りません.

ここでは2013年4月の1か月ぶんで手順を確認します. 1939年から2013年までの全部を回すのは build-states.R, まとめて1本の表にするのは win-probability-table.Rmd です.

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

dat <- fread("../../data/derived/events-2013-04.csv")
setnames(dat, unname(unlist(fread("../../data/reference/retrosheet-columns.csv", header = FALSE))))

30,709打席, 392試合です.

勝敗の判定でつまずく

ここが一番間違えやすいところです.

HOME_SCORE_CT / AWAY_SCORE_CT は, そのプレーが起きる「前」のスコアです. 最後のプレーの値をそのまま取ると, その打席で入った得点が抜けます. サヨナラ勝ちはまさに最後のプレーで点が入るので, ごっそり化けます.

naive <-
  dat |>
  summarise(away = max(AWAY_SCORE_CT), home = max(HOME_SCORE_CT), .by = GAME_ID)

correct <- game_results(dat)

tibble(
  数え方 = c("最終プレーのスコアをそのまま", "生還した走者を数える"),
  ホーム勝ち = c(sum(naive$home > naive$away), sum(correct$home > correct$away)),
  アウェイ勝ち = c(sum(naive$home < naive$away), sum(correct$home < correct$away)),
  引き分け = c(sum(naive$home == naive$away), sum(correct$home == correct$away))
) |> kable()

数え方	ホーム勝ち	アウェイ勝ち	引き分け
最終プレーのスコアをそのまま	184	175	33
生還した走者を数える	221	171	0

MLBに引き分けはほぼありません. 左の数え方で出てくる引き分けは全部サヨナラ勝ちです.

正しくは各プレーで本塁に到達した走者 (*_DEST_ID が4以上) を数えます. R/retrosheet.R の game_results() がそれをやっています.

この月のホーム勝率は0.564でした.

状態別に数える

イニング, 裏表, アウト, 走者, 点差の組ごとに, その場面を通った試合とその勝敗を数えます. win_prob_states() にまとめてあります.

wp <- win_prob_states(dat)
head(wp) |> kable()

INN_CT	RUNNERS	HOME_AWAY	HOME_WINS	GAMES	HOME_LOSES
1	0	-5	0	1	1
1	0	-4	0	1	1
1	0	-2	1	2	1
1	0	-1	5	12	7
1	0	0	221	392	171
1	1	-2	0	1	1

5,043通りの状態が出てきました.

走者は三塁=100, 二塁=10, 一塁=1 のビット和です. 満塁なら111です.

数えるのは打席ではなく試合です. アウトも走者も得点も動かないプレー (ファウルフライの落球など) があると1試合が同じ状態を2回通るので, 行をそのまま数えると水増しになります.

ホームアドバンテージ

試合開始の状態を引くと, ホームチームの勝率がそのまま出ます.

start <- wp |>
  filter(INN_CT == 1, BAT_HOME_ID == 0, OUTS_CT == 0, RUNNERS == 0, HOME_AWAY == 0)

start |>
  transmute(試合数 = GAMES, ホーム勝ち = HOME_WINS,
            ホーム勝率 = HOME_WINS / GAMES) |>
  kable(digits = 3)

試合数	ホーム勝ち	ホーム勝率
392	221	0.564

場面ごとに見る

9回裏の同点でアウトが増えるとどうなるか.

wp |>
  filter(INN_CT == 9, BAT_HOME_ID == 1, RUNNERS == 0, HOME_AWAY == 0) |>
  transmute(アウト = OUTS_CT, 試合数 = GAMES, ホーム勝率 = HOME_WINS / GAMES) |>
  arrange(アウト) |>
  kable(digits = 3)

アウト	試合数	ホーム勝率
0	40	0.675
1	32	0.562
2	22	0.500

サヨナラのチャンスが減るので下がります.

点差で見ると, 9回裏はこうです.

wp |>
  filter(INN_CT == 9, BAT_HOME_ID == 1, OUTS_CT == 0, RUNNERS == 0,
         abs(HOME_AWAY) <= 5) |>
  ggplot(aes(x = HOME_AWAY, y = HOME_WINS / GAMES, size = GAMES)) +
  geom_hline(yintercept = 0.5, linetype = "dashed") +
  geom_line(linewidth = 0.4) + geom_point() +
  xlab("点差 (ホーム - アウェイ)") + ylab("ホームの勝率") +
  ggtitle("9回裏0死走者なし (点の大きさは試合数)")

1か月では足りない

wp |>
  summarise(`状態の数` = n(),
            `10試合未満` = sum(GAMES < 10),
            `1試合だけ` = sum(GAMES == 1)) |>
  kable()

状態の数	10試合未満	1試合だけ
5043	4300	1904

38%の状態が1試合しかありません. これでは勝率が0%か100%にしかなりません.

見た目を整えようと「試合数が20以上の状態だけ」に絞ると, 今度は残った状態のほうが偏ります. 実際, イニングごとに点差と勝率の傾きを測ると, 閾値を20にしたときだけ「終盤ほど急」というきれいな順序が出て, 10にすると崩れます. 1か月ぶんではその程度の話しかできません.

対策は2つです.

年数を増やす. build-states.R は1939年から2013年まで回します.
それでも足りないぶんは平滑化する. win-probability-table.Rmd でやっています.

イニングと点差の関係は, そちらの全期間版で見てください.

注意

過去の平均であって, 目の前の試合の予測ではありません. 投手も打者も球場も無視しています.
1939年以降を全部混ぜると, 得点環境の違いも混ざります.
引き分けの試合は除いています.

INN_CT	RUNNERS	HOME_AWAY	HOME_WINS	GAMES	HOME_LOSES
1	0	-5	0	1	1
1	0	-4	0	1	1
1	0	-2	1	2	1
1	0	-1	5	12	7
1	0	0	221	392	171
1	1	-2	0	1	1

INN_CT	RUNNERS	HOME_AWAY	HOME_WINS	GAMES	HOME_LOSES
1	0	-5	0	1	1
1	0	-4	0	1	1
1	0	-2	1	2	1
1	0	-1	5	12	7
1	0	0	221	392	171
1	1	-2	0	1	1