競馬レース結果データベースを自作する方法:step3

R

netkeibaのサイトから競馬データを取得するためのステップは以下の通り。

  1. 入手したい日付(年、月)のカレンダーのページから開催日を調べる
  2. 開催日のページからrace_idを調べる
  3. race_idに対応したページからデータを抽出する

このページはステップ3に対応したコードです。全体像はこちら。

競馬 過去データcsvをnetkeibaから無料で入手する方法
JRA-VANを無料で使えるのはお試し期間のみ。競馬のデータ分析を継続して行うには、どうしても過去の競馬レース結果データを自前で収集する必要があります。netkeibaからのスクレイピング方法やデータをcsv 形式で保存する方法について記述しています。

スクレイピングを始める前に

Rでスクレイピングをするならrvestパッケージを使うのが簡単です。また、スクレイピングをするためにはHTML/CSSの理解も必要。とりあえず、これだけ知っていればスクレイピングは始められます。

Rでスクレイピングするならrvest 表もリンクもテキストも
Rでスクレイピングをするならrvestパッケージを使うのがベスト。表データ、リンク先URL、テキストなどのデータを簡単に入手できます。netkeibaのレース結果を題材にrvestパッケージの使い方をまとめています。
スクレイピングに必要な最低限のHTML/CSSの知識
スクレイピングでデータを収集するためには、HTMLで書かれたWebページの文書構造を理解し、どこに目的のデータが記載されているかをコンピュータに教えてやる必要があります。このページではスクレイピングに最低限必要なHTML/CSSの知識をまとめています。

Step3のコード

ステップ2で取得したrace_idに対応したレースについて、

  1. レース条件
  2. レース結果
  3. 払い戻し情報

をスクレイピングするためのコードです。

library(rvest)
library(stringr)
library(RSelenium)
library(tidyverse)
############################################################ # レース結果のhtmlの取得する関数
############################################################ get_race_result_html <- function(race_id){ URL_BASE <- "https://db.netkeiba.com/race/" url <- paste0(URL_BASE, race_id) html <- read_html(url, encoding = "EUC-JP") Sys.sleep(1) return(html) }

############################################################ # レース条件を取得する関数
############################################################ get_race_cond <- function(html, race_id){ race_name <- html %>% html_element(css = "#main > div > div > div > diary_snap > div > div > dl > dd > h1") %>% html_text() check <- html %>% html_element(css = "#main > div > div > div > diary_snap > div > div > dl > dd > p > diary_snap_cut") %>% html_text() if(is.na(check)){ df.cond <- tibble("race_id" = race_id, "開催" = NA, "日付" = NA, "競馬場" = NA, "レース" = NA, "レース名" = NA, "クラス" = NA, "class1" = NA, "class1a" = NA, "class2" = NA, "馬場" = NA, "距離" = NA, "左右" = NA, "天候" = NA, "馬場状態" = NA) return (df.cond) } race_No <- html %>% html_element(css = "#main > div > div > div > diary_snap > div > div > dl > dt") %>% html_text() %>% str_replace_all("\\n", "") %>% str_replace_all(" ", "") %>% str_replace_all("R", "") %>% as.numeric() race_cond <- html %>% html_element(css = "#main > div > div > div > diary_snap > div > div > dl > dd > p > diary_snap_cut") %>% html_text() %>% str_replace_all("[\xc2\xa0]", "") %>% str_replace_all(" ", "") %>% str_split("/") %>% unlist() %>% "["(1:3) date_place_class <- html %>% html_element(css = "#main > div > div > div > diary_snap > div > div > p") %>% html_text() %>% str_split(" ") %>% unlist() place <- date_place_class[2] %>% str_replace("回", "") %>% str_replace("日目", "") %>% str_replace_all("\\d", "") class1 <- date_place_class[3] %>% str_split("[\xc2\xa0]+") %>% "[["(1) %>% "["(1) class1a <- class1 %>% str_replace("500万下", "1勝クラス") %>% str_replace("1000万下", "2勝クラス") %>% str_replace("1600万下", "3勝クラス") class2 <- date_place_class[3] %>% str_split("[\xc2\xa0]+") %>% "[["(1) %>% "["(2) distance <- race_cond[1] %>% str_remove("2周") %>% str_match_all("\\d") %>% unlist() %>% paste0(collapse = "") %>% as.numeric() turf <- race_cond[1] %>% str_match_all("[^\\d]") %>% unlist() %>% "["(1:2) df.cond <- tibble("race_id" = race_id, "開催" = date_place_class[2], "日付" = as.Date(date_place_class[1],format = "%Y年%m月%d日"), "競馬場" = place, "レース" = race_No, "レース名" = race_name, "クラス" = date_place_class[3], "class1" = class1, "class1a" = class1a, "class2" = class2, "馬場" = str_split(race_cond[3], ":")[[1]][1], "距離" = distance, "左右" = turf[2], "天候" = str_split(race_cond[2], ":")[[1]][2], "馬場状態" = str_split(race_cond[3], ":")[[1]][2]) return (df.cond) }

