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

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

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

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

競馬 過去データcsvをnetkeibaから無料で入手する方法

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

walkintheforest.net

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

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

Rでスクレイピングするならrvest　表もリンクもテキストも

Rでスクレイピングをするならrvestパッケージを使うのがベスト。表データ、リンク先URL、テキストなどのデータを簡単に入手できます。netkeibaのレース結果を題材にrvestパッケージの使い方をまとめています。

walkintheforest.net

スクレイピングに必要な最低限のHTML/CSSの知識

スクレイピングでデータを収集するためには、HTMLで書かれたWebページの文書構造を理解し、どこに目的のデータが記載されているかをコンピュータに教えてやる必要があります。このページではスクレイピングに最低限必要なHTML/CSSの知識をまとめています。

walkintheforest.net

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をスクレイピングするためのコードです。

walkintheforest.net