【競馬】【やり直し】rvestでyahoo競馬にある過去のレース結果をスクレイピングしてみた。
みなさんおはこんばんにちは。 前回の投稿で、yahoo競馬にある過去のレース結果をスクレイピングしてみました。 osashimix.hatenablog.com しかし、取得したデータ数が少ないこともあり、何かおかしいなと思っていました。詳しく調べてみると、どうやら前回のコードでは過去のレース結果の全てを引っ張ることは出来ていないようです。そこで、今回はそのやり直しを行いたいと思います。基本的なコードは前回と変わりませんが、read_htmlとRSQLiteを使用している部分が変更されています。まず、パッケージの呼び出しです。
# rvestによる競馬データのwebスクレイピング #install.packages("rvest") #if (!require("pacman")) install.packages("pacman") #install.packages("beepr") #install.packages("RSQLite") pacman::p_load(qdapRegex) library(rvest) library(stringr) library(dplyr) library(beepr) library(RSQLite)
SQLiteへの接続を行います。horse_data.dbというデータベースファイルをあらかじめ作成し、そこにデータを格納していきます。
# warnning禁止 options(warn=-1) # SQLiteへの接続 con = dbConnect(SQLite(), "horse_data.db", synchronous="off")
ここからスクレイピングを行っていきます。そもそも前回はyahoo競馬の以下のページよりレース結果のurlを取得してました。
これだと1994年1月5日（水）のレースは①日刊スポーツ賞金杯と②スポーツニッポン賞金杯しかないことになっていますが、もちろんそんなことはありません。どうやらその日の注目レースのみが掲載されているようです。では、どこにその日のレース一覧があるのかということですが、上の画像でいうところの1回中山1日や1回阪神1日というリンクに飛ぶと以下のようなページにたどり着きます。
ここに競馬場ごとの全12レースの結果のリンクが掲載されています。というわけで、いったんこのページまで飛んで、ここから全レースのリンクを取得し、レース結果を一つずつ取得していきたいと思います。
for(year in 1994:2018){ # yahoo競馬のレース結果一覧ページの取得 for (k in 1:12){ # tryCatchでエラー処理 tryCatch( { keiba.yahoo <- read_html(str_c("https://keiba.yahoo.co.jp/schedule/list/", year,"/?month=",k)) Sys.sleep(2) race_lists <- keiba.yahoo %>% html_nodes("a") %>% html_attr("href") # 全urlを取得 # 競馬場ごとの各日のレースリストを取得 race_lists <- race_lists[str_detect(race_lists, pattern="race/list/\\d+/")==1] # 「result」が含まれるurlを抽出 } , error = function(e){signal <- 1} ) for (j in 1:length(race_lists)){ tryCatch( { race_list <- read_html(str_c("https://keiba.yahoo.co.jp",race_lists[j])) race_url <- race_list %>% html_nodes("a") %>% html_attr("href") # 全urlを取得 # レース結果のをurlを取得 race_url <- race_url[str_detect(race_url, pattern="result")==1] # 「result」が含まれるurlを抽出 } , error = function(e){signal <- 1} ) for (i in 1:length(race_url)){ print(str_c("現在、", year, "年", k, "月",j, "グループ、", i,"番目のレースの保存中です")) tryCatch( { race1 <- read_html(str_c("https://keiba.yahoo.co.jp",race_url[i])) # レース結果のurlを取得 signal <- 0 Sys.sleep(2) } , error = function(e){signal <- 1} ) # レースが中止orエラーでなければ処理を実行 if (identical(race1 %>% html_nodes(xpath = "//div[@class = 'resultAtt mgnBL fntSS']") %>% html_text(),character(0)) == TRUE && signal == 0){ # レース結果をスクレイピング race_result <- race1 %>% html_nodes(xpath = "//table[@id = 'raceScore']") %>% html_table() race_result <- do.call("data.frame",race_result) # リストをデータフレームに変更 # レース結果のurlが取得できないことがあったので、再処理のコードを準備 x <- 0 while (length(race_result) == 0){ race1 <- read_html(str_c("https://keiba.yahoo.co.jp",race_url[i])) # レース結果のurlを取得 race_result <- race1 %>% html_nodes(xpath = "//table[@id = 'raceScore']") %>% html_table() race_result <- do.call("data.frame",race_result) # リストをデータフレームに変更 x <- x + 1 if (x == 10) break } colnames(race_result) <- c("order","frame_number","horse_number","horse_name/age","time/margin","passing_rank/last_3F","jockey/weight","popularity/odds","trainer") # 列名変更 # 通過順位と上り3Fのタイム race_result <- dplyr::mutate(race_result,passing_rank=as.character(str_extract_all(race_result$`passing_rank/last_3F`,"(\\d{2}-\\d{2}-\\d{2}-\\d{2})|(\\d{2}-\\d{2}-\\d{2})|(\\d{2}-\\d{2})"))) race_result <- dplyr::mutate(race_result,last_3F=as.character(str_extract_all(race_result$`passing_rank/last_3F`,"\\d{2}\\.\\d"))) race_result <- race_result[-6] # タイムと着差 race_result <- dplyr::mutate(race_result,time=as.character(str_extract_all(race_result$`time/margin`,"\\d\\.\\d{2}\\.\\d|\\d{2}\\.\\d"))) race_result <- dplyr::mutate(race_result,margin=as.character(str_extract_all(race_result$`time/margin`,"./.馬身|.馬身|.[:space:]./.馬身|[ア-ン-]+"))) race_result <- race_result[-5] # 馬名、馬齢、馬体重 race_result <- dplyr::mutate(race_result,horse_name=as.character(str_extract_all(race_result$`horse_name/age`,"[ァ-ヴー・]+"))) race_result <- dplyr::mutate(race_result,horse_age=as.character(str_extract_all(race_result$`horse_name/age`,"牡\\d+|牝\\d+|せん\\d+"))) race_result <- dplyr::mutate(race_result,horse_weight=as.character(str_extract_all(race_result$`horse_name/age`,"\\d{3}"))) race_result <- dplyr::mutate(race_result,horse_weight_change=as.character(str_extract_all(race_result$`horse_name/age`,"\\([\\+|\\-]\\d+\\)|\\([\\d+]\\)"))) race_result$horse_weight_change <- sapply(rm_round(race_result$horse_weight_change, extract=TRUE), paste, collapse="") race_result <- race_result[-4] # ジョッキー race_result <- dplyr::mutate(race_result,jockey=as.character(str_extract_all(race_result$`jockey/weight`,"[ぁ-ん一-龠]+\\s[ぁ-ん一-龠]+|[:upper:].[ァ-ヶー]+"))) race_result <- race_result[-4] # オッズと人気 race_result <- dplyr::mutate(race_result,odds=as.character(str_extract_all(race_result$`popularity/odds`,"\\(.+\\)"))) race_result <- dplyr::mutate(race_result,popularity=as.character(str_extract_all(race_result$`popularity/odds`,"\\d+[^(\\d+.\\d)]"))) race_result$odds <- sapply(rm_round(race_result$odds, extract=TRUE), paste, collapse="") race_result <- race_result[-4] # レース情報 race_date <- race1 %>% html_nodes(xpath = "//div[@id = 'raceTitName']/p[@id = 'raceTitDay']") %>% html_text() race_name <- race1 %>% html_nodes(xpath = "//div[@id = 'raceTitName']/h1[@class = 'fntB']") %>% html_text() race_distance <- race1 %>% html_nodes(xpath = "//p[@id = 'raceTitMeta']") %>% html_text() race_result <- dplyr::mutate(race_result,race_date=as.character(str_extract_all(race_date,"\\d+年\\d+月\\d+日"))) race_result <- dplyr::mutate(race_result,race_name=as.character(str_replace_all(race_name,"\\s",""))) race_result <- dplyr::mutate(race_result,race_distance=as.character(str_extract_all(race_distance,"\\d+m"))) #race_result <- dplyr::mutate(race_result,race_type=as.character(str_extract_all(race_distance,pattern = "ダート"))) race_result <- dplyr::arrange(race_result,horse_number) # 馬番順に並べる ## ファイル貯めるのかく if (k == 1 && i == 1 && j == 1){ dataset <- race_result } else { dataset <- rbind(dataset,race_result) } # if文2の終わり }else { print("保存できませんでした") }# if文1の終わり } # iループの終わり } # jループ終わり } # kループの終わり beep(3) write.csv(dataset,"race_result2.csv", row.names = FALSE) dbWriteTable(con, "race_result", dataset) dbSendQuery(con, "INSERT INTO dataset select * from race_result") dbSendQuery(con, "DROP TABLE race_result") } # yearループの終わり beep(5) options(warn = 1) dbDisconnect(con)
このコードを実行し、データを取得したところ、データ数は1171008になりました。前回とは比較にならないほどのデータ量になり、分析を行うときはRSQLiteを用いてデータを落として来ようと思います。分析結果も近々公開する予定です。
