守備シフト時に配球（球種）は変化するか

MLBでは内野を片側に寄せる守備シフトがよく見られるようになった。これは主にプルヒッターに対して引っ張った方向にゴロを打たせてアウトをとるためだ。シフトを敷かれているプルヒッターは逆方向にゴロを打つことはそれほどなく内野手を両側に配置するよりも効率的という考えのもと行われている。（守備シフトの効果そのものについてはsninさんの先行研究等を参考にしてほしい）

この守備シフトを活かすためにシフトを敷いた時に配球が変化してはいないだろうかと疑問に思った。例えばゴロを打たせやすい球種を多く投げることで打者のゴロ率を高めれば効率よくアウトを稼げそうだ。

守備シフトの導入等科学的なアプローチで躍進を果たした2013年のパイレーツを描いた『ビッグデータ・ベースボール』で以下のような記述がある。

ゴロの比率に関して自己最高を記録したのはモートンだけではなかった。パイレーツの先発投手のほぼ全員が同様の結果を残した。パイレーツの投手はほぼ例外なくフォーシーム・ファストボールの使用を減らし、ツーシームの比率を増やし、ゴロの比率で自己最高を記録した。『ビッグデータ・ベースボール』（角川書店、トラヴィス・ソーチック　著　桑田健　訳　P.218）

これはチーム方針としてゴロを打たせやすい球種であるツーシームの投球割合を増やしてシフトの効果をより高めようとした例である。2013年のパイレーツのように守備シフトを敷いた時に特定の球種の割合を増やす・もしくは減らすといった傾向は現在もあるのだろうか。検証してみることにした。

検証

方法としては2015-2020年のMLBでシフト状態で300打席以上立った打者がシフトを敷かれなかった状態で推定される各球種の被投球割合と実際にシフトを敷かれた状態での各球種の被投球割合を比較する。

シフトを敷かれなかった時の被投球割合を推定する方法としては例えばシフトを敷かれなかったときのフォーシームの被投球割合が40%の打者が3球投球されたときと被投球割合が30%の打者が2球投球された場合は

（0.4+0.4+0.4+0.3+0.3)+(1+1+1+1+1)

と計算してフォーシームの被投球割合の期待値を出す。（他の球種も同様に行う）

Baseball Savantから入手したStatcastのデータを使用する。

フォーシーム

左投手対左打者でフォーシームの投球割合が推定値より低下している。他の組み合わせではそこまで大きな変動はない。

シンカー（ツーシーム）

シンカー（ツーシーム）は左投手対右打者、右投手対左打者のような反対側の利き腕との対戦で投球割合が推定値より低下している。理由としては以下のようなことが考えられる。

上記の画像は右投手対左打者のフォーシームとシンカーの引っ張ったゴロ/ゴロを比較したものだ。フォーシームで打たせたゴロは44.8%が引っ張った方向に飛ぶのに対しシンカーで打たせたゴロは37.9%しか引っ張った方向に飛んでいない。シフトは一般的に打者がゴロを引っ張った方向に野手を配置しているため右対左ではツーシームでゴロを打たせたとしても野手のいない逆方向に飛んでしまいヒットになるリスクが高くなる。シフトを活かすにはゴロを打たせるだけでなく打たせる方向も大事だということだ。ちなみに上記の画像では右投手対左打者の例を紹介したが左投手対右打者でも同様の結果が出る。反対側の利き腕の対戦ではシンカーの投球割合が減少するのは以上のようなことが理由だと考えられる。

カットボール

カットボールは左投手対右打者で割合がやや上昇している。右投手対左打者も上昇しているが左投手対右打者と比較するとわずかな上昇となっている。

スライダー

スライダーはどの組み合わせでもそれほど投球割合に変化は起きていない。

カーブ

カーブは左投手対右打者、右投手対左打者など反対側の利き腕との対戦で推定値よりわずかに上昇が見られる。

チェンジアップ

チェンジアップは右投手対右打者を除くと推定値より1%程度増えている。

全球種

