競馬予想 データを可視化 スピード指数を活用する

R

スピード指数を可視化して、出馬表をグラフィカルにするためのソースコードを公開します。データを可視化すれば、情報を適切に評価して、迷うことなく買い目を選択できるようになったり、競馬が上手な人にしかわからないことがわかるようになるなどの効果が得られる可能性があります。

競馬データを可視化するメリット

データサイエンスとデータの可視化は切っても切り離せないものです。データに基づく競馬予想を行うなら、そのデータの可視化も行ってみませんか。一般に、データを可視化するメリットとして、以下のような点が挙げられます。

  • 意思決定の迅速化
  • 属人的スキルの解消
  • 情報共有による業務効率化

競馬で勝つという意味では、良い情報は内緒にしたいという気持ちもあるので、「情報共有」はメリットではないかもしれませんが、

  • 情報を適切に評価して、迷うことなく買い目を選択できるようになる(意思決定の迅速化、業務効率化)
  • 競馬が上手な人にしかわからないことがわかるようになる(属人的スキルの解消)

などの効果が得られる可能性があります。

出馬表を可視化する

スピード指数データを用いた出馬表をグラフで表現してみました。2021年有馬記念です(クリックすると大きく表示されます)。

このグラフは、過去5走のスピード指数のデータを表現しています。右に行くほどスピード指数が高く、中央の四角および四角の中の縦線が過去5走のうち、スピード指数の順で2、3、4番目を示しています。その両脇の棒線、もしくは、丸点が過去5走の中で最も高い値、最も低い値を示しています。丸点でプロットされているのは、データ全体のばらつきからすると、はずれ傾向にあることを示しています(一般的に箱ひげ図と呼ばれるグラフです)。

人によって見え方は違って見えると思いますが、僕にはこのグラフから、このレースは拮抗して見えるものの、一番強そうなのは10番エフフォーリア(1番人気)、その次が7番クロノジェネシス(2番人気)、そして、8番ユーキャンスマイル(16番人気)、16番タイトルホルダー(4番人気)あたりかなぁと思えます。

実際には、

1着:10番エフフォーリア
2着:5番ディープボンド
3着:7番クロノジェネシス

でした(ユーキャンスマイルは9着、タイトルホルダーは5着)。ディープボンドは全体的には低めなので僕は外しましたが、最も高いデータでみると4番目なので、結果には納得してしまいます。

優れたデータの視覚化は以下のような特徴を備えていると言われます。

  • シンプルさ
  • 効率の良いデータ見える化
  • 情報の十分さ
  • バランス良く、見た目もいい

このグラフ、なかなか良くできているのではないかと自画自賛です(笑)

今週のメインレース の「血統指数」「タイム指数」「1着予想確率」
競馬予想に大切な要素である血統(父馬、母父馬)、過去の走破タイムを数値で評価。数値化することでこれまで競馬が上手い人にしかわからなかったこともクッキリ。
競馬スピード指数 当たる?当たらない?精度を知ってうまく活用
競馬をやっている人なら一度は「スピード指数」という言葉を聞いたことがありますよね。「当たる」という人もいれば、「当たらない」という人も。おそらく日本でもっとも有名なスピード指数である「西田式スピード指数」について精度、誤差を評価してみました。精度、誤差を知って上手に活用しましょう。

出馬表を可視化するためのコード

出馬表を可視化するためのコードを以下に示します。

分析用データベースの作成

レース条件、レース結果、スピード指数データベースを結合して分析用データベースを作ります。もととなるデータベースはnetkeibaからスクレイピングして作ります。スクレイピング方法はこちら。

レース条件データベース、レース結果データベース

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

スピード指数データベース

競馬予想AIの作り方 〜 Rでスピード指数をスクレイピング
スピード指数データは「無料」「スピード指数」で検索して、トップに出てくる下記のサイトからを入手させていただくことにしました。 競馬新聞&スピード指数(無料)

 

