retrosheetデータで、XRみたいな指標の計算をしたい

Rとretrosheetデータで、XRみたいな指標を計算する
====

## はじめに 手元でセイバーメトリクス

イチローと松井、どちらが凄いのかを考えます。

ヒットを量産するイチロー。長打力の松井。打者のタイプが異なります。どうやって比べましょうか。

セイバーメトリクスでは、打撃総合能力を表す指標がいくつか提案されています。

今回は[XR](http://baseballconcrete.web.fc2.com/glossary.html#xr)という指標に注目します。

表式は以下の通り(長いので少し省略があります)。

```math
\begin{aligned}
\text{XR} & = 0.50\times \text{単打数} + 0.72 \times \text{二塁打数} + 1.04 \times {三塁打数} \\
          & + 1.44 \times \text{本塁打数} + 0.34 \times \text{四死球数} +  0.25 \times \text{敬遠数} \\ 
          & + 0.18 \times \text{盗塁数} - 0.098 \times{三振数} + \ldots 
\end{aligned}
```

XRは、選手が生み出した総得点を算出するための指標です。

とはいったものの、各打席結果に、価値の重みをつけて線型和をとっているだけです。

本塁打は1本あたり1.44点生み出す、という気持ちで作られています。

なるほど。

...この重み係数はどこから来たのでしょうか。自分で計算してみたいです。

やってみました。

## 線形回帰でヒットとホームランの価値を計算

2005年のメジャーリーグの試合結果データを利用して、重み係数を作成します。

チーム得点 ~ 単打数 + 二塁打数 + 三塁打数 + 本塁打数 + 四球数 + 盗塁数 + 盗塁失敗数 + 三振数 + 凡打数 

という線型モデルを立てて、係数を推定します。

これにより、各イベントの生み出す得点数を調べます。

利用するデータは2005年のメジャーリーグ全試合全打席結果のデータです。

イチローも松井も、まだ元気だった頃です。

### 計算の準備

まずはパッケージとデータの準備をします。

```r
library(dplyr)
library(data.table)
library(tidyr)

## retrosheetパッケージを作りました!! 使って下さい!!
## devtools::install_github("gghatano/retrosheet")
library(retrosheet)

## データの用意。
dat = retrosheet(2005)

## 内容確認 データのサイズ
dat %>% dim
```

```
## [1] 191825     97
```

```r
## 内容確認 データの項目
dat %>% names
```

```
##  [1] "GAME_ID"                   "AWAY_TEAM_ID"             
##  [3] "INN_CT"                    "BAT_HOME_ID"              
##  [5] "OUTS_CT"                   "BALLS_CT"                 
##  [7] "STRIKES_CT"                "PITCH_SEQ_TX"             
##  [9] "AWAY_SCORE_CT"             "HOME_SCORE_CT"            
## [11] "BAT_ID"                    "BAT_HAND_CD"              
## [13] "RESP_BAT_ID"               "RESP_BAT_HAND_CD"         
## [15] "PIT_ID"                    "PIT_HAND_CD"              
## [17] "RESP_PIT_ID"               "RESP_PIT_HAND_CD"         
## [19] "POS2_FLD_ID"               "POS3_FLD_ID"              
## [21] "POS4_FLD_ID"               "POS5_FLD_ID"              
## [23] "POS6_FLD_ID"               "POS7_FLD_ID"              
## [25] "POS8_FLD_ID"               "POS9_FLD_ID"              
## [27] "BASE1_RUN_ID"              "BASE2_RUN_ID"             
## [29] "BASE3_RUN_ID"              "EVENT_TX"                 
## [31] "LEADOFF_FL"                "PH_FL"                    
## [33] "BAT_FLD_CD"                "BAT_LINEUP_ID"            
## [35] "EVENT_CD"                  "BAT_EVENT_FL"             
## [37] "AB_FL"                     "H_FL"                     
## [39] "SH_FL"                     "SF_FL"                    
## [41] "EVENT_OUTS_CT"             "DP_FL"                    
## [43] "TP_FL"                     "RBI_CT"                   
## [45] "WP_FL"                     "PB_FL"                    
## [47] "FLD_CD"                    "BATTEDBALL_CD"            
## [49] "BUNT_FL"                   "FOUL_FL"                  
## [51] "BATTEDBALL_LOC_TX"         "ERR_CT"                   
## [53] "ERR1_FLD_CD"               "ERR1_CD"                  
## [55] "ERR2_FLD_CD"               "ERR2_CD"                  
## [57] "ERR3_FLD_CD"               "ERR3_CD"                  
## [59] "BAT_DEST_ID"               "RUN1_DEST_ID"             
## [61] "RUN2_DEST_ID"              "RUN3_DEST_ID"             
## [63] "BAT_PLAY_TX"               "RUN1_PLAY_TX"             
## [65] "RUN2_PLAY_TX"              "RUN3_PLAY_TX"             
## [67] "RUN1_SB_FL"                "RUN2_SB_FL"               
## [69] "RUN3_SB_FL"                "RUN1_CS_FL"               
## [71] "RUN2_CS_FL"                "RUN3_CS_FL"               
## [73] "RUN1_PK_FL"                "RUN2_PK_FL"               
## [75] "RUN3_PK_FL"                "RUN1_RESP_PIT_ID"         
## [77] "RUN2_RESP_PIT_ID"          "RUN3_RESP_PIT_ID"         
## [79] "GAME_NEW_FL"               "GAME_END_FL"              
## [81] "PR_RUN1_FL"                "PR_RUN2_FL"               
## [83] "PR_RUN3_FL"                "REMOVED_FOR_PR_RUN1_ID"   
## [85] "REMOVED_FOR_PR_RUN2_ID"    "REMOVED_FOR_PR_RUN3_ID"   
## [87] "REMOVED_FOR_PH_BAT_ID"     "REMOVED_FOR_PH_BAT_FLD_CD"
## [89] "PO1_FLD_CD"                "PO2_FLD_CD"               
## [91] "PO3_FLD_CD"                "ASS1_FLD_CD"              
## [93] "ASS2_FLD_CD"               "ASS3_FLD_CD"              
## [95] "ASS4_FLD_CD"               "ASS5_FLD_CD"              
## [97] "EVENT_ID"
```

97列もあります。各列の説明するだけでも大変です。

試合の各状況が1行に表されている、ということだけ分かっていればいいです。

2013年はレギュラーシーズン全体で``191825``イベントがあった、ということです。

使う列の意味は、使うときに説明します。

### 試合-得点テーブルを作成

線形回帰の目的変数用データが必要です。

試合ID、ホームチームなのかビジターチームなのか、得点、という3列のテーブルを作ります。

試合IDはGAME\_ID列。ホームorビジターの得点はHOME\_SCORE\_CT, AWAY\_SCOCE\_CT列で表されています。


```r
## ここで使うデータ
dat_score = 
  dat %>%
  filter(GAME_END_FL == "T") %>% ## 1試合の最後の行である、という意味
  select(GAME_ID, AWAY_SCORE_CT, HOME_SCORE_CT) 

## 内容確認
dat_score %>% head(1)
```

```
##         GAME_ID AWAY_SCORE_CT HOME_SCORE_CT
## 1: ANA200504050             2             3
```

```r
## 試合別、ホーム/アウェイ別の得点
dat_score_all = 
  dat_score %>% 
  gather(HOME_AWAY, SCORE, -GAME_ID) %>% 
  mutate(HOME_AWAY_FLG = ifelse(HOME_AWAY=="HOME_SCORE_CT", 1, 0)) %>%
  select(-HOME_AWAY)
    
## 結果の確認
## GAME_IDの試合で、HOME/AWAYチームがSCORE点をとった。
dat_score_all %>% head(1)
```

```
##        GAME_ID SCORE HOME_AWAY_FLG
## 1 ANA200504050     2             0
```

1行目を見ると、2005年04月05日のビジターチームは、2点とったみたいです。

### 試合ごとに、各打撃イベントの発生回数を集計

各種イベントの回数を集計します。

GAME\_IDとHOME/AWAY, さらにEVENT\_CD列(イベントコード)を利用します。

EVENT\_CDの詳細は[このページ](http://www.retrosheet.org/datause.txt)に書いてありますが、今回利用するところだけ抜粋します。

EVENT\_CDと内容は、

* 2  : 凡打
* 3  : 三振
* 4  : 盗塁
* 6  : 盗塁死
* 14 : 四球
* 15 : 敬遠四球
* 16 : 死球
* 20 : 単打
* 21 : 二塁打
* 22 : 三塁打
* 23 : 本塁打

です。それぞれのイベントが出現した回数を、試合とチームごとに集計します。


```r
dat_game = 
  dat %>% 
  select(GAME_ID, BAT_HOME_ID, EVENT_CD) %>% 
  filter(EVENT_CD %in% c(2:4,6,14:16, 20:23)) 

## 各イベントのフラグを立てます
dat_game_event = 
  dat_game %>% 
  mutate(generic_out = ifelse(EVENT_CD == 2, 1, 0)) %>%
  mutate(strike_out = ifelse(EVENT_CD == 3, 1, 0)) %>%
  mutate(steal_base = ifelse(EVENT_CD == 4, 1, 0)) %>%
  mutate(caught_stealing = ifelse(EVENT_CD == 6, 1, 0)) %>%
  mutate(bb = ifelse(EVENT_CD %in% c(14,16), 1, 0)) %>%
  mutate(intentional = ifelse(EVENT_CD == 15, 1, 0)) %>%
  mutate(single = ifelse(EVENT_CD == 20, 1, 0))  %>%
  mutate(double = ifelse(EVENT_CD == 21, 1, 0)) %>%
  mutate(triple = ifelse(EVENT_CD == 22, 1, 0)) %>%
  mutate(homerun = ifelse(EVENT_CD == 23, 1, 0)) %>%
  select(-EVENT_CD) %>% 
  mutate(HOME_AWAY_FLG = BAT_HOME_ID) %>%
  select(-BAT_HOME_ID)

## 各イベント列でsumを取れば回数が出てきます。
## summarise_eachを使えば簡単です。
dat_game_event_count = 
  dat_game_event %>%
  group_by(GAME_ID, HOME_AWAY_FLG) %>%
  summarise_each(funs(sum))

## 結果の確認
dat_game_event_count %>% head(1)
```

```
##        GAME_ID HOME_AWAY_FLG generic_out strike_out steal_base
## 1 ANA200504050             0          17          8          0
##   caught_stealing bb intentional single double triple homerun
## 1               0  6           0      4      2      0       1
```
2005年4月5日のANA(エンゼルス)の試合で、アウェイチームが8三振6四球, 4単打2二塁打1本塁打だったみたいですね。

ちゃんとできているように見えます。

### 線形回帰

準備が整ったので、テーブルを結合して線形回帰します。

試合-得点テーブルと、試合-イベント回数テーブルを結合します。


```r
dat_score_event_count = 
  dat_score_all %>% 
  inner_join(dat_game_event_count, by = c("GAME_ID", "HOME_AWAY_FLG")) %>% 
  select(-GAME_ID, -HOME_AWAY_FLG) 


## 結合結果. 
## SCORE点とった試合で、各イベントが何回あったか、という表です。
dat_score_event_count %>% head(1)
```

```
##   SCORE generic_out strike_out steal_base caught_stealing bb intentional
## 1     2          17          8          0               0  6           0
##   single double triple homerun
## 1      4      2      0       1
```

```r
## 線形回帰
lm_res = lm(dat_score_event_count, formula = SCORE ~ .)

## 推定された係数
lm_coef = coef(lm_res)
lm_coef
```

```
##     (Intercept)     generic_out      strike_out      steal_base 
##      0.63012469     -0.11857960     -0.12262584      0.08676059 
## caught_stealing              bb     intentional          single 
##     -0.36105497      0.33566397      0.09889731      0.46789201 
##          double          triple         homerun 
##      0.76494241      1.03139625      1.39726489
```

ホームラン1本は1.41点生み出す、という結果です。

先ほどのXRの定義式では、係数は1.44でした。大体同じですね。

XRの定義式: 

```math
\begin{aligned}
\text{XR} & = 0.50\times \text{単打数} + 0.72 \times \text{二塁打数} + 1.04 \times {三塁打数} \\
          & + 1.44 \times \text{本塁打数} + 0.34 \times \text{四死球数} +  0.25 \times \text{敬遠数} \\ 
          & + 0.18 \times \text{盗塁数} - 0.098 \times{三振数} + \ldots .
\end{aligned}
```

今回、線形回帰で得られたXR:

```math
\begin{aligned}
\text{XR} & = 0.47\times \text{単打数} + 0.76 \times \text{二塁打数} + 1.03 \times {三塁打数} \\
          & + 1.40 \times \text{本塁打数} + 0.33 \times \text{四死球数} +  0.10 \times \text{敬遠数} \\ 
          & + 0.09 \times \text{盗塁数} - 0.12 \times{三振数} + \ldots 
\end{aligned}.
```

盗塁の係数が大きく異なっています。どうしましょうか。分からないので、無視します。

今回の線形回帰によって得られた係数によって、イチローと松井の打撃能力を評価してみます.

## イチローと松井の打撃能力

イベント重み係数から、得点創出能力XR(の簡易版)を計算してみます。

RのLahmanパッケージに、通算成績データが入っています。


```r
library(Lahman)

## 打撃成績を整理
batting_stats = 
  Batting %>% 
  mutate(X1B = H - X2B - X3B - HR) %>%
  mutate(GO = AB - H - SO) %>% 
  mutate(BB = BB + HBP) %>% 
  select(playerID, yearID, GO, AB, X1B, X2B, X3B, HR, SB, CS, BB, IBB, HBP, SO) 

## 選手情報のマスター
master_stats =
  Master %>% 
  mutate(name = paste(nameFirst, nameLast, sep = " ")) %>%
  select(playerID, name)
  
## IDと結合して、フルネームを取得する
batting_master = 
  batting_stats %>% 
  inner_join(master_stats, by = "playerID") 

## イチローの成績
batting_master %>% 
  select(-playerID) %>%
  filter(name == "Ichiro Suzuki")
```

```
##    yearID  GO  AB X1B X2B X3B HR SB CS BB IBB HBP SO          name
## 1    2001 397 692 192  34   8  8 56 14 38  10   8 53 Ichiro Suzuki
## 2    2002 377 647 165  27   8  8 31 15 73  27   5 62 Ichiro Suzuki
## 3    2003 398 679 162  29   8 13 34  8 42   7   6 69 Ichiro Suzuki
## 4    2004 379 704 225  24   5  8 36 11 53  19   4 63 Ichiro Suzuki
## 5    2005 407 679 158  21  12 15 33  8 52  23   4 66 Ichiro Suzuki
## 6    2006 400 695 186  20   9  9 45  2 54  16   5 71 Ichiro Suzuki
## 7    2007 363 678 203  22   7  6 37  8 52  13   3 77 Ichiro Suzuki
## 8    2008 408 686 180  20   7  6 43  4 56  12   5 65 Ichiro Suzuki
## 9    2009 343 639 179  31   4 11 26  9 36  15   4 71 Ichiro Suzuki
## 10   2010 380 680 175  30   3  6 42  9 48  13   3 86 Ichiro Suzuki
## 11   2011 424 677 154  22   3  5 40  7 39  13   0 69 Ichiro Suzuki
## 12   2012 257 402  81  15   5  4 15  2 17   4   0 40 Ichiro Suzuki
## 13   2012 133 227  54  13   1  5 14  5  7   1   2 21 Ichiro Suzuki
## 14   2013 321 520 111  15   3  7 20  4 27   4   1 63 Ichiro Suzuki
## 15   2014 189 359  86  13   2  1 15  3 22   1   1 68 Ichiro Suzuki
```

```r
## 松井の成績
batting_master %>% 
  select(-playerID) %>%
  filter(name == "Hideki Matsui") 
```

```
##    yearID  GO  AB X1B X2B X3B HR SB CS BB IBB HBP  SO          name
## 1    2003 358 623 120  42   1 16  2  2 66   5   3  86 Hideki Matsui
## 2    2004 307 584 107  34   2 31  3  0 91   2   3 103 Hideki Matsui
## 3    2005 359 629 121  45   3 23  2  2 66   7   3  78 Hideki Matsui
## 4    2006  97 172  35   9   0  8  1  0 27   2   0  23 Hideki Matsui
## 5    2007 318 547  99  28   4 25  4  2 76   2   3  73 Hideki Matsui
## 6    2008 191 337  73  17   0  9  0  0 41   6   3  47 Hideki Matsui
## 7    2009 256 456  75  21   1 28  0  1 68   1   4  75 Hideki Matsui
## 8    2010 252 482  86  24   1 21  0  1 68   6   1  98 Hideki Matsui
## 9    2011 303 517  90  28   0 12  1  1 57   3   1  84 Hideki Matsui
## 10   2012  59  95  11   1   0  2  0  0  8   1   0  22 Hideki Matsui
```

```r
## 今回計算するXRの簡易版を, ggXRとします。
## 線型和をとればいいです。
batting_ggXR = 
  batting_master %>% 
  mutate(ggXR = GO * lm_coef["generic_out"] + 
                X1B * lm_coef["single"] + 
                X2B * lm_coef["double"] + 
                X3B * lm_coef["triple"] + 
                HR  * lm_coef["homerun"] + 
                SB  * lm_coef["steal_base"] + 
                CS  * lm_coef["caught_stealing"] + 
                BB  * lm_coef["bb"] + 
                IBB  * lm_coef["intentional"] + 
                SO  * lm_coef["strike_out"])
```

内容の確認をします。

歴代の得点創出能力(ggXR)のランキングを見てみましょう。

```r
## 歴代ggXRのランキング
batting_ggXR %>% 
  arrange(desc(ggXR)) %>% 
  select(-playerID) %>%
  head(10)
```

```
##    yearID  GO  AB X1B X2B X3B HR SB CS  BB IBB HBP  SO           name
## 1    2004 197 373  60  27   3 45  6  1 241 120   9  41    Barry Bonds
## 2    2001 227 476  49  32   2 73 13  3 186  35   9  93    Barry Bonds
## 3    2002 207 403  70  31   2 46  9  2 207  68   9  47    Barry Bonds
## 4    1998 202 509  61  21   0 70  1  0 168  28   6 155   Mark McGwire
## 5    2001 235 577  86  34   5 64  0  2 122  37   6 153     Sammy Sosa
## 6    2000 303 580 113  59   2 42  5  3 107  22   4  61    Todd Helton
## 7    2001 328 609  98  36   7 57  1  1 114  24  14  83  Luis Gonzalez
## 8    2000 269 569  97  57   1 41  0  1 138  18  15 104 Carlos Delgado
## 9    1997 270 568 109  46   4 49 33  8  92  14  14  90   Larry Walker
## 10   2009 318 568  93  45   1 47 16  4 124  44   9  64  Albert Pujols
##        ggXR
## 1  179.2324
## 2  179.0859
## 3  168.7594
## 4  158.7011
## 5  158.0888
## 6  152.7839
## 7  151.5481
## 8  150.3962
## 9  147.9666
## 10 145.0006
```

歴代の得点創出能力、Top10です。パワーヒッターしかいません。

1位から3位までバリーボンズです。ステロイド全盛期とはいえ、さすがです。

では、イチローと松井の成績を出してみましょう。


```r
## シーズン通算の創出得点ランキング
batting_ggXR %>%
  filter(name %in% c("Ichiro Suzuki", "Hideki Matsui")) %>% 
  arrange(desc(ggXR)) %>% 
  select(yearID, name, ggXR) %>%
  head
```

```
##   yearID          name      ggXR
## 1   2004 Ichiro Suzuki 106.12334
## 2   2004 Hideki Matsui 103.41959
## 3   2005 Hideki Matsui  96.43124
## 4   2001 Ichiro Suzuki  95.24535
## 5   2007 Ichiro Suzuki  93.98948
## 6   2006 Ichiro Suzuki  90.93676
```

打席数が多かったイチローは、シーズン通算での創出得点が多いです。

打席数で割ることで、打席辺りの創出得点が計算されます。

セイバーメトリクスでは、XR27と呼ばれる指標に該当します。

27アウトとられるまでに何点取れるか、というものです。


```r
## 打席あたりの創出得点
batting_ggXR %>% 
  filter(name %in% c("Ichiro Suzuki", "Hideki Matsui")) %>% 
  mutate(ggXR27 = ggXR * 27 / (AB + BB + IBB + HBP)) %>%
  arrange(desc(ggXR27)) %>%
  select(yearID, name, ggXR, ggXR27) %>%
  head
```

```
##   yearID          name      ggXR   ggXR27
## 1   2004 Hideki Matsui 103.41959 4.106366
## 2   2006 Hideki Matsui  29.46369 3.957809
## 3   2009 Hideki Matsui  74.32018 3.793280
## 4   2005 Hideki Matsui  96.43124 3.693112
## 5   2007 Hideki Matsui  85.47009 3.674670
## 6   2004 Ichiro Suzuki 106.12334 3.673500
```

1打席あたりで計算すると、松井が凄いみたいです。

ちなみに、XR27の値4.10は、今年のセリーグではエルナンデス(4.08)、パ・リーグではクルーズ(4.11)くらいです。

創出得点の意味では、そこそこ活躍した外国人、という程度の成績です。寂しい。

## まとめ

打撃能力評価のために創出得点を計算して、イチローと松井の成績を比較してみました。

セイバーメトリクスでは、XRと呼ばれる指標です。

線形回帰によって打撃イベントの価値重みを計算すると、セイバーメトリクスの内容と似た結果が得られました。

比べてみると、シーズン通算ではイチローが、1打席あたりでは松井が優れていました。

以上です。