Baseball Referenceのデータをスクレイピングしようとして手こずった件
久しぶりの更新です。
さっそく言い訳をすると10〜11月は仕事が忙しく、更新出来ませんでした…。
(というか仕事以外でデータ分析する時間もなかなか取れなかった…。)
やっと最近時間がとれるようになり、なおかつ、今シーズンのプロ野球が閉幕したので、
これからいろいろ分析していきたいと思います。
まず手始めにデータ収集として、Baseball Referenceからスクレイピングしよう!! *1
………っと思った矢先に、はまったことがあったので備忘録として残しておきたいと思います。
目次
やろうと思ったこと
- 任意の年の各球団ページにアクセス
- 打撃成績と投手成績のデータをデータフレームとして取得
- データを整形
- 各年の成績をcsvで保存
うん。シンプル。
つまずいたプログラム
library("rvest") library("dplyr") # URL情報 allYearHtml <- list( # セ・リーグ read_html('http://www.baseball-reference.com/register/league.cgi?code=JPCL&class=Fgn'), # パ・リーグ read_html('http://www.baseball-reference.com/register/league.cgi?code=JPPL&class=Fgn') ) # 試しに2018年で実行 yearID <- 1 league <- 1 # チーム別URLを取得 linkTeamList <- allYearHtml[[league]] %>% html_nodes(xpath = paste0('//*[@id="lg_history"]/tbody/tr[', yearID, ']/td/a')) ## チーム別成績ページヘのリンクを取得 teamStatsURL <- paste0("http://www.baseball-reference.com", linkTeamList %>% html_attr("href")) # テーブルデータを取り出す stats <- read_html(teamStatsURL[1]) %>% html_table # 結果を確認 length(stats) # ん?1個しかない?!
おや、、、
> # 中身見てみる > head(stats[[1]]) Rk Name Age G PA AB R H 2B 3B HR RBI SB CS BB SO BA OBP SLG OPS 1 1 Toshiki Abe 28 18 26 23 1 5 3 0 0 4 0 0 3 3 0.217 0.308 0.348 0.656 2 2 Zoilo Almonte# 29 132 546 498 56 160 37 0 15 77 1 1 44 95 0.321 0.375 0.486 0.861 3 3 Masahiro Araki 40 52 84 82 11 22 6 0 1 3 0 2 1 13 0.268 0.277 0.378 0.655 4 4 Naomichi Donoue 29 74 56 47 3 10 0 0 0 6 0 0 3 9 0.213 0.278 0.213 0.491 5 5 Issei Endo* 29 2 1 1 0 0 0 0 0 0 0 0 0 0 0.000 0.000 0.000 0.000 6 6 Atsushi Fujii 37 96 162 145 21 35 8 0 3 30 0 0 12 36 0.241 0.290 0.359 0.649 TB GDP HBP SH SF IBB Notes 1 8 1 0 0 0 0 NA 2 242 16 1 0 3 1 NA 3 31 2 0 1 0 0 NA 4 10 2 2 2 2 0 NA 5 0 0 0 0 0 0 NA 6 52 1 0 0 5 1 NA
あれ、、、
ブラウザで見ると投手成績とか選手データとかあるのに打撃成績しかないぞ…
うーん…
ソースを改めて見てみる
バッティングデータ以外がコメントアウトされてる!!
よくわからないんですが、HTMLではなくCGIであることが影響してるんですかね?
詳しい方がいましたら、教えてください…。
完成したプログラム
read_html関数でこのコメントアウト記号()も取り除けるかも!と思いましたが、どうやら出来ないみたいです。
なので、ソースを文字列で受け取って、コメントアウト記号を置換処理してから読み込む形をとりました。
library("rvest") library("dplyr") # URL情報 allYearHtml <- list( # セ・リーグ read_html('http://www.baseball-reference.com/register/league.cgi?code=JPCL&class=Fgn'), # パ・リーグ read_html('http://www.baseball-reference.com/register/league.cgi?code=JPPL&class=Fgn') ) ## 2015年から2018年で実行 for (yearID in 1:4){ Year <- 2018 - yearID + 1 bat_tmp <- pit_tmp <- list() for(league in 1:length(allYearHtml)){ # チーム別URLを取得 linkTeamList <- allYearHtml[[league]] %>% html_nodes(xpath = paste0('//*[@id="lg_history"]/tbody/tr[', yearID, ']/td/a')) ## チーム名を取得 teamList <- html_text(linkTeamList) ## チーム別成績ページヘのリンクを取得 teamStatsURL <- paste0("http://www.baseball-reference.com", linkTeamList %>% html_attr("href")) for (i in 1:length(teamList)) { # 一部データがコメントアウトされてたのでコメントアウトを消す txt <- paste(readLines(teamStatsURL[i]), collapse = "") %>% gsub("<!--", "", .) %>% gsub("-->", "", .) # テーブルデータを取り出す stats <- read_html(txt) %>% html_table suppressWarnings({ # バッティング成績データを取得して格納 bat_tmp <- c(bat_tmp, list(stats[[1]] %>% select(-Notes) %>% filter(!is.na(Rk)) %>% mutate(Team = teamList[i], Year = Year, Age = as.numeric(Age)))) # ピッチング成績データを取得して格納 pit_tmp <- c(pit_tmp, list(stats[[2]] %>% select(-Notes) %>% filter(!is.na(Rk)) %>% mutate(Team = teamList[i], Year = Year, Age = as.numeric(Age)))) }) } Sys.sleep(1) } # 結果を保存 write.csv(bind_rows(bat_tmp), paste0("Batting", Year, ".csv"), row.names=F) write.csv(bind_rows(pit_tmp), paste0("Pitching", Year, ".csv"), row.names=F) # 進捗確認 print(Year) }
全部で10個のデータフレームがありますが、1番目が打撃成績、2番目が投手成績になっています。
10番目が選手のデータになっているので、興味のある人がいたら追加してください。
意外と簡単でした♪
まとめ
スクレイピングしたい箇所がコメントアウトされていた場合、readLines関数で読み込んでコメントアウト記号を消す文字列処理をすれば、問題なく読み込める!
次回はベストナインの分析をしていきたいと思います!
*1:@gg_hatanoさんの記事を参考にしています RPubs - 日本プロ野球のシーズン打撃成績データを作った