############################################################ # レース結果を取得する関数
############################################################ get_race_record <- function(html, race_id){ #結果、着順 df <- html %>% html_element(css = "#contents_liquid > table") %>% html_table()  %>% dplyr::mutate(race_id = race_id) df$sex <- df$性齢 %>% str_split("") %>% sapply(FUN = function(x){"["(x, 1)}) df$age <- df$性齢 %>% str_split("") %>% sapply(FUN = function(x){"["(x, 2)}) df$record <- df$タイム  %>% str_split(":") %>% lapply(as.numeric) %>% sapply( FUN = function(x){ 60*x[1] + x[2]}) df$weight <- df$馬体重 %>% str_split("\\(") %>% sapply(FUN = function(x){"["(x, 1)}) %>% as.numeric() df <- df %>% relocate(race_id) %>% relocate(sex, age, .after = "性齢") %>% relocate(record, .after = "タイム") %>% relocate(weight, .after = "馬体重") # 着順,age,単勝,賞金を文字列から数値に変更 df$着順 <- as.integer(df$着順) df$age <- as.integer(df$age) df$単勝 <- as.numeric(df$単勝) df$`賞金(万円)` <- as.numeric(df$`賞金(万円)`) # タイム指数をNAに df$`タイム指数` <- NA return(df) }

