走るチームは勝てる？ - Jリーグのトラッキングデータの簡単な分析
最近Rを使ったデータ分析入門のレクチャーをする機会があったので、せっかくなのでブログにも書いてみようと思う。
リサーチクエスチョン
サッカーの話をすると、しばしば「走るチームは強い」という言説を聞く気がする。
相手がボールを持った時素早くプレスをかければ走行距離は増えるのでこれは正しそうにも思えるが、ただ単に走ればいいというわけでもないだろう。
そこで、Jリーグのトラッキングデータを使って、実際に「走るチームは強い」のかを見てみたいと思う。
データ収集
残念ながら走行距離及びスプリントの回数について既存のデータセットを知らないので、Jリーグの公式サイトからJ1各チームの試合毎のトラッキングデータを集めることにする。
今回は2019年シーズンの、25節 (直近の週末)までのデータを分析に使うことにする。
以下がそのために使うRのコード。
# Load packages require(cowplot) require(dplyr) require(ggplot2) require(lfe) require(RCurl) require(XML) # Scrape match data j1.dat <- rep(NA, 7) for (i in 1:25){ # Loop over weeks # List of matches in the week u <- paste0("https://www.jleague.jp/match/section/j1/", i, "/") tmp <- htmlParse(getURL(u), encoding = "UTF-8") links <- unlist(xpathApply(tmp, "//a[contains(@href, 'trackingdata')]", xmlGetAttr, "href")) links.short <- gsub("/trackingdata", "", links) for (j in 1:length(links)){ # Loop over matches # Teams, scores, and results u <- paste0("https://www.jleague.jp", links[j]) tmp <- htmlParse(getURL(u), encoding = "UTF-8") team <- unlist(xpathApply(tmp, "//p[contains(@class, 'leagAccTeam')]/a/span[contains(@class, 'embL')]", xmlValue)) home <- c(1, 0) gf <- c(unlist(xpathApply(tmp, "//div[@class = 'leagLeftScore']", xmlValue)), unlist(xpathApply(tmp, "//div[@class = 'leagRightScore']", xmlValue))) gf <- as.numeric(gf) ga <- c(unlist(xpathApply(tmp, "//div[@class = 'leagRightScore']", xmlValue)), unlist(xpathApply(tmp, "//div[@class = 'leagLeftScore']", xmlValue))) ga <- as.numeric(ga) # Tracking data u <- paste0("https://www.jleague.jp", links.short[j], "ajax_trackingdata/") tmp <- htmlParse(getURL(u), encoding = "UTF-8") tracking <- unlist(xpathApply(tmp, "//td[@class = 'total_km']", xmlValue)) tracking <- gsub("[^[:digit:]|^[:punct:]]", "", tracking) distance <- tracking[1:2] sprint <- tracking[3:4] # Storing information week <- rep(i, 2) tmp.dat <- cbind.data.frame(week, team, home, gf, ga, distance, sprint) j1.dat <- rbind.data.frame(j1.dat, tmp.dat) } cat("Finished collecting information on week", i, "matches... \n") Sys.sleep(1) } j1.dat <- j1.dat[-1,]
あまり効率のよいコードではないが、それは目をつぶって下さい m(__)m
以上のコードでチーム節単位のパネルデータを収集することができる。
データの前処理
収集したデータは即座に分析に使えるわけではない。そこでデータが分析に使えるようにクリーニングする必要がある。
ここでは、1) チーム名を英語でも表記する、2) 勝ち点の情報を含める、3) 公式データの欠損に対応する、1 4) データを並べ替える、という作業を行う。
# Data preprocessing ## team names in English teams <- data.frame(team.ja = unique(j1.dat$team), team.en = c("Cerezo Osaka", "Vissel Kobe", "Vegalta Sendai", "Urawa Red Diamonds", "Kawasaki Frontale", "FC Tokyo", "Sanfrecce Hiroshima", "Shimizu S-Pulse", "Sagan Tosu", "Nagoya Grampus", "Kashima Antlers", "Oita Trinita", "Jubilo Iwata", "Matsumoto Yamaga", "Gamba Osaka", "Yokohama F. Marinos", "Shonan Bellmare", "Consadole Sapporo")) j1.dat <- merge(j1.dat, teams, by.x = "team", by.y = "team.ja") ## results & points j1.dat$res <- ifelse(j1.dat$gf > j1.dat$ga, "W", ifelse(j1.dat$gf == j1.dat$ga, "D", "L")) j1.dat$point <- ifelse(j1.dat$res == "W", 3, ifelse(j1.dat$res == "D", 1, 0)) j1.dat <- j1.dat %>% group_by(team) %>% mutate(point.total = sum(point)) %>% ungroup() ### adjusting the points for data missingness j1.dat$point.total[j1.dat$team.en == "Shimizu S-Pulse"] <- j1.dat$point.total[j1.dat$team.en == "Shimizu S-Pulse"] + 3 ## sorting data j1.dat <- j1.dat[order(j1.dat$point.total, j1.dat$week, decreasing = TRUE),]
データの可視化
統計的な分析を行う前にまずデータを可視化することで、分析に関する重要な情報が得られることが多い。
ここでは、チーム毎に走行距離及びスプリント回数を集計し、それが25節時点の順位と関係しているかを見てみることにする。
まず、データを可視化するためのRのコードが↓
# Visualization j1.dat$distance <- as.numeric(as.character(j1.dat$distance)) j1.dat$sprint <- as.numeric(as.character(j1.dat$sprint)) j1.dat$team.en <- factor(j1.dat$team.en, levels = rev(as.character(unique(j1.dat$team.en)))) g1 <- ggplot(data = j1.dat) + geom_boxplot(aes(x = team.en, y = distance)) + xlab("") + ylab("") + ggtitle("Running Diatance by Team") + theme_bw() + coord_flip() g2 <- ggplot(data = j1.dat) + geom_boxplot(aes(x = team.en, y = sprint)) + xlab("") + ylab("") + ggtitle("# of Sprints by Team") + theme_bw() + coord_flip() plot_grid(g1, g2, align = "h")
そして出力された図が↓
図を見ると、少なくともチーム単位で分析をする限り、特に勝敗と勝ち点との間に関係はないようだ。
チーム単位で分析をする限り、走行距離やスプリント回数の分布はむしろチームの戦略や特色を反映しているように思われる。
統計分析
デモンストレーションはデータの可視化までだったので、これはオマケ。
データ発生過程が今ひとつ分からないが、チームカラーや季節などによる時系列なトレンドをコントロールした上で走行距離やスプリント回数の勝敗への影響が知りたいので、ひとまず固定効果を含んだモデルを推定する。
従属変数は0/1のダミー変数だが、固定効果を含めたいため線形確率モデルを使う。
また、距離や回数に関しては自然対数をとった。
分析のコード及び結果は↓
# Analysis j1.dat$win <- as.numeric(j1.dat$res == "W") out <- felm(win ~ log(distance) + log(sprint) + home | team + week | 0 | 0, data = j1.dat) summary(out) Call: felm(formula = win ~ log(distance) + log(sprint) + home | team + week | 0 | 0, data = j1.dat) Residuals: Min 1Q Median 3Q Max -0.7323 -0.3594 -0.1941 0.4741 0.9173 Coefficients: Estimate Std. Error t value Pr(>|t|) log(distance) 2.29639 0.80680 2.846 0.00465 ** log(sprint) -0.02526 0.19050 -0.133 0.89456 home 0.06280 0.04570 1.374 0.17014 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Residual standard error: 0.4813 on 403 degrees of freedom Multiple R-squared(full model): 0.1131 Adjusted R-squared: 0.01627 Multiple R-squared(proj model): 0.02818 Adjusted R-squared: -0.07793 F-statistic(full model):1.168 on 44 and 403 DF, p-value: 0.2221 F-statistic(proj model): 3.895 on 3 and 403 DF, p-value: 0.009167
簡単な分析ではあるが、少なくとも走行距離に関してはある程度勝敗に影響がありそうだということがわかる。
以上非常に大雑把な分析だったが、個人的にはやっていてとても楽しかった。
公式データを使うだけでもまだ色々できそうだったので、暇にまた遊んでみようと思う。
