R: Bradley-Terryモデル その3

countsToBinomial()関数をつかってデータを整形してみる。

> set.seed(1119)
> 
> library(BradleyTerry2)
> 
> n <- 6
> pow <- seq(0, 1, length = n)
> m <- 24
> 
> mat <- matrix(NA, ncol = n, nrow = n)
> for (i in 1:(n - 1)) {
+   for (j in (i + 1):n) {
+     p <- exp(pow[i]) /
+           (exp(pow[i]) + exp(pow[j]))
+     mat[i, j] <- rbinom(1, m, p)
+     mat[j, i] <- m - mat[i, j]
+   }
+ }
> colnames(mat) <- rownames(mat) <- as.character(1:n)
> 
> print(mat)
   1  2  3  4  5  6
1 NA 11 10  9  2  8
2 13 NA  6  9 10  4
3 14 18 NA 11 12 10
4 15 15 13 NA  7  9
5 22 14 12 17 NA  9
6 16 20 14 15 15 NA
> 
> dat <- countsToBinomial(mat)
> print(dat)
   player1 player2 win1 win2
1        1       2   11   13
2        1       3   10   14
3        1       4    9   15
4        1       5    2   22
5        1       6    8   16
6        2       3    6   18
7        2       4    9   15
8        2       5   10   14
9        2       6    4   20
10       3       4   11   13
11       3       5   12   12
12       3       6   10   14
13       4       5    7   17
14       4       6    9   15
15       5       6    9   15
> 
> bt <- BTm(cbind(win1, win2), player1, player2, data = dat)
> summary(bt)

Call:
BTm(outcome = cbind(win1, win2), player1 = player1, player2 = player2, 
    data = dat)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-2.27304  -0.87520  -0.00976   0.46549   1.44423  

Coefficients:
    Estimate Std. Error z value Pr(>|z|)    
..2  0.06252    0.25009   0.250  0.80259    
..3  0.74439    0.24972   2.981  0.00287 ** 
..4  0.56923    0.24825   2.293  0.02185 *  
..5  1.01149    0.25393   3.983 6.80e-05 ***
..6  1.19625    0.25828   4.632 3.63e-06 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 52.848  on 15  degrees of freedom
Residual deviance: 14.146  on 10  degrees of freedom
AIC: 76.29

Number of Fisher Scoring iterations: 4

タグ：R