【小ネタ】開幕前にNPBの日程表をスクレイピングしよう

　今年の上皇誕生日は一人でカラオケに行ったんですが、死んだ顔でユニコーンの『スプリングマンのテーマ』を歌ったら抑揚0点とかいうけったいな点数を付けられました。カラオケの採点機能なんつうものは一切信用してないのですが、歌詞の内容を考えるとある意味正解なのかもしれません。

　牛乳をかける前のコーンフレーク。

　さて、今回はタイトルの通りの小ネタを粛々と。コードブロック除いて500字以内を目標に頑張ります。わけのわからない日記を書いている場合ではないので早速本題へ。

書いたよ

　野暮用でNPBの日程表を作る必要ができたのでコードを書きました。マジでただの日程表なので別に役立つ要素もないんですが、ウェブスクレイピングをやりたい方の参考になればと思ったので乗っけておきます。サイトの構造上
・終わった試合には使えない(得点が記入される関係)
・したがって過去のシーズンには使えない
要は日程が発表された段階から開幕までしか使えない雑なコードなので、何かに使うぞって方も応用前提で見てもらうことになります。まあ日程を見たり過去の試合結果を見たりするだけなら他にもいいサイトがいっぱいあるので、そっちを参照した方が良いでしょう。csvにしたいとかexcelで何かしら加工したいって方向けです。

ここまで519字でした。上出来です。

コード

　関数名はてきとうにscrape_scheduleとしました。引数はseason, month, typeの3つで、seasonにはスクレイピングしたいシーズンを入れます。typeはそれぞれオープン戦(ST)、一軍公式戦(RS)、春季教育リーグ(fST)、ファーム公式戦(fST)のどれをスクレイピングするのか指定するオプションです。公式戦の2つは、c(3, 4, 5)のようにベクトル形式で月を指定すれば、月別にスクレイピングも出来るようになっています。

　2020/12/25現在はオープン戦の日程しか発表されていないので、公式戦のスクレイピングは開始時刻が発表されるのを待って下さい。教育リーグは試合結果が記入されないようなので、2020年以前のものもスクレイピングできるようになっています。

# パッケージのインストール
install.packages('tidevyerse')
install.packages('rvest')
install.packages('lubridate')

library(tidyverse)

spring_training <- trackman_schedule(2021, type = 'ST')

readr::write_excel_csv(spring_training, file ='spring_training.csv')

　完成品をcsvに保存するとこうなります。

　関数の中身は↓

