フレーミングは投手と捕手、どちらの影響がどの程度大きいか。

球審にストライクを多くコールさせる技術であるフレーミングは一般的に捕手の能力と解されている。しかし逆球の少ないコントロールのいい投手や名投手が投げることによって球審にストライクとコールさせるなど投手が何かしらの影響を与える可能性も捨てきれない。実際のところはどうなのだろうか。

フレーミングの投手と捕手の年度間相関

初めにBaseball Savantから取得した2010-2019のMLBのデータを基に算出したフレーミング指標（算出方法は前回のnoteと同じ）を使い投手と捕手でフレーミングの偶数年と奇数年の相関を見てみることにした。偶数年と奇数年でそれぞれ捕球機会3000以上の選手を対象にしている。

結果は捕手が相関係数0.88、投手が相関係数0.75となった。これだけ見ると捕手の相関も非常に高いものの投手の相関も高いように思える。だがこの手法は問題がある。投手は基本、同じチームに所属する同じ捕手と多く組むことになり捕手もまた同じ投手陣とよく組む。つまり本来はどちらかの能力による影響のみが強いのに疑似相関でどちらの相関も高くなってしまっているという可能性がある。この点を考えると単純に年度間相関をとるのではなく何か工夫が必要なようだ。

移籍前後のフレーミング指標の相関をとる

そこで移籍前後のフレーミング指標の相関係数をとることにした。移籍したならば基本的に捕手は移籍前とは違う投手達と組みまた投手は他の捕手と組むようになるはずだ。もしフレーミングが捕手（投手）の能力によるところが大きいなら移籍前後で比較してもフレーミング指標は高い相関があるはずだ。移籍前後のどちらのチームでも捕球機会3000以上を経験した捕手と投手についてそれぞれのフレーミング指標の相関をとった結果が以下となる。

結果は対照的なものとなっている。捕手は移籍前後でも0.72と高い相関係数を記録したのに対し投手は0.13とほとんど相関がないという結果になった。これは捕手は組む投手が変わってもフレーミングの質が変わらないのに対し投手は組む捕手が変わるとフレーミングの質が大きく変化してしまうということだ。この結果から考えると投手がフレーミングに与える影響はわずかで捕手の影響が大きいと考えるのが自然だろう。

フレーミングは捕手の手柄

以上の検証からフレーミングの大部分は捕手による影響が大きいと推測される。ちなみにfangraphsではWARの算出の際フレーミングを評価指標に取り入れたことで投手にも補正がかかっている。投手と捕手のフレーミングの影響度の違いを考えるとこれは妥当な補正と言えるだろう。

Rのコード

library(tidyverse)
#baseball savantから取得した2010~2019データで必要な列に絞る

#Season_2010 <- Season_2010 %>%
#  select(game_year,description,plate_x,plate_z,balls,strikes,stand,pitch_type,delta_run_exp,pitcher,fielder_2,home_team,away_team,inning_topbot)

#2010-2019データを結合
#df <- rbind(Season_2010,Season_2011,Season_2012,Season_2013,Season_2014,Season_2015,Season_2016,Season_2017,Season_2018,Season_2019)

#フレーミング機会のみにデータを絞る
df <- df %>% filter(description == "called_strike" | description == "ball")

#垂直方向の座標が0未満の投球は評価から除外
df <- df %>% filter(plate_z > 0)

#投球位置データをフィートからセンチメートルにする
#ボールカウントの列を作成
#ifelse関数でストライクを1,ボールを0とする列を作成
#守備側チームの列を作成
#投手＋チームと捕手＋チームの列を作成
df <- df %>%
 mutate(plate_x_cm = plate_x * 30.48,
        plate_z_cm = plate_z * 30.48,
        count = paste(balls,"-",strikes),
        called_strike = ifelse(description == "called_strike" ,1,0),
        defence = ifelse(inning_topbot =="Top",home_team,away_team),
        pitcher_team = paste(pitcher,"-",defence),
        catcher_team = paste(fielder_2,"-",defence))
        
#cut関数で投球コースを縦横5cmずつに刻む
Group <- seq(-60,60,5)
Group_2<- seq(0, 120 , 5)
df$plate_x_bin <- with(df, cut(plate_x_cm, Group))
df$plate_z_bin <- with(df, cut(plate_z_cm, Group_2))
#投球コース、カウント、左右打席ごとのストライク期待値を出す
expected_called_strike <- df %>%
 group_by(plate_x_bin,plate_z_bin,count,stand,pitch_type)%>%
 dplyr::summarise(N = n(),
                  sumCS = sum(called_strike, na.rm = TRUE),
                  xCS = sumCS / N )
                  
