WEを計算する
Author: @sleep_in_nmbrs
2018-12-24
require(tidyverse)
require(gt)0. ロードマップ
WE/LIの計算過程は大まかに分けると以下の通りになる.
- RetrosheetデータからのMLBにおける平均的な打線のマルコフ連鎖モデルの構築
- マルコフ連鎖モデルを用いた, イニング内状況, あるいは複数イニングに関しての, 得点数の分布の取得
- 得点数分布を利用した, 各状況からの表/裏チームの得点数の取得と, WEの計算
- Retrosheetにおける各イベントによる進塁確率の計算
- WPAの平均的な変動の計算と, 実際の状況を利用したLIへの変換
ここではWEの計算, つまり3までを記述する. 16-18年のデータを使用する.
マルコフ連鎖モデルはMarchi, Albert, and Baumer (2018, 2版; 実際には初版由来の部分も残っている) で記述された方法を改変した. 状態遷移確率の計算に全データを使えばやや得点が低めになるが, データに介入することで得点環境の補正が可能であることも示す.
1. MLBにおける平均的な打線のマルコフ連鎖モデルの構築
状態遷移確率の取得
状態遷移確率の計算では打順は無視する. つまりどの打順も同じ能力と考える. 打順で異なる能力を考える場合, モデル自体は簡単に作れるのだが, WEの計算において, 状況によってどの打順から始まるかの確率を考える必要が生じる. 結果, 極端にWE計算が複雑になる.
状態遷移確率の計算方法はMarchi et al.で記述されている. データはRetrosheetを利用する.
# eval = FALSE
# Retrosheet data 2016-2018がdfとして保存されていることを想定
# 列名はMarchi et al.の教科書と同じ
# イベント開始前の24状況を示す変数STATE
# BASEX_RUN_IDには選手のID名が入っているので, 0,1に変換してつなげる
df <- df %>%
mutate(BASES =
paste(ifelse(BASE1_RUN_ID > '', 1, 0),
ifelse(BASE2_RUN_ID > '', 1, 0),
ifelse(BASE3_RUN_ID > '', 1, 0), sep = ""),
STATE = paste(BASES, OUTS_CT))
# イベント終了後の24状況を示す変数NEW.STATE
df <- df %>%
mutate(NRUNNER1 =
as.numeric(RUN1_DEST_ID == 1 | BAT_DEST_ID == 1),
NRUNNER2 =
as.numeric(RUN1_DEST_ID == 2 | RUN2_DEST_ID == 2 |
BAT_DEST_ID == 2),
NRUNNER3 =
as.numeric(RUN1_DEST_ID == 3 | RUN2_DEST_ID == 3 |
RUN3_DEST_ID == 3 | BAT_DEST_ID == 3),
NOUTS = OUTS_CT + EVENT_OUTS_CT,
NEW.BASES = paste(NRUNNER1, NRUNNER2,
NRUNNER3, sep = ""),
NEW.STATE = paste(NEW.BASES, NOUTS))
# イベントで記録された得点を示す列
df <- df %>%
mutate(RUNS.SCORED =
(BAT_DEST_ID > 3) + (RUN1_DEST_ID > 3) +
(RUN2_DEST_ID > 3) + (RUN3_DEST_ID > 3))
# 状況あるいは得点が変化していないイベントは捨てる
df <- df %>%
filter((STATE != NEW.STATE) | (RUNS.SCORED > 0))
# イニングで記録されたアウトを数える
df <- df %>%
mutate(HALF.INNING = paste(GAME_ID, INN_CT, BAT_HOME_ID))
half_innings <- df %>%
group_by(HALF.INNING) %>%
summarize(Outs.Inning = sum(EVENT_OUTS_CT))
# join
df <- df %>%
inner_join(half_innings, by = "HALF.INNING")
# complete half-innning (Outs/inning = 3)のみに絞る
# 変数HALF.INNINGごとにEVENT_OUT_CTを総計する
df.c <- df %>% filter(Outs.Inning == 3)
# batting eventのみに絞る
df.c <- df.c %>% filter(BAT_EVENT_FL == TRUE)
# これはあとのモデルにおける得点計算で打者が塁に出たことを前提としているので必要
# これを含める場合状態遷移ごとにifelseが一つ増えるので少し遅くなる可能性がある
# WPやPBが除かれているのでRE24の一部の状況には影響があるだろう (Marchi et al. pp209)
# 全体に関しては得点価値の小ささや, イベントの頻度の低さを考慮すれば影響は小さいだろう
# 3 outsのランナーは要らないのでrecodeする
library(car)
df.c$NEW.STATE <- recode(df.c$NEW.STATE,
"c('000 3', '100 3', '010 3', '001 3',
'110 3', '101 3', '011 3', '111 3') = '3'")
# 状態遷移確率マトリックスをつくる
T.matrix <- df.c %>%
select(STATE, NEW.STATE)%>%
table()
T.matrix
# 確率に変換
P.matrix <- prop.table(T.matrix, 1)
P.matrix
P.matrix <- rbind(P.matrix, c(rep(0, 24), 1)) # STATEの3に相当する列を作っておく
# 行がSTATE, 列がNEW.STATE
# 行に関してsumで1になっていることを確認
margin.table(P.matrix, 1)
P.matrix <- data.frame(P.matrix)
dimnames(P.matrix)
# 行名がおかしいので変えておく
dimnames(P.matrix)[[1]][25]
dimnames(P.matrix)[[1]][25] <- "3"
dimnames(P.matrix)[[2]] <- dimnames(P.matrix)[[1]]
dimnames(P.matrix)
save(P.matrix, file="P.matrix_16-18_average.Rdata")マルコフ連鎖モデル
ここではあるイニングにおける, 打撃イベント開始前の24状況(STATE)から, 打撃イベント終了後の24状況+1 (3 out) 状態 (NEW.STATE) への移行のみを考慮したモデルを設定する. 3アウトに達すると計算終了. 複数イニングはあとで考慮する.
上で計算した状態遷移確率に加えて, 状態が遷移したときに記録される得点のテーブルを利用する. Marchi et al.で記述されているもの (pp. 206).
load("P.matrix_16-18_average.Rdata")
# 1つの半イニング (1イニングが表/裏なので, 半イニング) を計算する関数の設定
simulate.half.inning <- function(df = P.matrix,
start_state = "000 0"){
# 初期条件
s <- start_state; runs.post <- 0;
# sは状態を示す変数
# 1,2,3塁ランナー状態 (0 or 1) + アウトカウント. 3アウトは"3"でコードしている
while(s != "3"){ # # while 2: イニングは3アウトになるまで
# 状態遷移行列からイベントをサンプリング
s.new <- sample(names(df), 1, prob = df[s, ])
# s.newは打席が終わった状態を示す
# "3"に達すると終了
# sからs.newに移行したときに記録される得点
runs <- R[s, s.new] # R in Marchi et al. pp.206
# 結果を記録する
runs.post <- runs.post + runs # 得点を記録する
# 次の打席に移る前に状態を示すsをs.newで置換
s <- s.new
# while loopの先頭に戻る
} # while 2の終わり. つまりイニングの終わり
return(runs.post)
} # function終わりこの関数は得点のみを返す. 100イニングの計算例.
1:100 %>%
map(~ simulate.half.inning())%>%
unlist()## [1] 0 0 4 0 1 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1
## [36] 1 0 2 3 1 1 0 0 0 0 0 0 0 0 0 0 2 2 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 3 0
## [71] 0 1 0 1 0 0 1 0 4 0 0 0 0 1 1 2 0 2 0 0 0 2 1 0 0 0 0 0 0 010000イニングの平均得点/イニング (RPI) とその経過時間 (Mac mini 2018, 3 GHz Core i5, 16 GB).
# 経過時間の測定
start <- proc.time()
1:10000 %>%
map_dbl(~ simulate.half.inning())%>%
mean()## [1] 0.4834print(proc.time() - start)[3]## user system elapsed
## 12.917 0.121 13.128## elapsed
## 13.128この結果は10,000回なので精度に問題がある. 下で200万回計算した結果0.485となった. 実際のRPIと比較する.
# https://www.fangraphs.com/leaders.aspx?pos=all&stats=pit&lg=all&qual=0&type=0&season=2018&month=0&season1=2016&ind=0&team=0,ss&rost=0&age=0&filter=&players=0
(21744 + 22582 + 21630) / (43305.333 + 43257 + 43489)## [1] 0.5071536モデルの得点が現実より少ない理由としては,
- 打順の効果が存在しない (現実では能力の高い打者が重要な打順に, 低い打者が重要でない打順を占める傾向がある)
- 打撃イベント以外を無視していること
などが考えられる.
2. イニング内状況, あるいは複数イニングに関しての, 得点数の分布の取得
まず各状況について繰り返し計算可能にする. この関数は初期状態の状況も記録したdata frameで返す.
simulate.n.innings <- function(df = P.matrix,
innings = 100,
start_state = "000 0"){
runs.scored <-
1:innings%>%
map(~simulate.half.inning(df = df,
start_state = start_state))%>%
unlist()
out <- data.frame(Start = start_state,
Runs_scored = runs.scored)
return(out)
}計算例.
simulate.n.innings(df = P.matrix,
innings = 4,
start_state = "000 0")## Start Runs_scored
## 1 000 0 0
## 2 000 0 0
## 3 000 0 0
## 4 000 0 0これで繰り返し計算できるので, 各状態における分布が取得できるようになった.
得点分布の取得
以下では2つの得点分布を取得する. つまり;
- あるイニングの特定の開始時点からイニング終了までの得点
- 複数イニングにおける得点
これらを組み合わせることで, あるイニングの特定の開始時点から9回終わりまでの得点を計算できるようにする.
まず, 24状況での得点分布を取得する. 24状況での計算例 (各状況について1000回). 先頭の10行のみ示す (実際には24000行).
state.list <- c("000 0", "100 0", "010 0", "001 0", "110 0", "101 0", "011 0", "111 0",
"000 1", "100 1", "010 1", "001 1", "110 1", "101 1", "011 1", "111 1",
"000 2", "100 2", "010 2", "001 2", "110 2", "101 2", "011 2", "111 2")
test <- state.list%>%
map(~simulate.n.innings(df = P.matrix,
innings = 1000,
start_state = .))%>%
bind_rows()
test %>%
head(10)%>%
gt()| Start | Runs_scored |
|---|---|
| 000 0 | 0 |
| 000 0 | 1 |
| 000 0 | 0 |
| 000 0 | 1 |
| 000 0 | 0 |
| 000 0 | 0 |
| 000 0 | 0 |
| 000 0 | 1 |
| 000 0 | 0 |
| 000 0 | 4 |
各状況について2,000,000回計算. ここからリサンプリングしていくので, ここで組み込まれたバイアスは影響を及ぼし続ける. が, 使い続けるのでここをあまり多くするとあとでメモリがきついらしい (メモリの仕様は理解していない).
# eval = FALSE
start <- proc.time()
run.dist.by.states <- state.list%>%
map(~simulate.n.innings(df = P.matrix,
innings = 2000000,
start_state = .))%>%
bind_rows()
print(proc.time() - start)[3]
elapsed
39267.83 得られた得点分布の平均や誤差などを示す.
load("run_dists_for_WE_calc_MLB16-18.rdata") # あとで計算する分布も入れている
run.dist.by.states%>%
group_by(Start)%>%
dplyr::summarise(N = n(),
Runs = mean(Runs_scored),
SD = sd(Runs_scored),
SE = SD / sqrt(N))%>%
mutate_if(is.numeric, funs(round), 5)%>%
gt()%>%
tab_header(title = "イニング終了までの得点")| イニング終了までの得点 | ||||
|---|---|---|---|---|
| Start | N | Runs | SD | SE |
| 000 0 | 2e+06 | 0.48468 | 1.00824 | 0.00071 |
| 000 1 | 2e+06 | 0.25661 | 0.71737 | 0.00051 |
| 000 2 | 2e+06 | 0.09879 | 0.42315 | 0.00030 |
| 001 0 | 2e+06 | 1.34241 | 1.19875 | 0.00085 |
| 001 1 | 2e+06 | 0.93802 | 1.02684 | 0.00073 |
| 001 2 | 2e+06 | 0.34049 | 0.72692 | 0.00051 |
| 010 0 | 2e+06 | 1.09387 | 1.31378 | 0.00093 |
| 010 1 | 2e+06 | 0.64983 | 1.06198 | 0.00075 |
| 010 2 | 2e+06 | 0.30623 | 0.71829 | 0.00051 |
| 011 0 | 2e+06 | 1.91786 | 1.51782 | 0.00107 |
| 011 1 | 2e+06 | 1.31900 | 1.38364 | 0.00098 |
| 011 2 | 2e+06 | 0.51448 | 1.06004 | 0.00075 |
| 100 0 | 2e+06 | 0.85068 | 1.33834 | 0.00095 |
| 100 1 | 2e+06 | 0.49862 | 1.03574 | 0.00073 |
| 100 2 | 2e+06 | 0.21011 | 0.66612 | 0.00047 |
| 101 0 | 2e+06 | 1.72156 | 1.49615 | 0.00106 |
| 101 1 | 2e+06 | 1.14935 | 1.32052 | 0.00093 |
| 101 2 | 2e+06 | 0.45449 | 0.96610 | 0.00068 |
| 110 0 | 2e+06 | 1.41459 | 1.63812 | 0.00116 |
| 110 1 | 2e+06 | 0.87781 | 1.37431 | 0.00097 |
| 110 2 | 2e+06 | 0.41675 | 0.96140 | 0.00068 |
| 111 0 | 2e+06 | 2.24701 | 1.81589 | 0.00128 |
| 111 1 | 2e+06 | 1.49526 | 1.64926 | 0.00117 |
| 111 2 | 2e+06 | 0.70017 | 1.30118 | 0.00092 |
この分布は24状況のもの. 次に複数イニング (2-8) の分布を取得する. “000 0”の得点は1イニングに相当するので, これから複数回サンプリングして複数イニングの得点とする.
run.dist.complete.half.inning <- run.dist.by.states%>%
filter(Start == "000 0")%>%
pull(Runs_scored)
# 1イニングにおける各状況の得点分布から,
# サンプリングで1-8イニングの各イニング数での得点分布をつくる
sample.n.half.innings <- function(run_dist = run.dist.complete.half.inning,
n = 100, # サンプリング回数
inning_length = 2){ # イニングの長さ 1-8
runs <- 1:n %>%
map(~ sample(run.dist.complete.half.inning, inning_length, replace=TRUE))%>%
unlist()
# 1イニングの得点分布からinning_length個取り出す
# それをn回繰り返してvectorで返す
out <- data.frame(Innings = inning_length,
Inning_ID = rep(1:n, each = inning_length), # イニングの長さだけ繰り返す数列でIDを作成
Runs = runs)%>%
group_by(Innings, Inning_ID)%>% # IDごとにまとめて合計をとる
dplyr::summarise(Runs_scored = sum(Runs))
return(out)
}# eval = FALSE
start <- proc.time()
run.dist.multiple.half.innings <- 1:8%>%
map_df(~ sample.n.half.innings(run_dist = run.dist.complete.half.inning,
n = 2000000,
inning_length = .))
print(proc.time() - start)[3]
elapsed
87.647
# 1は既にあるのでサンプリングする必要性は無いが
# joiningするのが面倒なのでまとめて取得してしまっている
# これはそんなに時間もかからないということもある
save(list = c("run.dist.by.states",
"run.dist.multiple.half.innings"),
file ="run_dists_for_WE_calc_MLB16-18.rdata")誤差範囲など.
# 上ですでに呼び出している
run.dist.multiple.half.innings%>%
group_by(Innings)%>%
dplyr::summarise(N = n(),
Runs = mean(Runs_scored),
SD = sd(Runs_scored),
SE = SD / sqrt(N))%>%
mutate_if(is.numeric, funs(round), 5)%>%
gt()%>%
tab_header(title = "各イニング数での得点")| 各イニング数での得点 | ||||
|---|---|---|---|---|
| Innings | N | Runs | SD | SE |
| 1 | 2e+06 | 0.48586 | 1.00960 | 0.00071 |
| 2 | 2e+06 | 0.96930 | 1.42618 | 0.00101 |
| 3 | 2e+06 | 1.45541 | 1.74754 | 0.00124 |
| 4 | 2e+06 | 1.93964 | 2.01810 | 0.00143 |
| 5 | 2e+06 | 2.42272 | 2.25168 | 0.00159 |
| 6 | 2e+06 | 2.90995 | 2.47210 | 0.00175 |
| 7 | 2e+06 | 3.39161 | 2.66802 | 0.00189 |
| 8 | 2e+06 | 3.87665 | 2.85089 | 0.00202 |
3. 各状況からのWEの計算
任意の状況から9回裏までの得点を計算する関数
イニングの開始時点/途中から, イニング終わりまでの得点の分布と, 複数イニングでの得点の分布が得られた. これら2つの分布をもとに試合中のある状況 (イニング, 表裏, 24状況を考慮) から, 9回裏終了時までの得点を取得する関数を設定する.
# 2つの分布を使って,
# 特定のイニングの特定の状態からスタートした時の9回終了時までの
# 表と裏の得点をサンプリングで取得する
sampling.runs.multiple.games <- function(games = 1,
start_inning = 1, # 1-9
start_topbot = "top",
start_state = "000 0",
RE_states = run.dist.by.states,
RE_innings = run.dist.multiple.half.innings){
# 初期条件
s <- start_state; inning <- start_inning; topbot <- start_topbot
runs <- NULL
# 開始後1イニング目 ここだけランナーアウトを考慮する
if(topbot == "top"){ # 表から開始した場合
runs <- RE_states%>%
filter(Start ==s)%>%
sample_n(games,
replace = TRUE)
runs <- as.numeric(runs$Runs_scored)
runs.top1 <- runs
# botはフル1イニング
runs <- RE_states%>%
filter(Start == "000 0")%>%
sample_n(games,
replace = TRUE)
runs <- as.numeric(runs$Runs_scored)
runs.bot1 <- runs
}else{ # 裏から開始する場合
# topは0得点
runs.top1 <- 0
# botのみ
runs <- RE_states%>%
filter(Start == s)%>%
sample_n(games,
replace = TRUE)
runs <- as.numeric(runs$Runs_scored)
runs.bot1 <- runs
}
if(start_inning %in% 1:8){
# 9回までの得点を分布から取得
innings.remaining <- 9 - inning
runs <- RE_innings%>%
filter(Innings == innings.remaining)%>%
sample_n(games,
replace = TRUE)
runs.top2 <- as.numeric(runs$Runs_scored)
runs.top <- runs.top1 + runs.top2
runs <- RE_innings%>%
filter(Innings == innings.remaining)%>%
sample_n(games,
replace = TRUE)
runs.bot2 <- as.numeric(runs$Runs_scored)
runs.bot <- runs.bot1 + runs.bot2
out <- data.frame(Inning = inning,
Topbot = topbot,
States = s,
Game = 1:games,
Runs_top = runs.top,
Runs_bot = runs.bot,
stringsAsFactors = FALSE)
return(out)
}else{
# 9回スタートの場合 そのまま返す
out <- data.frame(Inning = inning,
Topbot = topbot,
States = s,
Game = 1:games,
Runs_top = runs.top1,
Runs_bot = runs.bot1,
stringsAsFactors = FALSE)
return(out)
}
} # function終わり計算例.
sampling.runs.multiple.games(games = 5,
start_inning = 7, # 1-9
start_topbot = "top",
start_state = "111 0",
RE_states = run.dist.by.states,
RE_innings = run.dist.multiple.half.innings)## Inning Topbot States Game Runs_top Runs_bot
## 1 7 top 111 0 1 2 2
## 2 7 top 111 0 2 6 1
## 3 7 top 111 0 3 3 0
## 4 7 top 111 0 4 5 0
## 5 7 top 111 0 5 0 2だいぶWEが計算できそうになってきた.
# この関数を使ってさらに指定したイニングに関して
# 表裏の24状態からの9回終わりまでの得点をまとめて取得するする関数
# 各イニング, 状態でのtop botでの得点を得る
# inningsはまとめて計算可能だサンプル増やすとメモリがきついかもしれない
# 下ではこの関数で1イニングごとに結果を取得して, WEを計算してイニングごとに捨てるようにしている
compute.runs.all.states <- function(games = 100,
innings = 1:9){
state.list <- list("000 0", "100 0", "010 0", "001 0", "110 0", "101 0", "011 0", "111 0",
"000 1", "100 1", "010 1", "001 1", "110 1", "101 1", "011 1", "111 1",
"000 2", "100 2", "010 2", "001 2", "110 2", "101 2", "011 2", "111 2")
# top
out.i <- vector("list", length = length(state.list))
for(i in seq_along(state.list)){
res.i <- innings %>%
map_df(~sampling.runs.multiple.games(games = games,
start_inning = .,
start_topbot = "top",
start_state = state.list[[i]],
RE_states = run.dist.by.states,
RE_innings = run.dist.multiple.half.innings))
out.i[[i]] <- res.i
}
out.i <- out.i %>% bind_rows()
# bot
out.k <- vector("list", length = length(state.list))
for(k in seq_along(state.list)){
res.k <- innings %>%
map_df(~sampling.runs.multiple.games(games = games,
start_inning = .,
start_topbot = "bot",
start_state = state.list[[k]],
RE_states = run.dist.by.states,
RE_innings = run.dist.multiple.half.innings))
out.k[[k]] <- res.k
}
out.k <- out.k %>% bind_rows()
out <- bind_rows(out.i, out.k)
return(out)
}計算例.
compute.runs.all.states(games = 1, innings = 8)%>%
gt()%>%
tab_header(title = "8th各状況から9th botまでの得点計算例 (各1回ずつ)")| 8th各状況から9th botまでの得点計算例 (各1回ずつ) | |||||
|---|---|---|---|---|---|
| Inning | Topbot | States | Game | Runs_top | Runs_bot |
| 8 | top | 000 0 | 1 | 0 | 2 |
| 8 | top | 100 0 | 1 | 0 | 3 |
| 8 | top | 010 0 | 1 | 5 | 1 |
| 8 | top | 001 0 | 1 | 1 | 2 |
| 8 | top | 110 0 | 1 | 1 | 0 |
| 8 | top | 101 0 | 1 | 4 | 0 |
| 8 | top | 011 0 | 1 | 2 | 3 |
| 8 | top | 111 0 | 1 | 1 | 3 |
| 8 | top | 000 1 | 1 | 0 | 0 |
| 8 | top | 100 1 | 1 | 2 | 0 |
| 8 | top | 010 1 | 1 | 0 | 1 |
| 8 | top | 001 1 | 1 | 0 | 1 |
| 8 | top | 110 1 | 1 | 3 | 0 |
| 8 | top | 101 1 | 1 | 5 | 0 |
| 8 | top | 011 1 | 1 | 0 | 1 |
| 8 | top | 111 1 | 1 | 2 | 0 |
| 8 | top | 000 2 | 1 | 0 | 2 |
| 8 | top | 100 2 | 1 | 2 | 0 |
| 8 | top | 010 2 | 1 | 0 | 2 |
| 8 | top | 001 2 | 1 | 1 | 0 |
| 8 | top | 110 2 | 1 | 0 | 0 |
| 8 | top | 101 2 | 1 | 1 | 0 |
| 8 | top | 011 2 | 1 | 1 | 2 |
| 8 | top | 111 2 | 1 | 0 | 2 |
| 8 | bot | 000 0 | 1 | 0 | 0 |
| 8 | bot | 100 0 | 1 | 0 | 0 |
| 8 | bot | 010 0 | 1 | 0 | 1 |
| 8 | bot | 001 0 | 1 | 0 | 1 |
| 8 | bot | 110 0 | 1 | 2 | 1 |
| 8 | bot | 101 0 | 1 | 0 | 1 |
| 8 | bot | 011 0 | 1 | 0 | 3 |
| 8 | bot | 111 0 | 1 | 0 | 2 |
| 8 | bot | 000 1 | 1 | 0 | 0 |
| 8 | bot | 100 1 | 1 | 0 | 1 |
| 8 | bot | 010 1 | 1 | 0 | 1 |
| 8 | bot | 001 1 | 1 | 0 | 1 |
| 8 | bot | 110 1 | 1 | 0 | 1 |
| 8 | bot | 101 1 | 1 | 0 | 3 |
| 8 | bot | 011 1 | 1 | 0 | 1 |
| 8 | bot | 111 1 | 1 | 0 | 5 |
| 8 | bot | 000 2 | 1 | 0 | 0 |
| 8 | bot | 100 2 | 1 | 1 | 0 |
| 8 | bot | 010 2 | 1 | 1 | 1 |
| 8 | bot | 001 2 | 1 | 0 | 1 |
| 8 | bot | 110 2 | 1 | 0 | 0 |
| 8 | bot | 101 2 | 1 | 3 | 1 |
| 8 | bot | 011 2 | 1 | 0 | 0 |
| 8 | bot | 111 2 | 1 | 0 | 2 |
この関数でイニングを1:9, 試合数を多くすればすべての状況を取得可能だが, メモリがきついので上の関数を使って1イニングについて計算ごとに, WEを計算してからデータを上書きするようにする.
WE計算
ここで得点差も考慮する. 計算結果にhome/bot側から見て, -30から30を加えてhome側勝率を計算する. つまり, 得点差ごとに独立にはじめから計算するのは避けている (61xは辛いです).
# inningごとにすべて結果を保存するとメモリがきついので
# 各イニングでWEを計算するごとにデータを上書きする
compute.WE <- function(games = 1000,
inning = 1){
# イニングはmap()でひとつずつ渡す
# 各イニングについてcompute.runs.all.states()で結果を出力
runs.scored.all.states <- compute.runs.all.states(games = games,
innings = inning)
# その結果を用いて勝敗を調べて勝率を計算する
# 勝率を調べるための関数
# 引き分けは0.5勝としている. 表裏の戦力差がないので,
# 引き分け以後の勝率は期待値としては表/裏ともに0.5であるはず
compute.w.pct <- function(df = runs.scored.all.states,
run_diff = 0){
df <- df %>%
mutate(Run_diff = run_diff,
Runs_bot = Runs_bot + Run_diff)
out <- df %>%
group_by(Inning, Topbot, States, Run_diff)%>%
mutate(W_bot = ifelse(Runs_top < Runs_bot, 1,
ifelse(Runs_top == Runs_bot, 0.5, 0)))%>%
summarise(W_pct_bot = mean(W_bot))
return(out)
}
# 初期状態が-30:30の状態に関して9回終了時点での勝率
WE.table <- -30:30 %>%
map_df(~ compute.w.pct(df = runs.scored.all.states,
run_diff = .))
return(WE.table)
}すべての状況について4,000,000試合からhome側勝率を計算.
# eval = FALSE
# リストになんども入れているので試合数が少ないうちはそれが相対的に経過時間が大きいと思われる
# 試合数が多くなる場合は直接dfで扱うよりリストを使ったほうが早いと思う
start <- proc.time()
WE.table <- 1:9 %>%
map_df(~ compute.WE(games = 4000000,
inning = .))
print(proc.time() - start)[3]
elapsed
36310.28
# The BookのWE table (table 10, pp.35-43) との比較を容易にするためにfactor levelをあわせる
WE.table <- WE.table %>%
ungroup()%>%
mutate(States = factor(States,
level = c("000 0", "000 1", "000 2", "100 0", "100 1", "100 2",
"010 0", "010 1", "010 2", "001 0", "001 1", "001 2",
"110 0", "110 1", "110 2", "101 0", "101 1", "101 2",
"011 0", "011 1", "011 2", "111 0", "111 1", "111 2")))一部結果を示す.
load("WE_table_MLB_16-18.rdata")
WE.table%>%
filter(Run_diff <= 0, Run_diff >= -4,
Topbot == "top", Inning == 1)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 |
|---|---|---|---|---|---|---|---|
| 1 | top | 000 0 | 0.165 | 0.229 | 0.308 | 0.400 | 0.500 |
| 1 | top | 000 1 | 0.174 | 0.242 | 0.324 | 0.419 | 0.521 |
| 1 | top | 000 2 | 0.182 | 0.252 | 0.337 | 0.434 | 0.537 |
| 1 | top | 100 0 | 0.150 | 0.210 | 0.284 | 0.371 | 0.466 |
| 1 | top | 100 1 | 0.164 | 0.229 | 0.308 | 0.399 | 0.499 |
| 1 | top | 100 2 | 0.177 | 0.245 | 0.328 | 0.424 | 0.526 |
| 1 | top | 010 0 | 0.137 | 0.193 | 0.263 | 0.347 | 0.441 |
| 1 | top | 010 1 | 0.156 | 0.218 | 0.295 | 0.385 | 0.483 |
| 1 | top | 010 2 | 0.172 | 0.239 | 0.321 | 0.415 | 0.517 |
| 1 | top | 001 0 | 0.124 | 0.176 | 0.243 | 0.324 | 0.416 |
| 1 | top | 001 1 | 0.140 | 0.198 | 0.271 | 0.357 | 0.453 |
| 1 | top | 001 2 | 0.170 | 0.236 | 0.317 | 0.411 | 0.513 |
| 1 | top | 110 0 | 0.127 | 0.180 | 0.246 | 0.326 | 0.415 |
| 1 | top | 110 1 | 0.149 | 0.209 | 0.282 | 0.369 | 0.464 |
| 1 | top | 110 2 | 0.168 | 0.234 | 0.314 | 0.407 | 0.507 |
| 1 | top | 101 0 | 0.112 | 0.160 | 0.221 | 0.297 | 0.384 |
| 1 | top | 101 1 | 0.134 | 0.190 | 0.259 | 0.343 | 0.436 |
| 1 | top | 101 2 | 0.166 | 0.231 | 0.311 | 0.403 | 0.503 |
| 1 | top | 011 0 | 0.104 | 0.150 | 0.208 | 0.281 | 0.366 |
| 1 | top | 011 1 | 0.128 | 0.181 | 0.248 | 0.329 | 0.420 |
| 1 | top | 011 2 | 0.164 | 0.228 | 0.307 | 0.398 | 0.497 |
| 1 | top | 111 0 | 0.097 | 0.139 | 0.194 | 0.262 | 0.343 |
| 1 | top | 111 1 | 0.124 | 0.176 | 0.241 | 0.319 | 0.408 |
| 1 | top | 111 2 | 0.157 | 0.219 | 0.295 | 0.384 | 0.481 |
WE.table%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "bot", Inning == 1)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 | 1 | 2 | 3 | 4 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | bot | 000 0 | 0.187 | 0.258 | 0.345 | 0.443 | 0.547 | 0.648 | 0.737 | 0.811 | 0.869 |
| 1 | bot | 000 1 | 0.169 | 0.237 | 0.322 | 0.420 | 0.525 | 0.629 | 0.722 | 0.799 | 0.860 |
| 1 | bot | 000 2 | 0.157 | 0.224 | 0.306 | 0.404 | 0.510 | 0.616 | 0.711 | 0.791 | 0.854 |
| 1 | bot | 100 0 | 0.217 | 0.293 | 0.381 | 0.479 | 0.581 | 0.676 | 0.760 | 0.828 | 0.881 |
| 1 | bot | 100 1 | 0.188 | 0.260 | 0.347 | 0.445 | 0.548 | 0.648 | 0.737 | 0.811 | 0.869 |
| 1 | bot | 100 2 | 0.166 | 0.234 | 0.318 | 0.416 | 0.521 | 0.625 | 0.719 | 0.797 | 0.858 |
| 1 | bot | 010 0 | 0.234 | 0.313 | 0.405 | 0.505 | 0.606 | 0.699 | 0.779 | 0.843 | 0.892 |
| 1 | bot | 010 1 | 0.199 | 0.272 | 0.361 | 0.460 | 0.564 | 0.663 | 0.750 | 0.821 | 0.876 |
| 1 | bot | 010 2 | 0.173 | 0.242 | 0.327 | 0.426 | 0.531 | 0.634 | 0.726 | 0.803 | 0.863 |
| 1 | bot | 001 0 | 0.250 | 0.333 | 0.429 | 0.531 | 0.631 | 0.722 | 0.798 | 0.859 | 0.904 |
| 1 | bot | 001 1 | 0.218 | 0.297 | 0.389 | 0.491 | 0.594 | 0.690 | 0.772 | 0.839 | 0.889 |
| 1 | bot | 001 2 | 0.175 | 0.244 | 0.330 | 0.429 | 0.535 | 0.638 | 0.729 | 0.805 | 0.864 |
| 1 | bot | 110 0 | 0.264 | 0.345 | 0.437 | 0.534 | 0.631 | 0.719 | 0.794 | 0.854 | 0.900 |
| 1 | bot | 110 1 | 0.219 | 0.295 | 0.384 | 0.482 | 0.582 | 0.678 | 0.761 | 0.829 | 0.882 |
| 1 | bot | 110 2 | 0.182 | 0.253 | 0.338 | 0.436 | 0.540 | 0.642 | 0.732 | 0.807 | 0.866 |
| 1 | bot | 101 0 | 0.285 | 0.371 | 0.467 | 0.567 | 0.662 | 0.746 | 0.817 | 0.872 | 0.914 |
| 1 | bot | 101 1 | 0.238 | 0.318 | 0.411 | 0.511 | 0.611 | 0.703 | 0.782 | 0.846 | 0.894 |
| 1 | bot | 101 2 | 0.185 | 0.256 | 0.342 | 0.440 | 0.544 | 0.645 | 0.735 | 0.810 | 0.868 |
| 1 | bot | 011 0 | 0.302 | 0.391 | 0.488 | 0.586 | 0.679 | 0.761 | 0.828 | 0.881 | 0.920 |
| 1 | bot | 011 1 | 0.252 | 0.335 | 0.428 | 0.528 | 0.627 | 0.716 | 0.793 | 0.854 | 0.900 |
| 1 | bot | 011 2 | 0.190 | 0.262 | 0.348 | 0.446 | 0.550 | 0.650 | 0.738 | 0.812 | 0.869 |
| 1 | bot | 111 0 | 0.335 | 0.424 | 0.519 | 0.613 | 0.701 | 0.778 | 0.840 | 0.889 | 0.925 |
| 1 | bot | 111 1 | 0.270 | 0.353 | 0.445 | 0.542 | 0.637 | 0.724 | 0.798 | 0.858 | 0.903 |
| 1 | bot | 111 2 | 0.206 | 0.280 | 0.367 | 0.464 | 0.566 | 0.663 | 0.749 | 0.820 | 0.875 |
WE.table%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "top", Inning == 9)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 | 1 | 2 | 3 | 4 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 9 | top | 000 0 | 0.014 | 0.032 | 0.073 | 0.159 | 0.500 | 0.841 | 0.927 | 0.968 | 0.986 |
| 9 | top | 000 1 | 0.015 | 0.035 | 0.080 | 0.174 | 0.556 | 0.913 | 0.965 | 0.987 | 0.995 |
| 9 | top | 000 2 | 0.016 | 0.038 | 0.086 | 0.186 | 0.600 | 0.965 | 0.989 | 0.997 | 0.999 |
| 9 | top | 100 0 | 0.012 | 0.028 | 0.063 | 0.138 | 0.427 | 0.732 | 0.851 | 0.930 | 0.969 |
| 9 | top | 100 1 | 0.014 | 0.032 | 0.073 | 0.159 | 0.504 | 0.835 | 0.915 | 0.966 | 0.987 |
| 9 | top | 100 2 | 0.015 | 0.036 | 0.082 | 0.179 | 0.574 | 0.926 | 0.966 | 0.989 | 0.997 |
| 9 | top | 010 0 | 0.010 | 0.023 | 0.052 | 0.115 | 0.338 | 0.648 | 0.836 | 0.922 | 0.966 |
| 9 | top | 010 1 | 0.012 | 0.029 | 0.066 | 0.145 | 0.445 | 0.782 | 0.908 | 0.962 | 0.985 |
| 9 | top | 010 2 | 0.015 | 0.034 | 0.078 | 0.169 | 0.534 | 0.892 | 0.964 | 0.988 | 0.996 |
| 9 | top | 001 0 | 0.007 | 0.018 | 0.041 | 0.090 | 0.235 | 0.559 | 0.830 | 0.919 | 0.964 |
| 9 | top | 001 1 | 0.010 | 0.023 | 0.052 | 0.116 | 0.328 | 0.679 | 0.900 | 0.957 | 0.983 |
| 9 | top | 001 2 | 0.014 | 0.033 | 0.076 | 0.165 | 0.519 | 0.880 | 0.964 | 0.988 | 0.996 |
| 9 | top | 110 0 | 0.009 | 0.021 | 0.048 | 0.107 | 0.319 | 0.584 | 0.740 | 0.854 | 0.932 |
| 9 | top | 110 1 | 0.012 | 0.028 | 0.063 | 0.138 | 0.427 | 0.731 | 0.839 | 0.917 | 0.967 |
| 9 | top | 110 2 | 0.014 | 0.033 | 0.076 | 0.165 | 0.525 | 0.865 | 0.928 | 0.967 | 0.990 |
| 9 | top | 101 0 | 0.006 | 0.015 | 0.035 | 0.079 | 0.205 | 0.478 | 0.724 | 0.846 | 0.927 |
| 9 | top | 101 1 | 0.009 | 0.022 | 0.050 | 0.111 | 0.321 | 0.635 | 0.827 | 0.911 | 0.964 |
| 9 | top | 101 2 | 0.014 | 0.033 | 0.074 | 0.161 | 0.508 | 0.851 | 0.928 | 0.967 | 0.989 |
| 9 | top | 011 0 | 0.006 | 0.014 | 0.032 | 0.071 | 0.191 | 0.409 | 0.653 | 0.831 | 0.919 |
| 9 | top | 011 1 | 0.009 | 0.020 | 0.047 | 0.103 | 0.299 | 0.574 | 0.778 | 0.901 | 0.957 |
| 9 | top | 011 2 | 0.014 | 0.032 | 0.073 | 0.160 | 0.510 | 0.825 | 0.898 | 0.965 | 0.988 |
| 9 | top | 111 0 | 0.005 | 0.013 | 0.029 | 0.066 | 0.178 | 0.381 | 0.588 | 0.740 | 0.854 |
| 9 | top | 111 1 | 0.008 | 0.020 | 0.046 | 0.102 | 0.299 | 0.564 | 0.736 | 0.843 | 0.919 |
| 9 | top | 111 2 | 0.013 | 0.030 | 0.069 | 0.150 | 0.477 | 0.786 | 0.866 | 0.929 | 0.968 |
WE.table%>%
filter(Run_diff <= 0, Run_diff >= -4,
Topbot == "bot", Inning == 9)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 |
|---|---|---|---|---|---|---|---|
| 9 | bot | 000 0 | 0.017 | 0.040 | 0.089 | 0.194 | 0.632 |
| 9 | bot | 000 1 | 0.006 | 0.017 | 0.043 | 0.109 | 0.578 |
| 9 | bot | 000 2 | 0.001 | 0.004 | 0.014 | 0.045 | 0.534 |
| 9 | bot | 100 0 | 0.039 | 0.086 | 0.182 | 0.319 | 0.697 |
| 9 | bot | 100 1 | 0.017 | 0.043 | 0.106 | 0.199 | 0.625 |
| 9 | bot | 100 2 | 0.004 | 0.013 | 0.043 | 0.090 | 0.557 |
| 9 | bot | 010 0 | 0.043 | 0.096 | 0.201 | 0.430 | 0.795 |
| 9 | bot | 010 1 | 0.018 | 0.047 | 0.114 | 0.270 | 0.689 |
| 9 | bot | 010 2 | 0.005 | 0.015 | 0.046 | 0.136 | 0.602 |
| 9 | bot | 001 0 | 0.044 | 0.099 | 0.206 | 0.549 | 0.911 |
| 9 | bot | 001 1 | 0.021 | 0.053 | 0.123 | 0.406 | 0.821 |
| 9 | bot | 001 2 | 0.005 | 0.016 | 0.045 | 0.153 | 0.620 |
| 9 | bot | 110 0 | 0.084 | 0.177 | 0.310 | 0.485 | 0.794 |
| 9 | bot | 110 1 | 0.041 | 0.103 | 0.195 | 0.317 | 0.695 |
| 9 | bot | 110 2 | 0.013 | 0.042 | 0.089 | 0.162 | 0.605 |
| 9 | bot | 101 0 | 0.089 | 0.188 | 0.329 | 0.624 | 0.921 |
| 9 | bot | 101 1 | 0.045 | 0.111 | 0.208 | 0.443 | 0.813 |
| 9 | bot | 101 2 | 0.013 | 0.042 | 0.088 | 0.181 | 0.624 |
| 9 | bot | 011 0 | 0.099 | 0.206 | 0.421 | 0.700 | 0.916 |
| 9 | bot | 011 1 | 0.053 | 0.121 | 0.273 | 0.513 | 0.823 |
| 9 | bot | 011 2 | 0.015 | 0.044 | 0.128 | 0.208 | 0.613 |
| 9 | bot | 111 0 | 0.178 | 0.309 | 0.479 | 0.711 | 0.920 |
| 9 | bot | 111 1 | 0.100 | 0.189 | 0.311 | 0.510 | 0.817 |
| 9 | bot | 111 2 | 0.041 | 0.087 | 0.161 | 0.250 | 0.644 |
The BookのWE tableに比べると得点による利得が大きく, アウトによるコストがわずかに小さい. 部分的には1999-2002よりも得点が入りにくいことによるかもしれない. ここで記述したモデルが現実より得点が低いことも影響しているだろう (The Bookのモデルは当時の得点環境にきっちり合わせていると思われる; モデルを現実の得点環境に合わせる方法は後述する).
10回以後は9回の結果を流用する.
# eval = FALSE
new.data <- expand.grid(Inning = 10:25,
Topbot = c("top", "bot"),
Run_diff = -30:30,
States = state.list)%>%
left_join(WE.table%>%
filter(Inning == 9)%>%
select(- Inning),
by = c("Topbot", "Run_diff", "States"))
WE.table <- WE.table%>%
bind_rows(new.data)%>%
mutate(States = factor(States,
level = c("000 0", "000 1", "000 2", "100 0", "100 1", "100 2",
"010 0", "010 1", "010 2", "001 0", "001 1", "001 2",
"110 0", "110 1", "110 2", "101 0", "101 1", "101 2",
"011 0", "011 1", "011 2", "111 0", "111 1", "111 2")))test <- WE.table%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "top", Inning == 15)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()
WE.table%>%
filter(Run_diff <= 0, Run_diff >= -4,
Topbot == "bot", Inning == 15)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 |
|---|---|---|---|---|---|---|---|
| 15 | bot | 000 0 | 0.017 | 0.040 | 0.089 | 0.194 | 0.632 |
| 15 | bot | 000 1 | 0.006 | 0.017 | 0.043 | 0.109 | 0.578 |
| 15 | bot | 000 2 | 0.001 | 0.004 | 0.014 | 0.045 | 0.534 |
| 15 | bot | 100 0 | 0.039 | 0.086 | 0.182 | 0.319 | 0.697 |
| 15 | bot | 100 1 | 0.017 | 0.043 | 0.106 | 0.199 | 0.625 |
| 15 | bot | 100 2 | 0.004 | 0.013 | 0.043 | 0.090 | 0.557 |
| 15 | bot | 010 0 | 0.043 | 0.096 | 0.201 | 0.430 | 0.795 |
| 15 | bot | 010 1 | 0.018 | 0.047 | 0.114 | 0.270 | 0.689 |
| 15 | bot | 010 2 | 0.005 | 0.015 | 0.046 | 0.136 | 0.602 |
| 15 | bot | 001 0 | 0.044 | 0.099 | 0.206 | 0.549 | 0.911 |
| 15 | bot | 001 1 | 0.021 | 0.053 | 0.123 | 0.406 | 0.821 |
| 15 | bot | 001 2 | 0.005 | 0.016 | 0.045 | 0.153 | 0.620 |
| 15 | bot | 110 0 | 0.084 | 0.177 | 0.310 | 0.485 | 0.794 |
| 15 | bot | 110 1 | 0.041 | 0.103 | 0.195 | 0.317 | 0.695 |
| 15 | bot | 110 2 | 0.013 | 0.042 | 0.089 | 0.162 | 0.605 |
| 15 | bot | 101 0 | 0.089 | 0.188 | 0.329 | 0.624 | 0.921 |
| 15 | bot | 101 1 | 0.045 | 0.111 | 0.208 | 0.443 | 0.813 |
| 15 | bot | 101 2 | 0.013 | 0.042 | 0.088 | 0.181 | 0.624 |
| 15 | bot | 011 0 | 0.099 | 0.206 | 0.421 | 0.700 | 0.916 |
| 15 | bot | 011 1 | 0.053 | 0.121 | 0.273 | 0.513 | 0.823 |
| 15 | bot | 011 2 | 0.015 | 0.044 | 0.128 | 0.208 | 0.613 |
| 15 | bot | 111 0 | 0.178 | 0.309 | 0.479 | 0.711 | 0.920 |
| 15 | bot | 111 1 | 0.100 | 0.189 | 0.311 | 0.510 | 0.817 |
| 15 | bot | 111 2 | 0.041 | 0.087 | 0.161 | 0.250 | 0.644 |
# save(WE.table, file = "WE_table_MLB_16-18.rdata")ノーアウトランナー無しでの勝率を可視化しておく.
WE.table%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 6, Run_diff >= -6,
Inning <= 9, States == "000 0")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, color = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "イニング開始時点での勝率",
subtitle = "勝率と得点差はホーム側から見た差.",
x = "Inning", y = "ホーム側勝率",color = "得点差")
ここではマルコフ連鎖モデルを利用したが実データを利用することもできるかもしれない. 実データを利用した場合, 実際の打順の能力差も考慮に入り, あるいはホーム側のアドバンテージも取り込むことができる (上の図でもわかるようにモデルに基づく結果では各イニング表で同点の場合の勝率が.5となっているが, これは現実ではありえない.). 方法としては, 例えばlogistic回帰が利用可能だと思われるが, だいぶ前に試した限りでは珍しい状況では極端におかしな推定結果を避けるのは難しい印象だった気がする.
得点環境の調整
基本的な方法論はここまでで終わりだが, 得点環境が現実より低いのが不満かもしれない. モデルの細部をいじらずに, データへの介入で無理やり現実に合わせる.
1. 得点が少ない試合の除去
得点が少ない試合 (正確には表か裏の半試合) を除くことで, 得点/試合を合わせる. 極めて不自然な操作だが, 多分これが一番早いと思います.
Retrosheetデータから得点/試合 (RPG) を計算する.
# eval = FALSE
df <- df %>%
mutate(Game_topbot_ID = paste(GAME_ID, BAT_HOME_ID),
Runs_scored = (BAT_DEST_ID > 3) +
(RUN1_DEST_ID > 3) + (RUN2_DEST_ID > 3) + (RUN3_DEST_ID > 3),
Runs_post = ifelse(BAT_HOME_ID == 1,
HOME_SCORE_CT + Runs_scored,
AWAY_SCORE_CT + Runs_scored))
Runs.per.game <- df %>%
group_by(Game_topbot_ID)%>%
dplyr::summarise(Max_runs = max(Runs_post))load("Runs_per_game_16-18.rdata")
Runs.per.game %>%
dplyr::summarise(N = n(),
Runs_all = sum(Max_runs),
RPG = Runs_all / N)## # A tibble: 1 x 3
## N Runs_all RPG
## <int> <dbl> <dbl>
## 1 14578 65956 4.52すでに述べたように, 全データを使ったモデルは下の割合で得点 (RPI) が少なかった.
0.485 / 0.507## [1] 0.9566075得点分布の形状を考慮すると, 得点が少ない試合を除くというのは要するに0得点だった試合を除くことだと考えられる. このため, この割合だけRPGを増やすためには下の試合数を除けば良いと予想できる.
14578 * (1- (0.485 / 0.507))## [1] 632.5759キリがいいところで14000だけを残して, 得点が少ない試合を除く.
どれだけ増えたか確認.
Runs.per.game %>%
arrange(desc(Max_runs))%>%
slice(1:14000)%>%
dplyr::summarise(N = n(),
Runs_all = sum(Max_runs),
RPG = Runs_all / N)## # A tibble: 1 x 3
## N Runs_all RPG
## <int> <dbl> <dbl>
## 1 14000 65956 4.71悪くない. IDを取得.
game.topbot.ids <- Runs.per.game %>%
arrange(desc(Max_runs))%>%
slice(1:14000)%>%
pull(Game_topbot_ID)もとのdfからこのIDを持つ半試合だけを残して, 上と同様にWEテーブルを取得すればよい.
RPIを示す.
load("runs_each_state_MLB16-18_w_quick_adjust.rdata")
run.dist.by.states%>%
group_by(Start)%>%
dplyr::summarise(N = n(),
Runs = mean(Runs_scored),
SD = sd(Runs_scored),
SE = SD / sqrt(N))%>%
head(1)%>%
mutate_if(is.numeric, funs(round), 5)%>%
gt()| Start | N | Runs | SD | SE |
|---|---|---|---|---|
| 000 0 | 2e+06 | 0.50505 | 1.03187 | 0.00073 |
かなり現実に近づいた. 少し低いのはキリがいいからといって, 減らす試合数を少なくしたせいだろう (後悔).
この方法は特に試合単位での得点分布の形状が現実から大きく乖離する. 状態遷移にもバイアスが起こる可能性が予想される. そこで別の方法を試し, それぞれのWEテーブルを比較する.
2. 優秀な投手の除去
より自然な分布で得点環境を高得点側に寄せる方法としては, 優れた投手を除く, という方法が考えられる. 野手を除くことは, 状態遷移が異常になるためここで使ったモデルでは適用できない. 試合単位, あるいはイニング単位でデータを除く必要がある (実のところ上の方法もイニング単位でランダムに除去する選択肢もあるだろう). 打撃イベントのサンプリングを使ったモデルを使うのであれば, 打者を除くのも可能だろう (イベント後の進塁確率は, 除去されていないデータで別に用意する必要がある).
以下では, Retrosheetデータを使ってFIP上位選手を除くことで, 高得点環境へとシフトさせる. 使用する指標は別にFIPでなくてERAやRA/IPでもいいのだが, 単に計算するスクリプトがそこにあったからである.
まず2016-2018のFIPを近似的に計算する.
# eval = FALSE
# フラッグをつくる
# いらないものもある
df <- df %>% mutate(Year = str_sub(GAME_ID, start = 4L, end = 7L),
HIT_FL = ifelse(H_FL == 0, 0, 1),
HR_FL = ifelse(EVENT_CD == 23, 1, 0),
Triple_FL = ifelse(EVENT_CD == 22, 1, 0),
Double_FL = ifelse(EVENT_CD == 21, 1, 0),
Single_FL = ifelse(EVENT_CD == 20, 1, 0),
K_FL = ifelse(EVENT_CD == 3, 1, 0),
BB_FL = ifelse(EVENT_CD == 14, 1, 0),
IBB_FL = ifelse(EVENT_CD == 15, 1, 0),
HBP_FL = ifelse(EVENT_CD == 16, 1, 0))
# Fip constant取得
require(baseballr)
guts <- fg_guts()
cFIP <- guts%>%
select(season, cFIP)%>%
rename(Year = season)
cFIP$Year <- as.character(cFIP$Year)
df <- left_join(df, cFIP)
# 3年間のFIPを計算. Infは除く.
# FIP constantは手抜きで平均を使う.
fip <- df %>%
group_by(RESP_PIT_ID)%>%
dplyr::summarise(Pit_PA = sum(BAT_EVENT_FL),
Pit_K = sum(K_FL),
Pit_BB = sum(BB_FL),
Pit_IBB = sum(IBB_FL),
Pit_HBP = sum(HBP_FL),
Pit_HR = sum(HR_FL),
IP = sum(EVENT_OUTS_CT) /3,
Pit_K_rate = Pit_K / Pit_PA,
Pit_BB_rate = Pit_BB / Pit_PA,
Pit_HR_rate = Pit_HR / Pit_PA,
mean_cFIP = mean(cFIP), # corner-cutting
FIP = ((13*Pit_HR)+(3*(Pit_BB + Pit_IBB + Pit_HBP)) - (2*Pit_K)) / IP + mean_cFIP)%>%
mutate(FIP = ifelse(FIP == Inf, NA, FIP))%>%
filter(is.na(FIP) == FALSE)%>%
arrange(FIP)load("FIP_16-18.rdata")
# FIPの重み付け平均
fip %>%
dplyr::summarise(N = n(),
Weighted_cohort_FIP = weighted.mean(FIP, IP))%>%
mutate_if(is.numeric, funs(round), 2)%>%
gt()| N | Weighted_cohort_FIP |
|---|---|
| 1165 | 4.23 |
横着してFIP constantの処理をいい加減にしているため, 正確ではないが, ここではFIPを正確に測定することが目的ではないので大した事ではない. これを計算したのは得点/イニングへの影響の代理変数として利用するためである.
ここから選手を減らしていく. 100IP以上投げた投手を対象とする. これらの投手はそもそも全体平均よりも優秀である.
# 100イニング以上投手のNと重み付けFIP
fip%>%
filter(IP >= 100)%>%
select(RESP_PIT_ID, FIP)%>%
mutate_if(is.numeric, funs(round), 2)%>%
head(5)## # A tibble: 5 x 2
## RESP_PIT_ID FIP
## <chr> <dbl>
## 1 chapa001 2
## 2 milla002 2.16
## 3 jansk001 2.29
## 4 fernj003 2.3
## 5 syndn001 2.42fip %>%
filter(IP >= 100)%>%
dplyr::summarise(N = n(),
Weighted_cohort_FIP = weighted.mean(FIP, IP))%>%
mutate_if(is.numeric, funs(round), 2)%>%
gt()| N | Weighted_cohort_FIP |
|---|---|
| 448 | 4.11 |
この100IP以上投げた投手のFIP上位80人を除き, 全体のFIPを計算する.
# 優れた投手をFIP上位から選択する
# これらの選手をあとで除く
# この人数は適当に数字を入れて重み付けFIPを計算して検討した
elite.pitchcers <- fip %>%
filter(IP >= 100)%>%
slice(1:80)%>%
pull(RESP_PIT_ID)
# これらの選手を除いた重み付けFIP
fip %>%
filter(!RESP_PIT_ID %in% elite.pitchcers)%>%
dplyr::summarise(N = n(),
Weighted_cohort_FIP = weighted.mean(FIP, IP))%>%
mutate_if(is.numeric, funs(round), 2)%>%
gt()| N | Weighted_cohort_FIP |
|---|---|
| 1085 | 4.44 |
# だいたい5%弱程度増加全体のFIPが約5%弱程度増加した.
次に, これらの投手がイニングの先頭で投げたイニングをすべて除く. 途中から投げたケースは残る.
# eval = FALSE
# これらの投手がイニングの開始時点で投げていたイニングを除く
# まず各イニングの一人目の投手を取得しdfにjoin
df <- df %>%
mutate(Inning_ID = paste(GAME_ID, INN_CT, BAT_HOME_ID))
inning.starter <- df %>%
group_by(Inning_ID)%>%
dplyr::summarise(Inning_starter = RESP_PIT_ID[1])
df <- df %>%
left_join(inning.starter)%>%
filter(!Inning_starter %in% elite.pitchcers)
# これでeliteが絶滅寸前の世界の出来上がりこのデータから計算したRPIを示す.
load("runs_each_state_MLB16-18_wo_elite_pit.Rdata")
run.dist.by.states%>%
group_by(Start)%>%
dplyr::summarise(N = n(),
Runs = mean(Runs_scored),
SD = sd(Runs_scored),
SE = SD / sqrt(N))%>%
head(1)%>%
mutate_if(is.numeric, funs(round), 5)%>%
gt()| Start | N | Runs | SD | SE |
|---|---|---|---|---|
| 000 0 | 2e+06 | 0.5088 | 1.04 | 0.00074 |
かなり現実に近い数値となった. ちょっと高くなりすぎた感はある.
調整の有無によるWEへの影響
優秀な投手を除くことで補正を行ったデータから得られたWEテーブルから, 結果の一部として1回裏の結果を示す.
load("WE_table_MLB_16-18.rdata")
load("WE_table_MLB_16-18_wo_elite_pitchers.rdata")
load("WE_table_MLB_16-18_w_quick_adjust.rdata")
WE.table.wo.elite%>%
ungroup()%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "bot", Inning == 1)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 | 1 | 2 | 3 | 4 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | bot | 000 0 | 0.195 | 0.266 | 0.351 | 0.447 | 0.548 | 0.645 | 0.733 | 0.806 | 0.863 |
| 1 | bot | 000 1 | 0.177 | 0.245 | 0.328 | 0.423 | 0.526 | 0.626 | 0.717 | 0.793 | 0.854 |
| 1 | bot | 000 2 | 0.165 | 0.231 | 0.312 | 0.407 | 0.510 | 0.613 | 0.706 | 0.784 | 0.847 |
| 1 | bot | 001 0 | 0.258 | 0.341 | 0.434 | 0.533 | 0.630 | 0.718 | 0.793 | 0.853 | 0.899 |
| 1 | bot | 001 1 | 0.226 | 0.304 | 0.394 | 0.493 | 0.593 | 0.686 | 0.767 | 0.833 | 0.884 |
| 1 | bot | 001 2 | 0.182 | 0.252 | 0.336 | 0.432 | 0.535 | 0.635 | 0.724 | 0.799 | 0.858 |
| 1 | bot | 010 0 | 0.242 | 0.321 | 0.411 | 0.508 | 0.605 | 0.696 | 0.774 | 0.838 | 0.887 |
| 1 | bot | 010 1 | 0.207 | 0.280 | 0.367 | 0.464 | 0.564 | 0.660 | 0.745 | 0.815 | 0.870 |
| 1 | bot | 010 2 | 0.180 | 0.249 | 0.333 | 0.429 | 0.531 | 0.631 | 0.721 | 0.797 | 0.857 |
| 1 | bot | 011 0 | 0.309 | 0.396 | 0.490 | 0.586 | 0.676 | 0.756 | 0.823 | 0.875 | 0.915 |
| 1 | bot | 011 1 | 0.260 | 0.341 | 0.433 | 0.530 | 0.626 | 0.713 | 0.788 | 0.848 | 0.895 |
| 1 | bot | 011 2 | 0.198 | 0.269 | 0.354 | 0.450 | 0.550 | 0.647 | 0.733 | 0.806 | 0.863 |
| 1 | bot | 100 0 | 0.225 | 0.300 | 0.387 | 0.483 | 0.581 | 0.674 | 0.755 | 0.823 | 0.876 |
| 1 | bot | 100 1 | 0.197 | 0.268 | 0.353 | 0.449 | 0.549 | 0.646 | 0.733 | 0.806 | 0.863 |
| 1 | bot | 100 2 | 0.173 | 0.241 | 0.323 | 0.419 | 0.521 | 0.621 | 0.713 | 0.790 | 0.852 |
| 1 | bot | 101 0 | 0.294 | 0.378 | 0.472 | 0.568 | 0.661 | 0.743 | 0.812 | 0.867 | 0.909 |
| 1 | bot | 101 1 | 0.247 | 0.326 | 0.416 | 0.514 | 0.611 | 0.700 | 0.778 | 0.841 | 0.889 |
| 1 | bot | 101 2 | 0.192 | 0.263 | 0.348 | 0.443 | 0.544 | 0.642 | 0.729 | 0.803 | 0.861 |
| 1 | bot | 110 0 | 0.272 | 0.353 | 0.442 | 0.537 | 0.630 | 0.715 | 0.789 | 0.849 | 0.895 |
| 1 | bot | 110 1 | 0.227 | 0.302 | 0.389 | 0.485 | 0.582 | 0.675 | 0.756 | 0.823 | 0.876 |
| 1 | bot | 110 2 | 0.190 | 0.260 | 0.344 | 0.439 | 0.540 | 0.638 | 0.727 | 0.801 | 0.859 |
| 1 | bot | 111 0 | 0.342 | 0.429 | 0.521 | 0.613 | 0.699 | 0.774 | 0.836 | 0.884 | 0.921 |
| 1 | bot | 111 1 | 0.278 | 0.359 | 0.449 | 0.544 | 0.636 | 0.721 | 0.794 | 0.853 | 0.898 |
| 1 | bot | 111 2 | 0.214 | 0.287 | 0.373 | 0.467 | 0.566 | 0.660 | 0.744 | 0.814 | 0.869 |
高得点環境へとシフトしたことでThe Bookのテーブルに少し近づいた. 1-9回表裏のイニング開始時点でのホーム側勝率を図で示す.
WE.table.wo.elite%>%
ungroup()%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 6, Run_diff >= -6,
Inning <= 9, States == "000 0")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, color = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "イニング開始時点での勝率 (得点/イニング補正済み)",
subtitle = "勝率と得点差はホーム側から見た差.",
x = "Inning", y = "ホーム側勝率",color = "得点差")
これでは補正していないデータの結果との比較は難しい. テーブルの勝率の差分 (補正版-全データ版) を示す.
WE.table.compare <- WE.table %>%
left_join(WE.table.wo.elite %>%
rename(W_pct_bot_adj = W_pct_bot))
WE.table.compare%>%
mutate(W_pct_bot = W_pct_bot_adj - W_pct_bot)%>%
select(- W_pct_bot_adj)%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "bot", Inning == 1)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 | 1 | 2 | 3 | 4 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | bot | 000 0 | 0.008 | 0.008 | 0.006 | 0.004 | 0.001 | -0.002 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 000 1 | 0.008 | 0.008 | 0.006 | 0.004 | 0.001 | -0.003 | -0.005 | -0.006 | -0.007 |
| 1 | bot | 000 2 | 0.007 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.007 |
| 1 | bot | 001 0 | 0.008 | 0.007 | 0.005 | 0.002 | -0.002 | -0.004 | -0.005 | -0.006 | -0.005 |
| 1 | bot | 001 1 | 0.008 | 0.007 | 0.005 | 0.002 | -0.001 | -0.004 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 001 2 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 010 0 | 0.008 | 0.008 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 010 1 | 0.008 | 0.008 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 010 2 | 0.007 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 011 0 | 0.007 | 0.005 | 0.002 | -0.001 | -0.003 | -0.005 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 011 1 | 0.008 | 0.007 | 0.004 | 0.002 | -0.001 | -0.003 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 011 2 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 100 0 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.004 | -0.005 | -0.005 |
| 1 | bot | 100 1 | 0.008 | 0.008 | 0.006 | 0.004 | 0.001 | -0.002 | -0.004 | -0.006 | -0.006 |
| 1 | bot | 100 2 | 0.007 | 0.007 | 0.006 | 0.003 | -0.001 | -0.004 | -0.006 | -0.007 | -0.007 |
| 1 | bot | 101 0 | 0.009 | 0.007 | 0.004 | 0.001 | -0.001 | -0.003 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 101 1 | 0.009 | 0.008 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 101 2 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.006 | -0.007 | -0.007 |
| 1 | bot | 110 0 | 0.009 | 0.007 | 0.005 | 0.002 | -0.001 | -0.003 | -0.005 | -0.005 | -0.005 |
| 1 | bot | 110 1 | 0.008 | 0.007 | 0.005 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
| 1 | bot | 110 2 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.004 | -0.006 | -0.007 | -0.007 |
| 1 | bot | 111 0 | 0.007 | 0.005 | 0.003 | 0.000 | -0.002 | -0.004 | -0.005 | -0.005 | -0.004 |
| 1 | bot | 111 1 | 0.007 | 0.006 | 0.004 | 0.001 | -0.001 | -0.003 | -0.004 | -0.005 | -0.005 |
| 1 | bot | 111 2 | 0.008 | 0.007 | 0.006 | 0.003 | 0.000 | -0.003 | -0.005 | -0.006 | -0.006 |
得点環境が高得点にシフトしたことで, 失点のコストが小さくなっていることがわかる. 例えば, 1回裏で-4点差で負けている場合の勝率は0.008上昇している. アウトへの影響は誤差のは範囲程度かもしれない.
イニング開始時点でのホーム側から見た勝率差を図で示す.
WE.table.compare%>%
mutate(W_pct_bot = W_pct_bot_adj - W_pct_bot)%>%
ungroup()%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 3, Run_diff >= -3,
Inning <= 9, States == "000 0")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, linetype = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
ylim(-0.01, 0.01)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "イニング開始時点での勝率差",
subtitle = "補正済み - 補正なし",
x = "Inning", y = "ホーム側の勝率差",linetype = "得点差")
ここで示した得失点差範囲 (-3 - 3) では試合の前半では得点差が大きい場合に影響が大きく, 試合の後半では得点差が小さい場合に影響が大きい. これは環境の変化が1イニングあたり0.02程度であることを考えると合理的な結果と言えるだろう. 例えば, 試合の後半で3点差負けであれば, この程度の得点環境の変化では逆転する確率はあまり変わらないだろう.
優秀な投手を除くことで補正したテーブルと, 0点の試合を除くことで補正した結果を比較する. 前者から後者を引いた結果を示す.
WE.table.compare2 <- WE.table.wo.elite %>%
left_join(WE.table.adjusted %>%
rename(W_pct_bot_dirty = W_pct_bot))
WE.table.compare2%>%
mutate(W_pct_bot = W_pct_bot - W_pct_bot_dirty)%>%
select(- W_pct_bot_dirty)%>%
ungroup()%>%
filter(Run_diff <= 4, Run_diff >= -4,
Topbot == "bot", Inning == 1)%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Run_diff, value = W_pct_bot)%>%
gt()| Inning | Topbot | States | -4 | -3 | -2 | -1 | 0 | 1 | 2 | 3 | 4 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | bot | 000 0 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 000 1 | 0.001 | 0.001 | 0.000 | 0.000 | 0.000 | -0.001 | -0.001 | -0.002 | -0.002 |
| 1 | bot | 000 2 | 0.002 | 0.002 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 001 0 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 001 1 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.002 | -0.002 | -0.002 | -0.002 |
| 1 | bot | 001 2 | 0.002 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 010 0 | 0.001 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 010 1 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 010 2 | 0.001 | 0.002 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 011 0 | 0.000 | 0.000 | -0.001 | -0.001 | -0.002 | -0.002 | -0.002 | -0.002 | -0.002 |
| 1 | bot | 011 1 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 011 2 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.002 | -0.002 | -0.002 |
| 1 | bot | 100 0 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 100 1 | 0.001 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 100 2 | 0.001 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 101 0 | 0.002 | 0.002 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 101 1 | 0.002 | 0.002 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 101 2 | 0.001 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.002 | -0.002 | -0.002 |
| 1 | bot | 110 0 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 110 1 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.002 | -0.002 | -0.001 |
| 1 | bot | 110 2 | 0.001 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.002 | -0.002 |
| 1 | bot | 111 0 | 0.002 | 0.002 | 0.001 | 0.001 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
| 1 | bot | 111 1 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.002 | -0.002 | -0.001 |
| 1 | bot | 111 2 | 0.001 | 0.001 | 0.001 | 0.000 | 0.000 | -0.001 | -0.001 | -0.001 | -0.001 |
わずかに差があるが, これは補正を合わせるときに多少のズレが残ってしまったためだろう. どちらの方法でもほとんど差は見られない.
各イニング開始時点で比較.
WE.table.compare2%>%
mutate(W_pct_bot = W_pct_bot - W_pct_bot_dirty)%>%
ungroup()%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 3, Run_diff >= -3,
Inning <= 9, States == "000 0")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, linetype = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
ylim(-0.01, 0.01)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "イニング開始時点での勝率差",
subtitle = "優秀な投手を除いたもの
- 得点が少ない試合を除いたもの",
x = "Inning", y = "ホーム側の勝率差",linetype = "得点差")
y軸の範囲は上の図に合わせている. 違いは非常に小さいことが確認できる.
状況を開始時ではなく, 1アウト1,3塁にする.
WE.table.compare%>%
mutate(W_pct_bot = W_pct_bot_adj - W_pct_bot)%>%
ungroup()%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 3, Run_diff >= -3,
Inning <= 9, States == "101 1")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, linetype = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
ylim(-0.01, 0.01)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "1アウト1, 3塁での勝率差",
subtitle = "補正済み - 補正なし",
x = "Inning", y = "ホーム側の勝率差",linetype = "得点差")
WE.table.compare2%>%
mutate(W_pct_bot = W_pct_bot - W_pct_bot_dirty)%>%
ungroup()%>%
mutate(Topbot = factor(Topbot, levels = c("top", "bot")))%>%
filter(Run_diff <= 3, Run_diff >= -3,
Inning <= 9, States == "101 1")%>%
mutate(Run_diff = factor(Run_diff))%>%
ggplot(aes(x = factor(Inning), y = W_pct_bot,
group = Run_diff, linetype = Run_diff))+
geom_point(size = 0.5)+
geom_line()+
facet_wrap(~Topbot)+
ylim(-0.01, 0.01)+
theme_bw(base_family = "HiraKakuPro-W3") +
labs(title = "1アウト1, 3塁での勝率差",
subtitle = "優秀な投手を除いたもの
- 得点が少ない試合を除いたもの",
x = "Inning", y = "ホーム側の勝率差",linetype = "得点差")
ランナーがいる状態でも, イニング開始時点と比べてそれほど大きな変化はないかもしれない.
ここでは高得点側へのシフトを行ったが, 低得点側にシフトさせることも当然可能であり, NPBに似せた環境で計算して利用することも妥当性はあるだろう.
References
Marchi, Albert, and Baumer., Analyzing Baseball Data with R, Second Edition, 2018. (Github)
- Scripts for calculating the frequencies of transitions among different states and simulating a half-inning with Markov chain described here were sligthy modified from scripts provided in Chapter 9 of Marchi et al.
Tango, MGL, Dolphin. The Book, Potmac Books, 2007.
Albert, Calculation of Win Probabilities, Part II, 2015.