netkeibaのサイトから競馬データを取得するためのステップは以下の通り。
- 入手したい日付(年、月)のカレンダーのページから開催日を調べる
- 開催日のページからrace_idを調べる
- 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に対応したレースについて、
- レース条件
- レース結果
- 払い戻し情報
をスクレイピングするためのコードです。
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をスクレイピングするためのコードです。