1 ダウンロード

# インストールしていない場合, 
# コメントアウト (#) をはずしてインストール
# install.packages("tidyverse")
# install.packages("devtools")
# devtools::install_github("BillPetti/baseballr")

# 必要なパッケージをロード
require(baseballr)
require(tidyverse)
require(lubridate) # tidyversをインストールすれば同時にインストールされているはず

# data取得 ----
# baseballrのscrape_statcast_savant_batter_all()を使う
# 取得に利用する日付データを作成する
# 試しに2018の3/26から4/30までとする
# 当然真面目に計算するなら年単位で計算したほうがいい

# ymd()はlubridateの関数で, dateの列を作る
start.dates <- c(seq(ymd('2018-03-26'), ymd('2018-04-25'), by = 6))
end.dates  <- c(seq(ymd('2018-03-31'), ymd('2018-04-30'), by = 6))

df.dates <- data.frame(start.dates, end.dates)

# player nameに打者名が入ったデータをダウンロードする
# df.datesの行を日付範囲として利用
# 予め作成した行の長さを持つリストに保存するのを
# 行の長さ回数繰り返す

# df.datesの行の長さ (ダウンロード回数) を取得
# この場合6
rows <- 1:nrow(df.dates)

# df.datesの行の長さのlistを作成
batter <- vector("list", length = length(rows))
data.size <- vector("list", length = length(rows))
# pitcher <- vector("list", length = length(rows)) 
# player nameが投手のデータが必要な場合, 上のコメントアウトを外す

# データをdfとして取得してリストに放り込んでいく
# あとでbind_row()でdfに変換
# これくらいの期間の長さならdfのままrbind()していってもいいだろう
for (i in 1:nrow(df.dates)){
  # i行の日付でダウンロード
  temp.batter <- scrape_statcast_savant_batter_all(as.character(df.dates[i,1]), 
                                                   as.character(df.dates[i, 2]))
  # ダウンロードしたデータをbatterのi番目にいれる
  batter[[i]] <- temp.batter
  
  # player nameが投手のデータが必要な場合, 下の3行のコメントアウトを外す
  # temp.pitcher <- scrape_statcast_savant_pitcher_all(as.character(df.dates[i,1]), 
  #                                                    as.character(df.dates[i, 2]))
  # pitcher[[i]] <- temp.pitcher
  
  
  # ダウンロードしたデータの行の長さをいれていく
  data.size[[i]] <- nrow(temp.batter)
  
  print(paste(i, "th row of ", nrow(df.dates)))
  
  # ループごとにポーズ
  Sys.sleep(5)    
}

# dataの長さを確認 
# 30000が上限
# 超えている場合そのダウンロードでは取得できていないデータがある
data.size
# OK

# batterをdfに変換
batter <- bind_rows(batter)
# pitcher <- bind_rows(pitcher)

save(batter, file = "SC18_0326_0430.rdata")

2 計算

load("SC18_0326_0430.rdata")

# 打席のIDやカウントなどの列をつくる
batter <- batter %>% 
  mutate(AB_ID = paste(game_date, game_pk, at_bat_number,  sep = "-"),
         game_year = as.factor(game_year),
         BS_CT = paste(balls, strikes, sep = "-"),
         BSO = paste(BS_CT, outs_when_up, sep = " "),
         S_FL = ifelse(type == "S", 1, 0),
         B_FL = ifelse(type == "B", 1, 0),
         BIP_FL = ifelse(type == "X", 1, 0))
# game_pkは試合のID
# つまりAB_IDはgame_pk, at_bat_numberだけでいい
# 日付があると変な結果が出たときにどこがおかしいか確認するときに手間が省けるかも

# 計算 ----
# 1: 初球にボール or ストライクの確率を計算する
# 2: 2ストライクからファウルの頻度を計算する

# 必要な変数を確認する ----
# 打席の何球目かはpitch_number
# 打席開始前のカウントはballs, strikes
# その投球の結果はtype
batter%>%
  arrange(pitch_number)%>%
  select(AB_ID, pitch_number, BS_CT, type)

