日本プロ野球データを作る(打者・投手)

イントロ

自分のラボの人にRの使い方を説明するのに実験データだけではなく、より身近なデータがあるといいのに、とおもって探し始めてプロ野球データにたどり着きました。果たしてプロ野球データが身近なものであるかという疑問は静かに無視しつつ、baseball-reference.comという、古今東西の野球データが公開されているサイトからデータをダウンロードすることにしました。こちらのサイトを激しく参考にしましたが、打者だけではなく投手の情報も取得できるように改変しました。

目的

Rでいろんな実験をしやすくするために日本のプロ野球データを取得し、CSV形式でローカルPCに保存すること。

日本の過去のプロ野球データを取得する

リーグ一覧のうち、日本のプロ野球のリーグとして次の5つのデータを取得してみましょう。今回はイースタンとウェスタンはパスしました。同じように取得は可能なはずです。

League namecode
Japan Central LeagueJPCL
Japan Pacific LeagueJPPL
Japanese Baseball LeagueJPBL
Japanese Baseball League (Fall)JPBF
Japanese Baseball League (Spring)JPBS

ためしに“Japan Central League”のリンク先のURLをみてみると、次のようになっています:
https://www.baseball-reference.com/register/league.cgi?code=JPCL&class=Fgn

実際にリンク先には各年のチーム名が表になって並んでいます。現時点で2020年シーズンのデータはありませんので、2019年の”Yokohama Bay Stars”のリンクをみてみると、次のようになっています。どうも、各チーム・各年ごとにidがふられているっぽいですね(2019のベイスターズであればd2ea2428のように)。

https://www.baseball-reference.com/register/team.cgi?id=d2ea2428

そしてリンク先には打者と投手の成績がズラリと並んでいるわけです。

そこで、日本プロ野球の各チーム・各年ごとにidを取得して、打者と投手のデータをぐるぐるとクローリングしてローカルのcsvファイルに保存してみましょう。うちのそこそこMBPでだいたい1時間くらいかかりました。

# download Japanese Baseball League data  
library(tidyverse)
library(xml2)
library(rvest)
library(magrittr)
library(progress)

# create folders to store data
dir.create(path = file.path("rawdata"), showWarnings = FALSE, recursive = TRUE)
dir.create(path = file.path("data"), showWarnings = FALSE, recursive = TRUE)

# leagues and realted infos
leagues<-tribble(
  ~name,                               ~code, ~start_year, ~end_year,
  "Japan Central League",              "JPCL", 1950,       2020,
  "Japan Pacific League",              "JPPL", 1950,       2020,
  "Japanese Baseball League",          "JPBL", 1939,       1949,
  "Japanese Baseball League (Fall)",   "JPBF", 1936,       1938,
  "Japanese Baseball League (Spring)", "JPBS", 1936,       1938
)

total_years<-sum(leagues$end_year-leagues$start_year+1)

pb <- progress::progress_bar$new(
  format = "Downloading :what [:bar] :current/:total (:percent)", 
  total = total_years)

