← 記事一覧へ

走者がいると本塁打は出にくくなるのでしょうか.

library(data.table)
library(dplyr)
library(ggplot2)
library(knitr)

SEASONS <- 2004:2013
column_names <- unname(unlist(fread("../../data/reference/retrosheet-columns.csv", header = FALSE)))
need <- c("BAT_ID", "BAT_EVENT_FL", "AB_FL", "EVENT_CD",
          "BASE1_RUN_ID", "BASE2_RUN_ID", "BASE3_RUN_ID", "OUTS_CT",
          "INN_CT", "BAT_HOME_ID", "HOME_SCORE_CT", "AWAY_SCORE_CT")

files <- file.path("../../data", sprintf("all%d.csv", SEASONS))
missing <- files[!file.exists(files)]
if (length(missing) > 0) {
  stop("データがありません: ", paste(basename(missing), collapse = ", "),
       "\n  data/README.md を参照してください.")
}

pa <- rbindlist(Map(function(path, season) {
  d <- fread(path, header = FALSE, select = match(need, column_names))
  setnames(d, need)
  d[, year := season][]
}, files, SEASONS))

pa[, `:=`(一塁 = BASE1_RUN_ID != "",
          二塁 = BASE2_RUN_ID != "",
          三塁 = BASE3_RUN_ID != "")]
pa[, `:=`(走者数 = 一塁 + 二塁 + 三塁,
          HR = EVENT_CD == 23L)]

ab <- pa[AB_FL == "T"]

2004年から2013年の 1,663,754打数, 49,491本塁打です.

走者の人数で見ると, ほとんど差が無い

ci <- function(hr, ab) {
  m <- Map(\(h, n) binom.test(h, n)$conf.int, hr, ab)
  list(lo = vapply(m, \(x) x[1], numeric(1)),
       hi = vapply(m, \(x) x[2], numeric(1)))
}

by_n <-
  ab |>
  summarise(打数 = n(), 本塁打 = sum(HR), .by = 走者数) |>
  arrange(走者数) |>
  mutate(本塁打率 = 本塁打 / 打数,
         下限 = ci(本塁打, 打数)$lo,
         上限 = ci(本塁打, 打数)$hi)

by_n |> kable(digits = 4, format.args = list(big.mark = ","))
走者数 打数 本塁打 本塁打率 下限 上限
0 948,338 28,542 0.0301 0.0298 0.0304
1 481,239 14,204 0.0295 0.0290 0.0300
2 194,205 5,539 0.0285 0.0278 0.0293
3 39,972 1,206 0.0302 0.0285 0.0319
by_n |>
  ggplot(aes(x = factor(走者数), y = 本塁打率)) +
  geom_errorbar(aes(ymin = 下限, ymax = 上限), width = 0.15) +
  geom_point(size = 3) +
  xlab("走者の人数") + ylab("打数あたり本塁打率") +
  ggtitle("走者の人数別 本塁打率 (95%信頼区間つき)")

走者なしが0.0301, 走者ありが0.0293で, 差は0.0008 (95%信頼区間 0.0003 〜 0.0013)です.

打数が1,663,754もあるので信頼区間は0を含みませんが, 大きさとしては相対2.8%, 1228打数に1本の違いでしかありません. 「走者がいると本塁打が出にくい」と言えるほどの差ではないです.

しかも走者3人 (満塁) は走者なしと同じくらいあります. 人数では説明できません.

塁の埋まり方で見ると, はっきり分かれる

by_state <-
  ab |>
  mutate(状態 = case_when(
    !一塁 & !二塁 & !三塁 ~ "走者なし",
     一塁 & !二塁 & !三塁 ~ "一塁",
    !一塁 &  二塁 & !三塁 ~ "二塁",
    !一塁 & !二塁 &  三塁 ~ "三塁",
     一塁 &  二塁 & !三塁 ~ "一二塁",
     一塁 & !二塁 &  三塁 ~ "一三塁",
    !一塁 &  二塁 &  三塁 ~ "二三塁",
    TRUE                  ~ "満塁")) |>
  summarise(打数 = n(), 本塁打 = sum(HR), .by = c(状態, 一塁)) |>
  mutate(本塁打率 = 本塁打 / 打数,
         下限 = ci(本塁打, 打数)$lo,
         上限 = ci(本塁打, 打数)$hi,
         一塁の状況 = ifelse(一塁, "一塁が埋まっている", "一塁が空いている")) |>
  arrange(desc(本塁打率))