反対側の利き腕同士の対戦でも左投手対右打者と右投手対左打者ではやや内訳が異なる。推定値と比較してシンカーの投球割合が減少してカーブとチェンジアップの投球割合が増加しているのは共通しているが代わりに増えた球種が左はフォーシーム、カットボール、スライダーが万遍なく増えているのに対し右はカットボールの比重が大きくなっている。

同じ利き腕同士の対戦では左投手対左打者では推定値と比較してフォーシームが大きく減少しスライダーとチェンジアップが増加しているのに対し右投手対右打者ではフォーシームの割合はほぼ変化せずスライダーの投球割合とチェンジアップの投球割合は左対左ほど増えてはいない。

同じ利き腕同士の対戦、反対側の利き腕同士の対戦でも球種の投球割合の増減には差があることがわかった。

まとめ

・反対側の利き腕同士の対戦ではシンカー（ツーシーム）の投球割合が減少する。これは反対側の利き腕同士のシンカーは逆方向に打球が飛びやすくなるためだと思われる。

・同じ利き腕同士の対戦、反対側同士の利き腕の対戦でも組み合わせによって球種の増減に違いがある。

前述のビッグデータ・ベースボールの記述ではシフトを活かすためにシンカーの投球割合を上昇させたとあるが現在ではシフトのためにシンカーの投球割合を増やすといったことは行われていないようだ。逆方向に打球が飛ぶリスクが増える反対側同士の利き腕の対戦ならともかく同じ利き腕同士の対戦でもこのような傾向にあるのは意外だった。

その他、反対側の利き腕同士、同じ利き腕同士でも左右の組み合わせによって投球割合が異なるのも面白かった。

まとめて見ると左打者は右打者より速球の投球割合が低下し変化球の投球割合がより上昇している傾向にあった。理由はわからないが左右で綺麗に一致するとはいかないようだ。これが投手側の都合か打者側の都合かはわからないが興味深い。

ちなみに並行して投球コースについて調べてみたが球種と異なりこちらはシフトを敷いた時の投球コースと敷かなかった時に推定される投球コースのそれぞれの割合を調べてもほとんど差がなかった。球種との組み合わせも考慮すればもしかして変動もあるかも。

以下、今回分析に用いたＲのコード。

#tidyverseを使用
library(tidyverse)

# dfには2015-2020のstatcastのデータが入っている
# 列が全部含まれていると止まるので必要な列に絞る
df <- df%>%
 select(events, type,des,description,p_throws,pitch_type,stand,
        if_fielding_alignment,woba_denom,game_type,
        hc_x,hc_y,plate_x,plate_z,sz_top,sz_bot,batter)
save(df, file="sc_data_for_shift_haikyu.Rdata")

#データの下処理
df <- df %>% filter(game_type =="R")

df <- df %>% mutate( 
 if_fielding_alignment = 
   factor(if_fielding_alignment, 
          levels = c("Standard", "Infield shift", "Strategic")),
 #コースをcmに変換、左右で内外の値を揃える
 plate_x_r_cm = plate_x * 30.48,
 plate_x_cm = ifelse(stand == "R",plate_x_r_cm,-1 * plate_x_r_cm),
 plate_z_cm = plate_z *30.48,
 sz_middle = (sz_top + sz_bot)/2 *30.48,
 sz_cm = (plate_z) *30.48 - (sz_middle),
 sz_top_cm = sz_top *30.48,
 naikaku_ball = ifelse(plate_x_cm <= -21 , 1, 0),
 naikaku = ifelse(plate_x_cm > -21 & plate_x_cm <= -7,1,0),
 mannaka = ifelse(plate_x_cm > -7 & plate_x_cm <= 7,1,0),
 gaikaku = ifelse(plate_x_cm > 7 & plate_x_cm <= 21,1,0),
 gaikaku_ball = ifelse(plate_x_cm > 21 ,1,0),
 takame_ball = ifelse(sz_middle+21 < plate_z_cm,1,0),
 takame  = ifelse(sz_middle + 21 > plate_z_cm & sz_middle + 7 <= plate_z_cm ,1,0),
 middle = ifelse(sz_middle + 7 > plate_z_cm & sz_middle -7 <= plate_z_cm ,1,0),
 hikume = ifelse(sz_middle - 7 >  plate_z_cm & plate_z_cm & sz_middle - 21 < plate_z_cm ,1,0),
 hikume_ball = ifelse(sz_middle - 21 >  plate_z_cm  ,1,0),
 #SIとFTをSIに、CUとKCをCUに統一
 pitch_type_SI = ifelse(pitch_type == "FT" ,"SI",pitch_type),
 pitch_type_CU = ifelse(pitch_type_SI == "KC" ,"CU",pitch_type_SI),
 FF = ifelse(pitch_type_CU == "FF" ,1,0),
 SI = ifelse(pitch_type_CU == "SI" ,1,0),
 FC = ifelse(pitch_type_CU == "FC" ,1,0),
 SL = ifelse(pitch_type_CU == "SL" ,1,0),
 CU = ifelse(pitch_type_CU == "CU" ,1,0),
 CH = ifelse(pitch_type_CU == "CH" ,1,0),
 FS = ifelse(pitch_type_CU == "FS" ,1,0))
 