for (j in seq(leagues$code)){

  all_year_html <- read_html(sprintf("http://www.baseball-reference.com/register/league.cgi?code=%s&class=Fgn", 
    leagues[j, "code"]))

  years <- seq(leagues$end_year[j], leagues$start_year[j])

  for (year_id in seq(years)){

    pb$tick(1, tokens = list(what = paste(leagues$code[j], years[year_id])))

    # links to each team
    link_team_list <- all_year_html %>% 
      html_nodes(xpath = paste('//*[@id="lg_history"]/tbody/tr[', 
        year_id, ']/td/a', sep = ""))

    link_list <- link_team_list %>%
      html_attr("href")# %>% .[-1]

    team_list <- link_team_list %>%
      html_text()# %>% .[-1]

    team_stats_URL <- paste("http://www.baseball-reference.com", link_list, sep="")

    for (i in seq(team_list)) {
      html = read_html(team_stats_URL[i]) 

      # retrive batting info
      batting_player_id <- html %>%
        html_nodes(xpath = '//*[@id="team_batting"]/tbody/tr/td[1]')%>%
        html_attr("data-append-csv")%>%
        str_remove("player\\.fcgi\\?id=")

      if (!is_empty(batting_player_id)){
        batting_stats <- html %>% 
          html_node(xpath = '//*[@id="team_batting"]') %>% 
          html_table %>%
          select(-Notes) %>%
          filter(!is.na(Rk)) %>%
          mutate(League = leagues$name[j]) %>% 
          mutate(Team = team_list[i]) %>% 
          mutate(Year = years[year_id]) %>% 
          mutate(PlayerID = batting_player_id) 

        filename <- file.path("rawdata", sprintf("%s_%s.batting.csv", 
          years[year_id], str_remove(team_list[i], " ")))
        batting_stats %>% write_csv(filename)
      }

      # retrive pitching info
      pitching_html <- html %>%
        html_node(xpath = '//comment()[contains(., "team_pitching")]')
      if (!is_empty(pitching_html)){
        pitching_player_id <- pitching_html %>% 
          html_text() %>%
          read_html() %>%
          html_node("table") %>%
          html_nodes(xpath = '//*[@id="team_pitching"]/tbody/tr/td[1]')%>%
          html_attr("data-append-csv")%>%
          str_remove('player\\.fcgi\\?id=')

        if (!is_empty(pitching_player_id)){
          pitching_stats <- html %>% 
            html_node(xpath = '//comment()[contains(., "team_pitching")]') %>% 
            html_text() %>%
            read_html() %>%
            html_node("table") %>%
            html_table() %>%
            select(-Notes) %>%
            filter(!is.na(Rk)) %>%
            mutate(League = leagues$name[j]) %>% 
            mutate(Team = team_list[i]) %>% 
            mutate(Year = years[year_id]) %>% 
            mutate(PlayerID = pitching_player_id)

          filename <- file.path("rawdata", sprintf("%s_%s.pitching.csv", 
            years[year_id], str_remove(team_list[i], " ")))
          pitching_stats %>% write_csv(filename)
        }
      }
    }
  }
}

打者・投手のデータをそれぞれ1つのファイルにまとめる

rawdataフォルダに80年以上続くプロ野球の歴史が書き出されたわけですが、さらにこれを打者と投手のファイル(batting.csvとpitching.csv)にまとめてしまいます。まとめついでに、右打ち、左打ち、両打ち、をわかりやすく変換し、右投げ、左投げ、両投げ(!?)も変換しておきます。

# merge all data into two files
vars <- c("batting", "pitching")
col_types <- c("batting" = "iciiiiiiiiiiiiiiddddiiiiiiccic", 
  "pitching" = "iciiiddiiiiiidiiiiiiiiiiiddddddccic")
names(col_types) <- vars

for (var in vars){
  df <- tibble()
  files <- list.files("rawdata", pattern = sprintf("%s.csv$", var))
  pb <- progress::progress_bar$new(
    format = sprintf("%s data [:bar] :current/:total (:percent)", var), 
    total = length(files))
  for (file in files){
    temp.df <- read_csv(file.path("rawdata", file), 
      col_types = as.character(col_types[var]))
    df%<>%bind_rows(temp.df)
    pb$tick(1)
  }

  if (var == "batting"){
    df%<>%mutate(Bats = "right")
    df$Bats[str_which(df$Name, pattern = ".*\\*$")] <- "left"
    df$Bats[str_which(df$Name, pattern = ".*#$")] <-   "both"
    df$Bats[str_which(df$Name, pattern = ".*\\?$")] <- "unknown"
  }

  if (var == "pitching"){
    df%<>%mutate(Throws = "right")
    df$Throws[str_which(df$Name, pattern = ".*\\*$")] <- "left"
    df$Throws[str_which(df$Name, pattern = ".*#$")] <-   "both"
    df$Throws[str_which(df$Name, pattern = ".*\\?$")] <- "unknown"
  }

  write_csv(df, path = file.path("data", sprintf("%s.csv", var)))
}

これで、 楽しむ 勉強する準備ができました。

追記

上のソースコードで生成されるデータファイルをこちらからダウンロードできます:
batting.csv
pitching.csv