by_state |> select(状態, 打数, 本塁打, 本塁打率, 下限, 上限) |>
  kable(digits = 4, format.args = list(big.mark = ","))
状態 打数 本塁打 本塁打率 下限 上限
一塁 301,658 9,480 0.0314 0.0308 0.0321
満塁 39,972 1,206 0.0302 0.0285 0.0319
走者なし 948,338 28,542 0.0301 0.0298 0.0304
一三塁 47,116 1,379 0.0293 0.0278 0.0308
一二塁 116,787 3,373 0.0289 0.0279 0.0299
三塁 42,760 1,156 0.0270 0.0255 0.0286
二塁 136,821 3,568 0.0261 0.0252 0.0269
二三塁 30,302 787 0.0260 0.0242 0.0278
by_state |>
  mutate(状態 = factor(状態, levels = 状態)) |>
  ggplot(aes(x = 状態, y = 本塁打率, colour = 一塁の状況)) +
  geom_errorbar(aes(ymin = 下限, ymax = 上限), width = 0.15) +
  geom_point(size = 3) +
  theme(legend.position = "bottom", legend.title = element_blank()) +
  ylab("打数あたり本塁打率") +
  ggtitle("本塁打率は「一塁が空いているか」で分かれる")

順番に並べると, きれいに2つの群に分かれます. 上位は一塁に走者がいる状態, 下位は一塁が空いていて二塁か三塁に走者がいる状態です. 走者なしはその中間にあります.

一塁だけに走者がいる状態は, 走者なしより本塁打率が高いです. 「走者がいると出にくい」では説明できません.

一塁を空けておくと歩かせられる

説明は単純です. 一塁が空いていて得点圏に走者がいると, 投手は無理に勝負しなくてよくなります. 歩かせても走者が増えるだけで, 失点には直結しません. 勝負を避ければストライクゾーンに来る球が減り, 本塁打も減ります.

ab[, 敬遠できる場面 := (二塁 | 三塁) & !一塁]
pa[, 敬遠できる場面 := (二塁 | 三塁) & !一塁]

comp <-
  ab |>
  summarise(打数 = n(), 本塁打 = sum(HR), .by = 敬遠できる場面) |>
  mutate(本塁打率 = 本塁打 / 打数,
         場面 = ifelse(敬遠できる場面, "一塁が空いた得点圏", "それ以外")) |>
  arrange(desc(敬遠できる場面))

comp |> select(場面, 打数, 本塁打, 本塁打率) |>
  kable(digits = 4, format.args = list(big.mark = ","))
場面 打数 本塁打 本塁打率
一塁が空いた得点圏 209,883 5,511 0.0263
それ以外 1,453,871 43,980 0.0303

差は-0.0040 (95%信頼区間 -0.0047 〜 -0.0033), 相対で-13%です. 走者の人数で見たときの2.8%とは桁が違います.

本当に歩かせているのか

そう考えたなら, 四球が増えているはずです.

pa[BAT_EVENT_FL == "T"] |>
  summarise(打席 = n(),
            敬遠率 = mean(EVENT_CD == 15L),
            四球率 = mean(EVENT_CD %in% c(14L, 15L)),
            .by = 敬遠できる場面) |>
  mutate(場面 = ifelse(敬遠できる場面, "一塁が空いた得点圏", "それ以外")) |>
  arrange(desc(敬遠できる場面)) |>
  select(場面, 打席, 敬遠率, 四球率) |>
  kable(digits = 4, format.args = list(big.mark = ","))