#投球系
bat_plate <- df %>% 
 filter(if_fielding_alignment == "Standard")%>%
 group_by(p_throws,batter)%>%
 dplyr::summarise(bat_naikaku_ball_rate = mean(naikaku_ball, na.rm = TRUE),
                  bat_naikaku_rate = mean(naikaku, na.rm = TRUE),
                  bat_mannaka_rate = mean(mannaka, na.rm = TRUE),
                  bat_gaikaku_rate = mean(gaikaku, na.rm = TRUE),
                  bat_gaikaku_ball_rate = mean(gaikaku_ball, na.rm = TRUE),
                  bat_takame_ball_rate = mean(takame_ball, na.rm = TRUE),
                  bat_takame_rate  = mean(takame, na.rm = TRUE),
                  bat_middle_rate = mean(middle, na.rm = TRUE),
                  bat_hikume_rate = mean(hikume, na.rm = TRUE),
                  bat_hikume_ball_rate = mean(hikume_ball, na.rm = TRUE),
                  bat_FF_rate = mean(FF, na.rm = TRUE),
                  bat_SI_rate = mean(SI, na.rm = TRUE),
                  bat_FC_rate = mean(FC, na.rm = TRUE),
                  bat_SL_rate = mean(SL, na.rm = TRUE),
                  bat_CU_rate = mean(CU, na.rm = TRUE),
                  bat_CH_rate = mean(CH, na.rm = TRUE),
                  bat_FS_rate = mean(FS, na.rm = TRUE),
 )%>%
 select(p_throws,batter,bat_naikaku_ball_rate,bat_naikaku_rate,bat_mannaka_rate,bat_gaikaku_rate,bat_gaikaku_ball_rate,
        bat_takame_ball_rate,bat_takame_rate,bat_middle_rate,bat_hikume_rate,bat_hikume_ball_rate,
        bat_FF_rate,bat_SI_rate,bat_FC_rate,bat_SL_rate,bat_CU_rate,bat_CH_rate,bat_FS_rate)
        
# wOBA_denom >= 300の選手に絞る
bat <- df %>% 
 filter(if_fielding_alignment == "Standard")%>%
 group_by(batter)%>%
 dplyr::summarise(wOBA_denom = sum(woba_denom, na.rm = TRUE)
 )%>%
 filter(wOBA_denom >= 300) 
 
std_batting <- bat 
std_batting <- left_join(std_batting, bat_plate,by="batter") 
selected_players <- std_batting$batter
# pitch-by-pitch dataに打者の推定被投球割合を付加する
# 計算されている打者の打席だけに絞る
# シフトも簡単のためStandardかShiftだけに絞る
data <- df %>% filter(batter %in% selected_players)%>%
 left_join(std_batting)%>% 
 filter(if_fielding_alignment ==　"Infield shift")
