マルコフ連鎖モデルによる野球のシミュレーション2: 打順変更による効果の大きさの推定
Author: @sleep_in_nmbrs
2019-12-22
1 イントロ
前回のポストでは, NPBの平均的な選手を並べて, 野球の試合をシミュレーションした. ここでは同じマルコフ連鎖モデルを使い, 2018年にそれぞれの選手が記録した打撃成績を利用してイベントをサンプリングし, 打順を改変した場合の得点への効果の大きさを推定する.
ここでは2018年度カープの選手の打撃成績を利用する. カープを選んだことに特に意図はない (あえて言うならPAのサイズが大きい選手が多そうな気がした). 単年の選手成績を利用するが, これは選手本人の実際のスキルを表しているとは言い難い. そこで以後では, あくまで2018年におけるX選手の成績を真の確率として持つ選手を考えている, という点を強調するため“Xタイプ”と呼ぶことにする.
2 結果
2.1 データ
NPB公式から2018年カープの選手の基本的な打撃成績を取得した. そこから計算した, wOBA, OBP (の近似値), 今回のモデルで用いる打席イベント確率を示す. OBPに関しては, モデル中のものを示した.
# 打順は考慮に入れる
require(tidyverse)
require(gt)
# 打順に使う選手のイベント確率を入れたデータ
# 平均野手+投手
average <- read_csv("stats/average_2018.csv", locale=locale(encoding="CP932"))
# 100 PA以上の選手
fielder <- read_csv("stats/fielder_2018_100PA.csv", locale=locale(encoding="CP932"))
# 合わせる
fielder <- rbind(fielder, average)
fielder%>%
filter(Team == "C")%>%
mutate(OBP = 1 - (K+Out))%>%
mutate_if(is.numeric, funs(round), 3)%>%
select(Player, wOBA, OBP, everything(), - Team)%>%
gt()| Player | wOBA | OBP | Single | Double | Triple | HR | BB_IBB | HBP | K | Out |
|---|---|---|---|---|---|---|---|---|---|---|
| 丸 佳浩 | 0.462 | 0.476 | 0.124 | 0.038 | 0.000 | 0.068 | 0.240 | 0.005 | 0.226 | 0.298 |
| 鈴木 誠也 | 0.449 | 0.441 | 0.136 | 0.061 | 0.004 | 0.057 | 0.172 | 0.010 | 0.222 | 0.337 |
| 會澤 翼 | 0.386 | 0.403 | 0.168 | 0.047 | 0.003 | 0.034 | 0.115 | 0.037 | 0.147 | 0.450 |
| 松山 竜平 | 0.361 | 0.373 | 0.180 | 0.056 | 0.004 | 0.027 | 0.102 | 0.004 | 0.102 | 0.524 |
| バティスタ | 0.358 | 0.317 | 0.108 | 0.026 | 0.000 | 0.082 | 0.098 | 0.003 | 0.265 | 0.418 |
| 西川 龍馬 | 0.355 | 0.365 | 0.192 | 0.060 | 0.008 | 0.016 | 0.082 | 0.005 | 0.140 | 0.495 |
| 田中 広輔 | 0.333 | 0.361 | 0.164 | 0.028 | 0.015 | 0.015 | 0.115 | 0.025 | 0.174 | 0.465 |
| 野間 峻祥 | 0.325 | 0.340 | 0.201 | 0.031 | 0.016 | 0.011 | 0.067 | 0.013 | 0.154 | 0.506 |
| 安部 友裕 | 0.299 | 0.306 | 0.129 | 0.043 | 0.016 | 0.016 | 0.094 | 0.008 | 0.235 | 0.459 |
| 菊池 涼介 | 0.291 | 0.289 | 0.138 | 0.042 | 0.002 | 0.020 | 0.082 | 0.005 | 0.172 | 0.539 |
| 新井 貴浩 | 0.288 | 0.301 | 0.128 | 0.023 | 0.008 | 0.030 | 0.113 | 0.000 | 0.195 | 0.504 |
| 石原 慶幸 | 0.190 | 0.229 | 0.138 | 0.009 | 0.000 | 0.009 | 0.064 | 0.009 | 0.248 | 0.523 |
singleから右の列のイベントをサンプリングし試合を進行させる. 前回説明したように, イベントサンプリング後のランナーの進塁確率は, MLB 16-17においてランナーとアウト状況で得られた各イベントでの進塁確率を利用している.
2018年のカープは非常に優れた打撃成績を記録した選手が多く, かなり特殊な得点環境となっている. 以下で示す結果はこの得点環境に依存した, 一般化困難な部分もあるかもしれない.
2.2 石原タイプ vs 會澤タイプ
2018カープは捕手としては石原と會澤を併用していた. まずこの二人を入れ替えた場合の効果を見てみる. 2018年のこの二人のwOBAはかなり極端な違いがあった (数値は上のテーブルを参照; 参考までに, wOBAの平均は0.32程度であり, 規定クリア選手での個人間でのSDは0.03-0.04程度といったところだろう). この2人の2018年成績を元にした場合にどの程度の得点差が得られるか検討する.
スタメンデータベースはNPBにおける打順をまとめてくれている. 打順はスタメンデータベースを参照して適当に決めた, 以下の打順を利用する.
| Spot | with會澤 | with石原 |
|---|---|---|
| 1 | 田中 広輔 | 田中 広輔 |
| 2 | 菊池 涼介 | 菊池 涼介 |
| 3 | 丸 佳浩 | 丸 佳浩 |
| 4 | 鈴木 誠也 | 鈴木 誠也 |
| 5 | 松山 竜平 | 松山 竜平 |
| 6 | 野間 峻祥 | 野間 峻祥 |
| 7 | 會澤 翼 | 西川 龍馬 |
| 8 | 西川 龍馬 | 石原 慶幸 |
| 9 | AvgPitcher | AvgPitcher |
會澤は後半では7番に入ることが多かったようなので, 7番に入れた (純粋に能力差の影響をみたいなら8番に入れるべきだったかもしれないが再計算が面倒). これらの打順で143試合 x 800シーズン分計算する.
lineup1 <- data.frame(Player = c("田中 広輔", "菊池 涼介", "丸 佳浩", "鈴木 誠也",
"松山 竜平", "野間 峻祥", "會澤 翼", "西川 龍馬",
"AvgPitcher"))%>%
left_join(fielder)%>%
select(-c(1:3))
lineup2 <- data.frame(Player = c("田中 広輔", "菊池 涼介", "丸 佳浩", "鈴木 誠也",
"松山 竜平", "野間 峻祥", "西川 龍馬", "石原 慶幸",
"AvgPitcher"))%>%
left_join(fielder)%>%
select(-c(1:3))
source('functions/func_markov_model_using_event_sampling.R')
team.list <- list(lineup1, lineup2)
label.list <- list("with會澤", "with石原")
# res.catcher.comp <- simulate.multiple.teams(team_list = team.list,
# label_list = label.list,
# rep = 800,
# games = 143)
# save(res.catcher.comp, file = "results/2018_carp_800seasons_Aizawa_Ishihara.rdata")
load("results/2018_carp_800seasons_Aizawa_Ishihara.rdata")
res.catcher.comp <- res.catcher.comp %>%
mutate(Inning = paste(Replicate, Inning))1シーズンに相当する, 143試合ごとの得点の平均とSDを示す.
res.catcher.comp%>%
group_by(Type, Replicate, Game, Inning)%>%
summarise(Runs = max(Runs_post))%>%
ungroup()%>%
group_by(Type, Replicate)%>%
summarise(Runs_per_year = sum(Runs))%>%
ungroup()%>%
group_by(Type)%>%
summarise(Avg = mean(Runs_per_year),
SD = sd(Runs_per_year))%>%
mutate_if(is.numeric, funs(round), 1)%>%
gt()| Type | Avg | SD |
|---|---|---|
| with石原 | 657.3 | 37.4 |
| with會澤 | 748.3 | 40.0 |
2つの打順で大きな得点差が得られた. 当然, wOBAが優れた會澤タイプを含めた打順で得点が大きい (with會澤). 平均して年間90点ほどの得点差があった. これは1勝=10得点とする (蛭川, 2019, pp. 169-171) と, 9勝分もの違いということになる.
143試合ごとにまとめた平均得点のばらつきは非常に大きい. 2 SDを誤差範囲として許容するならば, 70-80得点, 割合としては総得点の10%以上が誤差範囲ということになる. 特定の打線が143試合で記録した総得点は, 仮にそれが1シーズン143試合の間、常に全く同じ打者で構成されていたとしても, その打線が記録する総得点の推定としてはほとんど当てにならないことがわかる. 現実の打線ではさらに打順の組み換えが頻繁にある. 現実の結果から打順の効果を明らかにすることも, あるいはモデルの結果を現実の結果と比較することでモデルの妥当性を問うことも難しいだろう.
9回に入るかどうかは乱数で設定している. この影響で少しイニング数が異なる可能性もあるため, イニングあたりの得点 (RPI) でも示す. 信頼区間も示す.
res.catcher.comp%>%
compute.runs.per.inning(split_by_Type = TRUE)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Type | RPI | Innings | SD | CI_95_upper | CI_95_lower | RPG |
|---|---|---|---|---|---|---|
| with石原 | 0.515 | 1021407 | 1.042 | 0.517 | 0.513 | 4.597 |
| with會澤 | 0.586 | 1021512 | 1.130 | 0.588 | 0.584 | 5.233 |
0.071点/イニングの差が見られ, 信頼区間も大きく離れていることがわかる.
wOBAの差から予想される効果の大きさと比較する. 各打順の一試合あたりの打席数を示す.
res.catcher.comp%>%
group_by(Batter)%>%
dplyr::summarise(PA_G = n() / (800*143*2) )%>%
mutate_if(is.numeric, funs(round), 2)%>%
gt()| Batter | PA_G |
|---|---|
| 1 | 4.83 |
| 2 | 4.72 |
| 3 | 4.60 |
| 4 | 4.51 |
| 5 | 4.42 |
| 6 | 4.31 |
| 7 | 4.20 |
| 8 | 4.10 |
| 9 | 3.98 |
とりあえず打席数は7, 8番の平均 (4.15) を入れることにする. 二人のwOBAの数値から, それらの差を求めて得点のスケールに変換し, 1イニングあたりの効果を計算する.
woba.diff <- (0.386 - 0.190)
lwts.diff <- woba.diff / 1.2 # (蛭川, 2019, pp. 36-37)
lwts.diff * 4.15 /8.93## [1] 0.07590519やや誤差があるとも言えるかもしれないが, 概ね一致した (モデルでは0.071点/イニングの差). wOBAはLinear Weights (LWTS) に属する指標の一つである. LWTSの基礎となる得点価値は, 現実のある期間の得点環境において, それぞれのイベントが1つ記録されたときの期待値である. ここでは, 平均的ではない得点環境であり, さらにかなり多くのイベント数が変化している. それにも関わらず, 単にwOBAから計算するだけでモデルの値と近い結果になった. LWTSはある程度頑健な性質を持っていることを示唆しているかもしれない.
全体の傾向を示すため, 143試合ごとのRPIをdot plotとboxplotで示す.
catcher.rpi <- res.catcher.comp%>%
group_by(Type, Replicate, Game, Inning)%>%
dplyr::summarise(Runs = max(Runs_post))%>%
ungroup()%>%
group_by(Type, Replicate)%>%
dplyr::summarise(RPI = mean(Runs),
Innings = n(),
SD = sd(Runs),
CI_95_upper = RPI + SD /sqrt(Innings) * qt(0.975, df = Innings-1),
CI_95_lower = RPI - SD /sqrt(Innings) * qt(0.975, df = Innings-1),
RPG = RPI * 8.93)
catcher.rpi%>%
ggplot(aes(x = Type, y = RPI, group = Type))+
geom_boxplot(outlier.shape = NA, width = 0.6) +
geom_dotplot(binaxis = "y",
binwidth = .002,
stackdir = "center") +
theme_bw(base_family = "HiraKakuPro-W3")+
theme(axis.text.x = element_text(size=12),
axis.text.y = element_text(size=10)) +
theme(axis.title.x = element_text(size=12),
axis.title.y = element_text(size=12)) +
theme(plot.margin= unit(c(1, 1, 1, 1), "lines"))+
labs(title = "RPIの比較.",
subtitle = "143試合 x 800セット計算し,
143試合ごとの平均値の分布を示す.",
x = "", y = "イニングあたり平均得点 (RPI)") 
平均値としては差はかなり大きいが, RPIのばらつきが大きいため, 分布としてはそれなりに重なりがある.
各打席イベントの得点価値 (RV) を示す.
res.catcher.comp <- res.catcher.comp%>%
compute.RE24(split_by_Type = TRUE,
out_RE24 = FALSE)
RV <- res.catcher.comp%>%
group_by(Type, Event)%>%
dplyr::summarise(RV = mean(RV_event))
RV %>%
spread(key = Type, value = RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Event | with石原 | with會澤 |
|---|---|---|
| Single | 0.452 | 0.477 |
| Double | 0.746 | 0.778 |
| Triple | 0.998 | 1.039 |
| HR | 1.485 | 1.487 |
| BB_IBB | 0.335 | 0.358 |
| HBP | 0.335 | 0.357 |
| Out | -0.267 | -0.304 |
| K | -0.280 | -0.319 |
會澤タイプの打順で全体的にRVの振れ幅が大きい. これはすべての打順位置の平均値だが, 前回のポストで説明したように打順に沿ってRVは変動する.
これらの打順における, 打順スポットごとの得点価値を示す (打席数の違いは補正されている).
RV.by.spots <- res.catcher.comp%>%
compute.adjusted.RV(split_by_Type = TRUE)
RV.by.spots %>%
select(-c(4:7))%>%
spread(key = Batter, value = Adjusted_RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| with石原 | |||||||||
| Single | 0.414 | 0.434 | 0.413 | 0.474 | 0.510 | 0.486 | 0.456 | 0.443 | 0.396 |
| Double | 0.668 | 0.710 | 0.696 | 0.810 | 0.842 | 0.783 | 0.738 | 0.725 | 0.644 |
| Triple | 0.927 | 0.980 | NA | 1.103 | 1.149 | 1.051 | 1.004 | NA | 0.885 |
| HR | 1.392 | 1.492 | 1.479 | 1.609 | 1.607 | 1.529 | 1.462 | 1.420 | 1.319 |
| BB_IBB | 0.344 | 0.356 | 0.322 | 0.363 | 0.368 | 0.353 | 0.330 | 0.317 | 0.298 |
| HBP | 0.345 | 0.357 | 0.327 | 0.365 | 0.366 | 0.346 | 0.327 | 0.317 | 0.297 |
| Out | -0.253 | -0.267 | -0.258 | -0.289 | -0.294 | -0.278 | -0.263 | -0.256 | -0.235 |
| K | -0.265 | -0.274 | -0.271 | -0.304 | -0.316 | -0.300 | -0.284 | -0.276 | -0.250 |
| with會澤 | |||||||||
| Single | 0.462 | 0.472 | 0.434 | 0.493 | 0.525 | 0.496 | 0.466 | 0.466 | 0.454 |
| Double | 0.734 | 0.758 | 0.714 | 0.829 | 0.853 | 0.794 | 0.752 | 0.758 | 0.726 |
| Triple | 1.010 | 1.051 | NA | 1.127 | 1.143 | 1.062 | 1.051 | 1.008 | 0.964 |
| HR | 1.453 | 1.503 | 1.476 | 1.598 | 1.581 | 1.502 | 1.442 | 1.445 | 1.401 |
| BB_IBB | 0.373 | 0.384 | 0.343 | 0.383 | 0.386 | 0.368 | 0.347 | 0.348 | 0.330 |
| HBP | 0.371 | 0.388 | 0.337 | 0.383 | 0.382 | 0.360 | 0.345 | 0.343 | 0.330 |
| Out | -0.299 | -0.308 | -0.291 | -0.323 | -0.327 | -0.310 | -0.294 | -0.295 | -0.283 |
| K | -0.315 | -0.316 | -0.304 | -0.336 | -0.347 | -0.331 | -0.313 | -0.310 | -0.302 |
2つの打順を比較すると, 石原タイプでは9, 1-3あたりで変動が小さくなっている. これは石原タイプが8番に入ることで, その後ろの打者のアウト/ランナー状態が悪化したためだと推測される.
會澤タイプを含む打線でも4-6番の重要性が高く, 2番がそれに次ぐといったところ. 打順を再掲する.
| Spot | with會澤 | with石原 |
|---|---|---|
| 1 | 田中 広輔 | 田中 広輔 |
| 2 | 菊池 涼介 | 菊池 涼介 |
| 3 | 丸 佳浩 | 丸 佳浩 |
| 4 | 鈴木 誠也 | 鈴木 誠也 |
| 5 | 松山 竜平 | 松山 竜平 |
| 6 | 野間 峻祥 | 野間 峻祥 |
| 7 | 會澤 翼 | 西川 龍馬 |
| 8 | 西川 龍馬 | 石原 慶幸 |
| 9 | AvgPitcher | AvgPitcher |
いずれの打線タイプでも価値の低い3番にチームの最強打者である丸が据えられている. これは丸が生み出すイベントの総価値を低下させていただろう.
4-6番で得点価値の変動が大きい. これは出塁率が高い丸と鈴木を3, 4番においた結果かもしれない. この結果は, 6番などの打席数の少なさを考慮している. これは丸や鈴木を打順の後ろめに置いていたことで, 打席数が少ない打順スポットを“重要にしてしまっていた”, と解釈することができる.
2.3 打順ごとの得点価値に基づくおおざっぱな打順改変の効果
上で利用した會澤タイプの打順をベースに, 打順の改変を試み, モデルにおける得点数増加効果を調べる. The Bookで示された指針を参考にする (前回, 平均的な野手を並べたモデルで, 概ねこの指針が支持されることを示した).
The Bookにおいて示された指針を大まかに示す (pp.132).
- チームで特に優秀な3人の打者は, 1, 2, 4に置く.
- それに次ぐ2人の打者は, 3, 5に置く.
- 特に出塁に優れたタイプは, 1, 2に置く.
以下の打順を利用する.
| Spot | Pit_9th | Pit_8th |
|---|---|---|
| 1 | 田中 広輔 | 田中 広輔 |
| 2 | 丸 佳浩 | 丸 佳浩 |
| 3 | 松山 竜平 | 松山 竜平 |
| 4 | 鈴木 誠也 | 鈴木 誠也 |
| 5 | 會澤 翼 | 會澤 翼 |
| 6 | 西川 龍馬 | 西川 龍馬 |
| 7 | 野間 峻祥 | 野間 峻祥 |
| 8 | 菊池 涼介 | AvgPitcher |
| 9 | AvgPitcher | 菊池 涼介 |
指針に反するかもしれない部分としては, 1番は出塁率はそれなりに高いが, wOBAはあまり高くない田中を置いた. これはDHなしでは投手の影響を受けやすい打順であるため, このようにした (西川を置いても良いかもしれないが, 試していない. おそらくあまり変わらないだろう). この打順で投手の位置を8/9番で変えて, その影響も推定している.
打順に含めた選手のイベント確率などを再掲する.
| Player | wOBA | OBP | Single | Double | Triple | HR | BB_IBB | HBP | K | Out |
|---|---|---|---|---|---|---|---|---|---|---|
| 丸 佳浩 | 0.462 | 0.476 | 0.124 | 0.038 | 0.000 | 0.068 | 0.240 | 0.005 | 0.226 | 0.298 |
| 鈴木 誠也 | 0.449 | 0.441 | 0.136 | 0.061 | 0.004 | 0.057 | 0.172 | 0.010 | 0.222 | 0.337 |
| 會澤 翼 | 0.386 | 0.403 | 0.168 | 0.047 | 0.003 | 0.034 | 0.115 | 0.037 | 0.147 | 0.450 |
| 松山 竜平 | 0.361 | 0.373 | 0.180 | 0.056 | 0.004 | 0.027 | 0.102 | 0.004 | 0.102 | 0.524 |
| 西川 龍馬 | 0.355 | 0.365 | 0.192 | 0.060 | 0.008 | 0.016 | 0.082 | 0.005 | 0.140 | 0.495 |
| 田中 広輔 | 0.333 | 0.361 | 0.164 | 0.028 | 0.015 | 0.015 | 0.115 | 0.025 | 0.174 | 0.465 |
| 野間 峻祥 | 0.325 | 0.340 | 0.201 | 0.031 | 0.016 | 0.011 | 0.067 | 0.013 | 0.154 | 0.506 |
| 菊池 涼介 | 0.291 | 0.289 | 0.138 | 0.042 | 0.002 | 0.020 | 0.082 | 0.005 | 0.172 | 0.539 |
主な変更点は以下の通り.
- 菊池タイプを2番から8/9番へ
打力で劣る (2018の) 菊池タイプの打席数を減らす
- 丸タイプを2番に
3番に比べてRVの変動が大きい2番に移すとともに, 規格外の出塁率で打席数が比較的多いspot (3-5あたり) の価値を高める
- 會澤タイプを7番から5番に
チーム3番目の打者を7番から重要な打順に上げる
143試合 * 800シーズン計算し, RPIを示す.
# 丸を2番. これ以外の微調整は調べていない.
# 1番も1通りだけ試したがここの打順よりはほんの少しRPIが低かった (誤差かもしれない)
lineup3 <- data.frame(Player = c("田中 広輔", "丸 佳浩", "松山 竜平", "鈴木 誠也",
"會澤 翼", "西川 龍馬", "野間 峻祥", "菊池 涼介",
"AvgPitcher"))%>%
left_join(fielder)%>%
select(-c(1:3))
lineup4 <- data.frame(Player = c("田中 広輔", "丸 佳浩", "松山 竜平", "鈴木 誠也",
"會澤 翼", "西川 龍馬", "野間 峻祥", "AvgPitcher",
"菊池 涼介"))%>%
left_join(fielder)%>%
select(-c(1:3))
# res.pit.spot <- simulate.multiple.teams(team_list = team.list,
# label_list = label.list,
# rep = 800,
# games = 143)
# save(res.pit.spot, file = "results/2018_carp_800seasons_pit_8or9_Maru_on_2nd_spot.rdata")
load("results/2018_carp_800seasons_pit_8or9_Maru_on_2nd_spot.rdata")
# 丸を5番
# lineup3 <- data.frame(Player = c("田中 広輔", "松山 竜平", "野間 峻祥", "鈴木 誠也",
# "丸 佳浩", "會澤 翼", "西川 龍馬", "菊池 涼介",
# "AvgPitcher"))%>%
# left_join(fielder)%>%
# select(-c(1:3))
#
#
#
# lineup4 <- data.frame(Player = c("田中 広輔", "松山 竜平", "野間 峻祥", "鈴木 誠也",
# "丸 佳浩", "會澤 翼", "西川 龍馬",
# "AvgPitcher", "菊池 涼介"))%>%
# left_join(fielder)%>%
# select(-c(1:3))
#
# team.list2 <- list(lineup3, lineup4)
# label.list2 <- list("Pit_9th", "Pit_8th")
# res.pit.spot2 <- simulate.multiple.teams(team_list = team.list2,
# label_list = label.list2,
# rep = 800,
# games = 143)
# save(res.pit.spot2, file = "results/2018_carp_800seasons_pit_8or9_Maru_on_5th_spot.rdata")
# RPIは0.59程度で丸を2番においたより低いだろう (それでも前のsectionの會澤タイプよりは6点/年多い)
res.pit.spot <- res.pit.spot%>%
mutate(Inning = paste(Replicate, Inning))
pit.spot.rpi <- res.pit.spot%>%
group_by(Type, Replicate, Game, Inning)%>%
dplyr::summarise(Runs = max(Runs_post))%>%
ungroup()%>%
group_by(Type, Replicate)%>%
dplyr::summarise(RPI = mean(Runs),
Innings = n(),
SD = sd(Runs),
CI_95_upper = RPI + SD /sqrt(Innings) * qt(0.975, df = Innings-1),
CI_95_lower = RPI - SD /sqrt(Innings) * qt(0.975, df = Innings-1),
RPG = RPI * 8.93)
res.pit.spot%>%
compute.runs.per.inning(split_by_Type = TRUE)%>%
mutate_if(is.numeric, funs(round), 4)%>%
gt()| Type | RPI | Innings | SD | CI_95_upper | CI_95_lower | RPG |
|---|---|---|---|---|---|---|
| Pit_8th | 0.5949 | 1021579 | 1.1398 | 0.5971 | 0.5927 | 5.3124 |
| Pit_9th | 0.5981 | 1021764 | 1.1426 | 0.6003 | 0.5958 | 5.3407 |
改変前の打順ではRPIの平均値は0.586であり, いずれのモデルでも小さい得点効率の改善が得られている.
ここまでに石原タイプを含む打順, 會澤タイプを含む現実に近い打順 (前のsection), 及びその改善案2つについてモデルで143*800試合のデータが得られた. これらの各打順における得点/試合の頻度を示す.
runs.per.game <- res.catcher.comp%>%
bind_rows(res.pit.spot)%>%
group_by(Type, Replicate, Game, Inning)%>%
summarise(Runs = max(Runs_post))%>%
group_by(Type, Replicate, Game)%>%
summarise(Score = sum(Runs))
runs.freq <- runs.per.game%>%
group_by(Type, Score)%>%
summarise(N = n())%>%
mutate(Freq = N / sum(N))
runs.freq%>%
ggplot()+
geom_line(aes(x=Score, y = Freq,
group = Type, colour = Type, linetype = Type)) +
geom_point(aes(x=Score, y = Freq,
group = Type, colour = Type), size = 1) +
theme_bw(base_family = "HiraKakuPro-W3") +
xlim(0,10)+
ylim(0.025, 0.15)+
theme(axis.text.x = element_text(size=12),
axis.text.y = element_text(size=12)) +
labs(title = "各モデルにおける得点/試合の頻度",
subtitle = "143試合 x 800シーズン.\n11点以上の試合はみやすさのために除いた.",
x = "得点/試合", y = "頻度")
石原を含めた打順では, 明らかな違いが見られる. 0-4 (点/試合) となった試合が多く, 6 (点/試合) 以上の高得点試合が少ない (青の点線). 前sectionにおける會澤を含む打順も, 改善案に比べると, 2-4点の低得点領域でわずかに多いかもしれない. しかし, 石原と會澤の交換に比べて効果は非常に小さく, この方法ではあまりよくわからないというべきだろう.
年度あたりの総得点への効果をRPIの値から計算する. 改善案である2つの打順の平均は0.5965. 前のsectionで示したの會澤モデルの平均が0.586であった. これらの間の差は, それぞれの95%信頼区間の幅が±0.002程度であることを考えると, 誤差よりはかなり大きいだろう. 1試合8.82イニング, 143試合/年として1年の得点数におおまかに変換する.
(0.5965 - 0.586) * 8.93 * 143## [1] 13.4084年間13点ほどの効果になった. これは約1.3勝分程度の価値である.
今度は改善案の打順について, 投手が8番 or 9番で143試合ずつ計算したRPIの分布を可視化する.
pit.spot.rpi%>%
ggplot(aes(x = Type, y = RPI, group = Type))+
geom_boxplot(outlier.shape = NA, width = 0.6) +
geom_dotplot(binaxis = "y",
binwidth = .001,
stackdir = "center") +
theme_bw(base_family = "HiraKakuPro-W3")+
theme(axis.text.x = element_text(size=12),
axis.text.y = element_text(size=10)) +
theme(axis.title.x = element_text(size=12),
axis.title.y = element_text(size=12)) +
theme(plot.margin= unit(c(1, 1, 1, 1), "lines"))+
labs(title = "RPIの比較.",
subtitle = "143試合 x 800セット計算し,
143試合ごとの平均値の分布を示す.",
x = "", y = "イニングあたり平均得点 (RPI)") 
差はほとんど無いようにみえる. 実際には頻度論的な有意差はあるが, 単純にN=800とサンプルが多いためだろう. サンプルを増やせばどんなに小さな (現実的に無意味な) 効果でも検出可能である. ここでは, 野球の試合自体への影響の大きさを考慮する必要がある.
とりあえず点推定値だけを考えることにする. RPIにおける差から1年での得点数へと変換する.
0.003 * 8.93 * 143## [1] 3.830973.8点ほどになった. 期待値として0.38勝と考えると, それなりに意味があるかもしれない. 2018年のカープは優秀な打者が非常に多く, 投手を8番にあげるコストが大きかった可能性が考えられる. しかし, 推定された効果は小さく, 信頼区間の幅とあまり変わらない. これらの要素を考えると, 少なくともここで得られた結果からは, あまり大きな意味を見出すべきではないかもしれない.
各打順でのRVを示す. 投手を9番においたモデルから.
res.pit.spot <- res.pit.spot%>%
compute.RE24(split_by_Type = TRUE,
out_RE24 = FALSE)
RV.by.spots <- res.pit.spot%>%
compute.adjusted.RV(split_by_Type = TRUE)
RV.by.spots %>%
filter(Type == "Pit_9th")%>%
select(-c(4:7))%>%
spread(key = Batter, value = Adjusted_RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| Pit_9th | |||||||||
| Single | 0.441 | 0.448 | 0.481 | 0.506 | 0.528 | 0.507 | 0.480 | 0.457 | 0.423 |
| Double | 0.689 | 0.728 | 0.806 | 0.836 | 0.854 | 0.817 | 0.769 | 0.734 | 0.677 |
| Triple | 0.961 | NA | 1.119 | 1.168 | 1.185 | 1.093 | 1.037 | 1.010 | 0.910 |
| HR | 1.392 | 1.479 | 1.594 | 1.597 | 1.583 | 1.546 | 1.473 | 1.410 | 1.329 |
| BB_IBB | 0.366 | 0.371 | 0.388 | 0.377 | 0.388 | 0.380 | 0.353 | 0.338 | 0.319 |
| HBP | 0.370 | 0.374 | 0.392 | 0.378 | 0.386 | 0.382 | 0.353 | 0.345 | 0.326 |
| Out | -0.291 | -0.309 | -0.327 | -0.325 | -0.333 | -0.323 | -0.304 | -0.290 | -0.271 |
| K | -0.304 | -0.317 | -0.336 | -0.348 | -0.354 | -0.341 | -0.323 | -0.311 | -0.287 |
3番におけるイベントの得点価値の振れ幅が1, 2番よりも大きくなった. これは1つには, 丸が2番に入ったために特に3番の状況が改善したことと関連があるだろう. また, 會澤と西川を打順の前に移動させて (7, 8 → 5, 6) 能力の劣る打者タイプを配置したことで, 1, 2番の状況が悪化したことも影響している可能性が高い.
投手を8番に入れたときの結果を示す.
RV.by.spots %>%
filter(Type == "Pit_8th")%>%
select(-c(4:7))%>%
spread(key = Batter, value = Adjusted_RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| Pit_8th | |||||||||
| Single | 0.447 | 0.458 | 0.489 | 0.513 | 0.530 | 0.508 | 0.481 | 0.460 | 0.381 |
| Double | 0.713 | 0.749 | 0.820 | 0.841 | 0.852 | 0.811 | 0.770 | 0.737 | 0.611 |
| Triple | 0.982 | NA | 1.112 | 1.099 | 1.155 | 1.087 | 1.041 | 1.023 | 0.827 |
| HR | 1.432 | 1.503 | 1.615 | 1.606 | 1.589 | 1.544 | 1.476 | 1.418 | 1.249 |
| BB_IBB | 0.372 | 0.374 | 0.390 | 0.377 | 0.384 | 0.379 | 0.351 | 0.336 | 0.293 |
| HBP | 0.373 | 0.373 | 0.379 | 0.380 | 0.382 | 0.376 | 0.353 | 0.343 | 0.290 |
| Out | -0.298 | -0.311 | -0.330 | -0.326 | -0.332 | -0.321 | -0.302 | -0.289 | -0.249 |
| K | -0.308 | -0.320 | -0.341 | -0.348 | -0.353 | -0.340 | -0.323 | -0.309 | -0.262 |
1-3番でやや改善が見られるが, それほど顕著ではない. 前回のポストでは, 投手の有無で比較した場合では大きな変化があったが, 9番から8番に上げた程度では, 投手のマイナス効果が上位打線に及ばないようにする効果は小さいかもしれない.
3 まとめと議論
2018年カープ選手の成績を真の成績として持つような状況を考えてそれらしい打順を組み, マルコフ連鎖モデルによるシミュレーションを用いて打順変更による得点への影響の大きさを検討した.
會澤タイプと石原タイプを7/8番においたときの得点差は大きく, 平均でみると90点/年ほどの違いが見られた. 捕手の守備評価は不明な点も多いが, 現在のところ明らかになっている主要な要因としてフレーミングがある. フレーミングまでを考慮すると, 捕手は守備能力の差が比較的出やすいポジションの一つかもしれない. しかし, 仮に打撃で90点/年の違いがあった場合, 守備で埋めることはなかなか難しいだろう. 公になっているNPBにおけるフレーミング効果定量の試みとしては, DELTAによる算出がある. 記事において, ある程度の守備イニング数を持つ捕手におけるフレーミングによってストライクが得られる頻度が示されている. ここで提示された数値を引用して, 5000球あたりのフレーミング得点のSDを計算する.
# 引用元
# https://1point02.jp/op/gnav/column/bs/column.aspx?cid=53587
# ミットの移動距離を補正した数値も提示されている.
# ここでは移動距離を考慮していない方の結果を利用する.
# これはミットの移動距離が何を補正しているのかが明らかではなく,
# 部分的に捕手のフレーミング能力とみなされるものを除いている可能性がありそうだと考えたため.
# ここの目的では補正していない数値の方が良さそうな気がした (曖昧).
# 結果的にはどちらでもSDのサイズはあまり変わらないことは確認した (結果は示していない).
NPB.2019 <- data.frame(Framing_chances = c(4587, 3124, 5307, 2898, 3393, 2769, 4672,
2786, 4606, 5572, 5629),
CSAA = c(-37.5, 30.9, 47.0, -15.6, -38.5, 77.8, -47.6,
52.6, -24.9, -90.8, -49.6))
# CSAAがストライク数なので (framing chancesに関して下で引用したBPのリーダーボードではrate)
# 5000球あたりに変換
# runs/strikeをかけて得点に変換
# Tangoが提案している数値を使う
# http://tangotiger.com/index.php/site/wowy-framing-part-3-of-n-run-value-of-a-called-strike
# おそらくNPBではもう少し小さいのでは?
NPB.2019 <- NPB.2019%>%
mutate(CSAA_5000 = CSAA*5000/Framing_chances,
Framing_runs = CSAA * 0.125,
Framing_runs_5000 = CSAA_5000 * 0.125)
NPB.2019%>%
pull(Framing_runs_5000)%>%
sd()## [1] 8.88938390得点の差は約10 SDほどに相当する. シーズン最大7000球程度ということを考えると, 少なくともフレーミングだけではこれほど大きな差を埋めることは難しいかもしれない (MLBで最大で8000球程度). 注意点として, デルタの目視による投球位置データについてはどの程度信頼が置けるかについての質の高い情報が提供されておらず, さらにフレーミングの計算で考慮される変数 (球種, 審判, 打者の身長など) がいまのところ無視されていると思われる. そのため, 無視できない大きさのバイアスが含まれている可能性があり, 現状では多少割り引いて見る必要があるかもしれない (とはいえ, デルタによる公表はNPBの捕手の守備評価において画期的な前進だと思われる; また, 多くの変数を無視した場合でも, ある程度以上フレーミングの効果を推定できるらしい).
會澤タイプをベースにして, 打順を変更してその効果を検討した. 主な変更点のまとめを再掲.
- 菊池タイプを2番から8/9番へ
打力で劣る (2018の) 菊池タイプの打席数を減らす
- 丸タイプを2番に
3番に比べてRVの変動が大きい2番に移すとともに, 規格外の出塁率で打席数が比較的多いspot (3-5あたり) の価値を高める
- 會澤タイプを7番から5番に
チーム3番目の打者を7番から重要な打順に上げる
これによって10点/年程度の改善が得られた. 同時に複数の打順を変更したため, どの変更点がどの程度効果があったのかはよくわからないが, おそらく菊池タイプを下げたことが大きいのではないか. とはいえ, 過去の菊池の成績を考えると, 2018年ほど成績が悪いことを予測することはおそらく困難であり, この打順改変による改善はあくまで後知恵である. また同様に會澤の2018年成績もおそらく偶然の影響が大きかった可能性もあり (実際には2019もかなり優秀だったが, 2018シーズン開始時点でこの成績は健全な予測システムからは出てこないだろう), 石原も過去の成績ではここまで打撃成績は悪くはない. ここでは1年の成績を元に選手タイプを作ったため, このような後知恵的なバイアスを避けることができていない. ある年 (あるいはその次の年) における打線の改善のためにシミュレーションモデルを使うのであれば, 選手成績自体も何らかの成績予測モデルの推定値を利用することが妥当だろう.
打順変更という介入策の効果は, 合計得点をどれぐらい増やしたかで最終的に評価される. ここで示した改善案では10点/年程度の改善が見られた. The Bookでは打順の改善による効果は10-15点/年程度だろうと記述されており (pp. 131), 概ね効果の大きさとしては一致した. これを大きいと見るか, 小さいと見るかは人によるだろう (そもそも大きいか小さいかという判断は基本的には主観であるが). 一つの基準としては, 偶然の大きさと比較することができるだろう. ここのモデルでは, 1 SDが総得点の5%程度であった. 1シーズンに600点を記録するチームを考えた場合, ±30点程度の違いは偶然で頻繁に起こる程度ということになる (68%水準). 10点/年はこれに比べてかなり小さい. このような小さい効果を明らかにするためにはモデルを使って“精密”に (=測定誤差を小さく) 推定する必要があるだろう (モデルにはバイアスが入っているはずなので, どこまで“正確” (=現実の効果の推定として妥当) かは議論がありうる). あるいは會澤や石原を入れ替えた場合の効果に比べれば, 同じ選手達を並べ替えることの効果はとても小さい. スポーツ新聞などでは, 短い期間の試合で記録された得点の違いをその時の打順の並べ替えに帰するような論評が頻繁に見られる. しかし, このような短期間で記録されるような大きな変化については, 偶然や対戦投手のレベルの違いからの影響がほとんどすべてだろう.
一方, この打順の並べ替えの効果はそれほど小さくはないと考えることもできる. 10点/年が期待値として得られるのであれば, 1勝=10点というよく利用される近似のもとで, 長期的な期待値としては1勝/年を得られると表現できる. 金銭的なコスト無しに1勝の利得が得られる要素は野球の中ではそれほど多くないと思われ, 1勝/年の価値を補強で得ようとすればおそらく億単位のコストが必要になるだろう. また, 打順の効果に限らず, 同じように小さい10点/年をもつ要素を3つ見つけることができれば, それはチームの年間得点のSD 1つ程度になる. このように考えると, 打順の効果もそれなりに重要であり, 無視するのはあまり合理的ではないと考えることもできるだろう.
Section 2.3の改善案は, “平均的な野手を並べた”打順ごとの得点価値に基づいてデザインした. この方法は単純で理解しやすく, 打順の効果の大部分は得られるような, 良い指針を与えていると考えられる. しかし, 能力差を持つ打順にこの方法を適用すると解釈に注意が必要になる. これは能力差のある打者を配置することで打順スポットの得点価値自体が影響を受けるためである. section 2.2の會澤モデルで得られた打順ごとの得点価値では, やや後ろめの打席が重要になっていたが, これは能力の高い丸と鈴木が3-4番にいたためだろう. この得点価値に沿って優秀な打者を4-6番に配置すると, ここで示した改善案よりも得点効率が低下する (計算はしたが結果は示していない). ここでは丸と鈴木が後ろめに配置されたことで, 打席数の少ないスポットを重要にしてしまっていた, と解釈するべきだろう. また, 丸を2番においた改善案の方では, 一般的には価値が低い3番打者の重要性がかなり高まっていた. 打順の最適化を達成しようとすれば, 平均的な打順における各スポットの得点価値を見ることでは難しく, ある程度総当たりしてそれぞれについて高精度の推定値を得る必要があるかもしれない.
得点数における偶然の効果の大きさは, 実際の打順が決まる過程において重要な要因となっていると思われる. 現状でも, 優れた打者は打順の前や中軸に置かれており, ある程度の妥当性のある打順となっている. すでに説明した通り, ここからさらなる改善による効果は, 偶然で生じる差に比べて小さい. そのため, シミュレーションなどに基づかない限り, 改善は困難となると考えられる. ここで, de fact standardに反して, シミュレーションによって支持されるような改善方法を適用した場合を考える. この時, 偶然がもたらす影響によって見かけ上得点数が減った場合 , 期待値としては改善している打順であっても, 効果がない, あるいは負の効果を持つと認識されることは容易に起こりうる. さらにその打順に固執すれば, 打順決定者のクビが飛ぶかもしれない. 打順の効果に対する偶然の効果の相対的な大きさは, 打順決定者にとってde fact standardに従うインセンティブの大きさに繋がっているだろう. あるいは, 偶然の影響に比べて打順の効果が十分に大きいようなものであったのであれば, 打順はより最適化に近い状態になっていたかもしれない, とも考えられるだろう.
ここで示した結果はあくまで, 様々な仮定を置き, さらにいろいろな要素を無視したモデルの結果である. 無視した要素はモデルがもつバイアスに繋がっているだろう. ここで考慮していない要素について, ツッコミが多そうな以下の項目について触れておく.
- 走力
- バント
これ以外にも打順を考える上での様々な要素について, The Bookあるいは, 市川 (2019) で詳しく調べられているが, 一般的に言って, 無視しているような要素の影響は小さいだろう.
走力の影響は打力に比べて小さいことが知られている (Baumer and Zimbalist, 2014, pp. 42). また, 打順との関連では, MLBにおいて, 盗塁については, 打順の比較的後ろの方, 例えば5-6番, で有効である一方, 単打や2塁打による進塁では打順の前の方で有効であることが議論されている (Tango et al., 2007, pp. 137). このため, 走力のある打者を特定の打順スポットにおいて価値を取り出すことは難しいだろう. 影響は非常に小さいことが予想される.
標準的な方法からバントの効果は小さいことと広く信じられている (蛭川, 2019, pp. 44-51). このような議論は, バントが意図通りに成功したケースや失敗したケースを考慮した場合の定量化を元にすることが多い. しかし, 野選や失策など最終的に起こったことの影響を考えること, 少し結果が変わることがMLBの実データから明らかにされている (Tango et al., 2007, Chap. 9; 李啓充氏による紹介記事). これは, 守備がバントを予測しているかというような複雑な要素を伴うと考えられる (蛭川, 2019, pp. 51-53). そのため, ありうるバントの効果をモデルの中で正確に評価するためには, 複雑な進塁確率を取り入れ, さらに守備位置の変化まで考慮する必要があるかもしれない. 今後調べてみる価値はあるかもしれない (やるとは言っていない). しかし, バントの効果はこのような要素を考慮した場合でも, 優秀な打者の打撃に比べて効果は小さいと考えられる. バントすることで利得があるような打順は, 同時に別の要素で得点を失う可能性が高い. 例えば, 打力の劣る打者を打順の前に置いてバントをさせることで利得を得ることが“仮にできたとしても”, そのような打順は打力に優れた打者の打席数を減らしてしまう. ここでは複雑さを避けるためバントの効果を無視したが, 結論には大きな影響は無いだろう.
4 参考文献
@sleep_in_nmbrs, 2019, マルコフ連鎖モデルによる野球のシミュレーション1: 平均的選手で構成された打順
蛭川皓平, (岡田友輔 監修), 2019, セイバーメトリクス入門, 水曜社.
Ben Lindbergh, 2018, On the Margins: How Pitch-Framing Became More Important—and More Common—Than Ever, The RINGER.
八代久通, 2019, ［1.02 FIELDING AWARDS 2019］捕手部門.
Tango, 2019, WOWY Framing, part 3 of N: run value of a called strike
BP, Custom Statistic Report: Catcher Stats - full season
Judge,Pavlidis, and Brooks, 2015, Moving Beyond WOWY: A Mixed Approach To Measuring Catcher Framing, BP.
Tango, 2019, WOWY Framing, part 1 of N
市川博久, 2019, 打順は打者のパフォーマンスや監督の采配に影響を与えるか in デルタ・ベースボール・リポート3
李啓充, “汝、バントするなかれ（２)”, 李啓充 ＭＬＢコラム, 2010.
Benjamin Baumer and Anderew Zimbalist, 2014, The Sabermetric Revolution, University of Pennsylvania Press.
Tango, MGL, Andrew Dolphin, 2007, The Book, Potomac Books.
5 関数定義
# 各イベント+状態による進塁規則
require(tidyverse)
# retrosheetから計算した状態遷移した時に記録される得点を示す行列
transition.table <- read_csv("required_tables/Make_New_State_retro_16-17.csv", locale=locale(encoding="CP932"))
# Outはretrosheetのgeneric outをそのまま使用
# バントやSFの大部分はgeneric outに含まれる
# error, FC etc.は無視
# 状態が遷移した時に記録される得点計算に利用する表
RunTable <- read_csv("required_tables/StateTransitionRunMatrix.csv", locale=locale(encoding="CP932"))
# progress barで表示
require(utils)
# 1試合を計算する関数の設定
simulate.one.game <- function(df = lineup, game = 1){
# 初期条件
s <- "000 0"; # 状態を示す変数 1,2,3塁ランナー状態 (0 or 1) + アウトカウント. 3アウトは"3"でコードしている
runs <- 0; # 得点 (イニングごとに0に戻していることに注意)
spot <- 1; # 打順
inning <- 1; # イニング
game_end <- FALSE ; # 試合終了判定用のflag
# 初期条件. 以下は記録のためのオブジェクト
innings <- NULL;
batter.rec = NULL;
# 下の5つはRE, RVの計算に使う (pre, postは片方あれば, あとでleadとかでイニングごとにずらしても可)
event.rec <- NULL;
state.pre <- NULL; state.post <- NULL;
runs.pre <- NULL; runs.post <- NULL;
while(game_end == FALSE){ # while 1: game_end flagについては下で記述
while(s != "3"){ # # while 2: イニングは3アウトになるまで
# イベント前の状態を記録
state.pre = c(state.pre, s)
runs.pre = c(runs.pre, runs)
# 打順データの"spot"行からイベントをサンプリング
bat.event <- sample(names(df), 1, prob = df[spot,])
# 進塁規則に従って状況を遷移させる
# MLB16-17での確率を利用する
# もっと単純なD’Esopo and Lefkowitzの進塁規則などでもそこそこの精度はでる
transition.prob <- transition.table %>%
ungroup()%>%
filter(STATE == s, Event_des == bat.event)%>%
select(-c(1:3))
s.new <- sample(names(transition.prob), 1, prob = as.numeric(transition.prob))
# s.newは打席が終わった状態を示す
# sからs.newに移行したときに記録される得点
runs <- as.numeric(runs + RunTable[RunTable$State_pre == s, s.new])
# 結果を記録する
# この辺が遅い最大の原因だろう
runs.post <- c(runs.post, runs) # 得点を記録する
event.rec <- c(event.rec, bat.event) #eventを記録していく
state.post <- c(state.post, sprintf("%s", s.new)) #stateを記録していく
batter.rec <- c(batter.rec, spot) # 打順を記録
innings <- c(innings, inning) # イニング(ry
# 打順を進める
spot <- ifelse(spot == 9, 1, spot +1)
# 次の打席に移る前に状態を示すsをs.newで置換
s <- s.new
# while loopの先頭に戻る
} # while 2の終わり. つまりイニングの終わり
# 試合終了判定 game_end flangの管理
if(! inning %in% 8:9){ # inningが8 or 9以外では次のイニングに入る
inning <- inning +1
s <- "000 0"
runs <- 0
}else if(inning==8){ # inningが8の場合, 次のイニングに入るかどうか調べる
U = runif(1) # 一様分布から乱数を取得
if(U < 0.93){ # 乱数が0.93より小さいと9回に入る
inning = inning + 1
s <- "000 0"
runs <- 0
}else{
game_end=TRUE}
}else{ # 9回なら終わり
game_end = TRUE
} # 試合終了判定おわり
} # while 1のおわり
# 結果をdfにまとめる
data <- data.frame(Game = game,
Inning = innings,
Batter = batter.rec,
Event = event.rec,
State_pre =state.pre,
State_post = state.post,
Runs_pre = runs.pre,
Runs_post = runs.post,
stringsAsFactors = FALSE)
# Eventをfactor typeにして見やすいようなレベルを設定しておく
data$Event <- factor(data$Event, levels = c("Single", "Double", "Triple", "HR",
"BB_IBB", "HBP", "Out", "K"))
return(data)
} # function終わり
# 複数試合を計算する関数
simulate.n.games <- function(df = lineup1,
rep = 1,
games = 100){
1:games%>%
map(~simulate.one.game(df = df,
game = .))%>%
bind_rows()%>%
mutate(Replicate = rep)
}
# 複数打線の結果をまとめて計算
simulate.multiple.teams <- function(team_list = team.list,
label_list = label.list,
rep = 2,
games = 5){
len <- length(team_list)
out.list <- vector("list", length = len)
for(i in 1:len){
team.df <- team_list[[i]]
team.label <- label_list[[i]]
team.res <- 1:rep%>%
map(~simulate.n.games(df = team.df,
games = games,
rep = .))%>%
bind_rows()%>%
mutate(Type = team.label)
out.list[[i]] <- team.res
}
out <- out.list%>%
bind_rows()
return(out)
}
# # 使用例
# team.list <- list(lineup1, lineup2)
# label.list <- list("with會澤", "with石原")
# simulate.multiple.teams(team_list = team.list,
# label_list = label.list,
# rep = 5,
# games = 3)
# 計算結果のdfを受け取ってRPIを計算する関数
compute.runs.per.inning <- function(df = res,
split_by_Type = FALSE){
if(split_by_Type == TRUE){
out <- df%>%
group_by(Type, Game, Inning)%>%
dplyr::summarise(Runs = max(Runs_post))%>%
ungroup()%>%
group_by(Type)%>%
dplyr::summarise(RPI = mean(Runs),
Innings = n(),
SD = sd(Runs),
CI_95_upper = RPI + SD /sqrt(Innings) * qt(0.975, df = Innings-1),
CI_95_lower = RPI - SD /sqrt(Innings) * qt(0.975, df = Innings-1),
RPG = RPI * 8.93)
}else{
out <- df%>%
group_by(Game, Inning)%>%
dplyr::summarise(Runs = max(Runs_post))%>%
ungroup()%>%
dplyr::summarise(RPI = mean(Runs),
Innings = n(),
SD = sd(Runs),
CI_95_upper = RPI + SD /sqrt(Innings) * qt(0.975, df = Innings-1),
CI_95_lower = RPI - SD /sqrt(Innings) * qt(0.975, df = Innings-1),
RPG = RPI * 8.93)
}
return(out)
}
# 計算結果を受け取ってRE24を返す (out_RE24 = TRUE) か,
# あるいは計算結果をRVの計算が利用可能なdfに変換する (out_RE24 = FALSE)
# ための関数
compute.RE24 <- function(df = res,
split_by_Type = FALSE,
out_RE24 = TRUE){
if(split_by_Type == TRUE){
max.runs <- df%>%
group_by(Type, Game, Inning)%>%
dplyr::summarise(Max_runs = max(Runs_post))
df <- df %>%
left_join(max.runs)
df <- df %>%
mutate(Runs_ROI = Max_runs - Runs_pre)
RE24 <- df %>%
group_by(Type, State_pre)%>%
dplyr::summarise(RE = mean(Runs_ROI))
if(out_RE24 == TRUE){ # RE24の計算結果を返す場合
return(RE24)
}else{ # RVの計算のためにRE24の結果をdfに付与する場合
names(RE24)[3] <- "RE_pre"
df <- df %>%
left_join(RE24)
names(RE24) <- c("Type","State_post", "RE_post")
df <- df %>%
left_join(RE24)
df[is.na(df)] <- 0
df <- df %>%
mutate(RV_event = RE_post - RE_pre + Runs_post - Runs_pre)
return(df)
}
}else{
max.runs <- df%>%
group_by(Game, Inning)%>%
dplyr::summarise(Max_runs = max(Runs_post))
df <- df %>%
left_join(max.runs)
df <- df %>%
mutate(Runs_ROI = Max_runs - Runs_pre)
RE24 <- df %>%
group_by(State_pre)%>%
dplyr::summarise(RE = mean(Runs_ROI))
if(out_RE24 == TRUE){ # RE24の計算結果を返す場合
return(RE24)
}else{ # RVの計算のためにRE24の結果をdfに付与する場合
names(RE24)[2] <- "RE_pre"
df <- df %>%
left_join(RE24)
names(RE24) <- c("State_post", "RE_post")
df <- df %>%
left_join(RE24)
df[is.na(df)] <- 0
df <- df %>%
mutate(RV_event = RE_post - RE_pre + Runs_post - Runs_pre)
return(df)
}
}
}
# RE24のlong tableを受け取って表に変換する関数
generate.RE24.matrix <- function(df = RE24){
RE.matrix <- t(round(matrix(df$RE, 3, 8), 3))
dimnames(RE.matrix)[[2]] <- c("0 outs", "1 out", "2 outs")
dimnames(RE.matrix)[[1]] <- c("000", "001", "010", "011",
"100", "101", "110", "111")
return(RE.matrix)
}
# 打席数で補正したイベントごとの得点価値を計算する
compute.adjusted.RV <- function(df = res,
split_by_Type = FALSE){
if(split_by_Type == TRUE){
RV.by.spots <- df%>%
group_by(Type, Batter, Event)%>%
dplyr::summarise(RV = mean(RV_event))
PA.by.spots <- df%>%
group_by(Type, Batter)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))
RV.by.spots <-
RV.by.spots %>%
left_join(PA.by.spots)
RV.by.spots <- RV.by.spots%>%
mutate(Relative_PA = freq / (1/9),
Adjusted_RV = RV * Relative_PA)
}else{
RV.by.spots <- df%>%
group_by(Batter, Event)%>%
dplyr::summarise(RV = mean(RV_event))
PA.by.spots <- df%>%
group_by(Batter)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))
RV.by.spots <-
RV.by.spots %>%
left_join(PA.by.spots)
RV.by.spots <- RV.by.spots%>%
mutate(Relative_PA = freq / (1/9),
Adjusted_RV = RV * Relative_PA)
}
return(RV.by.spots)
}