sessioninfo::session_info(c("tidyverse"))
## ─ Session info ───────────────────────────────────────────────────────────────
##  setting  value                       
##  version  R version 3.6.3 (2020-02-29)
##  os       macOS Mojave 10.14.6        
##  system   x86_64, darwin15.6.0        
##  ui       RStudio                     
##  language (EN)                        
##  collate  ja_JP.UTF-8                 
##  ctype    ja_JP.UTF-8                 
##  tz       Asia/Tokyo                  
##  date     2020-05-15                  
## 
## ─ Packages ───────────────────────────────────────────────────────────────────
##  package      * version  date       lib source        
##  askpass        1.1      2019-01-13 [1] CRAN (R 3.6.0)
##  assertthat     0.2.1    2019-03-21 [1] CRAN (R 3.6.0)
##  backports      1.1.6    2020-04-05 [1] CRAN (R 3.6.2)
##  base64enc      0.1-3    2015-07-28 [1] CRAN (R 3.6.0)
##  BH             1.72.0-3 2020-01-08 [1] CRAN (R 3.6.0)
##  broom          0.5.6    2020-04-20 [1] CRAN (R 3.6.2)
##  callr          3.4.3    2020-03-28 [1] CRAN (R 3.6.2)
##  cellranger     1.1.0    2016-07-27 [1] CRAN (R 3.6.0)
##  cli            2.0.2    2020-02-28 [1] CRAN (R 3.6.0)
##  clipr          0.7.0    2019-07-23 [1] CRAN (R 3.6.0)
##  colorspace     1.4-1    2019-03-18 [1] CRAN (R 3.6.0)
##  crayon         1.3.4    2017-09-16 [1] CRAN (R 3.6.0)
##  curl           4.3      2019-12-02 [1] CRAN (R 3.6.0)
##  DBI            1.1.0    2019-12-15 [1] CRAN (R 3.6.0)
##  dbplyr         1.4.3    2020-04-19 [1] CRAN (R 3.6.2)
##  desc           1.2.0    2018-05-01 [1] CRAN (R 3.6.0)
##  digest         0.6.25   2020-02-23 [1] CRAN (R 3.6.0)
##  dplyr        * 0.8.5    2020-03-07 [1] CRAN (R 3.6.0)
##  ellipsis       0.3.0    2019-09-20 [1] CRAN (R 3.6.0)
##  evaluate       0.14     2019-05-28 [1] CRAN (R 3.6.0)
##  fansi          0.4.1    2020-01-08 [1] CRAN (R 3.6.0)
##  farver         2.0.3    2020-01-16 [1] CRAN (R 3.6.0)
##  forcats      * 0.5.0    2020-03-01 [1] CRAN (R 3.6.0)
##  fs             1.4.1    2020-04-04 [1] CRAN (R 3.6.3)
##  generics       0.0.2    2018-11-29 [1] CRAN (R 3.6.0)
##  ggplot2      * 3.3.0    2020-03-05 [1] CRAN (R 3.6.0)
##  glue           1.4.0    2020-04-03 [1] CRAN (R 3.6.1)
##  gtable         0.3.0    2019-03-25 [1] CRAN (R 3.6.0)
##  haven          2.2.0    2019-11-08 [1] CRAN (R 3.6.0)
##  highr          0.8      2019-03-20 [1] CRAN (R 3.6.0)
##  hms            0.5.3    2020-01-08 [1] CRAN (R 3.6.0)
##  htmltools      0.4.0    2019-10-04 [1] CRAN (R 3.6.0)
##  httr           1.4.1    2019-08-05 [1] CRAN (R 3.6.0)
##  isoband        0.2.1    2020-04-12 [1] CRAN (R 3.6.2)
##  jsonlite       1.6.1    2020-02-02 [1] CRAN (R 3.6.0)
##  knitr        * 1.28     2020-02-06 [1] CRAN (R 3.6.0)
##  labeling       0.3      2014-08-23 [1] CRAN (R 3.6.0)
##  lattice        0.20-41  2020-04-02 [1] CRAN (R 3.6.3)
##  lifecycle      0.2.0    2020-03-06 [1] CRAN (R 3.6.0)
##  lubridate      1.7.8    2020-04-06 [1] CRAN (R 3.6.2)
##  magrittr       1.5      2014-11-22 [1] CRAN (R 3.6.0)
##  markdown     * 1.1      2019-08-07 [1] CRAN (R 3.6.0)
##  MASS           7.3-51.6 2020-04-26 [1] CRAN (R 3.6.2)
##  Matrix         1.2-18   2019-11-27 [1] CRAN (R 3.6.3)
##  mgcv           1.8-31   2019-11-09 [1] CRAN (R 3.6.3)
##  mime           0.9      2020-02-04 [1] CRAN (R 3.6.0)
##  modelr         0.1.7    2020-04-30 [1] CRAN (R 3.6.2)
##  munsell        0.5.0    2018-06-12 [1] CRAN (R 3.6.0)
##  nlme           3.1-147  2020-04-13 [1] CRAN (R 3.6.2)
##  openssl        1.4.1    2019-07-18 [1] CRAN (R 3.6.0)
##  pillar         1.4.4    2020-05-05 [1] CRAN (R 3.6.3)
##  pkgbuild       1.0.8    2020-05-07 [1] CRAN (R 3.6.3)
##  pkgconfig      2.0.3    2019-09-22 [1] CRAN (R 3.6.0)
##  pkgload        1.0.2    2018-10-29 [1] CRAN (R 3.6.0)
##  plogr          0.2.0    2018-03-25 [1] CRAN (R 3.6.0)
##  plyr           1.8.6    2020-03-03 [1] CRAN (R 3.6.0)
##  praise         1.0.0    2015-08-11 [1] CRAN (R 3.6.0)
##  prettyunits    1.1.1    2020-01-24 [1] CRAN (R 3.6.0)
##  processx       3.4.2    2020-02-09 [1] CRAN (R 3.6.0)
##  progress       1.2.2    2019-05-16 [1] CRAN (R 3.6.0)
##  ps             1.3.2    2020-02-13 [1] CRAN (R 3.6.0)
##  purrr        * 0.3.4    2020-04-17 [1] CRAN (R 3.6.2)
##  R6             2.4.1    2019-11-12 [1] CRAN (R 3.6.0)
##  RColorBrewer   1.1-2    2014-12-07 [1] CRAN (R 3.6.0)
##  Rcpp           1.0.4.6  2020-04-09 [1] CRAN (R 3.6.3)
##  readr        * 1.3.1    2018-12-21 [1] CRAN (R 3.6.0)
##  readxl         1.3.1    2019-03-13 [1] CRAN (R 3.6.0)
##  rematch        1.0.1    2016-04-21 [1] CRAN (R 3.6.0)
##  reprex         0.3.0    2019-05-16 [1] CRAN (R 3.6.0)
##  reshape2       1.4.4    2020-04-09 [1] CRAN (R 3.6.2)
##  rlang          0.4.6    2020-05-02 [1] CRAN (R 3.6.2)
##  rmarkdown    * 2.1      2020-01-20 [1] CRAN (R 3.6.0)
##  rprojroot      1.3-2    2018-01-03 [1] CRAN (R 3.6.0)
##  rstudioapi     0.11     2020-02-07 [1] CRAN (R 3.6.0)
##  rvest          0.3.5    2019-11-08 [1] CRAN (R 3.6.0)
##  scales         1.1.0    2019-11-18 [1] CRAN (R 3.6.0)
##  selectr        0.4-2    2019-11-20 [1] CRAN (R 3.6.1)
##  stringi        1.4.6    2020-02-17 [1] CRAN (R 3.6.0)
##  stringr      * 1.4.0    2019-02-10 [1] CRAN (R 3.6.0)
##  sys            3.3      2019-08-21 [1] CRAN (R 3.6.0)
##  testthat       2.3.2    2020-03-02 [1] CRAN (R 3.6.0)
##  tibble       * 3.0.1    2020-04-20 [1] CRAN (R 3.6.2)
##  tidyr        * 1.0.3    2020-05-07 [1] CRAN (R 3.6.3)
##  tidyselect     1.0.0    2020-01-27 [1] CRAN (R 3.6.0)
##  tidyverse    * 1.3.0    2019-11-21 [1] CRAN (R 3.6.0)
##  tinytex        0.22     2020-04-17 [1] CRAN (R 3.6.2)
##  utf8           1.1.4    2018-05-24 [1] CRAN (R 3.6.0)
##  vctrs          0.2.4    2020-03-10 [1] CRAN (R 3.6.0)
##  viridisLite    0.3.0    2018-02-01 [1] CRAN (R 3.6.0)
##  whisker        0.4      2019-08-28 [1] CRAN (R 3.6.0)
##  withr          2.2.0    2020-04-20 [1] CRAN (R 3.6.2)
##  xfun           0.13     2020-04-13 [1] CRAN (R 3.6.2)
##  xml2           1.3.2    2020-04-23 [1] CRAN (R 3.6.2)
##  yaml           2.2.1    2020-02-01 [1] CRAN (R 3.6.0)
## 
## [1] /Library/Frameworks/R.framework/Versions/3.6/Resources/library

コメント

  1. […] こちらのエントリで作成したプロ野球データの打者データを使っていきます。 打者のデータbatting.csvはこちらからダウンロードできます。 […]

  2. […] 最後は完全に自分のために。古今東西の野球チームの成績データがあります。MLBだけでなくNPBのデータも置いています。ただ、データセットをダウンロードできるわけではないので、データを取得するには色々と工夫が必要なようです。コチラやコチラのサイトを参考にさせていただきます。 […]

タイトルとURLをコピーしました