shift_bat <- data%>%
 group_by(p_throws,stand, if_fielding_alignment)%>%
 dplyr::summarise(ex_naikaku_ball_rate = mean(bat_naikaku_ball_rate, na.rm = TRUE)*100,
                  ex_naikaku_rate = mean(bat_naikaku_rate, na.rm = TRUE)*100,
                  ex_mannaka_rate = mean(bat_mannaka_rate, na.rm = TRUE)*100,
                  ex_gaikaku_rate = mean(bat_gaikaku_rate, na.rm = TRUE)*100,
                  ex_gaikaku_ball_rate = mean(bat_gaikaku_ball_rate, na.rm = TRUE)*100,
                  ex_takame_ball_rate = mean(bat_takame_ball_rate, na.rm = TRUE)*100,
                  ex_takame_rate  = mean(bat_takame_rate, na.rm = TRUE)*100,
                  ex_middle_rate = mean(bat_middle_rate, na.rm = TRUE)*100,
                  ex_hikume_rate = mean(bat_hikume_rate, na.rm = TRUE)*100,
                  ex_hikume_ball_rate = mean(bat_hikume_ball_rate, na.rm = TRUE)*100,
                  ex_FF_rate = mean(bat_FF_rate, na.rm = TRUE)*100,
                  ex_SI_rate = mean(bat_SI_rate, na.rm = TRUE)*100,
                  ex_FC_rate = mean(bat_FC_rate, na.rm = TRUE)*100,
                  ex_SL_rate = mean(bat_SL_rate, na.rm = TRUE)*100,
                  ex_CU_rate = mean(bat_CU_rate, na.rm = TRUE)*100,
                  ex_CH_rate = mean(bat_CH_rate, na.rm = TRUE)*100,
                  ex_FS_rate = mean(bat_FS_rate, na.rm = TRUE)*100,
                  naikaku_ball_rate = mean(naikaku_ball, na.rm = TRUE)*100,
                  naikaku_rate = mean(naikaku, na.rm = TRUE)*100,
                  mannaka_rate = mean(mannaka, na.rm = TRUE)*100,
                  gaikaku_rate = mean(gaikaku, na.rm = TRUE)*100,
                  gaikaku_ball_rate = mean(gaikaku_ball, na.rm = TRUE)*100,
                  takame_ball_rate = mean(takame_ball, na.rm = TRUE)*100,
                  takame_rate  = mean(takame, na.rm = TRUE)*100,
                  middle_rate = mean(middle, na.rm = TRUE)*100,
                  hikume_rate = mean(hikume, na.rm = TRUE)*100,
                  hikume_ball_rate = mean(hikume_ball, na.rm = TRUE)*100,
                  FF_rate = mean(FF, na.rm = TRUE)*100,
                  SI_rate = mean(SI, na.rm = TRUE)*100,
                  FC_rate = mean(FC, na.rm = TRUE)*100,
                  SL_rate = mean(SL, na.rm = TRUE)*100,
                  CU_rate = mean(CU, na.rm = TRUE)*100,
                  CH_rate = mean(CH, na.rm = TRUE)*100,
                  FS_rate = mean(FS, na.rm = TRUE)*100)%>%
 select(p_throws,stand,if_fielding_alignment, 
        naikaku_ball_rate,  ex_naikaku_ball_rate,
        naikaku_rate, ex_naikaku_rate,
        mannaka_rate, ex_mannaka_rate,
        gaikaku_rate, ex_gaikaku_rate,
        gaikaku_ball_rate, ex_gaikaku_ball_rate,
        takame_ball_rate, ex_takame_ball_rate,
        takame_rate,ex_takame_rate,
        middle_rate,ex_middle_rate,
        hikume_rate,ex_hikume_rate,
        hikume_ball_rate,ex_hikume_ball_rate,
        FF_rate,ex_FF_rate,
        SI_rate,ex_SI_rate,
        FC_rate,ex_FC_rate,
        SL_rate,ex_SL_rate,
        CU_rate,ex_CU_rate,
        CH_rate,ex_CH_rate,
        FS_rate,ex_FS_rate)
        
write_csv(shift_bat,"shift_haikyuu.csv")