Rで野球のデータを分析してみよう 4（ストレートを再定義して指標を算出）
この記事は一連の記事を読んでることを前提としたものです。そのため、まだ未読の方はそちらを読んでから読むことをお勧めします。
ストレートを再定義する
今回はストレート（フォーシーム）を再定義します。
一言にストレートと言っても伸びるストレート、沈むストレートなど色々あります。それらを球種別特徴で再定義したうえで、各種指標を算出しそれぞれのストレートの特徴を見ていきます。
MLB平均ストレートの球質を調査
再定義するにはまずMLBの平均的なストレートの球質を知ることが必要になります。というわけで下準備。
下準備
まず各単位をメートル法に変換…するのですが、1つ気をつけたいことがあります。それは横変化の値(pfx_x)です。当然のことですが投手の横変化は左右によって逆になります。右投手のスライダーは右打者の外に逃げるのに対し、左投手のスライダーは右打者に向かっていく、といった感じです。左右で値を揃えてやる必要があります。ここで使うのがifelse関数です。
ifelse(条件を満たすかどうかで異なる結果を返す)
ifelse(条件,条件を満たした場合の結果,条件を満たさなかった場合の結果)
使用例(投手の利き手が右ならpfx_xに30.48を、右以外ならpfx_xに-30.48を掛ける）
ifelse(p_throws == "R", pfx_x * 30.48, pfx_x * -30.48)p_trowsはStatcast上に含まれる投手の利き手データです。上のコードは投手の利き手が右ならpfx_x（横変化、feet表記）に30.48を、右以外(左)なら-30.48を掛けることで横変化の値を右を基準に揃えています。
というわけで下準備の続きです。
#dfにstatcast2022のデータを入れる
df <- read.csv("statcast2022.csv")
#メートル法に変換、左右で横変化の値を揃える
df <- df %>%
mutate(release_speed_km = release_speed*1.609,
pfx_z_cm = pfx_z*30.48,
adj_pfx_x_cm = ifelse(p_throws=="R",pfx_x*30.48,pfx_x*-30.48))
#球種ごとの球質データを算出
Pitch_Type_2022 <- df %>%
group_by(pitch_type)%>%
dplyr::summarise(
mean_velo = mean(release_speed_km,na.rm=TRUE),
mean_V_mov = mean(pfx_z_cm,na.rm=TRUE),
mean_H_mov = mean(adj_pfx_x_cm,na.rm=TRUE)
)
#csvデータで出力
write.csv(Pitch_Type_2022,"球質_2022.csv",row.names=F)以上の処理を行うと以下のようなcsvファイルを出力できます。
2022のMLB平均ストレートは球速151km/hｍ、縦変化40.9cm、横変化-18.5cm（マイナスはシュート側に動いてます）。
これを基準にストレートを再定義してみましょう。
case_when(条件によって異なる結果を返す)
case_when()は条件によって異なる値を返す関数です。
case_when(条件1 ~ 結果1,
条件2 ~ 結果2…)
記述例：
(縦変化48cm以上かつ横変化-10cm以上なら"Cut_Rise"を、
縦変化48cm以上かつ横変化-10cm以下、-25cm以上なら"Standard_Rise"を、
縦変化48cm以上かつ横変化-25cm以下なら"Arm_Rise")を列に入れる
FB_Profile = case_when(
pfx_z_cm >= 48 & adj_pfx_x_cm >= -10 ~ "Cut_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm <= -25 ~ "Arm_Rise")これによってフォーシームを条件によって再定義します。
df <- df %>%
mutate(FB_Profile = case_when(
pfx_z_cm >= 48 & adj_pfx_x_cm >= -10 ~ "Cut_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm <= -25 ~ "Arm_Rise",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm >= -10 ~ "Cut_Standard",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Standard",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm <= -25 ~ "Arm_Standard",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm >= -10 ~ "Cut_Dropper",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Dropper",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm <= -25 ~ "Arm_Dropper",
pfx_z_cm < 15 ~ "Sinker",
TRUE ~ "Other"
))
FB <- df %>%
filter(pitch_type == "FF")%>%
group_by(FB_Profile)%>%
dplyr::summarise(
mean_velo = mean(release_speed_km,na.rm=TRUE),
mean_V_mov = mean(pfx_z_cm,na.rm=TRUE),
mean_H_mov = mean(adj_pfx_x_cm,na.rm=TRUE)
)FBの中身を見るとちゃんと条件分けされています。
各種指標算出の下準備
あとは各種指標を算出しましょう。
case_whenとifelseで各種指標を算出する準備をします。
Whiff%を出すためにswing_denom（スイング分母）という列とwhiff（空振り）という列を、GB%とpopup%、xwOBAconを出すためにGB（フォロ）,popup（ポップフライ）,BBE_denom（打球分母）という列を作成します。
desctiptionという列には以下のようなデータが含まれています。
swing_denomという列にスイングを試みた場合の結果には1をスイング以外の結果には0を入るようにdiscriptinを対象にcase_when、同じくwhiffという列は空振りを1、それ以外が0になるようにします。
df <- df %>%
mutate(
swing_denom = case_when(
description == "swinging_strike" ~ 1,
description == "swinging_strike_blocked" ~ 1,
description == "foul_tip" ~ 1,
description == "foul" ~ 1,
description == "hit_into_play" ~ 1,
description == "hit_into_play_score" ~ 1,
description == "hit_into_play_no_out" ~ 1,
TRUE ~ 0),
whiff = case_when(
description == "swinging_strike" ~ 1,
description == "swinging_strike_blocked" ~ 1,
description == "foul_tip" ~ 1,
TRUE ~ 0))
続いて打球についてです。
打球の分母を対象とするためにtypeという列にX（打球結果の発生を意味する記号）が入ってる場合に1を、それ以外には0を、これをifelseで設定します。GBとpopupについてもbb_typeという列を使いifelseで設定します。
df <- df %>%
mutate(
BBE_denom = ifelse(type == "X",1,0),
GB = ifelse(bb_type == "ground_ball",1,0),
popup = ifelse(bb_type == "popup",1,0))結果算出
FB_Stats <- df %>%
filter(pitch_type == "FF")%>%
group_by(FB_Profile)%>%
dplyr::summarise(
N = n(),
RV_100 = mean(delta_run_exp,na.rm=TRUE)*100,
Whiffpct = sum(whiff,na.rm=TRUE)/sum(swing_denom,na.rm=TRUE)*100,
BBE = sum(BBE_denom,na.rm=TRUE),
GBpct = sum(GB,na.rm=TRUE)/BBE*100,
PUpct = sum(popup,na.rm=TRUE)/BBE*100,
xwOBAcon = sum(estimated_woba_using_speedangle,na.rm=TRUE)/BBE
)
write.csv(FB_Stats,"FB_Profile.csv",row_names=F)各指標の説明…
N = 投球数
RV_100 = 100球あたりの得点価値。投手にとっては低いほどよい。delta_run_expはstatcastデータに入っている得点期待値変動データ。
Whiffpct = 空振り/スイング。打者がスイングをした際にどれだけ空振りを取れたかを表す指標。
BBE = 打球イベントの総数。
GBpct = ゴロ/打球。打球がゴロになった割合。
PUpct = ポップフライ/打球。打球がポップフライ（角度の高すぎるフライ）になった割合。
xwOBAcon…打球の失点リスク。
estimated_woba_using_speedangleはStatcast内に含まれている打球の速度と角度から算出した打球価値のようなもの。
結果はこんな感じになりました。
ちょっとゴチャゴチャして分かりづらいですね。Excelで表にしましょう。
結果としてわかることをまとめます。
・Sinker＞Rise＞Standard＞Dropperの順に失点抑止力が高い。例外的にSinkerは優れているが基本的にホップの量が多いほど失点抑止できる。
・Sinkerは例外的に優れているが代表投手の名前を見るとサイド・サブマリンが多い。腕の角度が極端に低い投手以外はこの変化量で投球するのは難しいと思われる。
・ホップの量が多いほど空振りが取れる。
・ホップの量が多いほどポップフライを打たせられ、低いほどゴロを打たせられる。ただしxwOBAconではSinkerレベルでないと差がつかず。
・同じホップ量なら横変化はCut系の方が打球の失点リスクが低くなるため、失点を抑止しやすい。
よく「平均的なストレートが1番打たれやすい」という言説を目にすることがありますがSinkerレベルでホップ量が少なくないと、むしろホップの量が小さいDropperの方がStandardより失点抑止力が低いことがわかります。
「シュート回転しないきれいな真っ直ぐが理想」と言われることがありますが、実際にシュートしないCut系ストレートは打球の失点リスクが低いため失点抑止力が高いことがわかります。（とはいえ縦変化のが影響が大きいためまっスラを投げるためにカットリリースや回外を試みるかの判断は慎重に考慮したほうがよいと思いますが……）
今回のコードまとめ
#dfにstatcast2022のデータを入れる
df <- read.csv("statcast2022.csv")
#メートル法に変換、左右で横変化の値を揃える
df <- df %>%
mutate(release_speed_km = release_speed*1.609,
pfx_z_cm = pfx_z*30.48,
adj_pfx_x_cm = ifelse(p_throws=="R",pfx_x*30.48,pfx_x*-30.48))
#球種ごとの球質データを算出
Pitch_Type_2022 <- df %>%
group_by(pitch_type)%>%
dplyr::summarise(
mean_velo = mean(release_speed_km,na.rm=TRUE),
mean_V_mov = mean(pfx_z_cm,na.rm=TRUE),
mean_H_mov = mean(adj_pfx_x_cm,na.rm=TRUE)
)
#csvデータで出力
write.csv(Pitch_Type_2022,"球質_2022.csv",row.names=F)
#速球を変化量で再定義
df <- df %>%
mutate(FB_Profile = case_when(
pfx_z_cm >= 48 & adj_pfx_x_cm >= -10 ~ "Cut_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Rise",
pfx_z_cm >= 48 & adj_pfx_x_cm <= -25 ~ "Arm_Rise",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm >= -10 ~ "Cut_Standard",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Standard",
pfx_z_cm >= 32 & pfx_z_cm < 48 & adj_pfx_x_cm <= -25 ~ "Arm_Standard",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm >= -10 ~ "Cut_Dropper",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm < -10 & adj_pfx_x_cm > -25 ~ "Standard_Dropper",
pfx_z_cm >= 15 & pfx_z_cm < 32 & adj_pfx_x_cm <= -25 ~ "Arm_Dropper",
pfx_z_cm < 15 ~ "Sinker",
TRUE ~ "Other"
))
#FB_profileがちゃんと割り振られてるか確認
FB <- df %>%
filter(pitch_type == "FF")%>%
group_by(FB_Profile)%>%
dplyr::summarise(
mean_velo = mean(release_speed_km,na.rm=TRUE),
mean_V_mov = mean(pfx_z_cm,na.rm=TRUE),
mean_H_mov = mean(adj_pfx_x_cm,na.rm=TRUE)
)
#whiff%を作るための列を作成
df <- df %>%
mutate(
swing_denom = case_when(
description == "swinging_strike" ~ 1,
description == "swinging_strike_blocked" ~ 1,
description == "foul_tip" ~ 1,
description == "foul" ~ 1,
description == "hit_into_play" ~ 1,
description == "hit_into_play_score" ~ 1,
description == "hit_into_play_no_out" ~ 1,
TRUE ~ 0),
whiff = case_when(
description == "swinging_strike" ~ 1,
description == "swinging_strike_blocked" ~ 1,
description == "foul_tip" ~ 1,
TRUE ~ 0))
#打球系の結果をつくるための列を作成
df <- df %>%
mutate(
BBE_denom = ifelse(type == "X",1,0),
GB = ifelse(bb_type == "ground_ball",1,0),
popup = ifelse(bb_type == "popup",1,0))
#各速球のスタッツを算出
FB_Stats <- df %>%
filter(pitch_type == "FF")%>%
group_by(FB_Profile)%>%
dplyr::summarise(
N = n(),
RV_100 = mean(delta_run_exp,na.rm=TRUE)*100,
Whiffpct = sum(whiff,na.rm=TRUE)/sum(swing_denom,na.rm=TRUE)*100,
BBE = sum(BBE_denom,na.rm=TRUE),
GBpct = sum(GB,na.rm=TRUE)/BBE*100,
PUpct = sum(popup,na.rm=TRUE)/BBE*100,
mean_EV = mean(launch_speed,na.rm=TRUE)*1.609,
xwOBAcon = sum(estimated_woba_using_speedangle,na.rm=TRUE)/BBE
)
#csvに保存
write.csv(FB_Stats,"FB_Profile_a.csv",row.names = F)この記事が気に入ったらサポートをしてみませんか？