場面 打席 敬遠率 四球率
一塁が空いた得点圏 259,685 0.0458 0.1479
それ以外 1,606,400 0.0003 0.0735

敬遠は168倍, 四球全体でも2.0倍です. 勝負を避けているのは間違いありません.

打者の違いではない

打者ごとに得意不得意があります. 一塁が空いた得点圏に立つ打者は, クリーンアップに偏っているかもしれません. だとすると, 上の差は打者の顔ぶれの違いを見ているだけかもしれません.

同じ打者の中で比べます.

per_batter <-
  ab |>
  summarise(打数_該当 = sum(敬遠できる場面),
            本塁打_該当 = sum(HR & 敬遠できる場面),
            打数_他 = sum(!敬遠できる場面),
            本塁打_他 = sum(HR & !敬遠できる場面),
            .by = BAT_ID) |>
  filter(打数_該当 >= 200, 打数_他 >= 200) |>
  mutate(差 = 本塁打_該当 / 打数_該当 - 本塁打_他 / 打数_他)

tt <- t.test(per_batter$差)

tibble::tibble(
  打者数 = nrow(per_batter),
  平均の差 = mean(per_batter$差),
  下限 = tt$conf.int[1],
  上限 = tt$conf.int[2],
  `差が負の打者の割合` = mean(per_batter$差 < 0)
) |> kable(digits = 4)
打者数 平均の差 下限 上限 差が負の打者の割合
370 -0.004 -0.005 -0.003 0.6595
per_batter |>
  ggplot(aes(x = 差)) +
  geom_histogram(bins = 40) +
  geom_vline(xintercept = 0, linetype = "dashed") +
  geom_vline(xintercept = mean(per_batter$差), colour = "firebrick") +
  xlab("一塁が空いた得点圏 − それ以外 (本塁打率の差)") +
  ggtitle("打者ごとの差 (赤線が平均)")

打者を揃えても差は-0.0040で, 揃えないときの-0.0040とほぼ同じです. 打者の顔ぶれの違いでは説明できません.

場面の違いでもない

もう1つ疑うところがあります. 一塁が空いた得点圏は, 終盤や接戦に偏っているかもしれません. そういう場面は投手の質も違うので, そこを見ているだけかもしれない.

まず偏りを確かめます.

ab[, `:=`(点差 = fifelse(BAT_HOME_ID == 1L, HOME_SCORE_CT - AWAY_SCORE_CT,
                         AWAY_SCORE_CT - HOME_SCORE_CT))]

ab |>
  summarise(`終盤(7回以降)の割合` = mean(INN_CT >= 7),
            `接戦(2点差以内)の割合` = mean(abs(点差) <= 2),
            `平均イニング` = mean(INN_CT),
            .by = 敬遠できる場面) |>
  mutate(場面 = ifelse(敬遠できる場面, "一塁が空いた得点圏", "それ以外")) |>
  select(場面, everything(), -敬遠できる場面) |>
  kable(digits = 3)
場面 終盤(7回以降)の割合 接戦(2点差以内)の割合 平均イニング
それ以外 0.327 0.670 5.012
一塁が空いた得点圏 0.312 0.653 4.918

大きくは偏っていませんが, 揃えて比べます. イニング・点差・アウトカウントの同じ層の中だけで差を取り, 逆分散で重みを付けて平均します.

strata <-
  ab |>
  mutate(INN = pmin(INN_CT, 10L),
         D   = pmax(pmin(点差, 5L), -5L)) |>
  summarise(打数 = n(), 本塁打 = sum(HR),
            .by = c(敬遠できる場面, INN, D, OUTS_CT)) |>
  tidyr::pivot_wider(names_from = 敬遠できる場面,
                     values_from = c(打数, 本塁打)) |>
  filter(!is.na(打数_TRUE), !is.na(打数_FALSE),
         打数_TRUE >= 30, 打数_FALSE >= 30) |>
  mutate(p1 = 本塁打_TRUE / 打数_TRUE,
         p0 = 本塁打_FALSE / 打数_FALSE,
         w  = 1 / (p1 * (1 - p1) / 打数_TRUE + p0 * (1 - p0) / 打数_FALSE))