# ライブラリ
library(tidyverse)

# レース条件データベースの読み込み
df.race.cond <- readRDS("df.race.cond.2012to2022_0330.rds")

# レース結果データベースの読み込み
df.race.record <- readRDS("df.race.record.2012to2022_0330.rds")

# スピード指数データベースの読み込み
df.speed_index <- readRDS("df.speed_index.2012to2022_0330.rds")

# 平地のレースのrace_id
race_ids <- df.race.cond %>% 
filter(!str_detect(class1a, "障害")) %>% 
select(race_id) %>% 
unlist()

# 平地で着順がNA(=取り消し他)でないもの
df.analysis <- left_join(df.speed_index, df.race.cond) %>% 
filter(race_id %in% race_ids) %>% 
filter(!is.na(着順))

# df.race.recordとスピード指数を結合
df.analysis <- right_join(df.race.record, df.analysis, by = c("race_id", "馬番"))

# 必要なデータのみ抽出
df.analysis <- df.analysis %>% 
select(race_id, 日付, 馬番, 馬名, スピード指数,)

# 一旦保存
saveRDS(df.analysis, "df.analysis.2012to2022_0330.rds")

過去のレースの出馬表

過去のレースについてスピード指数を可視化して分析すると、スピード指数の出馬表を使った競馬予想のコツが掴めてきます。本番前の練習用にぜひ試してみてください。

ライブラリの読み込み

library(tidyverse)
library(lubridate)

df.analysis <- readRDS("df.analysis.2012to2022_0330.rds")

race_idに対応する日付、馬番、馬名を抽出

df.analysisからrace_idに対応する日付(race_date)と馬番、馬名(horses)を抽出

race_table <- function(id, df.analysis){
    # race_id == idのレースの日付
    race_date <- df.analysis %>%
        filter(race_id == id) %>%
        select(日付) %>%
        unlist() %>%
        unique() %>%
        as.Date.numeric(origin = "1970-01-01")

    # race_id == idのレースに出場した馬の名前と馬番
    horses <- df.analysis %>%
        filter(race_id == id) %>%
        select(馬番, 馬名) %>%
        arrange(馬番)

    ret <- list(race_date = race_date, horses = horses)

    ret
}

各馬データの抽出

レース日がrace_dateの場合、horsesの馬について、race_dateより前のデータで過去(past_n_race)走分のデータ抽出

get_horse_data <- function(df.analysis, race_date, horses, past_n_race){

    # horsesのデータに18頭分のデータになるように、足りない分を補正
    n <- length(horses$馬名)
    if(n < 18) {
        horses <- rbind(horses, 
        data.frame(馬番 = (n+1):18 , 馬名 = paste0("noname",1:(18-n))))
    }

    # 出走馬の過去のレース結果
    past_record <- df.analysis %>% 
        filter(馬名 %in% horses$馬名) %>% 
        arrange(馬名, desc(日付))  %>% 
        filter(日付 < race_date)

    # 過去の出走回数が最低 past_n_race 個になるように、dummyデータを作成
    df.dummy <- data.frame(
                                race_id = rep(NA, 18 * past_n_race), 
                                日付 = rep(seq(as.Date("1970-01-01"), 
                                                             by = "day", 
                                                             length.out = past_n_race), 
                                                     18), 
                                馬番 = rep(NA, 18 * past_n_race), 
                                馬名 = rep(horses$馬名, each = past_n_race), 
                                スピード指数 = rep(NA, 18 * past_n_race))

    # 過去のレース結果にダミーデータを合体
    past_record <- rbind(past_record, df.dummy)

    # 過去 past_n_race 走のデータを抽出
    past_record <- past_record %>% 
        filter(日付 < race_date)  %>% 
        group_by(馬名) %>% 
        arrange(desc(日付)) %>% 
        top_n(past_n_race, 日付)  %>% 
        arrange(馬名) %>% 
        ungroup()

    # 対象レースの馬番で整理
    input_data <- left_join(past_record, horses, by = "馬名") %>% 
        mutate(馬番 = 馬番.y) %>% 
        select(-c(馬番.x, 馬番.y)) %>% 
        relocate(馬番, .after = 日付)  %>% 
        arrange(馬番, desc(日付))

    input_data
}

