Bradley-Terryモデルを使ったJリーグデータの分析
先日ツイッターでプレミアリーグのデータのBradley-Terryモデルを使った分析を見つけて、自分もやってみたくなった。
こんなことをやっている場合ではないが、同様の分析を2019年シーズンのJリーグのデータを用いてやってみてしまった…ので、ブログにまとめておこうと思う。
Bradley-Terryモデルとは?
Bradley-Terryモデルは、一対比較データから各観測の潜在的な能力を推定するモデルである。サッカーでいえば、各チームの潜在的な強さを試合結果(勝敗データ)から推定するために使われる。
データの収集
以下のRコードを使ってJリーグの公式サイトから2019年シーズンの試合結果を取得する。 ここではリーグ戦のみならずルヴァンカップ及び天皇杯のデータも含めることで、J1からJ3までの全チームの強さを比較できるようにした。
# Load packages pacman::p_load(BradleyTerry2, dplyr, ggplot2, rvest) # Scrape match data dat <- rep(NA, 5) month <- c("02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12") for (i in month){ # loop over month url <- paste0("https://www.jleague.jp/match/search/?category%5B%5D=j1&category%5B%5D=leaguecup&category%5B%5D=j2&category%5B%5D=j3&category%5B%5D=emperor&year=2019&month%5B%5D=", i) web <- read_html(url) team_left <- web %>% html_nodes(css = "td[class='clubName leftside']") %>% html_text() team_left <- gsub("[[:space:]]", "", team_left) team_right <- web %>% html_nodes(css = "td[class='clubName rightside']") %>% html_text() team_right <- gsub("[[:space:]]", "", team_right) score_left <- web %>% html_nodes(css = "td[class='point leftside']") %>% html_text() score_left <- as.numeric(score_left) score_right <- web %>% html_nodes(css = "td[class='point rightside']") %>% html_text() score_right <- as.numeric(score_right) tmp <- cbind(team_left, team_right, score_left, score_right, rep(i, length(team_left))) dat <- rbind.data.frame(dat, tmp) Sys.sleep(2) } dat <- dat[-1,] # Data cleaning colnames(dat)[5] <- "month" dat$score_left <- as.numeric(as.character(dat$score_left)) dat$score_right <- as.numeric(as.character(dat$score_right)) ## code match results (ties as 0.5) dat$team_left_win <- ifelse(dat$score_left > dat$score_right, 1, ifelse(dat$score_left == dat$score_right, 0.5, 0)) dat$team_right_win <- 1 - dat$team_left_win ## drop cup games with non-league teams dat <- dat %>% group_by(team_left) %>% mutate(team_left_n = n()) %>% ungroup() dat <- dat %>% group_by(team_right) %>% mutate(team_right_n = n()) %>% ungroup() dat <- dat %>% dplyr::filter(team_left_n > 5 & team_right_n > 5) ## convert team names to factor class dat$team_left <- factor(as.character(dat$team_left)) dat$team_right <- factor(as.character(dat$team_right))
上記により、J1-J3のチーム同士による計1184試合の結果を取得することができる。
データを集めた後、パッケージの仕様に合わせてデータを整理しておく。
モデルの推定
モデルの推定にはRのBradleyTerry2パッケージを使う。最尤法を使っているので、今回のようにそれほど大きくないデータセットであれば推定は瞬時に終わる。
out <- BTm(outcome = cbind(team_left_win, team_right_win), player1 = team_left, player2 = team_right, id = "team", formula = ~ team, data = dat, br = TRUE)
簡単！1
ちなみにBradleyTerry2パッケージを使うと潜在スコアのモデリングもできる。
今回の例であれば、勝敗の確率はチームの潜在的な強さのみならず試合会場(ホームかアウェイか)にも左右されうると考えられる。
ただし、天皇杯などどちらがホームかが判別できない試合がデータに含まれているため、ここでは最もシンプルな方法で分析をした。
結果の図示
モデルにより推定された各チームの潜在的な強さをプロットしてみる。
# Summarize estimation results res <- BTabilities(out) res <- as.data.frame(res) res$lower <- res$ability + qnorm(0.025) * res$s.e. # 95% conf. intervals res$upper <- res$ability + qnorm(0.975) * res$s.e. res <- res[order(res$ability, decreasing = TRUE),] # sort teams # Visualize png("fig_jleague.png", width = 500, height = 1000) par(mar = c(3, 4, 3, 2), mgp = c(2, 0.5, 0), family = "HiraKakuProN-W3") plot(NULL, NULL, type = "n", xlim = c(-2.2, 4.0), ylim = c(1, 58), xlab = "Ability Estimates", ylab = "", main = "J League (2019 season)", axes = FALSE) axis(1, tck = -0.01, cex.axis = 0.8) axis(2, at = c(1:58), labels = rownames(res), las = 2, tck = -0.01, cex.axis = 0.8) abline(v = 0, col = 8, lty = 2) points(res$ability, c(1:58), pch = 20) segments(res$lower, c(1:58), res$upper, c(1:58)) dev.off()
出力された図を見てみると、信頼区間が非常に大きいことがわかる。
これは先に引用したツイートでも触れられているが、推定に使われたデータ数が1チームあたり30-40ゲームしかないためであると考えられる。2
ただ、推定誤差は大きいものの、潜在スコアの順序は割と直感にあっているように見える。
各リーグ内の順序は概ねリーグ戦の順位と相関している。また、おそらく多くの人が思っていた通り、柏レイソルはJ1下位チームよりも強く、FC岐阜はJ3の上位チームよりも弱い、という結果になっている。3
という感じでものすごく簡単に再現することができた。
Bradley-Terryモデルはパッケージを使ってしまえば簡単に推定できる一方、興味深い知見を得られるなぁという感想を持った。
政治学だと一対比較データはあまり見ないが、機会があればぜひ使ってみたいと思う。
