守備シフトが打者の打球に与える影響
前回に続き今回はMLBで行われている内野守備シフト（以下シフト）が打者の打球に与える影響について検証していく。
方法としては
・標準的な守備位置での各選手（通算300打球以上）の打撃成績を計算する
・その成績を使ってシフト状態で予想される打者の成績を推定する
・その予想成績を実際のシフト状態での数値と比較する
といったものである。データはBaseball Savantから取得したStatcastを使用する。
守備シフトによる方向・種類別打球価値の変動
守備シフトによって打球価値(wOBAcon)はどのように変動したのかをまとめたのが上の表になる。まず目を引くのがセンターから引っ張り方向のゴロ打球の価値の大きな減少だ。左右打者ともにセンターから引っ張り方向のゴロのwOBAconは60ポイント近く減少しておりシフトが効果を発揮している。反対にシフトの逆をついた打球である反対方向のゴロやライナーはwOBAconが大きく跳ね上がっている。特に元々反対方向の打球価値が低い右打者のゴロはその上昇の度合いが顕著である。
その他、全方向でフライのwOBAconが上昇している。どちらも逆方向のwOBAconは上昇しているがそれ以外は左右でやや内訳が異なる。左打者はセンター方向では価値があまり変動してない一方で引っ張った時の打球価値が大きく上昇している。右打者はセンター方向で価値が大きく上昇している一方で引っ張り方向ではあまり価値が変動していない。逆方向の価値が上昇したのは内野手を片側に寄せたことで内野と外野の間に落ちるフライが増加したのではと予想したが左右打者でセンター方向と引っ張り方向打球価値が異なるのが興味深い。左打者のが引っ張って強打する意識が強いということなのだろうか。
守備シフトが打球方向・種類に与える影響
シフトを敷いたことで推定した値と比較してどこに打球が分布したかをまとめたのが上記の表である。左打者の引っ張り方向のゴロについては推定値より2%ほど打球が飛んでいないがそれ以外は目立った変化は見られない。守備シフトを敷くと打者はシフトの網にかからないため打球を上げたり逆方向に打つ意識が高まるといった傾向は強くは見られなかった。
wOBAcon
打者の打球の価値を測るwOBAconは右打者・左打者共に推定値より下がっている。シフトは打球について言えば失点を減らす上で有効に働いたと言える。左打者の方が減少の度合いが大きくなっている。
BAcon
打球の打率を表すBAconを左右で比較すると右打者は推定値と比較してそれほど低下していない一方で左打者は大きく低下させている。
ISOcon
打球の長打力を表すISOconではBAconとは対照的に右打者の値に大きな変動がない一方で左打者の値が大きく上昇している。左打者はシフトを敷かれると打球の打率は上がりにくいものの長打はむしろ増える傾向にあるようだ。
Barrel/BBE
打球に対するバレルの割合を表したBarrel/BBEではどちらも値が上昇しているものの右打者より左打者のが上昇の度合いが大きい。シフトに対し左打者は右打者より強打重視にアプローチを変更させているのだろうか。
まとめ
・守備シフトが敷かれるとシフトが敷かれているセンター方向から引っ張り方向のゴロの打球価値が低下し逆にシフトが敷かれていない方向のゴロ・ライナーの価値は上昇する。
・シフトは左右打者どちらも有効に働いているが左打者の方が効果がわずかに大きい。
・シフトが敷かれると右打者の長打・打率は大して変化しない一方で左打者は打率が低下し長打が増える。
個人的にはシフトを敷くと左右で長打力と率に差が出るのが興味深い。前回の検証で右打者はシフトを敷かれるとK%が低下する一方で左打者は増加するという結果が出たがこれは左打者はシフトを敷かれると強い打球を打とうと強振してK%が低下するのでは？と思いシフト状態のPlate Disciplineについて調べてみた。打球と話が逸れてしまうが結果が以下である。
左打者と右打者を比較すると
・右打者はシフトを敷かれると推定値よりスイング率が低下するが左打者は増加する。
・コンタクト率は左右どちらも低下するが左打者のが低下の度合いが大きい。
・SwStr%は左は上昇する一方で右打者はやや低下する。
これだけで左右の三振率の違いを説明することや左打者がシフトを敷かれると本当に強振を心がけるのかの証拠にはならないと思うがなぜ左右でK%の違いが出るかを考えるうえでの参考になれば幸いである。（シフトの左右での効果の違い（左打者には有効だが右打者には逆効果）はK%によるところが大きいと推測されるので解き明かせばシフトが打者に与える影響を深く理解できる一歩になるのではと思っている。）
以下、今回書いたRのコード。
library(tidyverse)
#dfには2015-2020のレギュラーシーズンの全データが入っている
#必要なデータに絞る
df <- df %>%
select(type,game_type,launch_angle,woba_denom,woba_value,
if_fielding_alignment,des,batter,stand,hc_x, hc_y)
save(df, file="sc_data_for_shift_battedball_value.Rdata")
#打球に絞る
df <- df %>% filter(type == "X")
#バント除く
df <- df %>% filter(! grepl("bunt", des))
#データの下処理
df <- df %>% mutate(
spray_angle = atan2(hc_x - 125.42, 198.27 - hc_y) * 180 / pi,
hand_adj_spray =
ifelse(stand == "L", - spray_angle, spray_angle),
Pull_FL = ifelse(hand_adj_spray <= -17, 1,0),
Cent_FL = ifelse(hand_adj_spray > -17 & hand_adj_spray < 17 , 1, 0),
Opp_FL = ifelse(hand_adj_spray >= 17, 1, 0),
GB = ifelse(launch_angle < 10 ,1,0),
LD = ifelse(launch_angle >=10 & launch_angle < 25,1,0),
FB = ifelse(launch_angle >=25 & launch_angle < 50,1,0),
PU = ifelse(launch_angle >=50 ,1,0),
direction = case_when(
hand_adj_spray <= -17 ~ "Pull",
hand_adj_spray > -17 & hand_adj_spray < 17 ~ "Cent",
hand_adj_spray >= 17 ~ "Opp"),
BBtype = case_when(
launch_angle < 10 ~ "GB",
launch_angle >=10 & launch_angle < 25 ~ "LD",
launch_angle >=25 & launch_angle < 50 ~ "FB",
launch_angle >= 50 ~ "PU"),
GB_OppFL = ifelse(launch_angle < 10 & GB == 1 & direction == "Opp",1,0),
GB_CentFL = ifelse(launch_angle < 10 & GB == 1 & direction == "Cent",1,0),
GB_PullFL = ifelse(launch_angle < 10 & GB == 1 & direction == "Pull",1,0),
LD_OppFL = ifelse(launch_angle >= 10 &launch_angle < 25 & LD == 1 & direction == "Opp",1,0),
LD_CentFL = ifelse(launch_angle >= 10 &launch_angle < 25 & LD == 1 & direction == "Cent",1,0),
LD_PullFL = ifelse(launch_angle >= 10 &launch_angle < 25 & LD == 1 & direction == "Opp",1,0),
FB_OppFL = ifelse(launch_angle >= 25 &launch_angle < 50 & FB == 1 & direction == "Opp",1,0),
FB_CentFL = ifelse(launch_angle >= 25 &launch_angle < 50 & FB == 1 & direction == "Cent",1,0),
FB_OppFL = ifelse(launch_angle >= 25 &launch_angle < 50 & FB == 1 & direction == "Opp",1,0),
FB_PullFL = ifelse(launch_angle >= 25 &launch_angle < 50 & FB == 1 & direction == "Pull",1,0),
PU_OppFL = ifelse(launch_angle >= 50 & PU == 1 & direction == "Opp",1,0),
PU_CentFL = ifelse(launch_angle >= 50 & PU == 1 & direction == "Cent",1,0),
PU_PullFL = ifelse(launch_angle >= 50 & PU == 1 & direction == "Pull",1,0))
#各打者の推定打球種類・方向別価値を算出
standard_bat <- df %>%
filter(if_fielding_alignment == "Standard" ,woba_denom == 1) %>%
group_by(batter,direction,BBtype) %>%
dplyr::summarise(wOBAcon_value = sum(woba_value, na.rm = TRUE),
wOBAcon_denom = sum(woba_denom, na.rm = TRUE),
wOBAcon = wOBAcon_value / wOBAcon_denom)
#結合の為wOBAcon_denomを列から除外
standard_bat <- standard_bat %>% select(batter,direction,BBtype,wOBAcon)
#300打球以上の打者に絞るための処理
batting <- df %>%
group_by(batter) %>%
dplyr::summarise(wOBAcon_denom = sum(woba_denom, na.rm = TRUE))
batting <- batting %>%
filter(wOBAcon_denom >= 300)
batting <- batting %>% select(batter)
std_batting <- left_join(batting, standard_bat) %>%
select(batter,direction,BBtype,wOBAcon)
head(std_batting,10)
selected_players <- std_batting$batter
situations_of_interest <- c("Standard" , "Infield shift")
# pitch-by-pitch dataに推定打撃成績を付加する
data_1 <- df %>% filter(batter %in% selected_players)%>%
left_join(std_batting)%>%
filter(if_fielding_alignment %in% situations_of_interest)
shift_batX <- data_1 %>%
filter(woba_denom == 1)%>%
group_by(stand, direction,BBtype,if_fielding_alignment)%>%
dplyr::summarise(ex_wOBAcon = mean(wOBAcon, na.rm = TRUE),
wOBAcon_value = sum(woba_value, na.rm = TRUE),
wOBAcon_denom = sum(woba_denom, na.rm = TRUE),
wOBAcon = wOBAcon_value / wOBAcon_denom
)%>%
select(stand,direction,BBtype,if_fielding_alignment,
wOBAcon,ex_wOBAcon)
#Excelで表を作るためにcsvで保存
write_csv(shift_batX,"shift_battedball_BBtype_value.csv")
#各打者の打球方向・種類割合を算出
batX <- df %>%
filter(if_fielding_alignment == "Standard" ,woba_denom == 1) %>%
group_by(batter) %>%
dplyr::summarise(wOBAcon_denom = sum(woba_denom, na.rm = TRUE),
GB_OppCT = sum(GB_OppFL, na.rm = TRUE),
GB_CentCT = sum(GB_CentFL, na.rm = TRUE),
GB_PullCT = sum(GB_PullFL, na.rm = TRUE),
LD_OppCT = sum(LD_OppFL, na.rm = TRUE),
LD_CentCT = sum(LD_CentFL, na.rm = TRUE),
LD_PullCT = sum(LD_PullFL, na.rm = TRUE),
FB_OppCT = sum(FB_OppFL, na.rm = TRUE),
FB_CentCT = sum(FB_CentFL, na.rm = TRUE),
FB_PullCT = sum(FB_PullFL, na.rm = TRUE),
PU_OppCT = sum(PU_OppFL, na.rm = TRUE),
PU_CentCT = sum(PU_CentFL, na.rm = TRUE),
PU_PullCT = sum(PU_PullFL, na.rm = TRUE),
GB_Opppct = GB_OppCT / wOBAcon_denom,
GB_Centpct = GB_CentCT / wOBAcon_denom,
GB_Pullpct = GB_PullCT / wOBAcon_denom,
LD_Opppct = LD_OppCT / wOBAcon_denom,
LD_Centpct = LD_CentCT / wOBAcon_denom,
LD_Pullpct = LD_PullCT / wOBAcon_denom,
FB_Opppct = FB_OppCT / wOBAcon_denom,
FB_Centpct = FB_CentCT / wOBAcon_denom,
FB_Pullpct = FB_PullCT / wOBAcon_denom,
PU_Opppct = PU_OppCT / wOBAcon_denom,
PU_Centpct = PU_CentCT / wOBAcon_denom,
PU_Pullpct = PU_PullCT / wOBAcon_denom)
#300打球以上の打者に絞る
batX <- batX %>%
filter(wOBAcon_denom >= 300)
batX <- batX %>%
select(batter,
GB_Opppct,GB_Centpct,GB_Pullpct,
LD_Opppct,LD_Centpct,LD_Pullpct,
FB_Opppct,FB_Centpct,FB_Pullpct,
PU_Opppct,PU_Centpct,PU_Pullpct,)
head(batX,10)
selected_players <- batX$batter
situations_of_interest <- c("Standard" , "Infield shift")
# pitch-by-pitch dataに推定打球割合を付加する
data <- df %>% filter(batter %in% selected_players)%>%
left_join(batX)%>%
filter(if_fielding_alignment %in% situations_of_interest)
#推定値と実測値を算出
shift_bat <- data%>%
filter(woba_denom == 1)%>%
group_by(stand, if_fielding_alignment)%>%
dplyr::summarise(ex_GB_Opppct = mean(GB_Opppct, na.rm = TRUE)*100,
ex_GB_Centpct = mean(GB_Centpct, na.rm = TRUE)*100,
ex_GB_Pullpct = mean(GB_Pullpct, na.rm = TRUE)*100,
ex_LD_Opppct = mean(LD_Opppct, na.rm = TRUE)*100,
ex_LD_Centpct = mean(LD_Centpct, na.rm = TRUE)*100,
ex_LD_Pullpct = mean(LD_Pullpct, na.rm = TRUE)*100,
ex_FB_Opppct = mean(FB_Opppct, na.rm = TRUE)*100,
ex_FB_Centpct = mean(FB_Centpct, na.rm = TRUE)*100,
ex_FB_Pullpct = mean(FB_Pullpct, na.rm = TRUE)*100,
ex_PU_Opppct = mean(PU_Opppct, na.rm = TRUE)*100,
ex_PU_Centpct = mean(PU_Centpct, na.rm = TRUE)*100,
ex_PU_Pullpct = mean(PU_Pullpct, na.rm = TRUE)*100,
wOBAcon_denom = sum(woba_denom, na.rm = TRUE),
GB_OppCT = sum(GB_OppFL, na.rm = TRUE),
GB_CentCT = sum(GB_CentFL, na.rm = TRUE),
GB_PullCT = sum(GB_PullFL, na.rm = TRUE),
LD_OppCT = sum(LD_OppFL, na.rm = TRUE),
LD_CentCT = sum(LD_CentFL, na.rm = TRUE),
LD_PullCT = sum(LD_PullFL, na.rm = TRUE),
FB_OppCT = sum(FB_OppFL, na.rm = TRUE),
FB_CentCT = sum(FB_CentFL, na.rm = TRUE),
FB_PullCT = sum(FB_PullFL, na.rm = TRUE),
PU_OppCT = sum(PU_OppFL, na.rm = TRUE),
PU_CentCT = sum(PU_CentFL, na.rm = TRUE),
PU_PullCT = sum(PU_PullFL, na.rm = TRUE),
GB_Opppct = GB_OppCT / wOBAcon_denom * 100,
GB_Centpct = GB_CentCT / wOBAcon_denom * 100,
GB_Pullpct = GB_PullCT / wOBAcon_denom * 100,
LD_Opppct = LD_OppCT / wOBAcon_denom * 100,
LD_Centpct = LD_CentCT / wOBAcon_denom * 100,
LD_Pullpct = LD_PullCT / wOBAcon_denom * 100,
FB_Opppct = FB_OppCT / wOBAcon_denom * 100,
FB_Centpct = FB_CentCT / wOBAcon_denom * 100,
FB_Pullpct = FB_PullCT / wOBAcon_denom * 100,
PU_Opppct = PU_OppCT / wOBAcon_denom * 100,
PU_Centpct = PU_CentCT / wOBAcon_denom * 100,
PU_Pullpct = PU_PullCT / wOBAcon_denom * 100
)%>%
select(stand,if_fielding_alignment,
GB_Opppct,ex_GB_Opppct,
GB_Centpct,ex_GB_Centpct,
GB_Pullpct,ex_GB_Pullpct,
LD_Opppct,ex_LD_Opppct,
LD_Centpct,ex_LD_Centpct,
LD_Pullpct,ex_LD_Pullpct,
FB_Opppct,ex_FB_Opppct,
FB_Centpct,ex_FB_Centpct,
FB_Pullpct,ex_FB_Pullpct,
PU_Opppct,ex_PU_Opppct,
PU_Centpct,ex_PU_Centpct,
PU_Pullpct,ex_PU_Pullpct)
shift_bat[,3:26] <- round(shift_bat[,3:26], 1)
#Excelで表を作るためcsvで保存
write_csv(shift_bat,"shift_battedball_BBtype.csv")