出馬表の可視化

下記コードでは、race_table関数でrace_idがid(2021年有馬記念)の場合の日付、馬名を抽出し、get_horse_data関数で過去5走を抽出。結果をグラフ化しています。

df.analysis <- readRDS("df.analysis.2012to2022_0330.rds")
df.drawback <- readRDS("df.drawback.2012to2022_0330.rds")
df.race.cond <- readRDS("df.race.cond.2012to2022_0330.rds")

# 2021年 有馬記念
id <- 202106050811

# idに対応した、日付、馬名を抽出
ret <- race_table(id, df.analysis)

# 過去5走のデータを抽出
past_n_race <- 5
input_data <- get_horse_data(df.analysis, ret$race_date, ret$horses, past_n_race)

# 開催
kaisai <- df.race.cond %>% 
    filter(race_id == id) %>% 
    select(開催) %>% 
    unlist() %>% 
    unique()

# レース
raceNo <- df.race.cond %>% 
    filter(race_id == id) %>% 
    select(レース) %>% 
    unlist() %>% 
    unique()

# レース名
race_name <- df.race.cond %>% 
    filter(race_id == id) %>% 
    select(レース名) %>% 
    unlist() %>% 
    unique()

# 馬番 - スピード指数のグラフ化
input_data %>% 
    filter(!str_detect(馬名, "noname")) %>% 
    mutate(馬番_馬名 = sprintf("%02d %s", 馬番, 馬名)) %>% 
    ggplot() +
    geom_boxplot((aes(x = スピード指数, 
                      y = reorder(馬番_馬名, desc(馬番_馬名))))) +
    theme_gray(base_family = "HiraKakuPro-W3") +
    theme(axis.text.y = element_text(hjust = 0)) +
    labs(y ="", title = sprintf("%s年 %s %02dR %s", 
                                str_sub(id, 1, 4), 
                                kaisai, 
                                raceNo, 
                                race_name))

ggsave(file = sprintf("%s_%s_%02dR_%s.png", 
                       str_sub(id, 1, 4),
                       kaisai, 
                       raceNo, 
                       race_name),
       width = 9, height = 6)

 

今週末のレースの出馬表の可視化

今週のメインレース の「血統指数」「タイム指数」「1着予想確率」
競馬予想に大切な要素である血統(父馬、母父馬)、過去の走破タイムを数値で評価。数値化することでこれまで競馬が上手い人にしかわからなかったこともクッキリ。

日付、馬名の抽出はnetkeibaからスクレイピングするためコードが長くなりますが、過去レースの出馬表と考え方は基本的に同じです。

開催日(yyyymmdd)からレースIDを調べる関数

get_race_ids <- function(race_date){
    #netkeiba開催日のページ
    url<-paste0("https://race.netkeiba.com/top/race_list_sub.html?kaisai_date=", race_date)

    race_ids<- read_html(url, encoding="UTF-8")%>%
        html_nodes("a") %>%
        html_attr("href") %>%
        str_subset(".*race_id=") %>%
        str_replace(".*race_id=", "") %>%
        str_replace("&rf=.*", "") %>%
        unique()

    cat(" Sleep")
    Sys.sleep(1)
    cat(" Done\n")

    race_ids
}

netkeibaからrace_idに対応するページのhtmlを読み込む関数

get_scheduled_race_html <- function(race_id){
    url<-paste0("https://race.netkeiba.com/race/shutuba.html?race_id=", race_id)

    html<- read_html(url, encoding="EUC-JP")

    cat(" Sleep")
    Sys.sleep(1)
    cat(" Done\n")

    html
}

