見出し画像

Fangraphsの記事に倣ってR操作してみた

Fangraphsの記事に倣ってデータ操作をしました。
これはデータ操作の記録(と記事の紹介)です。

ネットの海に流したら誰かに敲いていただけるかなぁという淡い願望も抱いてます。
誤った解釈やデータ操作があればDMやコメントで遠慮なく指摘していただきたいです。

この記事の内容を超ざっくりいうと、打者を打ち取れるコース・球種を自身で理解しているかどうかに着目した記事です(たぶん……英語弱者には自信ない……)。そしてその能力をPME(Pitch Mix Effectiveness)という指標を用いて測っています。値が小さい投手ほど自身で理解して投げていると捉えるそうです。

記事の紹介終了。ごめんなさい。雑で。

これ以降ずっとデータ操作の話になります。
既にこの記事を読んでる方は「データ入手」の章に飛んでOKです。

PMEの求め方


記事を読んでいただくのがいちばんですが、
オール英語で億劫かもしれないので一応。
なお、言葉で説明するのが苦手なので言葉足らずな箇所が多々あると思われます。お許しを。

PMEは、「カウント(12通り)」「球種(n通り)」「コース(5通り)」ごとの投球割合とwOBAを掛けて足し合わせて求めます。

PME = wOBA1 × usage1 +  wOBA2 × usage2 + ……  + wOBA60n × usage60n

コースは下の画像に掲載されてるHeart、Chase、Wasteに加えて、Shadowの緑点線枠内をShadow-in、枠外をShadow-outと分類しています。

次に、wOBAの求め方ですが……

その投球の結果(ストライクorボールorインプレイ)ごとのwOBAの変化と投球割合を掛けて求めます。ストライク/ボール時のwOBAの変化はこのです。

0-0から0-1の投球はwOBA.330→.302なので-.028。同様に0-0から1-0の投球は+.002。

例えば、カウント0-0でheartゾーンに投じたスライダーのwOBAを求めるとします。
もしその投球が全部で200球で、うちストライクが100球、ボールが60球、インプレイが40球、インプレイ時のwOBAが.300だったとしたら、

wOBA = -.028 × 0.5 + .002 × 0.3 + .300 × 0.2 = .0466

これが、カウント0-0でheartゾーンに投じたスライダーのwOBAです。この計算を各カウントコース球種ごとに行い、各々の投球割合をかけて足した値がPMEとなります。

wOBAの表はどうやって求めたんでしょうね。

データ入手

まずはパッケージのインストール。
Rstudioのbaseballrパッケージを用います。
データ加工ではtidyverseを中心に行います。

library(tidyverse)
library(baseballr)

続いて投球データの入手。
baseball savantのstatcastデータを用いますが、ネットに上がってたコード(こちら)を使って入手します。日付をポチポチ入力してスクレイピングする方法もありますが、こっちのほうが圧倒的に簡単。

データの一部がこちら。

既に「カウント」「球種」「投球結果」が揃っています。一方、投球コースは座標のみ、wOBAはインプレイの投球時のみです。というわけで、投球コースはplate_xとplate_zのデータを、wOBAはカウントとtypeを加工して作成していきます。

データの加工

まずは投球コースの割り当て。
ボールの通過した位置座標を使って投球コースを設定します。
statcastデータにはボールが通過したゾーンを1~10に分類して記録されていますが、それでは不十分なので、この画像(出典先)をもとに力技で設定しました。