scrape_schedule <- function(
season, month = NULL, type = c('ST', 'RS', 'fST', 'fRS')
) {
 #必要なパッケージの読み込み
 library(tidyverse)
 library(lubridate)
 library(rvest)
 
 # season: シーズン
 # month: 公式戦の場合、月指定も可
 # type: ST = オープン戦 RS = 公式戦, f = ファーム
 TN <- function(tn_jp){ #チーム名をアルファベットに変換(好き好き)
   tn_en <- dplyr::case_when(
     is.na(tn_jp) ~ NA_character_,
     tn_jp == 'ソフトバンク' ~ 'H',
     tn_jp == 'ロッテ' ~ 'M',
     tn_jp == '西武' ~ 'L',
     tn_jp == '楽天' ~ 'E',
     tn_jp == '日本ハム' ~ 'F',
     tn_jp == 'オリックス' ~ 'B',
     tn_jp == '巨人' ~ 'G',
     tn_jp == '阪神' ~ 'T',
     tn_jp == '中日' ~ 'D',
     tn_jp == 'DeNA' ~ 'DB',
     tn_jp == '広島' ~ 'C',
     tn_jp == 'ヤクルト' ~ 'S'
   )
   tn_en
 }
 
 TN_english <- function(tn_en){
   tn_english <- dplyr::case_when(
     is.na(tn_en) ~ NA_character_,
     tn_en == 'H' ~ 'Hawks',
     tn_en == 'M' ~ 'Marines',
     tn_en == 'L' ~ 'Lions',
     tn_en == 'E' ~ 'Eagles',
     tn_en == 'F' ~ 'Fighters',
     tn_en == 'B' ~ 'Buffaloes',
     tn_en == 'G' ~ 'Giants',
     tn_en == 'T' ~ 'Tigers',
     tn_en == 'D' ~ 'Dragons',
     tn_en == 'DB' ~ 'Baystars',
     tn_en == 'C' ~ 'Carp',
     tn_en == 'S' ~ 'Swallows'
   )
   tn_english
 }
 
 CL <- c('G', 'T', 'D', 'DB', 'C', 'S')
 PL <- c('H', 'M', 'L', 'E', 'F', 'B')
 EL <- c('G', 'DB', 'S', 'M', 'L', 'E', 'F')
 WL <- c('T', 'D', 'C', 'H', 'B')
 
 
 if (type == 'ST'){ 
   ##---------1軍オープン戦-----------------------------
   base <- xml2::read_html(
   paste0('http://npb.jp/preseason/', season, '/schedule_detail.html')
   ) %>%
     paste0() %>% # htmlをテキスト化
     gsub("<!--", "", .) %>% # htmlがコメントアウトされている可能性があるので、
     gsub("-->", "", .) %>% # 関係する部分を削除
     xml2::read_html() # 再度読み直し
   table <- base %>% 
     rvest::html_table() %>% # html中の表を取り出す
     {.[[1]]} %>% 
     # リストの要素番号を指定して取り出し:ページに1つしか表がないので[[1]]を取り出す
     dplyr::select(1:3) # 責任投手の欄は使わないので、最初の3列のみ抜き出し
   
   schedules <- list() # 空のリストを定義
   
   schedules[[1]] <- table %>% # 日付
     dplyr::pull('月日') %>% # ベクトルに変換
     stringr::str_split(., pattern = '（', simplify = T) %>% 
     # 全角カッコの前後で2列に分ける
     # 3/1 （月）→ 3/1 | 月）みたいな
     data.frame %>% # データフレーム化
     dplyr::rename('date' = 1, 'day' = 2) %>% # 列名つける
     dplyr::mutate(
       day = str_remove(day, '）') # 曜日の後ろの閉じカッコを消す
     )
   # (試合数) × 2列のデータフレームをリストに突っ込む
   
   schedules[[2]] <- table %>% # カード
     dplyr::pull('対戦カード') %>% # ベクトル化
     stringr::str_remove_all(., '[\n]') %>% # 改行を取り除く
     stringr::str_remove_all(., '[[:blank:]]') %>% # 余計なスペースも取り除く
     stringr::str_split(., pattern = '-', simplify = T) %>% 
     # 対戦カードの間のハイフンで2列に分ける
     data.frame %>% # データフレーム化
     dplyr::rename('home' = 1, 'visitor' = 2) %>%
     # ホーム球団とビジター球団を別の変数にする
     dplyr::transmute( # ↓で定義した変数だけ残す
       home = TN(home), #球団名をアルファベットに変換：しなくていい人はお好きなようにどうぞ
       visitor = TN(visitor),
       card = paste0(home, ' - ', visitor), 
       # せっかくだから対戦カード形式でも表記しておく
     )
   # (試合数) × 3列のデータフレーム
   
   schedules[[3]] <- table %>% 
     dplyr::pull('球場・開始時間') %>% # 球場, PB時刻 
     stringr::str_remove_all(., pattern = '[[:blank:]]') %>% # 余計な空白を消す
     stringr::str_split(., '[\n]', simplify = T) %>% # 改行で2列に区切る
     data.frame %>% #データフレーム化
     dplyr::rename(stadium = 1, time = 2) # 左が球場名, 右が開始時刻
   
   #------結合------
   
   df <- dplyr::bind_cols(schedules) %>% 
     #リストの要素(3つのデータフレーム)を横に結合
     dplyr::filter(!is.na(home)) %>% #ホーム球団の欄が空：試合のない行は取り除く
     mutate(
       game_type = 'オープン戦',
       date = lubridate::ymd(paste0(season, '/', date)), 
       #日付として認識されるようにしておく
       yobi = '', #オープン戦に予備日は存在しないので全部空にしておく
       card_en = paste0(TN_english(home), ' - ', TN_english(visitor)),
       # 英語でカード名をつくっちゃう。おしゃれ～
     ) %>%
     dplyr::arrange(date, time) %>%
     dplyr::select(
       '試合種別' = game_type, '日付' = date, '曜日' = day, '開始予定時刻' = time, 
       '予備日' = yobi,
       'カード' = card, 'ホーム' = home, 'ビジター' = visitor, '球場名' = stadium, 
       Game = card_en
       #列名付け直す
     )
   
 } else if (type == 'fST') {
   #---------ファーム教育リーグ----------------
   base_kyoiku <- xml2::read_html(paste0('http://npb.jp/preseason_farm/', season, '/')) %>%
     paste0() %>%
     gsub("<!--", "", .) %>%
     gsub("-->", "", .) %>%
     xml2::read_html()
   # 日程表へのリンクがあるページを読む
   
   Sys.sleep(1) #まあお茶でも飲めよ
   
   urls <- list()
   urls[[1]] <- base_kyoiku %>%
     rvest::html_nodes(xpath = '//*[@id="layout"]/div/div/section[1]/dl/dd/ul/li[1]/a') %>%
     # xpathはブラウザから取得出来るのでそれをコピぺ
     rvest::html_attr('href') %>% # ハイパーリンクを引っ張ってくる
     stringr::str_sub(., start = 2) 
     # 頭の"./"を切り取る：イースタンの試合へのリンク
   urls[[2]] <- base_kyoiku %>%
     rvest::html_nodes(xpath = '//*[@id="layout"]/div/div/section[2]/dl/dd/ul/li[1]/a') %>%
     rvest::html_attr('href') %>%
     stringr::str_sub(., start = 2) #ウエスタン
   
   df_sub <- list()
   # リーグ毎にスクレイピング
   for (i in 1:length(urls)) { 
   # urlsはイースタン・ウエスタンのリンクを含むのでlengthは2
     base <- xml2::read_html(paste0('https://npb.jp/preseason_farm/', season, urls[[i]]))
     table <- base %>%
       rvest::html_table(fill = T) %>%
       {.[[1]]} %>% 
       dplyr::slice(-n()) 
       #最終行に「開幕～」みたいなどうでもいい行があるので消す
     
     schedules <- list() #この辺は一緒
     
     schedules[[1]] <- table %>% #日付
       dplyr::pull('月日') %>%
       stringr::str_split(., pattern = '（', simplify = T) %>%
       data.frame %>%
       dplyr::rename('date' = 1, 'day' = 2) %>%
       dplyr::mutate(
         day = str_remove(day, '）')
       )
     
     schedules[[2]] <- table %>% #カード
       dplyr::pull('対戦カード') %>%
       stringr::str_remove_all(., '[\n]') %>%
       stringr::str_remove_all(., '[[:blank:]]') %>%
       stringr::str_split(., pattern = '-', simplify = T) %>%
       data.frame %>%
       dplyr::rename('home' = 1, 'visitor' = 2) %>%
       dplyr::transmute(
         home = TN(home),
         visitor = TN(visitor),
         card = paste0(home, ' - ', visitor),
       )
     
     schedules[[3]] <- table %>% #球場, PB
       dplyr::pull('球場・開始時間') %>%
       stringr::str_remove_all(., pattern = '[[:blank:]]') %>%
       stringr::str_split(., '[\n]', simplify = T) %>%
       data.frame %>%
       dplyr::rename(stadium = 1, time = 2)
     
     df_sub[[i]] <- dplyr::bind_cols(schedules) %>% 
       dplyr::filter(!is.na(home)) %>%
       mutate(
         game_type = '教育リーグ', #教育リーグ
         date = lubridate::ymd(paste0(season, '/', date)),
         yobi = '', # 同じ理由で予備日はなし
         card_en = paste0(TN_english(home), ' - ', TN_english(visitor)),
         )
     
     Sys.sleep(2) #まあまあゆっくりしていけよ
   }
   df <- dplyr::bind_rows(df_sub) %>% # イースタンとウエスタンをくっつける
     dplyr::arrange(date, time) %>% # 日付と開始時刻順にソート
     dplyr::select(
       '試合種別' = game_type, '日付' = date, '曜日' = day, '開始予定時刻' = time, 
       '予備日' = yobi,
       'カード' = card, 'ホーム' = home, 'ビジター' = visitor, '球場名' = stadium, 
       Game = card_en
     )
 } else if (type == 'RS') {
   ##----------一軍公式戦-------------------
   base_rs <- xml2::read_html(paste0('https://npb.jp/games/', season, '/')) %>%
     paste0() %>%
     gsub("<!--", "", .) %>%
     gsub("-->", "", .) %>%
     xml2::read_html()
   month_urls <- base_rs %>%
     rvest::html_nodes(xpath = '//*[@id="schedule_section"]/ul/li/a') %>%
     rvest::html_attr('href') %>%
     stringr::str_subset(., '_detail.html') %>%
     #月毎の日程以外のurlも引っ掛かってしまうので、日程のurlに共通するワードを指定して検索
     stringr::str_sub(start = 2) #月毎のurlを取得
   
   month_numbers <- base_rs %>%
     rvest::html_nodes(xpath = '//*[@id="schedule_section"]/ul/li/a') %>%
     rvest::html_text() %>%
     {.[1:length(month_urls)]} %>%
     readr::parse_number() #試合がある月をベクトルで
   #月別のurlにくっついてるテキストを数値に変換：何月の日程なのか分かるようにする
   
   Sys.sleep(1) # 急いでも仕方ないのでね
   
   if (!is.null(month)) { #月別のオプションがある場合はわける
     # "month"オプションに何らかの指定がある場合
     months_scraped <- dplyr::intersect(month, month_numbers)
     # 共通部分を出すことでスクレイピングをする月を指定
   } else {
     # 何も指定がなければそのまま
     months_scraped <- month_numbers
   }
   urls <- tibble::tibble(mon = month_numbers, ur = month_urls) %>%
     #月とそのリンクがあるデータフレームをつくる
     dplyr::right_join(., tibble::tibble(mon = months_scraped), by = 'mon') %>%
     dplyr::mutate(url = paste0('https://npb.jp/games/', season, ur)) %>%
     dplyr::pull(name = 'url') #対象月のurlのみが入った列を作る
   
   df_sub <- list()
   for (i in 1:length(urls)) {
     base <- xml2::read_html(urls[i]) %>%
       paste0() %>%
       gsub("<!--", "", .) %>%
       gsub("-->", "", .) %>%
       xml2::read_html()
     
     table <- base %>%
       rvest::html_table() %>%
       {.[[1]]} %>% #リストの要素番号を指定して取り出し
       dplyr::select(1:3)
     
     schedules <- list()
     
     schedules[[1]] <- table %>% #日付
       dplyr::pull('月日') %>%
       stringr::str_split(., pattern = '（', simplify = T) %>%
       data.frame %>%
       dplyr::rename('date' = 1, 'day' = 2) %>%
       dplyr::mutate(
         day = str_remove(day, '）')
       )
     
     cards <- table %>% #カード：ちょっとめんどい
       dplyr::pull('対戦カード') %>%
       stringr::str_remove_all(., '[\n]') %>% #改行、空白を消去
       stringr::str_remove_all(., '[[:blank:]]') %>%
       tibble::tibble() %>% # データフレーム化
       dplyr::rename(., c('medium' = 1)) %>% #適当に列名をつけておく 
       dplyr::mutate(
         yobi_flag = if_else(str_detect(medium, '[(]予備日[)]'), 'X', ''), 
         # （予備日）が入った日程は予備日なので、該当する行に"X"が入るよう変数を作る
         medium = stringr::str_replace_all(medium, pattern = '[(]予備日[)]', replacement = '-')
         # （予備日）をハイフンにした変数を作る
       )
     
     yobi_status <- cards %>% pull(name = yobi_flag) #予備日のベクトル
     
     schedules[[2]] <- cards %>%
       dplyr::pull(., medium) %>%
       stringr::str_split(., pattern = c('-'), simplify = T) %>%
       data.frame %>%
       dplyr::rename('home' = 1, 'visitor' = 2) %>%
       dplyr::transmute(
         home = TN(home),
         visitor = TN(visitor),
         card = paste0(home, ' - ', visitor),
         yobi = yobi_status, # 予備日に関する情報のベクトルをここでくっつける
       )
     
     schedules[[3]] <- table %>% #球場, PB
       dplyr::pull('球場・開始時間') %>%
       stringr::str_remove_all(., pattern = '[[:blank:]]') %>%
       stringr::str_split(., '[\n]', simplify = T) %>%
       data.frame %>%
     dplyr::rename(stadium = 1, time = 2)
     
     df_sub[[i]] <- dplyr::bind_cols(schedules) %>% #試合のある日程のみ残して結合
       dplyr::filter(!is.na(home)) %>%
       mutate(
         game_type = dplyr::case_when( # 対戦球団の所属リーグから試合タイプを特定
           (home %in% CL) & (visitor %in% CL) ~ 'セ・リーグ',
           (home %in% PL) & (visitor %in% PL) ~ 'パ・リーグ',
           TRUE ~ '交流戦'
         ),
         date = lubridate::ymd(paste0(season, '/', date)),
       )
     #------
     Sys.sleep(1)
   }
   df <- dplyr::bind_rows(df_sub) %>%
     dplyr::arrange(date, time) %>%
     dplyr::select(
       '試合種別' = game_type, '日付' = date, '曜日' = day, '開始予定時刻' = time, 
       '予備日' = yobi,
       'カード' = card, 'ホーム' = home, 'ビジター' = visitor, '球場名' = stadium, 
       Game = card_en
     )
 } else if (type == fRS) {
   ##----------ファーム公式戦-------
   base_frs <- xml2::read_html(paste0('https://npb.jp/farm/', season, '/')) %>%
     paste0() %>%
     gsub("<!--", "", .) %>%
     gsub("-->", "", .) %>%
     xml2::read_html()
   
   month_urls <- base_frs %>%
     rvest::html_nodes(xpath = '//*[@id="schedule_detail"]/ul/li/a') %>%
     rvest::html_attr('href') %>%
     stringr::str_subset(., '_detail.html') %>% 
     #月毎の日程以外のurlも引っ掛かってしまうので、日程のurlに共通するワードを指定して検索
     stringr::str_sub(start = 2) #月毎のurlを取得
   month_numbers <- base_frs %>%
     rvest::html_nodes(xpath = '//*[@id="schedule_detail"]/ul/li/a') %>%
     rvest::html_text() %>%
     {.[1:length(month_urls)]} %>%
     readr::parse_number() 
   #月別のurlにくっついてるテキストを数値に変換：何月の日程なのか分かるようにする
   
   Sys.sleep(1) #トッポたべる？
   
   if (!is.null(month)) { #月別のオプションがある場合はわける
     #"month"オプションに何らかの指定がある場合
     months_scraped <- dplyr::intersect(month, month_numbers)
     #共通部分を出すことでスクレイピングをする月を指定
   } else {
     months_scraped <- month_numbers
   }
   urls <- tibble::tibble(mon = month_numbers, ur = month_urls) %>% 
     #月とそのリンクがあるデータフレームをつくる
     dplyr::right_join(., tibble::tibble(mon = months_scraped), by = 'mon') %>%
     dplyr::mutate(url = paste0('https://npb.jp/games/', season, ur)) %>%
     dplyr::pull(name = 'url') #対象月のurlのみが入った列を作る
   
   df_sub <- list()
   for (i in 1:length(urls)) {
     base <- xml2::read_html(urls[i]) %>% #さっき作ったリンクにアクセス
       paste0() %>%
       gsub("<!--", "", .) %>%
       gsub("-->", "", .) %>%
       xml2::read_html()
     
     #この辺はいっしょ
     
     table <- base %>%
       rvest::html_table() %>%
       {.[[1]]} %>% #リストの要素番号を指定して取り出し
       dplyr::select(1:3)
     
     schedules <- list()
     
     schedules[[1]] <- table %>% #日付
       dplyr::pull('月日') %>%
       stringr::str_split(., pattern = '（', simplify = T) %>%
       data.frame %>%
       dplyr::rename('date' = 1, 'day' = 2) %>%
       dplyr::mutate(
         day = str_remove(day, '）')
       )
     
     schedules[[2]] <- table %>% #カード
       dplyr::pull('対戦カード') %>%
       stringr::str_remove_all(., '[\n]') %>%
       stringr::str_remove_all(., '[[:blank:]]') %>%
       stringr::str_split(., pattern = '-', simplify = T) %>%
       data.frame %>%
       dplyr::rename('home' = 1, 'visitor' = 2) %>%
       dplyr::transmute(
         home = TN(home),
         visitor = TN(visitor),
         card = paste0(home, ' - ', visitor),
       )
     
     schedules[[3]] <- table %>% #球場, PB
       dplyr::pull('球場・開始時間') %>%
       stringr::str_remove_all(., pattern = '[[:blank:]]') %>%
       stringr::str_split(., '[\n]', simplify = T) %>%
       data.frame %>%
       dplyr::rename(stadium = 1, time = 2)
     
     df_sub[[i]] <- dplyr::bind_cols(schedules) %>% 
     #試合のある日程のみ残して結合
       dplyr::filter(!is.na(home)) %>%
       mutate(
         game_type = dplyr::case_when( # ホーム・ビジター球団からリーグを判別
           (home %in% CL) & (visitor %in% CL) ~ 'セ・リーグ',
           (home %in% PL) & (visitor %in% PL) ~ 'パ・リーグ',
           TRUE ~ '交流戦'
         ),
         date = lubridate::ymd(paste0(season, '/', date)),
         yobi = '',
         card_en = paste0(TN_english(home), ' - ', TN_english(visitor)),
       )
     #------
     Sys.sleep(1)
   }
   df <- dplyr::bind_rows(df_sub)  %>%
     dplyr::arrange(date, time) %>%
     dplyr::select(
       '試合種別' = game_type, '日付' = date, '曜日' = day, '開始予定時刻' = time, 
       '予備日' = yobi,
       'カード' = card, 'ホーム' = home, 'ビジター' = visitor, '球場名' = stadium, 
       Game = card_en
     )
 } else {
   stop('Argument "type" is invalid.') #エラーメッセージを吐かせておく
 }
 
 #-----return as a data frame------------
 df # 出来上がった試合のデータを出力
}

　こんな感じです。細かい解説はコメントに書きました。RStudioででもスクリプトにコピペして読んでもらう方が読みやすいと思います。まあ「こんな感じか～」ぐらいのアレでアレして下さい。責任は一つも負いたくないので何かあれば遠慮なく文句を言いに来て下さると幸いです。

　本noteの執筆にあたっては、tsuyupon(@ponsa__ku)さんのブログをがっちり参考にさせて頂きました。

Baseball Referenceのデータをスクレイピングしようとして手こずった件 - 誰ガ為ニ分析ヲスル

参考文献

・松村、湯谷、紀ノ定、前田『RユーザのためのRStudio[実践]入門−tidyverseによるモダンな分析フローの世界−』技術評論社

#R #野球 #スクレイピング #コード #備忘録

おまけ

　おまけです。まあこれがメインですね。今年で25になってしまいました。ぼちぼち若者とは言えない年齢になってきて危機感を煽られています。私は今年一年、何を成すことができたでしょうか(だれ)