R: Bradley-Terryモデル その2

自分で架空データをつくってみた。コード自体はやはりhelp(BTm)を参考にした。

> set.seed(1009)
> 
> library(BradleyTerry2)
> 
> # 6チーム
> n <- 6
> 
> # チーム1, 2 .. 6の「強さ」を0, 0.2,..., 1.0とする
> pow <- seq(0, 1, length = n)
> 
> t1 <- rep(seq(1, n), each = n)
> t2 <- rep(seq(1, n), n)
> d <- data.frame(home = t1, away = t2)
> d2 <- d[d$home != d$away, ]
> 
> # ホーム・アウェイそれぞれ12試合
> m <- 12
> 
> # ホームでは0.2だけ強くなる
> s <- 0.2
> 
> p <- exp(pow[d2$home] + s) /
+       (exp(pow[d2$home] + s) + exp(pow[d2$away]))
> d2$home.win <- rbinom(length(p), m, p)
> d2$away.win <- m - d2$home.win
> d2$home <- data.frame(team = as.factor(d2$home), at.home = 1)
> d2$away <- data.frame(team = as.factor(d2$away), at.home = 0)
> print(d2)
   home.team home.at.home away.team away.at.home home.win away.win
2          1            1         2            0        8        4
3          1            1         3            0        7        5
4          1            1         4            0        2       10
5          1            1         5            0        2       10
6          1            1         6            0        8        4
7          2            1         1            0        6        6
9          2            1         3            0        5        7
10         2            1         4            0        6        6
11         2            1         5            0        6        6
12         2            1         6            0        3        9
13         3            1         1            0        5        7
14         3            1         2            0        7        5
16         3            1         4            0        8        4
17         3            1         5            0        1       11
18         3            1         6            0        7        5
19         4            1         1            0        8        4
20         4            1         2            0        9        3
21         4            1         3            0        5        7
23         4            1         5            0        4        8
24         4            1         6            0        7        5
25         5            1         1            0        8        4
26         5            1         2            0       10        2
27         5            1         3            0        7        5
28         5            1         4            0        7        5
30         5            1         6            0        5        7
31         6            1         1            0       10        2
32         6            1         2            0        8        4
33         6            1         3            0       12        0
34         6            1         4            0        8        4
35         6            1         5            0       10        2
> 
> bt <- BTm(cbind(home.win, away.win), home, away,
+           formula = ~ team + at.home, id = "team", data = d2)
> summary(bt)

Call:
BTm(outcome = cbind(home.win, away.win), player1 = home, player2 = away, 
    formula = ~team + at.home, id = "team", data = d2)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.47022  -0.83266  -0.05199   0.73779   2.74592  

Coefficients:
        Estimate Std. Error z value Pr(>|z|)    
team2    -0.1801     0.2454  -0.734 0.463006    
team3     0.0590     0.2429   0.243 0.808105    
team4     0.3506     0.2430   1.443 0.149017    
team5     0.7046     0.2472   2.850 0.004369 ** 
team6     0.8267     0.2497   3.310 0.000932 ***
at.home   0.2289     0.1103   2.075 0.038032 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 75.999  on 30  degrees of freedom
Residual deviance: 44.811  on 24  degrees of freedom
AIC: 137.7

Number of Fisher Scoring iterations: 4

タグ：R