adj    <- with(strata, sum(w * (p1 - p0)) / sum(w))
adj_se <- sqrt(1 / sum(strata$w))
base   <- with(strata, sum(w * p0) / sum(w))

tibble::tibble(
  推定 = c("そのまま", "イニング・点差・アウトを揃えて"),
  差 = c(d2, adj),
  下限 = c(d2 - 1.96 * se2, adj - 1.96 * adj_se),
  上限 = c(d2 + 1.96 * se2, adj + 1.96 * adj_se),
  相対 = c((p1 - p0) / p0, adj / base)
) |> kable(digits = 4)
推定 下限 上限 相対
そのまま -0.0040 -0.0047 -0.0033 -0.1320
イニング・点差・アウトを揃えて -0.0053 -0.0060 -0.0045 -0.1807

揃えると差は小さくなるどころか大きくなりました (-13% → -18%, 308層, 打数1,661,412). 場面の偏りは効果を弱める向きに働いていたので, そのままの推定は 控えめだったことになります.

アウトカウント別

ab |>
  summarise(打数 = n(), 本塁打率 = mean(HR), .by = c(OUTS_CT, 敬遠できる場面)) |>
  mutate(場面 = ifelse(敬遠できる場面, "一塁が空いた得点圏", "それ以外")) |>
  select(アウト = OUTS_CT, 場面, 打数, 本塁打率) |>
  tidyr::pivot_wider(names_from = 場面, values_from = c(打数, 本塁打率)) |>
  arrange(アウト) |>
  kable(digits = 4, format.args = list(big.mark = ","))
アウト 打数_それ以外 打数_一塁が空いた得点圏 本塁打率_それ以外 本塁打率_一塁が空いた得点圏
0 541,255 37,149 0.0320 0.0262
1 475,943 73,181 0.0297 0.0270
2 436,673 99,553 0.0287 0.0257

どのアウトカウントでも同じ向きです.

1シーズンでは見えない

ab |>
  filter(year == max(SEASONS)) |>
  summarise(打数 = n(), 本塁打 = sum(HR), .by = 敬遠できる場面) |>
  mutate(本塁打率 = 本塁打 / 打数,
         下限 = ci(本塁打, 打数)$lo,
         上限 = ci(本塁打, 打数)$hi,
         場面 = ifelse(敬遠できる場面, "一塁が空いた得点圏", "それ以外")) |>
  arrange(desc(敬遠できる場面)) |>
  select(場面, 打数, 本塁打, 本塁打率, 下限, 上限) |>
  kable(digits = 4, format.args = list(big.mark = ","))
場面 打数 本塁打 本塁打率 下限 上限
一塁が空いた得点圏 20,288 473 0.0233 0.0213 0.0255
それ以外 145,782 4,188 0.0287 0.0279 0.0296

2013年だけだと信頼区間が重なります. 10シーズンぶん集めてやっと分かる大きさの話です.

まとめ

  • 走者の人数では本塁打率はほとんど変わりません. 相対2.8%しか違いません.
  • 効くのは一塁が空いているかどうかです. 一塁が空いて得点圏に走者がいる場面では, 本塁打率が 13%低くなります.
  • 同じ場面で敬遠は168倍, 四球は2.0倍に増えています. 勝負を避けた結果です.
  • 打者を揃えても差は変わらないので, 打者の顔ぶれの違いではありません.

注意

  • 「投手が勝負を避けた」と「打者が長打より確実性を選んだ」は このデータでは分けられません. どちらも同じ向きに効きます.
  • 本塁打率は打数あたりです. 四球は打数に入らないので, 「歩かされた打席」は分母から消えています. つまりここで見ているのは 勝負してもらえた打席の中での本塁打率です.
  • 2004-2013年です. 敬遠の頻度は時代で変わるので, 別の年代では効果の大きさも変わります.