#NAになってる行を削除
expected_called_strike <- subset(expected_called_strike, !(is.na(expected_called_strike$plate_x_bin)))
expected_called_strike <- subset(expected_called_strike, !(is.na(expected_called_strike$plate_z_bin)))
#left_joinで各組合せのストライク期待値を結合

df <- df %>%
 left_join(expected_called_strike %>% 
             select(plate_x_bin,plate_z_bin,count,stand,pitch_type,xCS))
             
#ストライク-ストライク期待値の列を作成
df <- df %>% mutate(CS_AA = called_strike - xCS)
#捕手＋チームごとにまとめ、捕手のid順に行を入れ替える
Framing_catcher <- df %>%
 group_by(fielder_2,catcher_team) %>%
 dplyr::summarise(N = n(),
                  before_Extra_Strike_per_Called_Pitch = mean(CS_AA, na.rm = TRUE)) %>%
 dplyr::arrange(fielder_2)%>%
 filter(N >= 3000)
 
#lead関数で下の行の捕手idが一致する行の値を上の行に代入
Framing_catcher <- Framing_catcher %>%
 mutate(lead_fielder_2 = lead(fielder_2),
        after_Extra_Strike_per_Called_Pitch = lead(before_Extra_Strike_per_Called_Pitch),
        after_team = lead(catcher_team))
        
#前後の捕手idの値が一致する行だけを残す
Framing_catcher <- Framing_catcher %>%
 filter(fielder_2 == lead_fielder_2)
 
 #相関係数を算出
cor(Framing_catcher$before_Extra_Strike_per_Called_Pitch,Framing_catcher$after_Extra_Strike_per_Called_Pitch)

#グラフ作成
ggplot(Framing_catcher,aes(x= before_Extra_Strike_per_Called_Pitch,y = after_Extra_Strike_per_Called_Pitch))+
 geom_point() +
 ggtitle("2010-2019 MLB Catcher　Extra Strike per Called Pitch 移籍前 vs 移籍後（捕球機会3000以上）N=118 ") +
 scale_x_continuous(breaks = c(-0.05,-0.025,0,0.025,0.050) , limits = c(-0.05,0.05)) +
 scale_y_continuous(breaks = c(-0.05,-0.025,0,0.025,0.050) , limits = c(-0.05,0.05)) +
 geom_hline(yintercept = 0) +
 geom_vline(xintercept = 0) +
 annotate("text",x=0.025 , y =-0.025,label = "r == 0.72")


#投手＋チームごとにまとめ、投手のid順に行を入れ替える
Framing_pitcher <- df %>%
 group_by(pitcher,pitcher_team) %>%
 dplyr::summarise(N = n(),
                  before_Extra_Strike_per_Called_Pitch = mean(CS_AA, na.rm = TRUE)) %>%
 dplyr::arrange(pitcher)%>%
 filter(N >= 3000)
 
#lead関数で下の行の投手idが一致する行の値を上の行に代入
Framing_pitcher <- Framing_pitcher %>%
 mutate(lead_pitcher = lead(pitcher),
        after_Extra_Strike_per_Called_Pitch = lead(before_Extra_Strike_per_Called_Pitch),
        after_team = lead(pitcher_team))
        
#前後の投手idの値が一致する行だけを残す
Framing_pitcher <- Framing_pitcher %>%
 filter(pitcher == lead_pitcher)

cor(Framing_pitcher$before_Extra_Strike_per_Called_Pitch,Framing_pitcher$after_Extra_Strike_per_Called_Pitch)

ggplot(Framing_pitcher,aes(x= before_Extra_Strike_per_Called_Pitch,y = after_Extra_Strike_per_Called_Pitch))+
 geom_point() +
 ggtitle("2010-2019 MLB Pitcher　Extra Strike per Called Pitch 移籍前 vs 移籍後（捕球機会3000以上）N=36 ") +
 scale_x_continuous(breaks = c(-0.05,-0.025,0,0.025,0.050) , limits = c(-0.05,0.05)) +
 scale_y_continuous(breaks = c(-0.05,-0.025,0,0.025,0.050) , limits = c(-0.05,0.05)) +
 geom_hline(yintercept = 0) +
 geom_vline(xintercept = 0) +
 annotate("text",x=0.025 , y =-0.025,label = "r == 0.13")