htmlデータからレース条件(race.cond)を読み込む関数

get_scheduled_race_cond <- function(html, race_id){

    #レース
    race_No<-html%>%
        html_element(".RaceNum") %>%
        html_text() %>%
        str_remove("R") %>%
        as.integer()

    #レース名
    race_name<-html%>%
        html_element(".RaceName") %>%
        html_text() %>%
        str_trim()


    race_data01<-html%>%
        html_element(".RaceData01") %>%
        html_text() %>%
        str_remove_all("\n")

    race_data02<-html%>%
        html_element(".RaceData02") %>%
        html_text() %>%
        str_split("\n") %>%
        unlist()

    # 開催
    kaisai<-paste0(race_data02[2:4], collapse="")


    #競馬場
    place<-race_data02[3]

    #クラス
    class<-paste0(race_data02[5:6], collapse="")

    #馬場
    turf<-race_data01%>%
        str_split("/") %>%
        .[[1]] %>%
        .[2] %>%
        str_trim() %>%
        str_sub(1,1)

    # 距離
    distance<-race_data01%>%
        str_split("/") %>%
        .[[1]] %>%
        .[2] %>%
        str_extract("\\d+") %>%
        as.integer()

    #左右
    rotation<-race_data01%>%
        str_split("/") %>%
        .[[1]] %>%
        .[2] %>%
        str_replace("^.*\\((.)\\)$", "\\1")


    df.cond<- tibble("race_id" = race_id,
        "開催" = kaisai,
        "競馬場" = place,
        "レース" = race_No,
        "レース名" = race_name,
        "クラス" = class,
        "馬場" = turf,
        "距離" = distance,
        "左右" = rotation)

    df.cond
}

htmlデータから出走馬情報(df.horse)を読み込む

get_scheduled_race_horse <- function(html, race_id){
    df.horse<-html%>%
        html_element(".Shutuba_Table") %>%
        html_table()

    names(df.horse) <-unlist(df.horse[1, ])

    df.horse<-df.horse[-1, ]

    df.horse<-df.horse%>%
        select(`枠`, `馬番`, `馬名`, `性齢`, `斤量`, `騎手`, `厩舎`) %>%
        mutate(race_id = race_id, .before = everything())

    df.horse
}

race_date(yyyymmdd)で指定した日の出馬表を抽出

get_scheduled_race_table <- function(race_date){

    # race_idの読み込み
    race_ids<- get_race_ids(race_date) 

    df.cond<-NULL
    df.horse<-NULL

    for(race_id in race_ids){
        html<- get_scheduled_race_html(race_id) # htmlデータの読み込み

        df.cond.tmp<- get_scheduled_race_cond(html, race_id) # race条件の読み込み

        df.horse.tmp<- get_scheduled_race_horse(html, race_id) # 出馬表を取得する

        if(is.null(df.cond)){
            df.cond<-df.cond.tmp
            df.horse<-df.horse.tmp
        }else{
            df.cond<-rbind(df.cond, df.cond.tmp)
            df.horse<-rbind(df.horse, df.horse.tmp)
        }
    }

    df.race.table<- left_join(df.cond, df.horse)

    df.race.table

}

レース日がrace_dateの場合、horsesの馬の過去(past_n_race)走分のデータ抽出