# 初球で0-0. つまり開始前のカウント
# typeは
# S: strike
# B: Ball
# X: 打球 (つまりballs in play, BIP)

# ファウルかどうかはdescriptionに記載
batter %>%
  pull(description)%>%
  unique()

# "foul", "foul_bunt", "foul_tip"をファウルとする
des.foul <- c("foul", "foul_bunt", "foul_tip")

# 上の3種類のfoulのtypeを調べる
batter %>%
  filter(description %in% des.foul)%>%
  pull(type)%>%
  unique()
# 全てS
# つまりアウトになったfoul flyはXになっている

# 1を計算する ----
# 初球かつtypeが記録されたデータに絞る
# それのSとBの割合を作ったflagで計算する
batter%>%
  filter(pitch_number == 1, 
         is.na(type) ==  FALSE)%>%
  summarise(N =n(),
            S = mean(S_FL),
            B = mean(B_FL),
            X = mean(BIP_FL))
#        N     S     B     X
#    <int> <dbl> <dbl> <dbl>
#  1 32280 0.497 0.401 0.102

# 2を計算する ----
# foulかどうかを示すflagをつくる
batter <- batter %>% 
  mutate(Foul_FL =  ifelse(description %in% des.foul, 1, 0))

# Sが2の状態で各打席における投球数とfoulの数を数える
# 投球数 (行数) とfoulの頻度を計算する
batter%>%
  filter(strikes == 2,
         is.na(description) == FALSE)%>%
  summarise(N = n(),
            Foul_freq = mean(Foul_FL))

#　　　　N Foul_freq
#　　<int>     <dbl>
#  1 36793     0.236

# BSカウントでデータを分割し集計する場合
batter%>%
  filter(strikes == 2,
         is.na(description) == FALSE)%>%
  group_by(BS_CT)%>%
  summarise(N = n(),
            Foul_freq = mean(Foul_FL),
            S_freq = mean(S_FL) - Foul_freq,
            B_freq = mean(B_FL),
            BIP_freq = mean(BIP_FL))
#   BS_CT     N Foul_freq S_freq B_freq X_freq
#  <chr>   <int>     <dbl>  <dbl>  <dbl>  <dbl>
# 1 0-2    8049     0.190  0.183  0.458  0.168
# 2 1-2   11931     0.215  0.190  0.390  0.204
# 3 2-2   10408     0.253  0.195  0.310  0.242
# 4 3-2    6405     0.302  0.174  0.230  0.294

# さらにアウトカウントでも分ける場合
batter%>%
  filter(strikes == 2,
         is.na(description) == FALSE)%>%
  group_by(BS_CT, outs_when_up)%>%
  summarise(N = n(),
            Foul_freq = mean(Foul_FL))
# 影響はなさそう?

# コードがworkしているか確認するため
# 極端なfoul数になった打席を調べておく
# AB IDごとに分割し投球数 (行数) とfoul数をカウントする
foul.with.2S <- 
  batter%>%
  filter(strikes == 2,
         is.na(description) == FALSE)%>%
  group_by(AB_ID)%>%
  summarise(Pitch_CT = n(),
            Foul_CT = sum(Foul_FL))

# foulが多い打席を調べる
foul.with.2S %>%
  arrange(desc(Foul_CT))%>%
  print(n = 10)

# Foul_CTが15とかいう打席があるので中身を確認
batter %>%
  filter(AB_ID == "2018-04-22-529732-2")%>%
  arrange(pitch_number)%>%
  select(player_name, pitch_number, type, description, events, BSO)%>%
  print(n = Inf)
# Brandon Belt
# "Brandon Belt Foul" ググれば動画付きの記事がでてくる

3 参考

Statcast data are property of MLB advanced media.

Marchi, Albert, and Baumer., Analyzing Baseball Data with R, Second Edition, 2018. (Github)

https://github.com/statsbylopez/mlb-shirking/blob/master/Code/scraping.R

初球からのカウント遷移確率など

Author: @sleep_in_nmbrs

2019-02-02

1 ダウンロード

2 計算

3 参考