野球の解析において何らかの要因からの影響の大きさを推定する方法として、試合をシミュレーションすることが考えられる. ここでは, ランナー/アウトカウントごとの状態の移行として試合の進行をモデル化し, 打順の各スポットにおける打席イベントの得点価値の違いについて検討する. これは打順の沿って生じる, 1. ランナー/アウト状況の違い, 2. 打席数の違いを考慮した上で, 打席イベント (単打, 2塁打, …, 三振) の価値を計算することで得られる. 非常に単純な方法だが, 打順変更による得点効率改善の主要な経路であると考えられ, 打順に組み方の基礎的な考え方を提供している.
野球の状況は非常に定義しやすく, 試合の進行は状態の遷移として表現することが可能となっている. アウトカウントとランナーに関してありうる状態としては、アウトカウント (0から2の3通り) x ランナー状況 (2^3 = 8通り), で24通りの状態, それらに加えて3アウト (ランナーに関しては無差別とする) で25の状態と定義できる. 本ポストではマルコフ連鎖モデルを利用する. このモデルでは, 現在の状態が次の状態に移行する確率は, どのようにして現在の状態に至ったかによって影響を受けないことを仮定する. この単純な仮定が成立する状況を考えることで, モデルの中で考慮した要因からの影響を定量的に推定することができる. もちろん現実にはその他の影響はあるが, 幸運なことに影響はそれほど大きくないことが知られており, 極端に状況を分けない限りはそれなりに妥当な推定が可能となっている.
マルコフ連鎖モデルを利用した野球の研究は多くの研究者が行ってきたが, 最も有名なものの一つは, TangoらによるThe Bookだろう. 例えばChap. 5においては, 打席結果イベントサンプリングを利用したマルコフ連鎖モデルを使って, 打順を考える上で重要な要素についての結果と考察が示されている. 打順の評価については様々な議論があるが, 現状ではThe Bookが示した結果が最も重要であるとみなされていると言えるだろう. 以下に示す内容の大半も, The BookのChapter. 5の一部 (pp.121-131) の概念的な追試である.
以下では平均的な選手を並べたモデルを利用して野球の過程をシミュレーションする. 野球のマルコフ連鎖モデルにおいては, なんらかの介入を与えた際に最終的な得点数がどう変化するか調べることで, その介入の効果を定量的に調べることが多い. しかし, ここでは得点数それ自体はモデルがある程度現実を模倣できているかどうかの基準程度としてのみ考える. ここで重視するのは打順の各スポットにおける, 各打席イベントの得点価値である (蛭川, 2019). これによって, 打順における各スポットの重要性の違いや, どのようなタイプの選手をどのスポットに置くとよいかについての大まかな指針が得られることを示す.
試合をシミュレーションするための関数に渡す打順を設定する. NPB公式の2018年度成績から打者と投手に分けて打撃成績を集計した. 各イベントの頻度を計算し, 9人分並べる.
ここでは2つの打順;
を設定し, それぞれを利用する.
平均的な野手と投手からなる打線におけるイベント発生確率を示す.
require(tidyverse)
require(knitr)
require(kableExtra)
# 打順を考慮するモデルを使うため打順データを用意する
# 平均的な野手のみの打線では, 同じ選手を9人並べており単に計算量が増えているだけ
# だが, 比較のため能力差を考慮できる同じモデルで扱うことにする
average <- read_csv("stats/average_2018.csv", locale=locale(encoding="CP932"))
# NPB公式から
# 1. 全打者 (投手除く) の打撃成績
# 2. 全投手の打撃成績
# を集計したもの
lineup1 <- data.frame(Player = rep("AvgFielder", 9))%>%
left_join(average)%>%
select(-c(1:3))
lineup2 <- data.frame(Player = c(rep("AvgFielder", 8), "AvgPitcher"))%>%
left_join(average)%>%
select(-c(1:3))
# 平均的野手と投手が含まれるlineup2だけ示す
tibble(Spot = 1:9)%>%
cbind(lineup2)%>%
mutate_all(funs(round),3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Spot | Single | Double | Triple | HR | BB_IBB | HBP | K | Out |
|---|---|---|---|---|---|---|---|---|
| 1 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 2 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 3 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 4 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 5 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 6 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 7 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 8 | 0.158 | 0.040 | 0.005 | 0.026 | 0.092 | 0.010 | 0.181 | 0.488 |
| 9 | 0.076 | 0.014 | 0.001 | 0.005 | 0.032 | 0.003 | 0.436 | 0.435 |
これらの確率を使ってイベントをサンプリングし, MLB (16-17) における, ランナー/アウト状況と各イベントの組み合わせごとに得られた進塁確率を用いて, 打席後の状態を決定する. これら以外のイベント (盗塁関連, 妨害系 etc.) は無視している. MLBでの走塁の状態遷移確率の計算はRetrosheetを利用した.
BBとIBBはまとめている. IBBはランナー/アウト状況に依存して記録されるため, モデルとの相性がやや悪い. IBBが記録される可能性が高い場面だけで記録されるようにするという手もあるだろうが, 面倒だし計算コストの割に得るものが少なそうに思われる. BBも投手側から見てコストが低い状態で発生しやすい (野球を見る限りBBとIBBは故意の成分が0-100%の連続的なものだと思われる). それ以外にも, ここでのモデルは状況によるイベント発生確率変化の要素は考慮されておらず, バイアスの原因となりうる.
SFとSHはOut扱いとした. Retrosheetから計算した進塁状態遷移確率においても, Outが記録された時にSFとSHによるランナー進塁が含まれているため整合性は取れているといえるが, Outの価値の計算ではこれらの比較的中立的な価値を持つイベントが含まれていることは注意が必要かもしれない.
このようにイベントのサンプリングを利用する場合, 状態の遷移確率のみを使う場合に比べて, 1つの遷移を:
の2つのサンプリングに分けるため計算速度が遅くなる. さらに複雑さを避けるため一部のイベントを無視することになり, 得点の推定自体も正確でなくなる可能性が高い. しかし, 各イベントのラベルによってどのような原因で状態が推移したかを識別可能になるため, 移行過程の解釈が容易になる利点がある. 単にランナー/アウト状態の遷移確率を考慮した場合, どのような原因でその移行が生じたかわからないため, 野球を見ている人間の認識から遠くなり, 解釈が困難となる.
本ポストで利用するコードはMarchi et al.で記述されている, 24状態の遷移確率を用いたモデルを元に改変した.
# 使用する関数をまとめたファイル
# 末尾の関数定義参照
source('functions/func_markov_model_using_event_sampling.R')
# 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"行からイベント (row name) をサンプリング
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, 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 loop1の先頭に戻る 次の打者に移る
} # while 2の終わり. sが"3"ならloop終了. つまりイニングの終わり
# 各イニング終了後, 試合終了判定 game_end flangの管理
# これも無駄に遅くなるがイニング数を合わせるため
# 実のところRPGではなくRPIを考えるならそもそもあまり必要はない
# つまり9イニング計算してしまい, 期待イニング数に変換すればいい
# 1イニングだけ計算して x9すると打順が常に#1から開始するので当然だめ
# このあたりは https://github.com/ssharpe42/BaseballMarkov を参考にしたような気がするが, かなり昔なので憶えていない
if(inning ==9){ # 9回なら終わり
game_end = TRUE
}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{ # inningが8 or 9以外では次のイニングに入る
inning <- inning +1
s <- "000 0"
runs <- 0
} # 試合終了判定おわり
} # 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終わりイニングは2018年実測値に合わせて8.93に設定.
c(CL= (7689 + 1/3) / 858, PL = 7643 / 858)## CL PL
## 8.961927 8.907925# 1.02で示されていた数値を使っている
# https://1point02.jp/op/gnav/leaders/lg/lps_standard.aspx?sn=2018&lg=0&tm=0&ps=0&sl=1&sr=0&pn=0
# 以前は登録なしで見られたのだが無料会員登録が必要になったようだモデルでは延長戦を考慮せずにイニング数を合わせているため, 9回に入る確率が実際より高くなっていると思われる.
一試合の計算例.
simulate.one.game(df = lineup1)## Game Inning Batter Event State_pre State_post Runs_pre Runs_post
## 1 1 1 1 Single 000 0 100 0 0 0
## 2 1 1 2 Out 100 0 100 1 0 0
## 3 1 1 3 Out 100 1 100 2 0 0
## 4 1 1 4 Out 100 2 3 0 0
## 5 1 2 5 Out 000 0 000 1 0 0
## 6 1 2 6 Out 000 1 000 2 0 0
## 7 1 2 7 K 000 2 3 0 0
## 8 1 3 8 K 000 0 000 1 0 0
## 9 1 3 9 Out 000 1 000 2 0 0
## 10 1 3 1 Single 000 2 100 2 0 0
## 11 1 3 2 BB_IBB 100 2 110 2 0 0
## 12 1 3 3 Out 110 2 3 0 0
## 13 1 4 4 K 000 0 000 1 0 0
## 14 1 4 5 Out 000 1 000 2 0 0
## 15 1 4 6 Out 000 2 3 0 0
## 16 1 5 7 Out 000 0 000 1 0 0
## 17 1 5 8 BB_IBB 000 1 100 1 0 0
## 18 1 5 9 Single 100 1 110 1 0 0
## 19 1 5 1 Single 110 1 111 1 0 0
## 20 1 5 2 Out 111 1 111 2 0 0
## 21 1 5 3 Single 111 2 110 2 0 2
## 22 1 5 4 Out 110 2 3 2 2
## 23 1 6 5 Out 000 0 000 1 0 0
## 24 1 6 6 Out 000 1 000 2 0 0
## 25 1 6 7 Out 000 2 3 0 0
## 26 1 7 8 Single 000 0 100 0 0 0
## 27 1 7 9 HR 100 0 000 0 0 2
## 28 1 7 1 Out 000 0 000 1 2 2
## 29 1 7 2 Out 000 1 000 2 2 2
## 30 1 7 3 Out 000 2 3 2 2
## 31 1 8 4 Double 000 0 010 0 0 0
## 32 1 8 5 Single 010 0 101 0 0 0
## 33 1 8 6 Out 101 0 000 2 0 1
## 34 1 8 7 Out 000 2 3 1 1
## 35 1 9 8 K 000 0 000 1 0 0
## 36 1 9 9 Single 000 1 100 1 0 0
## 37 1 9 1 HR 100 1 000 1 0 2
## 38 1 9 2 Single 000 1 100 1 2 2
## 39 1 9 3 HR 100 1 000 1 2 4
## 40 1 9 4 Single 000 1 100 1 4 4
## 41 1 9 5 Out 100 1 100 2 4 4
## 42 1 9 6 BB_IBB 100 2 110 2 4 4
## 43 1 9 7 Out 110 2 3 4 4打席開始時の状況 (State_pre) と, 打席終了時の状況 (State_post)では塁上と, 0から2アウトの状態を4つの数字で表している. 例を示す.
“000 0”: ランナー無し, 0アウト
“100 0”: 1塁、0アウト
“000 1”: ランナー無し, 1アウト
なお, 3アウトはランナーを考える意味が無いので単に“3”と表している.
平均的な野手9人 (wo_pit) と, 平均的な野手8人+平均的な投手1人 (9番打者; w_pit) とについて, 80,000試合計算し, その結果を比較する.
# eval = FALSE
# 80000試合ずつ計算
res.wo.pit <- 1:80000%>%
map(~simulate.one.game(df = lineup1,
game = .))%>%
bind_rows()%>%
mutate(Type = "wo_pit")
res.w.pit <- 1:80000%>%
map(~simulate.one.game(df = lineup2,
game = .))%>%
bind_rows()%>%
mutate(Type = "w_pit")
res <- rbind(res.w.pit, res.wo.pit)%>%
mutate(Type = factor(Type, level = c("wo_pit", "w_pit")))
save(res, file = "2018_avg_80k_games.rdata")それぞれの打順 (Type) について, 1試合あたりの得点 (RPG) を計算.
load("results/2018_avg_80k_games.rdata")
Game.runs <- res %>%
group_by(Type, Game, Inning)%>%
dplyr::summarise(Runs = max(Runs_post))%>%
ungroup()%>%
group_by(Type, Game)%>%
dplyr::summarise(Runs = sum(Runs))
Game.runs%>%
group_by(Type)%>%
dplyr::summarise(RPG = mean(Runs),
SD = sd(Runs),
N = n(),
CI_95_upper = RPG + SD /sqrt(N) * qt(0.975, df = N-1),
CI_95_lower = RPG - SD /sqrt(N) * qt(0.975, df = N-1))%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | RPG | SD | N | CI_95_upper | CI_95_lower |
|---|---|---|---|---|---|
| wo_pit | 4.483 | 3.130 | 80000 | 4.505 | 4.462 |
| w_pit | 3.817 | 2.801 | 80000 | 3.836 | 3.798 |
95%CIの上限と下限の差は0.04程度. 80,000試合 (正確には半試合) だが多少誤差は残っている.
点推定値の平均.
(3.82 + 4.45) /2## [1] 4.135NPB2018の実際の値と比較する.
c(CL= 3751 / 858, PL = 3658 / 858)## CL PL
## 4.371795 4.263403投手なし (wo_pit)では4.48でやや実測値より高く, 投手あり (w_pit) では3.82で大幅にRPGが低い. 平均を取ると, 4.135程度で実測値よりやや低い. 現実では打者の能力に差があり, 得点価値や打席数の観点から見て重要な打順に高い能力の打者を置くことで得点を稼いでいるはずである. また, 投手は代打によって打順から除かれやすい. ここではそれらの影響を考慮していないことを考慮すると, これらのモデルで得点が低い事自体は理にかなっているのかもしれない. RPGで見る限り現実からの乖離は数%程度というところだろう.
現実のデータでは投手の打席が多いはずのCLで得点が多い. 野手の打撃能力と投手の投手としての能力のバランスでは, PLのほうが投手優勢だったのかもしれない.
実際にはNPB全体でも, 143 * 12試合で各リーグではその半分なので, 母平均からの誤差は多少あるはずで, 上の2つの議論はやや単純化し過ぎかもしれない.
1.02による, 実際のリーグごとのwOBAは以下の通り.
c(CL= 0.330, PL = 0.326)## CL PL
## 0.330 0.326少なくとも実際に試合で起こったイベントからの評価としては, 基本的にDHが無いため投手の打席が多かったにも関わらずCLのほうが得点がわずかに入りやすかったことようだ.
さらに問題があるのは, CLとPLではのイニング数/試合が異なり, 上のモデルとも差がある. このため, 試合数あたり得点に注目した比較はそれ自体が何を比較しているのか理解はやや困難となっている.
より比較が容易な, イニング当たり得点も示しておく.
まずモデル.
# ここのRPGは8.93をかけた近似値
res%>%
compute.runs.per.inning(split_by_Type = TRUE)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | RPI | Innings | SD | CI_95_upper | CI_95_lower | RPG |
|---|---|---|---|---|---|---|
| wo_pit | 0.502 | 714447 | 1.042 | 0.504 | 0.500 | 4.483 |
| w_pit | 0.427 | 714420 | 0.937 | 0.430 | 0.425 | 3.817 |
ここで示したRPGはRPIに期待イニング数の8.93をかけたものだが, これぐらいのサンプル数であればこの計算で概ね正確だろう.
実際の値.
c(CL= 3594 / (7689 + 1/3), PL = 3815 / 7643)## CL PL
## 0.4674007 0.4991495wOBAはCLの方がわずかに高いにも関わらず, RPIはPLの方がやや高い. 誤差の効果かもしれないし, 投手がいることによる影響がなにがしかあったのかもしれない.
PLは投手を含めていないモデルとほぼ同じとなった. モデルでは上述した打順の効果がないため得点が低下しそうなものだが, 少なくとも2018年度に関してはPLの打者のwOBAが低かったため, これらの効果が相殺したのかもしれない.
次に, 得点期待値 (RE) 24を示す. これは打者が打席に入った時点の状態に関して, イニングの終了までに記録された得点の平均 (つまり期待値) である. 投手なしモデルの結果を示す.
# このあたりから下で定義している簡単な自作関数を多用していく
RE24 <- res %>%
compute.RE24(split_by_Type = TRUE,
out_RE24 = TRUE)
RE.matrix <- RE24%>%
filter(Type == "wo_pit")%>%
generate.RE24.matrix()
require(gt)
RE.matrix## 0 outs 1 out 2 outs
## 000 0.502 0.269 0.103
## 001 1.343 0.928 0.367
## 010 1.111 0.666 0.319
## 011 1.911 1.345 0.584
## 100 0.873 0.511 0.221
## 101 1.734 1.133 0.490
## 110 1.481 0.916 0.454
## 111 2.349 1.589 0.773DeltagraphsによるNPB2013-2015のRE24を示す.
# NPB 13-15
# http://1point02.jp/op/gnav/column/bs/column.aspx?cid=53003
# NPB 14-18のものが蛭川 2019のpp.29にあり,
# そこはもう少し得点が入りやすい環境
NPB <- matrix(
c(0.440, 0.233, 0.087, 1.291, 0.906, 0.349,
1.059, 0.682, 0.305, 1.888, 1.321, 0.578,
0.807, 0.478, 0.204, 1.684, 1.165, 0.495,
1.412, 0.878, 0.417, 2.092, 1.454, 0.758),
8, 3, byrow=TRUE)
dimnames(NPB)[[2]] <- c("0 outs", "1 out", "2 outs")
dimnames(NPB)[[1]] <- c("000", "001", "010", "011",
"100", "101", "110", "111")
NPB## 0 outs 1 out 2 outs
## 000 0.440 0.233 0.087
## 001 1.291 0.906 0.349
## 010 1.059 0.682 0.305
## 011 1.888 1.321 0.578
## 100 0.807 0.478 0.204
## 101 1.684 1.165 0.495
## 110 1.412 0.878 0.417
## 111 2.092 1.454 0.758全体的な傾向は似ているが, モデルから得られた結果のほうが全体的に高い. 得点環境が違うため, 比較は困難だが差分を示す (モデルにおいて得点環境を無理やり合わせる方法に関しては, WEの計算に関するポストで説明した. 得点環境を調整すればより厳密な比較が可能となるだろうが, ここではそのような比較は重要ではない).
diff.matrix <- RE.matrix - NPB
diff.matrix## 0 outs 1 out 2 outs
## 000 0.062 0.036 0.016
## 001 0.052 0.022 0.018
## 010 0.052 -0.016 0.014
## 011 0.023 0.024 0.006
## 100 0.066 0.033 0.017
## 101 0.050 -0.032 -0.005
## 110 0.069 0.038 0.037
## 111 0.257 0.135 0.015ここまでに24状況の得点期待値 (RE24) が得られた. これを使って, 各モデルでの打席イベントの得点価値 (RV) を示す. RVは打席に入る前と終了後 (走者の移行も終了後) に注目し, 各イベントがどれだけ得点期待値を変動させたかについて平均を取った値である. 当然, RVの計算では, それぞれのモデルで個別に計算したRE24を利用している.
res <- res %>%
compute.RE24(split_by_Type = TRUE,
out_RE24 = FALSE)
RV <- res%>%
group_by(Type,Event)%>%
dplyr::summarise(RV = mean(RV_event))
RV %>%
spread(key = Type, value = RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Event | wo_pit | w_pit |
|---|---|---|
| Single | 0.451 | 0.417 |
| Double | 0.760 | 0.717 |
| Triple | 1.048 | 0.997 |
| HR | 1.453 | 1.444 |
| BB_IBB | 0.344 | 0.309 |
| HBP | 0.344 | 0.310 |
| Out | -0.264 | -0.223 |
| K | -0.282 | -0.242 |
得点が入りやすい投手なしモデルでは, 単打や四球などで価値が顕著に増加し, アウトで顕著な低下している. 一方, 長打, 特にHR, は得点環境が変化しても比率で見ると価値の変化は小さい. これは大まかに言えば, 塁に出たときに得点になる平均的確率が上昇することで, 塁に出ることの効果が大きくなっているためだと考えられる.
これらの得点価値はあくまで平均的なものである. ランナーアウト状態によってその価値は動的に変化する.
res%>%
group_by(Type, State_pre, Event)%>%
dplyr::summarise(RV = mean(RV_event))%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Event, value = RV)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)%>%
row_spec(c(1:3, 25:27), bold = T, color = "white", background = "grey")%>%
row_spec(c(13,16,19,22,
37, 40, 43, 46), bold = T, color = "white", background = "royalblue")| Type | State_pre | Single | Double | Triple | HR | BB_IBB | HBP | Out | K |
|---|---|---|---|---|---|---|---|---|---|
| wo_pit | 000 0 | 0.370 | 0.606 | 0.838 | 1.000 | 0.372 | 0.372 | -0.222 | -0.231 |
| wo_pit | 000 1 | 0.241 | 0.396 | 0.659 | 1.000 | 0.243 | 0.243 | -0.158 | -0.164 |
| wo_pit | 000 2 | 0.118 | 0.215 | 0.262 | 1.000 | 0.118 | 0.118 | -0.099 | -0.102 |
| wo_pit | 001 0 | 0.527 | 0.772 | 1.000 | 1.158 | 0.391 | 0.391 | -0.244 | -0.405 |
| wo_pit | 001 1 | 0.574 | 0.732 | 1.000 | 1.341 | 0.205 | 0.205 | -0.177 | -0.557 |
| wo_pit | 001 2 | 0.842 | 0.935 | 0.943 | 1.736 | 0.129 | 0.123 | -0.348 | -0.362 |
| wo_pit | 010 0 | 0.662 | 0.980 | 1.239 | 1.390 | 0.373 | 0.370 | -0.299 | -0.440 |
| wo_pit | 010 1 | 0.631 | 0.990 | 1.268 | 1.603 | 0.253 | 0.250 | -0.313 | -0.343 |
| wo_pit | 010 2 | 0.649 | 0.987 | 1.029 | 1.784 | 0.135 | 0.135 | -0.304 | -0.316 |
| wo_pit | 011 0 | 0.867 | 1.190 | 1.432 | 1.590 | 0.426 | 0.438 | -0.303 | -0.562 |
| wo_pit | 011 1 | 0.925 | 1.305 | 1.599 | 1.924 | 0.245 | 0.244 | -0.303 | -0.754 |
| wo_pit | 011 2 | 1.288 | 1.713 | 1.783 | 2.519 | 0.204 | 0.190 | -0.548 | -0.568 |
| wo_pit | 100 0 | 0.668 | 1.077 | 1.471 | 1.628 | 0.608 | 0.608 | -0.404 | -0.366 |
| wo_pit | 100 1 | 0.458 | 0.931 | 1.420 | 1.757 | 0.405 | 0.404 | -0.313 | -0.294 |
| wo_pit | 100 2 | 0.246 | 0.702 | 1.162 | 1.882 | 0.233 | 0.233 | -0.213 | -0.220 |
| wo_pit | 101 0 | 0.798 | 1.224 | 1.609 | 1.768 | 0.617 | 0.615 | -0.376 | -0.595 |
| wo_pit | 101 1 | 0.817 | 1.291 | 1.795 | 2.136 | 0.459 | 0.456 | -0.353 | -0.638 |
| wo_pit | 101 2 | 0.942 | 1.414 | 1.825 | 2.613 | 0.285 | 0.283 | -0.463 | -0.488 |
| wo_pit | 110 0 | 0.933 | 1.482 | 1.862 | 2.020 | 0.868 | 0.868 | -0.510 | -0.562 |
| wo_pit | 110 1 | 0.883 | 1.520 | 2.013 | 2.353 | 0.673 | 0.673 | -0.524 | -0.461 |
| wo_pit | 110 2 | 0.788 | 1.450 | 1.856 | 2.649 | 0.320 | 0.319 | -0.437 | -0.452 |
| wo_pit | 111 0 | 1.064 | 1.590 | 1.994 | 2.152 | 1.000 | 1.000 | -0.570 | -0.760 |
| wo_pit | 111 1 | 1.174 | 1.821 | 2.339 | 2.680 | 1.000 | 1.000 | -0.622 | -0.811 |
| wo_pit | 111 2 | 1.387 | 2.076 | 2.594 | 3.330 | 1.000 | 1.000 | -0.745 | -0.771 |
| w_pit | 000 0 | 0.335 | 0.566 | 0.815 | 1.000 | 0.337 | 0.337 | -0.190 | -0.198 |
| w_pit | 000 1 | 0.214 | 0.363 | 0.614 | 1.000 | 0.216 | 0.216 | -0.133 | -0.139 |
| w_pit | 000 2 | 0.105 | 0.198 | 0.241 | 1.000 | 0.106 | 0.106 | -0.084 | -0.087 |
| w_pit | 001 0 | 0.515 | 0.758 | 1.000 | 1.182 | 0.359 | 0.358 | -0.206 | -0.399 |
| w_pit | 001 1 | 0.589 | 0.743 | 1.000 | 1.386 | 0.221 | 0.220 | -0.131 | -0.507 |
| w_pit | 001 2 | 0.854 | 0.935 | 0.927 | 1.761 | 0.109 | 0.104 | -0.310 | -0.320 |
| w_pit | 010 0 | 0.653 | 0.981 | 1.260 | 1.431 | 0.346 | 0.340 | -0.263 | -0.398 |
| w_pit | 010 1 | 0.629 | 0.990 | 1.253 | 1.635 | 0.226 | 0.222 | -0.276 | -0.303 |
| w_pit | 010 2 | 0.652 | 0.991 | 1.022 | 1.801 | 0.116 | 0.115 | -0.270 | -0.283 |
| w_pit | 011 0 | 0.869 | 1.190 | 1.464 | 1.646 | 0.344 | 0.351 | -0.272 | -0.563 |
| w_pit | 011 1 | 0.985 | 1.363 | 1.642 | 2.013 | 0.223 | 0.219 | -0.223 | -0.675 |
| w_pit | 011 2 | 1.317 | 1.741 | 1.800 | 2.561 | 0.188 | 0.174 | -0.494 | -0.517 |
| w_pit | 100 0 | 0.636 | 1.065 | 1.483 | 1.663 | 0.572 | 0.572 | -0.353 | -0.323 |
| w_pit | 100 1 | 0.434 | 0.888 | 1.401 | 1.784 | 0.372 | 0.371 | -0.268 | -0.253 |
| w_pit | 100 2 | 0.221 | 0.680 | 1.150 | 1.894 | 0.208 | 0.208 | -0.186 | -0.192 |
| w_pit | 101 0 | 0.789 | 1.238 | 1.642 | 1.824 | 0.532 | 0.529 | -0.315 | -0.537 |
| w_pit | 101 1 | 0.799 | 1.242 | 1.780 | 2.166 | 0.375 | 0.372 | -0.300 | -0.626 |
| w_pit | 101 2 | 0.942 | 1.415 | 1.818 | 2.657 | 0.274 | 0.270 | -0.405 | -0.426 |
| w_pit | 110 0 | 0.893 | 1.503 | 1.909 | 2.091 | 0.796 | 0.796 | -0.456 | -0.519 |
| w_pit | 110 1 | 0.861 | 1.518 | 2.027 | 2.413 | 0.619 | 0.619 | -0.465 | -0.413 |
| w_pit | 110 2 | 0.788 | 1.455 | 1.887 | 2.686 | 0.300 | 0.299 | -0.386 | -0.398 |
| w_pit | 111 0 | 1.108 | 1.691 | 2.113 | 2.295 | 1.000 | 1.000 | -0.477 | -0.699 |
| w_pit | 111 1 | 1.204 | 1.856 | 2.408 | 2.794 | 1.000 | 1.000 | -0.517 | -0.728 |
| w_pit | 111 2 | 1.400 | 2.102 | 2.626 | 3.387 | 1.000 | 1.000 | -0.669 | -0.698 |
グレーはランナー無し状態を示しているが, アウトカウントが増えるごとに多くのイベントの価値の振れ幅が小さくなっていることがわかる (つまり, +の値も-の値も絶対値が小さくなる). ノーアウトランナー無し (“000 0”; 状況のコード方法についてはsection 2.2参照) と比べ, 2アウトランナー無しは単打四死球を取る価値は1/3以下まで低下し, 一方でアウトとなるコストも1/2以下まで減少した. HRだけはアウトカウントが増えるほど価値が上がる. これはHRでは得点数自体はランナーの数+1 (ここではランナーがいないので1) で固定されているためである.
青はノーアウトでランナーが少なくとも1塁にいる状況を示しているが, ランナーが貯まるほど一般的に振れ幅は大きくなっている.
上で示した, 状況に依存した得点価値の変動は打順を考える上で重要となりうる. これは打順の各スポットはランナーやアウトの状態に関して異なる傾向を持つためである. この傾向における差異の結果, 打順ごとにイベントの得点価値は異なることになる.
投手なしモデルに関して, 各打順におけるイベントの得点価値を示す.
RV.by.spots <- res%>%
group_by(Type, Batter, Event)%>%
dplyr::summarise(RV = mean(RV_event))
RV.by.spots %>%
filter(Type == "wo_pit")%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Batter, value = RV)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|---|
| wo_pit | Single | 0.437 | 0.439 | 0.435 | 0.460 | 0.468 | 0.455 | 0.455 | 0.457 | 0.461 |
| wo_pit | Double | 0.739 | 0.736 | 0.737 | 0.782 | 0.790 | 0.753 | 0.771 | 0.774 | 0.768 |
| wo_pit | Triple | 1.008 | 1.020 | 1.018 | 1.065 | 1.076 | 1.060 | 1.060 | 1.078 | 1.055 |
| wo_pit | HR | 1.377 | 1.414 | 1.460 | 1.487 | 1.475 | 1.455 | 1.477 | 1.473 | 1.476 |
| wo_pit | BB_IBB | 0.350 | 0.346 | 0.333 | 0.345 | 0.349 | 0.345 | 0.342 | 0.344 | 0.343 |
| wo_pit | HBP | 0.350 | 0.348 | 0.331 | 0.348 | 0.348 | 0.340 | 0.343 | 0.342 | 0.344 |
| wo_pit | Out | -0.258 | -0.259 | -0.257 | -0.267 | -0.271 | -0.267 | -0.265 | -0.267 | -0.268 |
| wo_pit | K | -0.273 | -0.274 | -0.274 | -0.288 | -0.290 | -0.283 | -0.283 | -0.286 | -0.287 |
1-3番で全体的に価値の振れ幅が小さく, 特にHRで顕著である. これは塁上の走者が少ないこと (1, 2番) や, 2アウトが多いこと (3番) などが影響していると思われる. このモデルでは実際の野球とは異なり, 打者の能力差が存在しないが, このような平坦な打順に沿って, 得点価値への影響の違いが生じた. これは:
などのルール (とNPBの平均的なイベント確率) だけでこのようなパターンが生じる. 変動させた得点価値によって打者を評価する場合, 結果が同じであっても, 打順のどこに置くかによって結果が変わることがわかる. wOBAが平均的な価値を利用することは, 打順のどこに置かれたかという影響を取り除くことを意図した操作でもあると理解できるだろう.
この結果を見ると下位打線が重要なように見えるかもしれない. しかし, 下位打線に比べて打順の前の方は打席数が多くなるためその補正が必要となる.
打席数補正の前にとりあえず投手ありモデルの結果を示す.
RV.by.spots %>%
filter(Type == "w_pit")%>%
mutate_if(is.numeric, funs(round), 3)%>%
spread(key = Batter, value = RV)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|---|
| w_pit | Single | 0.370 | 0.385 | 0.391 | 0.433 | 0.447 | 0.438 | 0.433 | 0.440 | 0.441 |
| w_pit | Double | 0.635 | 0.662 | 0.692 | 0.750 | 0.766 | 0.743 | 0.742 | 0.757 | 0.751 |
| w_pit | Triple | 0.898 | 0.944 | 0.959 | 1.067 | 1.043 | 1.028 | 1.040 | 1.012 | 1.040 |
| w_pit | HR | 1.295 | 1.367 | 1.434 | 1.508 | 1.505 | 1.478 | 1.486 | 1.494 | 1.500 |
| w_pit | BB_IBB | 0.294 | 0.305 | 0.296 | 0.311 | 0.318 | 0.320 | 0.315 | 0.316 | 0.314 |
| w_pit | HBP | 0.296 | 0.306 | 0.296 | 0.308 | 0.318 | 0.320 | 0.317 | 0.314 | 0.333 |
| w_pit | Out | -0.202 | -0.211 | -0.214 | -0.229 | -0.234 | -0.230 | -0.229 | -0.232 | -0.231 |
| w_pit | K | -0.216 | -0.222 | -0.229 | -0.250 | -0.255 | -0.250 | -0.251 | -0.251 | -0.252 |
全体的に低下しているが, 特に打順の前の方で顕著となっている. これは9番に投手が入ったことで, 望ましくない状態で打席に入りやすくなっているためかもしれない. このような変化については後述する (section 3.5.2).
打席数の補正のために各打順での打席数をカウントし, 相対的な頻度とともに示す.
PA.by.spots <- res%>%
group_by(Type, Batter)%>%
dplyr::summarise(N = n() / 80000)%>%
mutate(freq = N / sum(N))
require(gt)
PA.by.spots%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Batter | N | freq |
|---|---|---|
| wo_pit | ||
| 1 | 4.754 | 0.123 |
| 2 | 4.638 | 0.120 |
| 3 | 4.525 | 0.117 |
| 4 | 4.414 | 0.114 |
| 5 | 4.307 | 0.111 |
| 6 | 4.199 | 0.108 |
| 7 | 4.092 | 0.106 |
| 8 | 3.983 | 0.103 |
| 9 | 3.870 | 0.100 |
| w_pit | ||
| 1 | 4.625 | 0.122 |
| 2 | 4.514 | 0.119 |
| 3 | 4.404 | 0.117 |
| 4 | 4.299 | 0.114 |
| 5 | 4.197 | 0.111 |
| 6 | 4.097 | 0.108 |
| 7 | 3.992 | 0.106 |
| 8 | 3.880 | 0.103 |
| 9 | 3.769 | 0.100 |
打席数/試合 (N) 自体は投手を含まないモデルのほうが多い. これはアウトになりやすい投手がいないためだろう. しかし, 相対的な頻度 (freq) は異なるモデル間でほとんど同じである. いずれのモデルでも打順が一つ前にあるごとに0.1打席程度多くなった. 例えば, 1番と5番では1試合で0.4-0.45程度の打席数の違いがあり, これは5番の打席数 (4.2-4.3) を基準とすると11%程度にもなる.
上で得られた打席数を使って打順ごとの打席数の多寡を補正し, 各打順スポットにおける各イベントの得点価値を計算する. 5番打者を1として, 打席数の割合を計算し, これを使って重み付けする. 投手なしモデル.
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)
RV.by.spots %>%
filter(Type == "wo_pit")%>%
select(-c(4:7))%>%
spread(key = Batter, value = Adjusted_RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|---|
| wo_pit | Single | 0.482 | 0.472 | 0.457 | 0.471 | 0.468 | 0.444 | 0.432 | 0.423 | 0.414 |
| wo_pit | Double | 0.815 | 0.793 | 0.774 | 0.801 | 0.790 | 0.733 | 0.732 | 0.716 | 0.690 |
| wo_pit | Triple | 1.113 | 1.098 | 1.069 | 1.091 | 1.075 | 1.033 | 1.007 | 0.996 | 0.947 |
| wo_pit | HR | 1.520 | 1.523 | 1.534 | 1.523 | 1.474 | 1.417 | 1.402 | 1.361 | 1.325 |
| wo_pit | BB_IBB | 0.386 | 0.372 | 0.349 | 0.353 | 0.349 | 0.336 | 0.324 | 0.318 | 0.308 |
| wo_pit | HBP | 0.386 | 0.375 | 0.348 | 0.356 | 0.348 | 0.332 | 0.325 | 0.316 | 0.309 |
| wo_pit | Out | -0.285 | -0.279 | -0.270 | -0.273 | -0.271 | -0.260 | -0.252 | -0.247 | -0.240 |
| wo_pit | K | -0.302 | -0.295 | -0.288 | -0.295 | -0.290 | -0.276 | -0.269 | -0.264 | -0.257 |
打席数を補正したことで1-3番など全体的に得点価値が高めになった. 特に出塁関連の効果が他の打順よりも高く, アウトになる (Out, K) コストが大きい. 3番打者はHRこそ価値が高いが, それ以外は1, 2, 4, 5よりも絶対値が低く, この打線では3番は比較的重要ではなかったことがわかる. これは打順が1番から始まるというルール上, 初回にアウトが記録された状態で回ってくる確率が高いことが影響している可能性が高い. 3番の重要性の低さはThe Bookでも強調されている.
下位打線では打席数が少ないため, 補正によって重要性が大きく低下した. 少なくともこのモデルでは, 下位打線が重要でないのはランナー/アウト状況によるものではなく, 主に打席数の問題だったようだ.
1, 2番で全体的に振れ幅が大きいが, 特にBBによる出塁 (BB_IBB) からの利得, やK以外のアウト (Out) へのペナルティが大きい. このモデルではおそらく1, 2番が最も重要なスポットと言えるだろう. 4番はそれに次ぐ重要なスポットであり, 特に長打の価値は1, 2番に近い. 3番, 5番は, 3番のHRを除けば, 4番よりも全体的に振れ幅が小さい. 特に2番では主要な打球イベントである単打と2塁打の価値が低い. 6-9番の重要性が低いのは明らかだろう.
投手ありモデルでも同様に計算する.
RV.by.spots %>%
filter(Type == "w_pit")%>%
select(-c(4:7))%>%
spread(key = Batter, value = Adjusted_RV)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)| Type | Event | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|---|
| w_pit | Single | 0.408 | 0.414 | 0.411 | 0.443 | 0.447 | 0.427 | 0.411 | 0.407 | 0.396 |
| w_pit | Double | 0.700 | 0.711 | 0.726 | 0.768 | 0.766 | 0.726 | 0.706 | 0.700 | 0.674 |
| w_pit | Triple | 0.989 | 1.015 | 1.007 | 1.093 | 1.043 | 1.003 | 0.989 | 0.935 | 0.934 |
| w_pit | HR | 1.426 | 1.470 | 1.505 | 1.545 | 1.505 | 1.442 | 1.413 | 1.381 | 1.347 |
| w_pit | BB_IBB | 0.324 | 0.327 | 0.311 | 0.318 | 0.318 | 0.312 | 0.300 | 0.292 | 0.282 |
| w_pit | HBP | 0.327 | 0.329 | 0.311 | 0.315 | 0.318 | 0.312 | 0.301 | 0.291 | 0.299 |
| w_pit | Out | -0.223 | -0.227 | -0.225 | -0.234 | -0.234 | -0.225 | -0.218 | -0.214 | -0.207 |
| w_pit | K | -0.238 | -0.239 | -0.241 | -0.256 | -0.254 | -0.244 | -0.238 | -0.232 | -0.226 |
投手を9番に入れることで, 1, 2番は重要性はかなり低下した. 出塁の価値はこのモデルでも高いが, その他のイベントで変化は大きく, 3番や6番とそう大差がない程度になっているのではないか. このモデルでは4, 5番が比較的重要だったようだ.
打順の各スポットにおける得点価値に違いが見られた. この違いには打席に入った時のランナー/アウト状態が貢献していると考えられる. 投手なしモデルについて各スポットでの状況の頻度を示す.
res %>%
filter(Type == "wo_pit")%>%
group_by(Batter, State_pre)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))%>%
select(-N)%>%
spread(key = Batter, value = freq)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)%>%
row_spec(3, bold = T, color = "white", background = "gray")| State_pre | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| 000 0 | 0.388 | 0.182 | 0.179 | 0.255 | 0.242 | 0.217 | 0.224 | 0.231 | 0.225 |
| 000 1 | 0.129 | 0.270 | 0.135 | 0.132 | 0.181 | 0.174 | 0.158 | 0.162 | 0.167 |
| 000 2 | 0.105 | 0.103 | 0.205 | 0.111 | 0.107 | 0.142 | 0.138 | 0.126 | 0.130 |
| 001 0 | 0.001 | 0.003 | 0.002 | 0.002 | 0.002 | 0.002 | 0.002 | 0.002 | 0.002 |
| 001 1 | 0.005 | 0.005 | 0.009 | 0.007 | 0.006 | 0.007 | 0.007 | 0.007 | 0.006 |
| 001 2 | 0.010 | 0.010 | 0.010 | 0.017 | 0.013 | 0.011 | 0.013 | 0.013 | 0.013 |
| 010 0 | 0.009 | 0.019 | 0.011 | 0.010 | 0.013 | 0.012 | 0.011 | 0.011 | 0.012 |
| 010 1 | 0.018 | 0.017 | 0.033 | 0.020 | 0.018 | 0.023 | 0.023 | 0.021 | 0.021 |
| 010 2 | 0.023 | 0.024 | 0.023 | 0.039 | 0.028 | 0.025 | 0.030 | 0.030 | 0.029 |
| 011 0 | 0.002 | 0.002 | 0.004 | 0.003 | 0.003 | 0.003 | 0.003 | 0.003 | 0.003 |
| 011 1 | 0.006 | 0.006 | 0.006 | 0.010 | 0.007 | 0.007 | 0.008 | 0.008 | 0.008 |
| 011 2 | 0.007 | 0.007 | 0.007 | 0.007 | 0.011 | 0.009 | 0.008 | 0.009 | 0.010 |
| 100 0 | 0.049 | 0.106 | 0.051 | 0.049 | 0.070 | 0.067 | 0.060 | 0.062 | 0.064 |
| 100 1 | 0.062 | 0.061 | 0.125 | 0.065 | 0.063 | 0.085 | 0.082 | 0.075 | 0.076 |
| 100 2 | 0.063 | 0.065 | 0.063 | 0.121 | 0.071 | 0.067 | 0.086 | 0.084 | 0.078 |
| 101 0 | 0.004 | 0.004 | 0.007 | 0.005 | 0.004 | 0.005 | 0.005 | 0.005 | 0.005 |
| 101 1 | 0.009 | 0.009 | 0.009 | 0.016 | 0.012 | 0.010 | 0.012 | 0.013 | 0.012 |
| 101 2 | 0.014 | 0.014 | 0.014 | 0.014 | 0.022 | 0.018 | 0.017 | 0.018 | 0.019 |
| 110 0 | 0.014 | 0.014 | 0.028 | 0.015 | 0.014 | 0.019 | 0.018 | 0.017 | 0.017 |
| 110 1 | 0.024 | 0.025 | 0.025 | 0.045 | 0.029 | 0.026 | 0.033 | 0.033 | 0.030 |
| 110 2 | 0.030 | 0.030 | 0.031 | 0.030 | 0.052 | 0.037 | 0.033 | 0.040 | 0.041 |
| 111 0 | 0.004 | 0.004 | 0.004 | 0.008 | 0.006 | 0.005 | 0.006 | 0.006 | 0.006 |
| 111 1 | 0.009 | 0.009 | 0.009 | 0.009 | 0.016 | 0.012 | 0.010 | 0.012 | 0.013 |
| 111 2 | 0.012 | 0.011 | 0.011 | 0.011 | 0.011 | 0.017 | 0.014 | 0.013 | 0.014 |
基本的に多くの打順でノーアウトランナー無しが多い. これは, すべての状態の中で唯一, 1イニングに少なくとも1度は発生する状況であるためだと理解できる. しかし, 2番では1アウトランナー無し, 3番では2アウトランナー無し (灰色で示した) が最も多い状況となっている. これは初回に1番打者から始まるというルールのためである. この傾向は3番打者において, 出塁する利得やアウトになるコストが2, 4番などに比べて小さかったことと関連があるはずである. 2番は1アウトなので振れ幅の減少がやや小さく, また打席数がさらに多いため, このモデルでは, 3番よりも重要な打順になりやすかったと考えられる.
24状態は見るのが困難なのでランナーとアウトで大まかに分割して, 打順ごとの特徴を示す.
まず, ランナー数の頻度を示す.
res %>%
filter(Type == "wo_pit")%>%
group_by(Batter, Runner_CT)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))%>%
select(-N)%>%
spread(key = Batter, value = freq)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)%>%
row_spec(3:4, bold = T, color = "white", background = "gray")| Runner_CT | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| 0 | 0.622 | 0.555 | 0.519 | 0.497 | 0.530 | 0.532 | 0.519 | 0.520 | 0.523 |
| 1 | 0.241 | 0.309 | 0.326 | 0.329 | 0.283 | 0.299 | 0.313 | 0.305 | 0.302 |
| 2 | 0.111 | 0.111 | 0.131 | 0.146 | 0.154 | 0.134 | 0.138 | 0.145 | 0.144 |
| 3 | 0.025 | 0.025 | 0.025 | 0.028 | 0.032 | 0.034 | 0.031 | 0.031 | 0.032 |
左の列の0-3は塁上のランナー数を示す. 特に得点価値が高いであろうランナーが複数いる状態は1-2番では少なかった. 1番では特にランナー無しの頻度が他の打順に比べて高く, これがHRの価値の低さ (打席数補正前の数値) に繋がっているだろう. 3番でも複数ランナーがいるような状態の頻度は, 4番以後に比べて小さいかもしれない.
次にアウトカウント.
res %>%
filter(Type == "wo_pit")%>%
group_by(Batter, Out)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))%>%
select(-N)%>%
spread(key = Batter, value = freq)%>%
mutate_if(is.numeric, funs(round), 3)%>%
kable()%>%
kable_styling(bootstrap_options = "striped", full_width = F)%>%
row_spec(3, bold = T, color = "white", background = "gray")| Out | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| 0 | 0.473 | 0.334 | 0.286 | 0.347 | 0.353 | 0.331 | 0.329 | 0.337 | 0.334 |
| 1 | 0.263 | 0.403 | 0.349 | 0.304 | 0.332 | 0.343 | 0.332 | 0.331 | 0.333 |
| 2 | 0.264 | 0.263 | 0.364 | 0.349 | 0.315 | 0.326 | 0.339 | 0.332 | 0.333 |
2アウトはやはり3番で多いが, 4番でもそれなりに多い. しかし, 上で見たように4番は2アウトランナーなしは少ないことから, ランナーはいる状態が多かったことが推測できる.
投手あり/なしで得られた24状況の頻度を示す.
res %>%
group_by(Batter, State_pre, Type)%>%
dplyr::summarise(N = n())%>%
mutate(freq = N / sum(N))%>%
select(-N)%>%
spread(key = Batter, value = freq)%>%
mutate_if(is.numeric, funs(round), 3)%>%
gt()| Type | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
|---|---|---|---|---|---|---|---|---|---|
| 000 0 | |||||||||
| wo_pit | 0.480 | 0.508 | 0.511 | 0.505 | 0.503 | 0.509 | 0.506 | 0.505 | 0.506 |
| w_pit | 0.520 | 0.492 | 0.489 | 0.495 | 0.497 | 0.491 | 0.494 | 0.495 | 0.494 |
| 000 1 | |||||||||
| wo_pit | 0.452 | 0.481 | 0.508 | 0.512 | 0.506 | 0.503 | 0.510 | 0.508 | 0.505 |
| w_pit | 0.548 | 0.519 | 0.492 | 0.488 | 0.494 | 0.497 | 0.490 | 0.492 | 0.495 |
| 000 2 | |||||||||
| wo_pit | 0.460 | 0.467 | 0.484 | 0.507 | 0.511 | 0.506 | 0.505 | 0.509 | 0.507 |
| w_pit | 0.540 | 0.533 | 0.516 | 0.493 | 0.489 | 0.494 | 0.495 | 0.491 | 0.493 |
| 001 0 | |||||||||
| wo_pit | 0.794 | 0.522 | 0.511 | 0.488 | 0.518 | 0.508 | 0.477 | 0.511 | 0.520 |
| w_pit | 0.206 | 0.478 | 0.489 | 0.512 | 0.482 | 0.492 | 0.523 | 0.489 | 0.480 |
| 001 1 | |||||||||
| wo_pit | 0.567 | 0.642 | 0.500 | 0.508 | 0.509 | 0.512 | 0.502 | 0.511 | 0.503 |
| w_pit | 0.433 | 0.358 | 0.500 | 0.492 | 0.491 | 0.488 | 0.498 | 0.489 | 0.497 |
| 001 2 | |||||||||
| wo_pit | 0.525 | 0.571 | 0.601 | 0.496 | 0.508 | 0.503 | 0.504 | 0.498 | 0.509 |
| w_pit | 0.475 | 0.429 | 0.399 | 0.504 | 0.492 | 0.497 | 0.496 | 0.502 | 0.491 |
| 010 0 | |||||||||
| wo_pit | 0.744 | 0.493 | 0.511 | 0.509 | 0.508 | 0.498 | 0.511 | 0.505 | 0.512 |
| w_pit | 0.256 | 0.507 | 0.489 | 0.491 | 0.492 | 0.502 | 0.489 | 0.495 | 0.488 |
| 010 1 | |||||||||
| wo_pit | 0.560 | 0.581 | 0.493 | 0.508 | 0.510 | 0.507 | 0.503 | 0.507 | 0.503 |
| w_pit | 0.440 | 0.419 | 0.507 | 0.492 | 0.490 | 0.493 | 0.497 | 0.493 | 0.497 |
| 010 2 | |||||||||
| wo_pit | 0.525 | 0.533 | 0.538 | 0.496 | 0.506 | 0.510 | 0.508 | 0.502 | 0.509 |
| w_pit | 0.475 | 0.467 | 0.462 | 0.504 | 0.494 | 0.490 | 0.492 | 0.498 | 0.491 |
| 011 0 | |||||||||
| wo_pit | 0.727 | 0.683 | 0.515 | 0.496 | 0.505 | 0.479 | 0.485 | 0.515 | 0.512 |
| w_pit | 0.273 | 0.317 | 0.485 | 0.504 | 0.495 | 0.521 | 0.515 | 0.485 | 0.488 |
| 011 1 | |||||||||
| wo_pit | 0.580 | 0.632 | 0.605 | 0.511 | 0.509 | 0.509 | 0.503 | 0.516 | 0.521 |
| w_pit | 0.420 | 0.368 | 0.395 | 0.489 | 0.491 | 0.491 | 0.497 | 0.484 | 0.479 |
| 011 2 | |||||||||
| wo_pit | 0.520 | 0.585 | 0.581 | 0.557 | 0.507 | 0.508 | 0.504 | 0.498 | 0.508 |
| w_pit | 0.480 | 0.415 | 0.419 | 0.443 | 0.493 | 0.492 | 0.496 | 0.502 | 0.492 |
| 100 0 | |||||||||
| wo_pit | 0.698 | 0.481 | 0.508 | 0.510 | 0.503 | 0.503 | 0.505 | 0.506 | 0.504 |
| w_pit | 0.302 | 0.519 | 0.492 | 0.490 | 0.497 | 0.497 | 0.495 | 0.494 | 0.496 |
| 100 1 | |||||||||
| wo_pit | 0.551 | 0.533 | 0.482 | 0.508 | 0.514 | 0.504 | 0.503 | 0.510 | 0.507 |
| w_pit | 0.449 | 0.467 | 0.518 | 0.492 | 0.486 | 0.496 | 0.497 | 0.490 | 0.493 |
| 100 2 | |||||||||
| wo_pit | 0.528 | 0.508 | 0.504 | 0.485 | 0.509 | 0.509 | 0.503 | 0.504 | 0.511 |
| w_pit | 0.472 | 0.492 | 0.496 | 0.515 | 0.491 | 0.491 | 0.497 | 0.496 | 0.489 |
| 101 0 | |||||||||
| wo_pit | 0.673 | 0.700 | 0.503 | 0.521 | 0.503 | 0.504 | 0.507 | 0.506 | 0.508 |
| w_pit | 0.327 | 0.300 | 0.497 | 0.479 | 0.497 | 0.496 | 0.493 | 0.494 | 0.492 |
| 101 1 | |||||||||
| wo_pit | 0.582 | 0.603 | 0.608 | 0.511 | 0.503 | 0.514 | 0.512 | 0.510 | 0.502 |
| w_pit | 0.418 | 0.397 | 0.392 | 0.489 | 0.497 | 0.486 | 0.488 | 0.490 | 0.498 |
| 101 2 | |||||||||
| wo_pit | 0.552 | 0.565 | 0.553 | 0.563 | 0.508 | 0.511 | 0.514 | 0.512 | 0.505 |
| w_pit | 0.448 | 0.435 | 0.447 | 0.437 | 0.492 | 0.489 | 0.486 | 0.488 | 0.495 |
| 110 0 | |||||||||
| wo_pit | 0.704 | 0.701 | 0.488 | 0.506 | 0.506 | 0.508 | 0.500 | 0.503 | 0.500 |
| w_pit | 0.296 | 0.299 | 0.512 | 0.494 | 0.494 | 0.492 | 0.500 | 0.497 | 0.500 |
| 110 1 | |||||||||
| wo_pit | 0.596 | 0.580 | 0.577 | 0.490 | 0.511 | 0.512 | 0.513 | 0.502 | 0.510 |
| w_pit | 0.404 | 0.420 | 0.423 | 0.510 | 0.489 | 0.488 | 0.487 | 0.498 | 0.490 |
| 110 2 | |||||||||
| wo_pit | 0.565 | 0.551 | 0.542 | 0.536 | 0.491 | 0.508 | 0.511 | 0.506 | 0.508 |
| w_pit | 0.435 | 0.449 | 0.458 | 0.464 | 0.509 | 0.492 | 0.489 | 0.494 | 0.492 |
| 111 0 | |||||||||
| wo_pit | 0.699 | 0.709 | 0.701 | 0.509 | 0.503 | 0.511 | 0.502 | 0.500 | 0.503 |
| w_pit | 0.301 | 0.291 | 0.299 | 0.491 | 0.497 | 0.489 | 0.498 | 0.500 | 0.497 |
| 111 1 | |||||||||
| wo_pit | 0.624 | 0.616 | 0.607 | 0.600 | 0.508 | 0.502 | 0.502 | 0.507 | 0.502 |
| w_pit | 0.376 | 0.384 | 0.393 | 0.400 | 0.492 | 0.498 | 0.498 | 0.493 | 0.498 |
| 111 2 | |||||||||
| wo_pit | 0.575 | 0.574 | 0.578 | 0.562 | 0.562 | 0.496 | 0.500 | 0.511 | 0.506 |
| w_pit | 0.425 | 0.426 | 0.422 | 0.438 | 0.438 | 0.504 | 0.500 | 0.489 | 0.494 |
全体的に好ましい状況 (アウトカウントが少ない, ランナーが多い) が減少している. 特に, ノーアウトでランナーがいる状況の減少は顕著である. 打順の前ほど大きな変化があることも確認できる. この結果は, 投手は非常に高い確率でアウトになることで, アウトカウントを増やす, あるいは3アウト目を記録して塁上の走者を除くであろうという常識的な予想と一致する. この状況の変化が投手なしモデルで見られた, 1, 2番における得点価値の振れ幅の減少の原因だろう.
単純なサンプリングを利用したマルコフ連鎖モデルで野球をシミュレーションし, 主に打順ごとのイベントの得点価値について検討した.
打順の組み立てを評価する上では,
などの要素が重要になると考えられる. この2つの要素はそれぞれ異なる効果で得点力を改善すると考えることができる. 1つめの要素は起こるであろうイベントのもつ得点価値を高め, チームwOBAのわりに得点が高い状況を狙う方法と言えるだろう. 一方, 2つめの要素は, チームwOBA自体を高めることを志向した方策と言える. 打順の効果の議論に関して, チームwOBA (or BsR, RC, XR, etc..) とチーム得点の相関が十分に強いためにそれほど重要では無い, というようなものがあるが, 実のところチームwOBA自体に, 打順の効果が部分的に含まれている可能性がある. この議論では打順の効果を適切に捉えることはできていないだろう
マルコフ連鎖モデルを使った打順の評価では, 多くの場合, 最終的な得点を主要な評価項目として利用する. ここでは, 主に打順ごとの得点価値に注目した. これは, 打順への介入によって生じる得点力変化に至る主要なメカニズムだと考えられる. これはThe Bookで使われた方法だが, 単に得点の大小が生じるかどうかという結果ではなく, なぜ得点の大小が生じるかを説明できるようになる利点がある. もちろん, 打順自体の評価としては最終的な得点をみる必要があるだろう. この得点価値は打線を構成する打者やその順序によってある程度変動する. しかし, 平均的な選手で構成された打線と最低限の野球のルールによって生じる得点価値の変化を捉えるだけでも, おおまかな打順の改善方法を考えるための基準が得られる. どの程度の改善が可能かは, 元の打順が持つ非効率性の大きさにも依存するが, The Bookでは10-15点程度の改善が可能だと議論している (The Book chapter 5は, ここでは考えていないような走力や併殺などのさらに細かい要素についても検討している. この効果の大きさはそれらも含めての話だろうが, そのような改善が可能である場合においては, おそらく大部分はここで議論したような要素によってもたらされるだろう).
打順ごとの得点価値は, 打席数の補正がない状態では, 打線の後ろの方が高い. これは, 主に初回に1番から試合が始まるために, 1巡目において1番はランナーがなく, 2-3番はアウトが記録された状態かつ複数のランナーは存在しないことが多いためだろう. しかし, 打線の前は当然打席数が多く, 重要性の評価ではこの補正が必要となる. 1番と5番を比較しても1試合あたりで0.4打席以上の違いがあり, そのためこの要素を考慮すると上位打線の重要性が高まる. しかし, 3番打者は補正の程度も小さく, 元の価値も低いため, 投手を入れないモデルでは重要性が低い結果となった. この打席数の違いのため, 効率性の高い打順では能力の高い打者を前に揃えることになる. これは先制点につながりやすい一方で, 前借り的な側面も持ちうるため, その後の得点を減らし, 勝負弱い打線と言った主観的な評価を受けるリスクもあるかもしれない (その効果は, 人間の認知で検出できるほどの大きさではないと思うが).
The Bookにおいて示された, 打順の各スポットについての指針を大まかに示す (pp.132).
本ポストにおいて, 投手なしモデル得られた結果は概ねこの指針と合致すると言えるだろう. 投手ありモデルでは1, 2番の重要性は大きく低下した. これは9番に投手を置いたことで, アウトカウントが多いか, ランナーが少ない状態で, 打順の先頭に戻ったためだろう. DHの有無, 投手のスポット (8 or 9) は, 適切な打順を考慮する上で重要な要素になりうるだろう.
ここでのモデルは平均的な能力を持つ打者だけで構成されていたが, 実際の各打者からイベント確率を計算すれば打者の能力の違いを考慮したモデルも容易に構築できる. 打者の能力の違いを考慮したモデルについては以後のポストで検討する.
ここではモデルだけを扱ったが, 打順ごとの状況の違いと, それに伴う打順ごとの得点価値などは現実のply-by-play dataでも容易に計算可能であり, より現実的な状況における評価にも利用できるだろう. 注意点としては, 現実の試合数はモデルに比べて非常に少ないので, 打順ごとに分けていくタイプのデータでは推定が非常に甘くならざるを得ない (大雑把に言って, 全体に適用する場合に比べてサンプルが1/9程度まで減るので誤差が3倍程度になる). 特定のチームに対して適用するのはおそらく意味がないだろう. NPBでは年間の試合数が少ないために特に注意が必要だろう.
蛭川皓平, (岡田友輔 監修), 2019, 打順の文脈を解析する in セイバーメトリクス入門, 水曜社.
Marchi, Albert, Baumer, 2018, Analyzing Baseball Data with R, CRC press.
Sokol, 2018, An Intuitive Markov Chain Lesson From Baseball, INFORMS Transactions on Education.
Tango, MGL, Dolphin, 2007, The Book, Potomac Books.
ssharpe42, BaseballMarkov.
Deltagraphs, 1.02.
Tango, How are runs really created.
# 各イベント+状態による進塁規則
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.は無視
# 状態が遷移した時に記録される得点計算に利用する表
# Albert et al.から拝借している気がする
RunTable <- read_csv("required_tables/StateTransitionRunMatrix.csv", locale=locale(encoding="CP932"))
# 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, 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 loop1の先頭に戻る
} # 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終わり
# 計算結果の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)
}