get_horse_data <- function(df.analysis, race_date, horses, past_n_race){

    # horsesのデータに18頭分のデータになるように、足りない分を補正
    n <- length(horses$馬名)
    if(n < 18) {
        horses <- rbind(horses, 
                                  data.frame(馬番 = (n+1):18 , 
                                                        馬名 = paste0("noname",1:(18-n))))
    }

    # 出走馬の過去のレース結果
    past_record <- df.analysis %>% 
        filter(馬名 %in% horses$馬名) %>% 
        arrange(馬名, desc(日付))  %>% 
        filter(日付 < race_date)

    # 過去の出走回数が最低 past_n_race 個になるように、dummyデータを作成
    df.dummy <- data.frame(race_id = rep(NA, 18 * past_n_race), 
                日付 = rep(seq(as.Date("1970-01-01"), by = "day", length.out = past_n_race), 18), 
                馬番 = rep(NA, 18 * past_n_race), 
                馬名 = rep(horses$馬名, each = past_n_race), 
                スピード指数 = rep(NA, 18 * past_n_race))

    # 過去のレース結果にダミーデータを合体
    past_record <- rbind(past_record, df.dummy)

    # 過去 past_n_race 走のデータを抽出
    past_record <- past_record %>% 
        filter(日付 < race_date)  %>% 
        group_by(馬名) %>% 
        arrange(desc(日付)) %>% 
        top_n(past_n_race, 日付)  %>% 
        arrange(馬名) %>% 
        ungroup()

    # 対象レースの馬番で整理
    input_data <- left_join(past_record, horses, by = "馬名") %>% 
        mutate(馬番 = 馬番.y) %>% 
        select(-c(馬番.x, 馬番.y)) %>% 
        relocate(馬番, .after = 日付)  %>% 
        arrange(馬番, desc(日付))

    input_data
}

出馬表の可視化

library(tidyverse)
library(rvest)
library(lubridate)

df.analysis <- readRDS("df.analysis.2012to2022_0330.rds")
# 出走馬一覧を取得するレースの日付
race_date <- "20220403"

df.race.table <- get_scheduled_race_table(race_date)

# お目当てのレースの出走予定馬、他を抽出
id <- df.race.table %>%
    filter(競馬場 == "阪神", レース == 11) %>%
    select(race_id) %>%
    unlist() %>%
    unique()

horses <- df.race.table %>%
    filter(race_id == id) %>%
    select(馬番, 馬名) %>%
    mutate(馬番 = ifelse(馬番 == "", 0, 馬番)) %>%
    mutate(馬番 = as.numeric(馬番)) 

race_name <- df.race.table %>%
    filter(race_id == id) %>%
    select(レース名) %>%
    unlist() %>%
    unique()

kaisai <- df.race.table %>%
    filter(race_id == id) %>%
    select(開催) %>%
    unlist() %>%
    unique()

raceNo <- df.race.table %>%
    filter(race_id == id) %>%
    select(レース) %>%
    unlist() %>%
    unique()

# 過去5走のデータを抽出
past_n_race <- 5
input_data <- get_horse_data(df.analysis, today(), horses, past_n_race)

#馬番 - スピード指数のグラフ化
input_data %>%
    filter(!str_detect(馬名, "noname")) %>%
    mutate(馬番_馬名 = sprintf("%02d %s", 馬番, 馬名)) %>%
    ggplot() +
    geom_boxplot((aes(y = reorder(馬番_馬名, desc(馬番_馬名)), x = スピード指数))) +
    theme_gray(base_family = "HiraKakuPro-W3") +
    theme(axis.text.y = element_text(hjust = 0)) +
    labs(y ="", 
              title = sprintf("%s年 %s %02dR %s", 
                                               str_sub(id, 1, 4), 
                                               kaisai, 
                                               raceNo, 
                                               race_name))

枠順が決まるまでは、先頭に「00」がつきます。枠順が決まった後にコードを実行すると枠順にグラフ化されます(下のグラフは2022年大阪杯)。

 

まとめ

ちょっと長いコードですが、「今週末のレースの出馬表の可視化」は一度作っておけば、かなり使えるのではないかと思っています。ぜひ活用してみてください。

競馬スピード指数 当たる?当たらない?精度を知ってうまく活用
競馬をやっている人なら一度は「スピード指数」という言葉を聞いたことがありますよね。「当たる」という人もいれば、「当たらない」という人も。おそらく日本でもっとも有名なスピード指数である「西田式スピード指数」について精度、誤差を評価してみました。精度、誤差を知って上手に活用しましょう。