【競馬】【やり直し】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を用いてデータを落として来ようと思います。分析結果も近々公開する予定です。
【競馬】rvestでyahoo競馬にある過去のレース結果をスクレイピングしてみた。
みなさん、おはこんばんにちは。
競馬のレース結果を的中させるモデルを作ろうということで研究をはじめました。まずはデータを自分で取ってくるところからやろうとおもいます。どこからデータを取ってくるのかという点が重要になるわけですが、データ先としてはdatascisotistさんがまとめられた非常にわかりやすい記事があります。どこからデータが取れるのかというと大きく分けて二つで、①JRA提供のJRA-VAN、電子競馬新聞でおなじみの？JRJDといったデータベース、②netkeiba、yahoo競馬とといった競馬情報サイトとなってます。②の場合は自分でコードを書き、スクレイピングを行う必要があります。今回はyahoo競馬のデータをWebスクレイピングで落としてきたいと思います。Pythonは使えないのでRでやります。Rでスクレイピングを行うパッケージとしては、rvest, httr, XMLがありますが、今回は1番簡単に使えるrvestを用います。yahoo競馬では以下のように各レース結果が表にまとめられています（5月の日本ダービーの結果）。
各馬のざっくりとした特徴やレース結果（通過順位等含む）、オッズが掲載されています。とりあえず、このぐらい情報があれば良いのではないかと思います（オッズの情報はもう少し欲しいのですが）。ただ、今後は少しずつ必要になった情報を拡充していこうとも思っています。1986年までのレース結果が格納されており、全データ数は50万件を超えるのではないかと思っています。ただ、単勝オッズが利用できるのは1994年からのようなので今回は1994年から直近までのデータを落としてきます。今回のゴールは、このデータをcsvファイル or SQLに格納することです。
Rvestとは
Rvestとは、webスクレイピングパッケージの一種でdplyrでおなじみのHadley Wickhamさんによって作成されたパッケージです。たった数行でwebスクレイピングができる優れものとなっており、操作が非常に簡単であるのが特徴です。今回は以下の本を参考にしました。
そもそも、htmlも大学一年生にやった程度でほとんど忘れていたのですが、この本はそこも非常にわかりやすく解説されており、非常に実践的な本だと思います。
レース結果をスクレイピングしてみる
さて、実際にyahoo競馬からデータを落としてみたいと思います。コードは以下のようになっております。ご留意頂きたいのはこのコードをそのまま使用してスクレイピングを行うことはご遠慮いただきたいという事です。webスクレイピングは高速でサイトにアクセスするため、サイトへの負荷が大きくなる可能性があります。スクレイピングを行う際は、時間を空けるコーディングするなどその点に留意をして行ってください（最悪訴えられる可能性がありますが、こちらは一切の責任を取りません）。
# rvestによる競馬データのwebスクレイピング
#install.packages("rvest")
#if (!require("pacman")) install.packages("pacman")
pacman::p_load(qdapRegex)
library(rvest)
library(stringr)
library(dplyr)
使用するパッケージはqdapRegex、rvest、stringr、dplyrです。qdapRegexはカッコ内の文字を取り出すために使用しています。
keiba.yahoo <- read_html(str_c("https://keiba.yahoo.co.jp/schedule/list/2016/?month=",k))
race_url <- keiba.yahoo %>%
html_nodes("a") %>%
html_attr("href") # 全urlを取得# レース結果のをurlを取得
race_url <- race_url[str_detect(race_url, pattern="result")==1] # 「result」が含まれるurlを抽出
まず、read_htmlでyahoo競馬のレース結果一覧のhtml構造を引っ張ってきます（リンクは2016年1月の全レース）。ここで、kと出ているのは月を表し、k=1であれば2016年1月のレース結果を引っ張ってくるということです。keiba.yahooを覗いてみると以下のようにそのページ全体のhtml構造が格納されているのが分かります。
> keiba.yahoo {xml_document} <html xmlns="http://www.w3.org/2016/xhtml"> [1] <head>\n<!---京---><meta http-equiv="Content-Type" content="text/html; charset=utf-8 ... [2] <body>\n\n<div id="wrapH">\n\n <!-- #contentHeader -->\n <header ..
race_urlにはyahoo.keibaのうちの2016年k月にあった全レース結果のリンクを格納しています。html_nodeとはhtml構造のうちどの要素を引っ張るかを指定し、それを引っ張る関数で、簡単に言えばほしいデータの住所を入力する関数であると認識しています（おそらく正しくない）。ここではa要素を引っ張ることにしています。注意すべきことは、html_nodeは欲しい情報をhtml形式で引っ張ることです。なので、テキストデータとしてリンクを保存するためにはhtml_attrを使用する必要があります。html_attrの引数として、リンク属性を表すhrefを渡しています。これでレース結果のurlが取れたと思いきや、実はこれでは他のリンクもとってしまっています。一番わかりやすいのが広告のリンクです。こういったリンクは除外する必要があります。レース結果のurlには"result"が含まれているので、この文字が入っている要素だけを抽出したのが一番最後のコードです。
for (i in 1:length(race_url)){
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) # リストをデータフレームに変更
colnames(race_result) <- c("order","frame_number","horse_number","horse_name/age","time/margin","passing_rank/last_3F","jockey/weight","popularity/odds","trainer") # 列名変更
さて、いよいよレース結果のスクレイピングを行います。さきほど取得したリンク先のhtml構造を一つ一つ取得し、その中で必要なテキスト情報を引っ張るという作業をRに実行させます（なのでループを使う）。race_1にはあるレース結果ページのhtml構造が格納されおり、race_resultにはその結果が入っています。html_nodesの引数に入っているxpathですが、これはXLMフォーマットのドキュメントから効率的に要素を抜き出す言語です。先ほど説明した住所のようなものと思っていただければ良いと思います。その横に書いてある「//table[@id = 'raceScore']」が住所です。これはwebブラウザから簡単に探すことができます。Firefoxの説明になりますが、ほかのブラウザでも同じような機能があると思います。スクレイプしたい画面でCtrl+Shift+Cを押すと下のような画面が表示されます。
このインスペクターの横のマークをクリックすると、カーソルで指した部分のhtml構造（住所）が表示されます。この場合だと、レース結果はtable属性のidがraceScoreの場所に格納されていることが分かります。なので、上のコードではxpath=のところにそれを記述しているのです。そして、レース結果は表（table）形式でドキュメント化されているので、html_tableでごっそりとスクレイプしました。基本的にリスト形式で返されるので、それをデータフレームに変換し、適当に列名をつけています。
# 通過順位と上り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]
ここまででデータは取得できたわけなのですが、そのデータは綺麗なものにはなっていません。 上のコードでは、その整形作業を行っています。現在、取得したデータは以下のようになっています。
> head(race_result) order frame_number horse_number horse_name/age time/margin 1 1 4 5 ヤマカツエース\n \n牡4/492(+6)/ 2.01.2 2 2 5 7 マイネルフロスト\n \n牡5/488(+4)/ 2.01.33/4馬身 3 3 6 10 フルーキー\n \n牡6/490(+6)/ 2.01.43/4馬身 4 4 8 14 ライズトゥフェイム\n \n牡6/488(+4)/ 2.01.61 1/4馬身 5 5 3 3 ステラウインド\n \n牡7/490(+4)/ 2.01.6アタマ 6 6 4 6 ブライトエンブレム\n \n牡4/492(+4)/ 2.01.6アタマ passing_rank/last_3F jockey/weight popularity/odds trainer 1 05-05-04-0233.0 池添 謙一\n 56.0 3 (4.9) 池添 兼雄 2 01-01-01-0134.4 松岡 正海\n 57.0 5 (6.9) 高木 登 3 08-09-08-0832.7 M.デムーロ\n 57.5 1 (3.4) 角居 勝彦 4 10-11-10-1032.6 石川 裕紀人\n 56.0 6 (12.4) 加藤 征弘 5 03-03-03-0233.6 蛯名 正義\n 56.0 7 (17.2) 尾関 知人 6 06-06-06-0633.2 C.ルメール\n 56.0 2 (4.8) 小島 茂之
ご覧のように、\nが入っていたり、通過順位と上り3ハロンのタイムが一つのセルに入っていたりとこのままでは分析ができません。不要なものを取り除いたり、データを二つに分割する作業が必要になります。今回の記事ではこの部分について詳しくは説明しません。この部分は正規表現を駆使する必要がありますが、私自身全く詳しくないからです。今回も手探りでやりました。
# レース情報
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_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","")))
## ファイル格納
if (k ==1 && i == 1){
dataset <- race_result
} else {
dataset <- rbind(dataset,race_result)
}# if文の終わり
} # iループの終わり
最後に、レース日時とレース名を抜き出し、データを一時的に格納するコードとcsvファイルに書き出すコードを書いて終了です。完成データセットは以下のような状態になっています。
> head(dataset) order frame_number horse_number trainer passing_rank last_3F time margin 1 1 4 5 池添 兼雄 05-05-04-02 33.0 2.01.2 character(0) 2 2 5 7 高木 登 01-01-01-01 34.4 2.01.3 3/4馬身 3 3 6 10 角居 勝彦 08-09-08-08 32.7 2.01.4 3/4馬身 4 4 8 14 加藤 征弘 10-11-10-10 32.6 2.01.6 1 1/4馬身 5 5 3 3 尾関 知人 03-03-03-02 33.6 2.01.6 アタマ 6 6 4 6 小島 茂之 06-06-06-06 33.2 2.01.6 アタマ horse_name horse_age horse_weight horse_weight_change jockey odds 1 ヤマカツエース 牡4 492 +6 池添 謙一 4.9 2 マイネルフロスト 牡5 488 +4 松岡 正海 6.9 3 フルーキー 牡6 490 +6 M.デムーロ 3.4 4 ライズトゥフェイム 牡6 488 +4 石川 裕紀人 12.4 5 ステラウインド 牡7 490 +4 蛯名 正義 17.2 6 ブライトエンブレム 牡4 492 +4 C.ルメール 4.8 popularity 1 3 2 5 3 1 4 6 5 7 6 2
以上です。次回はこのデータセットを使用して、分析を行っていきます。次回までには1994年からのデータを全てスクレイピングしてきます。
【追記（2018/6/10）】
上述したスクリプトを用いて、スクレイピングを行ったところエラーが出ました。どうやらレース結果の中には強風などで中止になったものも含まれているらしく、そこでエラーが出る様子（race_resultがcharacter(0)になってしまう）。なので、この部分を修正したスクリプトを以下で公開しておきます。こちらは私の PC環境では正常に作動しています。
# rvestによる競馬データのwebスクレイピング
#install.packages("rvest")
#if (!require("pacman")) install.packages("pacman")
install.packages("beepr")
pacman::p_load(qdapRegex)
library(rvest)
library(stringr)
library(dplyr)
library(beepr)# pathの設定
setwd("C:/Users/assiy/Dropbox/競馬統計解析")for(year in 1994:2018){
# yahoo競馬のレース結果一覧ページの取得
for (k in 1:12){
keiba.yahoo <- read_html(str_c("https://keiba.yahoo.co.jp/schedule/list/", year,"/?month=",k))
race_url <- keiba.yahoo %>%
html_nodes("a") %>%
html_attr("href") # 全urlを取得# レース結果のをurlを取得
race_url <- race_url[str_detect(race_url, pattern="result")==1] # 「result」が含まれるurlを抽出for (i in 1:length(race_url)){
Sys.sleep(10)
print(str_c("現在、", year, "年", k, "月", i,"番目のレースの保存中です"))race1 <- read_html(str_c("https://keiba.yahoo.co.jp",race_url[i])) # レース結果のurlを取得
# レースが中止でなければ処理を実行
if (identical(race1 %>%
html_nodes(xpath = "//div[@class = 'resultAtt mgnBL fntSS']") %>%
html_text(),character(0)) == TRUE){
# レース結果をスクレイピング
race_result <- race1 %>% html_nodes(xpath = "//table[@id = 'raceScore']") %>%
html_table()
race_result <- do.call("data.frame",race_result) # リストをデータフレームに変更
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_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","")))
## ファイル貯めるのかく
if (k == 1 && i == 1 && year == 1994){
dataset <- race_result
} else {
dataset <- rbind(dataset,race_result)
} # if文2の終わり
} # if文1の終わり
} # iループの終わり
} # kループの終わり
beep()
} # yearループの終わり
write.csv(dataset,"race_result.csv", row.names = FALSE)
これを回すのに16時間かかりました（笑）データ数は想定していたよりは少なく、97939になりました。
【競馬】馬券版ファクターモデル
おはこんばんにちわ。
まず研究第1弾。
馬券版ファクターモデル構想なるものをご紹介したいと思います。
実は今、競馬×データサイエンスが熱い。
ウマナリティクスなるものがあるようです。
https://www.slideshare.net/mobile/data_sciesotist/umanalytics-1
単純に言えば、これまでのレース結果からなんらかのモデルを作成し、順位予想や回収率を高める馬券購入方法を考えようというものです。
中には回収率100%を超える事に成功された方もいるようで、馬券市場には歪みがある事がわかります(http://stockedge.hatenablog.com/entry/2016/01/17/180919)。
ただし、その具体的な方法などは当たり前ですが一般に公開はされておらず、そのインパクトがどれほどなのかもわかりません(どれほど儲かるのか？、費用対効果は？、汎用性は？などなど)
ということで、今回は「馬券市場の歪みを捉え、回収率100%を超える馬券版ファクターモデルを1ヶ月(仮)運用したらいくら儲かるのか？」というテーマで研究を進めて行きたいと思います。
はじめまして
どうもはじめまして。
東京にある投資顧問会社に勤める新卒1年目のおさしみっくすと申します。
簡単に自己紹介をしたいと思います。
大学院卒の24歳です。
専攻はマクロ経済学で特にDSGEモデル、状態空間モデル、カルマンフィルタ、ベイズ推定、MCMCなんかをやっていました。
指導教官の研究サポートとして自然言語処理をやったこともあります。
もともと学者志望でしたが金銭的な問題で就職することになりました。
今は営業サポートの下働きをしています。
このブログは研究への興味関心を捨てることができない私が趣味として研究を進めていく際の備忘録という位置付けになるのだと思います。
現在進めている研究は以下の２つです。
①馬券版ファクターモデル
②四半期GDP予測モデル
①は、馬券市場が株式市場よりも投機的に魅力のある市場であるという観点から、回収率100%超えを目指す馬券ポートフォリオを構築するモデルを作成できないかというものです。株式にはファーマフレンチのようなファクターモデルがありますが、それを応用して馬券版ファクターモデルなるものを作れないかと思っています。
②は最近の四半期GDP速報の精度が低いという問題意識から、精度の高い予測モデルを新たに構築できないかというものです。特にこれまでのようなマクロ経済理論に基づいたモデルではなく、機械学習を用い、通常マクロ経済学の研究で使用しないようなデータを織り込んだモデルを作成する方向で研究を進めていきたいと思っています。
まだ、研究は始めたばかりなのですが、
興味を持ってもらえるように頑張りたいと思います…
では、最初はこの辺で。
よろしくお願いします。
