2019 NPB各球団投手事情～パリーグ編～

ロバートさん（@robertsan_CD）が先日、中日ドラゴンズの投手事情のわかりやすい可視化をしていて、それを機に各球団ファンの方々が好きな球団について同様のマッピングをしてみる、という流れがありました。

twitter.com

これってかなり素敵な流れだと思っていて、マッピングを見て

（野球の基本ルールを知っている前提はあるが）誰でも同じ見方になる
シンプルなのでミスリードする危険性が低い
自分も真似してみようと思える
（データがあれば）実際に簡単に真似できる

など輪が広がる要素がたくさんあったなと思いました。

これが"可視化"なんだよなぁ。

たくさんの情報を1枚のグラフに一度に載せるのではなく、シンプルで誰もが一目で理解でき、誤った解釈が生まれないものを提供していきたいですし、Twitterなどでグラフを載せるときは常にこれを意識しています。

ただ、各球団でいろんな方がこれをやると軸の幅が違ったり、文字の大きさが違ったりで球団間の比較がしにくいんですよね。

本当はテンプレートとかを配布するのがいいかもしれませんが、１から作ってみんなでより良い可視化を目指すのもいいと思うので、ここの塩梅は難しいですね…。

一人で全部やってみた

ということで、球団間の比較が出来るようにパリーグ6球団を並べてみました。

データは日本野球機構（NPB）のオフィシャルサイトからスクレイピングしました。（サーバーに負担をかける可能性もあるので、スクレイピングコードは非公開にします）

6球団まとめ

先発

f:id:tsuyu_pon:20200123155101p:plain

中継ぎ抑え

f:id:tsuyu_pon:20200123155138p:plain

ソフトバンク、オリックスは長いイニングを投げてくれ、かつ、QS率の高い先発が複数人いるのがわかります。

ただ、チーム防御率は1位と5位で中継ぎの差が多かったですね。

ソフトバンクは抑えが森・甲斐野と複数枚いて、層の厚さを思い知らされました。

計算できる先発がいると逆算して中継ぎを休めさせられますし、反対に途中でQS達成率7割を超えていた上沢が抜けてしまった日本ハムはずっと先発に悩まされていた印象があります。

そして、平井投手お疲れ様でした。

各球団について

最近、よくウニウニ動くグラフを見るな～と思っていて、Rで再現できないかと試行錯誤したら、ggplot2とgganimateを使ってきれいに作れました。

よく見るウニウニ動くランキング、Rでも出来た。 pic.twitter.com/O8zDVDxawR
— tsuyupooooon (@ponsa__ku) 2020年1月20日

思いのほか、いいねをいただけたので、使ったコードを載せておきます。

library(tidyverse)
library(lubridate)
library(gganimate)


# データ読み込み
pitcher <- read_rds("pitcher2019.rds") # スクレイピングした投手成績データ

team = c("埼玉西武", "福岡ソフトバンク", "東北楽天", "千葉ロッテ", "北海道日本ハム", "オリックス")
col = c("#1F366A", "#F5C700", "#860010", "#000000", "#4C7B98", "#000019")
for(num in 1:6){
  # 各週、投球回数上位15人に絞る
  team1 <- pitcher %>% 
    filter(Team==team[num]) %>% 
    mutate(INN = round(INN, 1)) %>%
    group_by(week_date) %>% 
    arrange(week_date, desc(INN)) %>% 
    mutate(rank = row_number()) %>% 
    ungroup() %>% 
    filter(rank <= 15)

  # ウニウニグラフ 
  p <- team1 %>%
    ggplot(aes(x = -rank, y = INN, group = Player)) +
    geom_tile(aes(y = INN / 2, height = INN), fill = col[num], width = 0.9) +
    geom_text(aes(label = Player), hjust = "right", colour = "white", nudge_y = -2) +
    geom_text(aes(label = as.character(INN)), hjust = "left", nudge_y = 2) +
    coord_flip(clip="off") +
    scale_x_discrete("") +
    xlab("") + ylab("累計投球回") +
    ylim(c(-10,185)) +
    theme_bw(base_size = 20) +
    transition_time(week_date) +
    labs(
      title=paste(team[num], '2019投手陣　投球回'),
      subtitle='{frame_time}',
      caption='作 tsuyupon') +
    ease_aes('cubic-in-out')
  
  # 保存
  save_animation(
    animate(p, fps = 10, duration = 20,
            width = 600, height = 600, end_pause = 50),
    paste0(team[num], ".gif")
  )
}