TokyoR 打撃結果データの利用例
2026-08-09
野球のデータ解析: 打撃データの確認
retroSheetからダウンロードしてパースしたデータを利用します.
2013年主要打者100人の打撃結果のデータファイル
data/derived/batters-2013.csv を使って,
データの中身を確認します.
library(data.table)
library(dplyr)
library(ggplot2)
library(knitr)
source("../../R/retrosheet.R")
dat <- fread("../../data/derived/batters-2013.csv")
fullname <- fread("../../data/derived/player-names.csv")
# 1打席の状況を, 97種のデータで表現しています
ncol(dat)## [1] 97各打席の結果は97個のデータで表現されています. 各列の意味は http://www.retrosheet.org/datause.txt にありますが, これを読むのは大変なので, 使いながら説明します.
打率の集計
打者ごとに, ヒット数を打数で割れば打率になります.
使う列は3つです.
BAT_ID打者AB_FL打数として数える打席か (四死球や犠打は含まない)H_FL何塁打を打ったか (0なら安打でない, 4なら本塁打)
昔の fread は "T" / "F" を
logical として読んでいたので sum(AB_FL)
がそのまま動きましたが, 今は character です. R/retrosheet.R
の as_flag() で変換します.
dat_average <-
dat |>
as_tibble() |>
mutate(打数 = as_flag(AB_FL), 安打 = H_FL > 0) |>
summarise(atbat = sum(打数), hit = sum(安打 & 打数), bases = sum(H_FL),
.by = BAT_ID) |>
mutate(average = hit / atbat, slug = bases / atbat) |>
inner_join(fullname, by = c("BAT_ID" = "retroID"))
dat_average |>
arrange(desc(average)) |>
select(名前 = name, 打数 = atbat, 安打 = hit, 打率 = average) |>
head(10) |>
kable(digits = 4)| 名前 | 打数 | 安打 | 打率 |
|---|---|---|---|
| Miguel Cabrera | 554 | 193 | 0.3484 |
| Mike Trout | 589 | 190 | 0.3226 |
| Freddie Freeman | 551 | 176 | 0.3194 |
| Matt Carpenter | 626 | 199 | 0.3179 |
| Andrew McCutchen | 583 | 185 | 0.3173 |
| Adrian Beltre | 631 | 199 | 0.3154 |
| Allen Craig | 508 | 160 | 0.3150 |
| Robinson Cano | 605 | 190 | 0.3140 |
| David Ortiz | 518 | 160 | 0.3089 |
| Joey Votto | 581 | 177 | 0.3046 |
得点圏打率
もっと条件のついた打率も出せます. 走者の位置は
BASE1_RUN_ID 〜 BASE3_RUN_ID
に走者のIDが入っていて, 空欄なら走者なしです.
dat_runner <-
dat |>
as_tibble() |>
filter(as_flag(AB_FL)) |>
mutate(走者 = base_state(dat[as_flag(dat$AB_FL)]),
安打 = H_FL > 0) |>
summarise(atbat = n(), hit = sum(安打), .by = c(BAT_ID, 走者))
dat_runner |>
inner_join(fullname, by = c("BAT_ID" = "retroID")) |>
filter(name == "Mike Trout") |>
mutate(走者 = base_state_label(走者), 打率 = hit / atbat) |>
select(走者, 打数 = atbat, 安打 = hit, 打率) |>
kable(digits = 4)| 走者 | 打数 | 安打 | 打率 |
|---|---|---|---|
| 一二塁 | 30 | 5 | 0.1667 |
| 一塁 | 94 | 24 | 0.2553 |
| 走者なし | 359 | 122 | 0.3398 |
| 二塁 | 48 | 18 | 0.3750 |
| 一三塁 | 21 | 8 | 0.3810 |
| 二三塁 | 11 | 5 | 0.4545 |
| 三塁 | 14 | 5 | 0.3571 |
| 満塁 | 12 | 3 | 0.2500 |
得点圏は二塁または三塁に走者がいる場面です. base_state()
は一塁=1, 二塁=2, 三塁=4 のビット和なので, 2以上が得点圏です.
dat_scoring <-
dat_runner |>
mutate(得点圏 = 走者 >= 2) |>
summarise(atbat = sum(atbat), hit = sum(hit), .by = c(BAT_ID, 得点圏)) |>
mutate(average = hit / atbat)
dat_scoring |>
summarise(打数 = sum(atbat), 安打 = sum(hit), .by = 得点圏) |>
mutate(打率 = 安打 / 打数) |>
arrange(desc(得点圏)) |>
kable(digits = 4)| 得点圏 | 打数 | 安打 | 打率 |
|---|---|---|---|
| TRUE | 13427 | 3814 | 0.2841 |
| FALSE | 43851 | 11875 | 0.2708 |
全体では得点圏0.284, それ以外0.271で, チャンスのほうが13ポイント高くなっています.
走者がいると一塁手がベースに付くのでヒットゾーンが広がりますし, 投手も走者を気にします. 妥当な向きだと思います.
「チャンスに強い打者」は取り出せるか
得点圏打率と非得点圏打率の差を取って並べれば, チャンスに強い打者が 分かりそうな気がします. やってみます.
diff_tbl <-
dat_scoring |>
select(BAT_ID, 得点圏, atbat, average) |>
tidyr::pivot_wider(names_from = 得点圏, values_from = c(atbat, average)) |>
rename(得点圏打数 = atbat_TRUE, 他打数 = atbat_FALSE,
得点圏打率 = average_TRUE, 他打率 = average_FALSE) |>
mutate(差 = 得点圏打率 - 他打率) |>
inner_join(fullname, by = c("BAT_ID" = "retroID"))
diff_tbl |>
arrange(desc(差)) |>
select(name, 得点圏打数, 得点圏打率, 他打率, 差) |>
head(5) |>
kable(digits = 4)| name | 得点圏打数 | 得点圏打率 | 他打率 | 差 |
|---|---|---|---|---|
| Allen Craig | 130 | 0.4538 | 0.2672 | 0.1867 |
| Freddie Freeman | 131 | 0.4427 | 0.2810 | 0.1618 |
| Matt Holliday | 123 | 0.3902 | 0.2720 | 0.1182 |
| Michael Brantley | 120 | 0.3750 | 0.2592 | 0.1158 |
| Pablo Sandoval | 144 | 0.3542 | 0.2493 | 0.1048 |
が, この順位表は読めません.
得点圏の打数は1人あたり136打数ほどしかありません. 打率.260の打者が100打数で記録する打率は, 実力が一定でも 標準偏差0.044ほどばらつきます. 差を取れば, ばらつきはさらに大きくなります.
つまり上位に来るのは「チャンスに強い打者」ではなく, 「たまたま得点圏で当たった打者」である可能性が高いということです.
どのくらい偶然で説明できるか
実際に観測された差のばらつきと, 実力が全員同じでも生じる偶然のばらつきを 比べます.
obs_sd <- sd(diff_tbl$差)
# 打者ごとに、実力が「その打者のシーズン通算打率」で一定だとしたときの
# 差の標準誤差。二項分布から見積もる。
p <- (diff_tbl$得点圏打率 * diff_tbl$得点圏打数 + diff_tbl$他打率 * diff_tbl$他打数) /
(diff_tbl$得点圏打数 + diff_tbl$他打数)
noise_sd <- sqrt(mean(p * (1 - p) * (1 / diff_tbl$得点圏打数 + 1 / diff_tbl$他打数)))| 標準偏差 | |
|---|---|
| 実際に観測された差 | 0.0502 |
| 偶然だけで生じる差 | 0.0444 |
観測されたばらつきは, 偶然だけの見積もりと ほぼ同じか, わずかに大きい程度です.
もし「チャンスに強い」という安定した能力が打者ごとに存在するなら, 観測されたばらつきは偶然の分よりはっきり大きくなるはずです. そうなっていません.
diff_tbl |>
ggplot(aes(x = 差)) +
geom_histogram(bins = 25, fill = "grey70", colour = "white") +
stat_function(fun = \(x) dnorm(x, 0, noise_sd) * nrow(diff_tbl) *
diff(range(diff_tbl$差)) / 25,
colour = "red", linewidth = 1) +
geom_vline(xintercept = 0, linetype = "dashed") +
xlab("得点圏打率 − 非得点圏打率") +
ggtitle("赤線は「実力差なし」としたときに予想される分布")
ヒストグラムは赤線 (実力差なしのときの予想) にほぼ重なります.
結論
- 全体で見ると, 得点圏の打率はそれ以外より 13ポイント高い. これは場面の性質で説明がつく.
- 一方, 打者ごとの「チャンスの強さ」は, このデータからは取り出せない. 順位表は作れるが, 中身はほぼ偶然.
100人・1シーズンでは足りません. 仮に本当の能力差があったとしても, それを検出するにはもっと多くの打席が要ります.
おまけ: 走者状況別の打率ランキング
走者の状況ごとに打率上位を出します.
dat_runner |>
filter(atbat >= 20) |>
mutate(打率 = hit / atbat) |>
inner_join(fullname, by = c("BAT_ID" = "retroID")) |>
slice_max(打率, n = 3, by = 走者) |>
mutate(走者 = base_state_label(走者)) |>
select(走者, name, 打数 = atbat, 打率) |>
arrange(走者) |>
kable(digits = 4)| 走者 | name | 打数 | 打率 |
|---|---|---|---|
| 一三塁 | Chris Carter | 23 | 0.5217 |
| 一三塁 | Miguel Cabrera | 25 | 0.5200 |
| 一三塁 | Matt Holliday | 24 | 0.5000 |
| 一二塁 | Josh Donaldson | 39 | 0.4615 |
| 一二塁 | Freddie Freeman | 37 | 0.4595 |
| 一二塁 | Allen Craig | 39 | 0.4359 |
| 一塁 | Matt Carpenter | 65 | 0.4000 |
| 一塁 | Josh Donaldson | 116 | 0.3966 |
| 一塁 | Carlos Santana | 111 | 0.3964 |
| 三塁 | Daniel Murphy | 25 | 0.4800 |
| 三塁 | Ian Kinsler | 23 | 0.3913 |
| 三塁 | Adrian Beltre | 23 | 0.3913 |
| 二三塁 | Dustin Pedroia | 20 | 0.3000 |
| 二塁 | Billy Butler | 41 | 0.4878 |
| 二塁 | Brett Gardner | 31 | 0.4839 |
| 二塁 | Carlos Beltran | 42 | 0.4762 |
| 満塁 | Mike Napoli | 24 | 0.4583 |
| 満塁 | Jay Bruce | 23 | 0.3913 |
| 満塁 | Hunter Pence | 21 | 0.3810 |
| 走者なし | Mike Trout | 359 | 0.3398 |
| 走者なし | Andrew McCutchen | 321 | 0.3396 |
| 走者なし | Adrian Beltre | 328 | 0.3384 |
こちらも20打数以上に絞ってなお小標本なので, 順位そのものより 「その程度のばらつきがある」ことのほうを見てください.