x <- data %>%
   mutate(
     #投球ゾーンをインチに変換
     px = as.numeric(plate_x * 12), 
     pz = as.numeric(plate_z * 12), 
     #attack zone列を作成
     attack =
       case_when(
         -6.7 <= px & px <= 6.7 & 22<= pz & pz <= 38 ~ "heart",
         
         6.7<=px & px<= 10 & 22<= pz & pz <= 38 | 
           -10<=px & px<= -6.7 & 22<= pz & pz <= 38 | 
           -10<=px & px<= 10 & 18<= pz & pz<= 22 |
           -10<= px & px<= 10 & 38<=pz & pz<= 42 ~ "shadow-in",
         
         10<=px & px<= 13.3 & 18<= pz & pz <= 42 | 
           -13.3<=px & px<= -10 & 18<= pz & pz <= 42 |
           -13.3<=px & px<= 13.3 & 14<= pz & pz<= 18 | 
           -13.3<=px & px<= 13.3 & 42<=pz & pz<= 46 ~"shadow-out",
         
         13.3<=px & px<= 20 & 14<= pz & pz<=46 | 
           -20<=px & px<= -13.3 & 14<= pz & pz<=46 | 
           -20<=px & px<= 20 & 6<= pz & pz<=14 | 
           -20<=px & px<= 20 & 46<=pz & pz<=54 ~ "chase",
         
         TRUE ~ "waste"),

続いてwOBAの加工。
インプレイじゃない投球の行にwOBAの変化の値をラベリングして、wOBA_c列に全投球のwOBA_valueを反映しました。もっと効率のいい方法があったら教えてください。

      #カウント列を作成
      count = paste(balls, strikes),
      #「球種+ゾーン」列と「カウント+イベント」列を追加
      pitchzone = paste(pitch_name, attack),
      counttype = paste(count, type),
      #表に基づいて、type = S,B時のwOBAの変化をラベリング
      OBA_change =
        as.numeric(
          case_when(
            counttype == "0 0 S""-0.028",
            counttype == "0 0 B""0.002",
            counttype == "0 1 S""-0.058",
            counttype == "0 1 B""0.009",
            counttype == "0 2 B""0.015",
            counttype == "1 0 B""0.034",
            counttype == "1 0 S""-0.021",
            counttype == "1 1 S""-0.052",
            counttype == "1 1 B""0.034",
            counttype == "1 2 B""0.038",
            counttype == "2 0 S""-0.017",
            counttype == "2 0 B""0.086",
            counttype == "2 1 S""-0.048",
            counttype == "2 1 B""0.085",
            counttype == "2 2 B""0.087",
            counttype == "3 0 S""-0.018",
            counttype == "3 1 S""-0.046"))) %>%
    #type = Xの行ではOBA_change列が、type =SB行ではwoba_value列がN/Aになってるため、0に置換
    replace_na(list(woba_value = 0, OBA_change = 0)) %>%
    #wOBA_c列にwOBAの変化を全打撃に反映させる
    mutate(wOBA_c = woba_value + OBA_change)

こうやって完成したデータがこちら。

PMEを求める

まずは各カウントコース球種の投球割合(usage)を求めます。

y <- x %>%
    group_by(pitcher, count, pitchzone) %>%
    summarize(tPA = n(), .groups = "drop") %>%
    group_by(pitcher, count) %>%
    summarize(pitchzone = pitchzone,
              tPA = tPA,
              usage = tPA / sum(tPA),
              .groups = "drop")

次に、カウントコース球種ごとのwOBAを求め、usageと掛け合わせてカウントコース球種ごとのPMEを出します。

 P<- x %>%
    group_by(pitcher, count, counttype, pitchzone) %>%
    summarize(PA = n(),
              wOBA_c = sum(wOBA_c) / PA,
              .groups = "drop") %>% 
    inner_join(y, by = c("count""pitchzone""pitcher")) %>%
    mutate(prob = 100 * PA / tPA,
           wOBA = wOBA_c * prob,
           PME = wOBA * usage) %>%
    distinct()
Buehlerのデータの一部

最後に投手ごとにPME値の和を求めたら完成。

PME<- P %>%
  group_by(pitcher) %>%
  summarize(PME = sum(PME))

MLBIDデータと結合し、1250球以上投球した人に限定してPMEの小さい順に並べた表がこれ。
(idデータの入手先を見つけ次第貼る)

記事に近い値が出たからヨシ!!
入手したデータにPSの試合が含まれてたり、投球ゾーンの設定に誤差があったりで微妙にズレてるのだと思います。

wOBAとの関係を示したグラフも真似たけど、
これ以上書き進める余力ないからおしまい。

最後までありがとうございました。

追記する余裕ができたら追記しよっと。

この記事が気に入ったらサポートをしてみませんか?