野球のスコアと試合数

野球のスコア別に試合数を集計して, ありがちな試合を調べます.

もとはnysolのコマンド列で集計していました (当時の記事). 速くて良かったのですが, 数え方に穴があったので R で書き直します.

もとの数え方の穴

もとのコマンド列はこうでした.

cat ./batting_data.csv |
mcut f=GAME_ID,HOME_SCORE_CT,AWAY_SCORE_CT |
mstats k=GAME_ID f=HOME_SCORE_CT:HOME,AWAY_SCORE_CT:AWAY c=max |
mcal c='max(${HOME},${AWAY})' a=SCORE_WIN |
mcal c='min(${HOME},${AWAY})' a=SCORE_LOSE |
mcut f=SCORE_WIN,SCORE_LOSE |
mcount k=SCORE_WIN,SCORE_LOSE a=GAME |
msortf f=GAME%nr

問題は c=max です. HOME_SCORE_CT / AWAY_SCORE_CT は, そのプレーが起きる「前」のスコアです. 最大値を取ると, 最後のプレーで入った得点がまるごと抜けます. サヨナラ勝ちは必ず最後のプレーで点が入るので, 全部おかしくなります.

正しくは各プレーで本塁に到達した走者を数えます (R/retrosheet.R の game_final_scores()).

集計

library(data.table)
library(dplyr)
library(ggplot2)
library(knitr)
source("../../R/retrosheet.R")

DATA_DIR <- "../../data"
files <- sort(list.files(DATA_DIR, pattern = "^all[0-9]{4}\\.csv$", full.names = TRUE))
if (length(files) == 0) {
  stop("data/all<year>.csv がありません. data/README.md を参照してください.")
}
column_names <- unname(unlist(fread("../../data/reference/retrosheet-columns.csv", header = FALSE)))
need <- c("GAME_ID", "BAT_HOME_ID", "HOME_SCORE_CT", "AWAY_SCORE_CT",
          "BAT_DEST_ID", "RUN1_DEST_ID", "RUN2_DEST_ID", "RUN3_DEST_ID")

read_season <- function(path) {
  d <- fread(path, header = FALSE, select = match(need, column_names))
  setnames(d, need)
  d[, year := as.integer(sub(".*all([0-9]{4})\\.csv$", "\\1", path))]
  d
}

scores <- rbindlist(lapply(files, function(p) {
  d <- read_season(p)
  correct <- game_final_scores(d)
  naive   <- d[, .(home_naive = max(HOME_SCORE_CT),
                   away_naive = max(AWAY_SCORE_CT),
                   year = year[1]), by = GAME_ID]
  merge(correct, naive, by = "GAME_ID")
}))

76シーズン, 138,031試合です (1938年から2013年).

穴の大きさ

scores |>
  summarise(`試合数` = n(),
            `スコアが違う` = sum(home != home_naive | away != away_naive),
            `勝敗まで違う` = sum(sign(home - away) != sign(home_naive - away_naive)),
            `引き分けに化けた` = sum(home_naive == away_naive) - sum(home == away)) |>
  kable(format.args = list(big.mark = ","))

試合数	スコアが違う	勝敗まで違う	引き分けに化けた
138,031	13,051	12,908	11,490

9%の試合でスコアが違いました. 最後の打席で点が入る試合はそれだけ多い, ということです.

スコア別の試合数

tbl <-
  scores |>
  filter(home != away) |>          # 引き分けは除く (ほぼ無い)
  mutate(勝 = pmax(home, away), 負 = pmin(home, away)) |>
  count(勝, 負, name = "試合数") |>
  arrange(desc(試合数))

tbl |> head(10) |>
  mutate(割合 = 試合数 / sum(tbl$試合数)) |>
  kable(digits = 4, format.args = list(big.mark = ","))

勝	負	試合数	割合
3	2	7,964	0.0578
4	3	7,818	0.0568
2	1	6,345	0.0461
5	4	6,071	0.0441
4	2	5,111	0.0371
3	1	4,634	0.0336
5	3	4,505	0.0327
6	5	4,319	0.0314
5	2	4,167	0.0303
4	1	3,977	0.0289

一番ありがちなのは3-2で, 7,964試合, 全体の5.8%でした.

もとの記事では 3-2 が5,964試合と書いていました. 数え方が違うので値も違います.

tbl |>
  filter(勝 <= 12, 負 <= 12) |>
  ggplot(aes(x = 負, y = 勝, fill = 試合数)) +
  geom_tile() +
  geom_text(aes(label = ifelse(試合数 >= 4000, format(試合数, big.mark = ","), "")),
            size = 2.6, colour = "white") +
  scale_fill_viridis_c(transform = "sqrt", labels = scales::comma) +
  scale_x_continuous(breaks = 0:12) + scale_y_continuous(breaks = 0:12) +
  coord_fixed() +
  ggtitle("スコア別の試合数 (勝ちチーム × 負けチーム)")

対角線の1つ上, つまり1点差の試合が濃くなっています.

scores |>
  filter(home != away) |>
  mutate(点差 = abs(home - away)) |>
  count(点差, name = "試合数") |>
  mutate(割合 = 試合数 / sum(試合数), 累積 = cumsum(割合)) |>
  head(6) |>
  kable(digits = 3, format.args = list(big.mark = ","))

点差	試合数	割合	累積
1	41,608	0.302	0.302
2	25,435	0.185	0.487
3	20,088	0.146	0.633
4	15,409	0.112	0.744
5	11,103	0.081	0.825
6	7,935	0.058	0.883

1点差が30%, 3点差以内が63%です.

時代で変わる

得点環境は時代でかなり動きます.

by_year <-
  scores |>
  summarise(総得点 = mean(home + away),
            完封 = mean(pmin(home, away) == 0),
            .by = year)

by_year |>
  ggplot(aes(x = year, y = `総得点`)) +
  geom_line() +
  geom_smooth(se = FALSE, linewidth = 0.5, colour = "steelblue") +
  xlab("年") + ylab("1試合あたりの両チーム合計得点") +
  ggtitle("投高打低と打高投低")

一番低いのが1968年の6.84点, 一番高いのが2000年の10.28点です. 1968年は「投手の年」と呼ばれた年で, 翌年マウンドが低くされ, ストライクゾーンも狭められました.

by_year |>
  ggplot(aes(x = year, y = 完封)) +
  geom_line() +
  scale_y_continuous(labels = scales::percent) +
  xlab("年") + ylab("完封で終わった試合の割合") +
  ggtitle("完封試合の割合")

注意

1938年から2013年のうち, Retrosheet のイベントファイルが揃っている年だけです.
引き分けはスコア別の集計から除いています.
延長戦も同じ扱いで数えています.

野球のスコアと試合数

2026-08-09

もとの数え方の穴

集計

穴の大きさ

スコア別の試合数

時代で変わる

注意