############################################################ # 払戻情報を取得する関数
############################################################ get_drawback <- function(html, race_id){ df.drawback <- html %>% html_elements(css = "#contents > div.result_info.box_left > diary_snap > dl > dd > table") %>% html_table() df.drawback <- rbind(df.drawback[[1]], df.drawback[[2]]) df.drawback[df.drawback$X1 %in% c("複勝", "ワイド"),2:4] <- NA #複勝の処理 a <- html %>% html_elements(css = "#contents > div.result_info.box_left > diary_snap > dl > dd > table:nth-child(1)") %>% html_text2()%>% str_replace_all("\\t", "*") %>% str_replace_all("\\n", "*") %>% str_replace_all("\\*\\*", "*") %>% str_split("\\*") %>% unlist() %>% "["(6:14) df.fuku <- tibble(X1 = c("複勝","複勝","複勝"), X2 = a[1:3], X3 = a[4:6], X4 = a[7:9]) #ワイドの処理 a <- html %>% html_elements(css = "#contents > div.result_info.box_left > diary_snap > dl > dd > table:nth-child(2)") %>% html_text2()%>% str_replace_all("\\t", "*") %>% str_replace_all("\n", "*") %>% str_split("\\*") %>% unlist() %>% "["(2:10) df.wide <- tibble(X1 = c("ワイド","ワイド","ワイド"), X2 = a[1:3], X3 = a[4:6], X4 = a[7:9]) df.res <- rbind(df.drawback[1,], df.fuku, df.drawback[3:4,], df.wide, df.drawback[6:8, ]) df.res$X3 <- df.res$X3 %>% str_replace_all(",", "") %>% as.numeric() df.res$X4 <- df.res$X4 %>% as.numeric() df.res <- df.res %>% mutate(race_id = race_id, .before = 1) names(df.res) <- c("race_id", "種別", "組合せ", "払戻金", "人気") df.res$人気 <- as.integer(df.res$人気) return (df.res) } ############################################################ # スクレイピング ############################################################ (race_ids <- readRDS("race_ids.2012to2016.rds")) ##################################################### # 1回目の場合(df.race.cond, etcが存在しない場合) ##################################################### # i <- 1 race_id <- race_ids[i] html <- get_race_result_html(race_id) df.race.cond <- get_race_cond(html, race_id) df.race.record <- get_race_record(html, race_id) df.drawback <- get_drawback(html, race_id) # # ##################################################### # 2回目以降の場合 ##################################################### # df.race.cond <- readRDS("df.race.cond.rds") # df.race.record <- readRDS("df.race.record.rds") # df.drawback <- readRDS("df.drawback.rds") (n_done <- length(df.race.cond$race_id)) length(unique(df.drawback$race_id)) length(unique(df.race.record$race_id)) (idmax <- length(race_ids)) i <- 0 id_count <- 0 tmp.df.race.cond <- NULL tmp.df.race.record <- NULL tmp.df.drawback <- NULL (max_id_to_calc <- min(100000, length(race_ids))) tmp.filename.race.cond <- "tmp.df.race.cond.rds" tmp.filename.race.record <- "tmp.df.race.record.rds" tmp.filename.drawback <- "tmp.df.drawback.rds" system.time({ while(id_count < max_id_to_calc){ i <- i + 1 id_count <- n_done + i cat(paste("id_count =", id_count, "(", floor(id_count/idmax*100*10) / 10, "%)", format(Sys.time(), "%H:%M:%S "), sep = " " ) ) race_id <- race_ids[id_count] html <- get_race_result_html(race_id) # race.condの処理 tmp <- get_race_cond(html, race_id) if( is.null(tmp.df.race.cond)){ tmp.df.race.cond <- tmp }else{ tmp.df.race.cond <- rbind(tmp.df.race.cond, tmp) } # check if(is.na(tmp$開催)){ cat(paste0("Error : data doesn't exist. id_count = ", id_count, "\n")) next }else{ cat(paste(tmp$日付, tmp$競馬場, tmp$レース, "R", tmp$race_id, "\n", sep=" ")) } # race.record, drawbackの処理 if( is.null(tmp.df.race.cond)){ tmp.df.race.record <- get_race_record(html, race_id) tmp.df.drawback <- get_drawback(html, race_id) }else{ tmp.df.race.record <- rbind(tmp.df.race.record, get_race_record(html, race_id)) tmp.df.drawback <- rbind(tmp.df.drawback, get_drawback(html, race_id)) } if(id_count %% 100 == 0 | id_count == max_id_to_calc){ cat("Save\n") df.race.cond <- rbind(df.race.cond, tmp.df.race.cond) df.race.record <- rbind(df.race.record, tmp.df.race.record) df.drawback <- rbind(df.drawback, tmp.df.drawback) saveRDS(df.race.cond, tmp.filename.race.cond) saveRDS(df.race.record, tmp.filename.race.record) saveRDS(df.drawback, tmp.filename.drawback) tmp.df.race.cond <- NULL tmp.df.race.record <- NULL tmp.df.drawback <- NULL i <- 0 n_done <- length(df.race.cond$race_id) } } }) (n_done <- length(df.race.cond$race_id)) length(unique(df.drawback$race_id)) length(unique(df.race.record$race_id)) if(!is.null(tmp.df.race.cond)){ cat("Save\n") df.race.cond <- rbind(df.race.cond, tmp.df.race.cond) df.race.record <- rbind(df.race.record, tmp.df.race.record) df.drawback <- rbind(df.drawback, tmp.df.drawback) saveRDS(df.race.cond, tmp.filename.race.cond) saveRDS(df.race.record, tmp.filename.race.record) saveRDS(df.drawback, tmp.filename.drawback) tmp.df.race.cond <- NULL tmp.df.race.record <- NULL tmp.df.drawback <- NULL } (n_done <- length(df.race.cond$race_id)) length(unique(df.drawback$race_id)) length(unique(df.race.record$race_id)) ########################################################## # 後処置 ########################################################## df.race.cond <- df.race.cond[!is.na(df.race.cond$開催), ] #race_idはあるのに、データがない場合がある (n_done <- length(df.race.cond$race_id)) length(unique(df.drawback$race_id)) length(unique(df.race.record$race_id)) filename.race.cond <- "df.race.cond.2012to2021.rds" filename.race.record <- "df.race.record.2012to2021.rds" filename.drawback <- "df.drawback.2012to2021.rds" saveRDS(df.race.cond, filename.race.cond) saveRDS(df.race.record, filename.race.record) saveRDS(df.drawback, filename.drawback)

step2に戻る場合はこちら

競馬レース結果データベースを自作する方法:step2
指定した開催日に行われた競馬のrace_idをスクレイピングするためのコードです。