【学習動機】
とあるスポーツをやっていて, 過去に試合に出るメンバーを選ばないといけない役割を背負ったことがあった. その際に, 各メンバーの強さを数値化できればいいのにと思ったことがあった. 他にも連携による強さが数値化できたらいいなと思ったことがあった. そんな経験があった中で, Bradley-Terryモデルという、勝敗データから強さを推定するモデルの存在を知った. そんなわけで, Rの{BradleyTerry2}パッケージを用いて, 作成したシミュレーションデータでBradley-Terryモデルの基本を学習する.
【学習内容】
以下では, この発表スライドの分析に使用したコードを記載していく.
ライブラリ読み込み.
library(tidyverse)
library(ggplot2)
library(BradleyTerry2)
library(qvcalc) #擬似標準誤差計算## Registered S3 methods overwritten by 'ggplot2':
## method from
## [.quosures rlang
## c.quosures rlang
## print.quosures rlang## -- Attaching packages ------------------------------------------------------------------- tidyverse 1.2.1 --## √ ggplot2 3.1.1 √ purrr 0.3.2
## √ tibble 2.1.3 √ dplyr 0.8.1
## √ tidyr 0.8.3 √ stringr 1.4.0
## √ readr 1.3.1 √ forcats 0.4.0## -- Conflicts ---------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()自作の対戦データの読み込みとその表示.
dat <- read_csv("winlose1.csv")## Parsed with column specification:
## cols(
## player1 = col_character(),
## player2 = col_character(),
## win1 = col_double(),
## win2 = col_double()
## )dat## # A tibble: 15 x 4
## player1 player2 win1 win2
## <chr> <chr> <dbl> <dbl>
## 1 どら のび 7 13
## 2 どら しず 5 12
## 3 どら たけ 9 6
## 4 どら すね 8 4
## 5 どら でき 1 5
## 6 のび しず 3 17
## 7 のび たけ 4 14
## 8 のび すね 6 9
## 9 のび でき 1 7
## 10 しず たけ 10 3
## 11 しず すね 9 2
## 12 しず でき 6 1
## 13 たけ すね 17 2
## 14 たけ でき 2 1
## 15 すね でき 1 4player1とplayer2の対戦成績でwin1がplayer1の勝利数, win2がplayer2の勝利数を記録している.
データ構造の確認.
str(dat)## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 15 obs. of 4 variables:
## $ player1: chr "どら" "どら" "どら" "どら" ...
## $ player2: chr "のび" "しず" "たけ" "すね" ...
## $ win1 : num 7 5 9 8 1 3 4 6 1 10 ...
## $ win2 : num 13 12 6 4 5 17 14 9 7 3 ...
## - attr(*, "spec")=
## .. cols(
## .. player1 = col_character(),
## .. player2 = col_character(),
## .. win1 = col_double(),
## .. win2 = col_double()
## .. ){BradleyTerry2}パッケージのBTm関数は比較対象(ここではplayer)因子型しか受け入れてくれないので因子型に変換しておく. playerのところが同じレベルの因子型になっていないといけないので, そこも注意.
playerset <- c(dat$player1,dat$player2) %>% unique()
dat$player1 <- dat$player1 %>% factor(levels = playerset)
dat$player2 <- dat$player2 %>% factor(levels = playerset)まずは, 勝率を確認する.
dat4count <- dat %>% mutate(nfights = win1 + win2)
datlong <- rbind.data.frame(dat4count %>% select(player1,win1,nfights) %>%
rename(win = win1, player = player1),
dat4count %>% select(player2,win2,nfights) %>%
rename(win = win2, player = player2))
datlong %>% group_by(player) %>%
summarise(totalwin = sum(win), totalfights = sum(nfights)) %>%
mutate(winrate = totalwin/totalfights, rank = rank(-winrate)) %>% arrange(rank)## # A tibble: 6 x 5
## player totalwin totalfights winrate rank
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 しず 54 68 0.794 1
## 2 でき 18 29 0.621 2
## 3 たけ 42 68 0.618 3
## 4 どら 30 70 0.429 4
## 5 のび 27 81 0.333 5
## 6 すね 18 62 0.290 6すねを基準点としてモデルをあてはめる. すねを0として戦闘力パラメータを推定する.
res <- BTm(cbind(win1,win2), player1, player2, ~ player, id = "player", data = dat, refcat = "すね")
res## Bradley Terry model fit by glm.fit
##
## Call: BTm(outcome = cbind(win1, win2), player1 = player1, player2 = player2,
## formula = ~player, id = "player", refcat = "すね", data = dat)
##
## Coefficients:
## playerどら playerのび playerしず playerたけ playerでき
## 0.5662 0.2364 1.9715 1.1319 1.3129
##
## Degrees of Freedom: 15 Total (i.e. Null); 10 Residual
## Null Deviance: 60.62
## Residual Deviance: 17.27 AIC: 65.41パラメータの区間を擬似標準誤差を使って求める.
res.qv <- qvcalc(BTabilities(res))
plot(res.qv, levelNames = playerset)
2番目より3番目の方が強いとは言い切るのはとても難しそう.
参考にしたものはスライドに載せた.
【学習予定】
Cattelan(2012) “Models for Paired Comparison Data: A Review with Emphasis on Dependent Data”に拡張のモデルが紹介されているので, 興味があるものを追っていけたらいいなと思っているが, 優先度はあまり高くないので, いつになるかは分からない. やる気が出たらそのうち.
