Rとretrosheetデータで、XRみたいな指標を計算する
はじめに 手元でセイバーメトリクス
イチローと松井、どちらが凄いのかを考えます。
ヒットを量産するイチロー。長打力の松井。打者のタイプが異なります。どうやって比べましょうか。
セイバーメトリクスでは、打撃総合能力を表す指標がいくつか提案されています。
今回はXRという指標に注目します。
表式は以下の通り(長いので少し省略があります)。
\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年のメジャーリーグ全試合全打席結果のデータです。
イチローも松井も、まだ元気だった頃です。
計算の準備
まずはパッケージとデータの準備をします。
library(dplyr)
library(data.table)
library(tidyr)
## retrosheetパッケージを作りました!! 使って下さい!!
## devtools::install_github("gghatano/retrosheet")
library(retrosheet)
## データの用意。
dat = retrosheet(2005)
## 内容確認 データのサイズ
dat %>% dim
## [1] 191825 97
## 内容確認 データの項目
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列で表されています。
## ここで使うデータ
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
## 試合別、ホーム/アウェイ別の得点
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の詳細はこのページに書いてありますが、今回利用するところだけ抜粋します。
EVENT_CDと内容は、
- 2 : 凡打
- 3 : 三振
- 4 : 盗塁
- 6 : 盗塁死
- 14 : 四球
- 15 : 敬遠四球
- 16 : 死球
- 20 : 単打
- 21 : 二塁打
- 22 : 三塁打
- 23 : 本塁打
です。それぞれのイベントが出現した回数を、試合とチームごとに集計します。
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本塁打だったみたいですね。
ちゃんとできているように見えます。
線形回帰
準備が整ったので、テーブルを結合して線形回帰します。
試合-得点テーブルと、試合-イベント回数テーブルを結合します。
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
## 線形回帰
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の定義式:
\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:
\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パッケージに、通算成績データが入っています。
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
## 松井の成績
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
## 今回計算する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)のランキングを見てみましょう。
## 歴代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位までバリーボンズです。ステロイド全盛期とはいえ、さすがです。
では、イチローと松井の成績を出してみましょう。
## シーズン通算の創出得点ランキング
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アウトとられるまでに何点取れるか、というものです。
## 打席あたりの創出得点
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打席あたりでは松井が優れていました。
以上です。