A Bradley-Terry analysis of three grandmasters: Karpov, Kasparov, Anand
R. K. S. Hankin
(takes about forty five minutes to run without cache)
To cite the hyper2 package in publications, please use
Hankin (2017). Here we define dataset kka which is the observed
scorelines between players Karpov, Kasparov, and Anand. It is used to
calculate likelihood functions: karpov_kasparov_anand, kka_3whites
and kka_3draws. This Rmd file supercedes files
inst/karpov_kasparov_anand.R and inst/kka_3draws.R and
inst/kka_array.R. Some more detail is given in man/kka.Rd.
kka <- c(
## Kasparov vs Karpov
karpov_plays_white_beats_kasparov = 18, # 12 on p1, 6 on p2
kasparov_plays_white_beats_karpov = 30, # 13 on p1, 17 on p2
kasparov_plays_white_losesto_karpov = 07,
karpov_plays_white_losesto_kasparov = 09,
karpov_plays_white_draws_kasparov = 11+13+14+17+14+03,
kasparov_plays_white_draws_karpov = 14+12+11+08+11+01,
## Kasparov vs Anand
kasparov_plays_white_beats_anand = 15,
anand_plays_white_beats_kasparov = 06,
anand_plays_white_losesto_kasparov = 11,
kasparov_plays_white_losesto_anand = 02,
kasparov_plays_white_draws_anand = 26,
anand_plays_white_draws_kasparov = 20,
## Karpov vs Anand
karpov_plays_white_beats_anand = 07,
anand_plays_white_beats_karpov = 18,
anand_plays_white_losesto_karpov = 05,
karpov_plays_white_losesto_anand = 13,
karpov_plays_white_draws_anand = 29,
anand_plays_white_draws_karpov = 20
)
kka## karpov_plays_white_beats_kasparov kasparov_plays_white_beats_karpov
## 18 30
## kasparov_plays_white_losesto_karpov karpov_plays_white_losesto_kasparov
## 7 9
## karpov_plays_white_draws_kasparov kasparov_plays_white_draws_karpov
## 72 57
## kasparov_plays_white_beats_anand anand_plays_white_beats_kasparov
## 15 6
## anand_plays_white_losesto_kasparov kasparov_plays_white_losesto_anand
## 11 2
## kasparov_plays_white_draws_anand anand_plays_white_draws_kasparov
## 26 20
## karpov_plays_white_beats_anand anand_plays_white_beats_karpov
## 7 18
## anand_plays_white_losesto_karpov karpov_plays_white_losesto_anand
## 5 13
## karpov_plays_white_draws_anand anand_plays_white_draws_karpov
## 29 20Quite a lot of information here, but for example we might ask what the scoreline is for Karpov playing white against Kasparov:
(a1 <- c(
kka["karpov_plays_white_beats_kasparov"],
kka["karpov_plays_white_draws_kasparov"],
kka["karpov_plays_white_losesto_kasparov"]
))## karpov_plays_white_beats_kasparov karpov_plays_white_draws_kasparov
## 18 72
## karpov_plays_white_losesto_kasparov
## 9If we were to ask instead what happens if Karpov plays black against Kasparov this would be:
(a2 <- c(
kka["kasparov_plays_white_beats_karpov"],
kka["kasparov_plays_white_draws_karpov"],
kka["kasparov_plays_white_losesto_karpov"]
))## kasparov_plays_white_beats_karpov kasparov_plays_white_draws_karpov
## 30 57
## kasparov_plays_white_losesto_karpov
## 7To investigate the effect of playing white we might do this:
M <- rbind(a1,rev(a2))
dimnames(M) <- list(karpov_plays=c("White","Black"),result=c("karpov wins","karpov draws","karpov loses"))
M## result
## karpov_plays karpov wins karpov draws karpov loses
## White 18 72 9
## Black 7 57 30fisher.test(M)##
## Fisher's Exact Test for Count Data
##
## data: M
## p-value = 0.00011
## alternative hypothesis: two.sidedbut we need a likelihood function. Here I define likelihood function
karpov_kasparov_anand but to save typing we work with temporary
object H and rename it at the end:
results <- as.list(kka)
attach(results)
H <- hyper2()
## Kasparov vs Karpov
karpov_vs_kasparov <- c("Karpov","Kasparov","white","draw") # all "players", real and imaginary
H <- H + pick(c("Karpov" ,"white"), karpov_vs_kasparov) * karpov_plays_white_beats_kasparov
H <- H + pick(c("Kasparov","white"), karpov_vs_kasparov) * kasparov_plays_white_beats_karpov
H <- H + pick( "Karpov" , karpov_vs_kasparov) * kasparov_plays_white_losesto_karpov
H <- H + pick( "Kasparov" , karpov_vs_kasparov) * karpov_plays_white_losesto_kasparov
H <- H + pick( "draw" , karpov_vs_kasparov) * karpov_plays_white_draws_kasparov
H <- H + pick( "draw" , karpov_vs_kasparov) * kasparov_plays_white_draws_karpov
## Kasparov vs Anand
kasparov_vs_anand <- c("Kasparov","Anand","white","draw")
H <- H + pick(c("Kasparov","white"), kasparov_vs_anand) * kasparov_plays_white_beats_anand
H <- H + pick(c("Anand" ,"white"), kasparov_vs_anand) * anand_plays_white_beats_kasparov
H <- H + pick(c("Kasparov" ), kasparov_vs_anand) * anand_plays_white_losesto_kasparov
H <- H + pick(c("Anand" ), kasparov_vs_anand) * kasparov_plays_white_losesto_anand
H <- H + pick( "draw" , kasparov_vs_anand) * kasparov_plays_white_draws_anand
H <- H + pick( "draw" , kasparov_vs_anand) * anand_plays_white_draws_kasparov
## Karpov vs Anand
karpov_vs_anand <- c("Karpov","Anand","white","draw")
H <- H + pick(c("Karpov","white"), karpov_vs_anand) * karpov_plays_white_beats_anand
H <- H + pick(c("Anand" ,"white"), karpov_vs_anand) * anand_plays_white_beats_karpov
H <- H + pick( "Karpov" , karpov_vs_anand) * anand_plays_white_losesto_karpov
H <- H + pick( "Anand" , karpov_vs_anand) * karpov_plays_white_losesto_anand
H <- H + pick( "draw" , karpov_vs_anand) * karpov_plays_white_draws_anand
H <- H + pick( "draw" , karpov_vs_anand) * anand_plays_white_draws_karpov
detach(results)
karpov_kasparov_anand <- H
karpov_kasparov_anand## log(Anand^15 * (Anand + Karpov + draw + white)^-92 * (Anand + Kasparov
## + draw + white)^-80 * (Anand + white)^24 * Karpov^12 * (Karpov +
## Kasparov + draw + white)^-193 * (Karpov + white)^25 * Kasparov^20 *
## (Kasparov + white)^45 * draw^224)(karpov_kasparov_anand_maxp <- maxp(karpov_kasparov_anand))## Anand draw Karpov Kasparov white
## 0.150898 0.532267 0.064241 0.148545 0.104050(above, note that pick() supercedes deprecated function trial()).
Now test the hypothesis that all three players have the same strength;
first do the free optimization:
samep.test(karpov_kasparov_anand,c("Karpov","Kasparov","Anand"))##
## Constrained support maximization
##
## data: karpov_kasparov_anand
## null hypothesis: Karpov = Kasparov = Anand
## null estimate:
## Anand draw Karpov Kasparov white
## 0.11409 0.54366 0.11409 0.11409 0.11408
## (argmax, constrained optimization)
## Support for null: -333.23 + K
##
## alternative hypothesis: sum p_i=1
## alternative estimate:
## Anand draw Karpov Kasparov white
## 0.150898 0.532267 0.064241 0.148545 0.104050
## (argmax, free optimization)
## Support for alternative: -328.3 + K
##
## degrees of freedom: 2
## support difference = 4.9297
## p-value: 0.0072287and we reject that null. Now test the hypothesis that playing white confers no advantage:
specificp.test(karpov_kasparov_anand,"white",0)## Error in constrOptim(theta = startp_try, f = objective, grad = gradfun, :
## initial value is not in the interior of the feasible region
## known R bug (bugzilla ID 17703; wmmin not finite). Kludge: maxp_single() will try a slightly different start point##
## Constrained support maximization
##
## data: H
## null hypothesis: sum p_i=1, white = 0
## null estimate:
## Anand draw Karpov Kasparov white
## 2.7540e-01 2.6554e-01 2.1563e-01 2.4342e-01 1.0060e-06
## (argmax, constrained optimization)
## Support for null: -388.65 + K
##
## alternative hypothesis: sum p_i=1
## alternative estimate:
## Anand draw Karpov Kasparov white
## 0.150898 0.532267 0.064241 0.148545 0.104050
## (argmax, free optimization)
## Support for alternative: -328.3 + K
##
## degrees of freedom: 1
## support difference = 60.355
## p-value: 4.4215e-28 (two sided)We now allow each player to have a personalised draw monster. The
resulting likelihood function is called kka_3draws but the idiom
below uses H to save typing.
library("hyper2")
H <- hyper2()
results <- as.list(kka)
attach(results)
karpov_vs_kasparov <- c("Karpov","Kasparov","Karpov_draw","Kasparov_draw","white")
draw1 <- c("Karpov_draw","Kasparov_draw")
H <- H + pick(c("Karpov" ,"white"), karpov_vs_kasparov) * karpov_plays_white_beats_kasparov
H <- H + pick(c("Kasparov","white"), karpov_vs_kasparov) * kasparov_plays_white_beats_karpov
H <- H + pick(c("Karpov" ) , karpov_vs_kasparov) * kasparov_plays_white_losesto_karpov
H <- H + pick(c("Kasparov") , karpov_vs_kasparov) * karpov_plays_white_losesto_kasparov
H <- H + pick(draw1 , karpov_vs_kasparov) * karpov_plays_white_draws_kasparov
H <- H + pick(draw1 , karpov_vs_kasparov) * kasparov_plays_white_draws_karpov
## Kasparov vs Anand
kasparov_vs_anand <- c("Kasparov","Anand","Kasparov_draw","Anand_draw","white")
draw2 <- c("Kasparov_draw","Anand_draw")
H <- H + trial(c("Kasparov","white"), kasparov_vs_anand) * kasparov_plays_white_beats_anand
H <- H + trial(c("Anand" ,"white"), kasparov_vs_anand) * anand_plays_white_beats_kasparov
H <- H + trial(c("Kasparov" ) , kasparov_vs_anand) * anand_plays_white_losesto_kasparov
H <- H + trial(c("Anand") , kasparov_vs_anand) * kasparov_plays_white_losesto_anand
H <- H + trial(draw2 , kasparov_vs_anand) * kasparov_plays_white_draws_anand
H <- H + trial(draw2 , kasparov_vs_anand) * anand_plays_white_draws_kasparov
## Karpov vs Anand
karpov_vs_anand <- c("Karpov","Anand","Karpov_draw","Anand_draw","white")
draw3 <- c("Karpov_draw","Anand_draw")
H <- H + pick(c("Karpov","white"), karpov_vs_anand) * karpov_plays_white_beats_anand
H <- H + pick(c("Anand" ,"white"), karpov_vs_anand) * anand_plays_white_beats_karpov
H <- H + pick(c("Karpov" ), karpov_vs_anand) * anand_plays_white_losesto_karpov
H <- H + pick(c("Anand" ), karpov_vs_anand) * karpov_plays_white_losesto_anand
H <- H + pick(draw3 , karpov_vs_anand) * karpov_plays_white_draws_anand
H <- H + pick(draw3 , karpov_vs_anand) * anand_plays_white_draws_karpov
detach(results)
kka_3draws <- H
kka_3draws ## log(Anand^15 * (Anand + Anand_draw + Karpov + Karpov_draw + white)^-92
## * (Anand + Anand_draw + Kasparov + Kasparov_draw + white)^-80 * (Anand
## + white)^24 * (Anand_draw + Karpov_draw)^49 * (Anand_draw +
## Kasparov_draw)^46 * Karpov^12 * (Karpov + Karpov_draw + Kasparov +
## Kasparov_draw + white)^-193 * (Karpov + white)^25 * (Karpov_draw +
## Kasparov_draw)^129 * Kasparov^20 * (Kasparov + white)^45)and one natural test is that the three draw monsters are of equal strength:
(kka_3draws_maxp <- maxp(kka_3draws))## Anand Anand_draw Karpov Karpov_draw Kasparov
## 0.094858 0.066127 0.052101 0.192549 0.146052
## Kasparov_draw white
## 0.368246 0.080068pie(kka_3draws_maxp)
samep.test(kka_3draws,c("Karpov_draw","Kasparov_draw","Anand_draw"))##
## Constrained support maximization
##
## data: kka_3draws
## null hypothesis: Karpov_draw = Kasparov_draw = Anand_draw
## null estimate:
## Anand Anand_draw Karpov Karpov_draw Kasparov
## 0.119164 0.210195 0.050715 0.210195 0.117354
## Kasparov_draw white
## 0.210195 0.082182
## (argmax, constrained optimization)
## Support for null: -328.3 + K
##
## alternative hypothesis: sum p_i=1
## alternative estimate:
## Anand Anand_draw Karpov Karpov_draw Kasparov
## 0.094858 0.066127 0.052101 0.192549 0.146052
## Kasparov_draw white
## 0.368246 0.080068
## (argmax, free optimization)
## Support for alternative: -325.06 + K
##
## degrees of freedom: 2
## support difference = 3.2351
## p-value: 0.039356Now allow each player to have distinct white strength. We create
kka_3whites, again using temporary variable H to save typing:
H <- hyper2()
results <- as.list(kka)
attach(results)
D <- "draw"
## First: Karpov vs Kasparov
karpov_plays_white_vs_kasparov <- c("Karpov","Kasparov","Karpov_white","draw" ) # "players"
kasparov_plays_white_vs_karpov <- c("Karpov","Kasparov","Kasparov_white","draw")
H <- H + trial(c("Karpov" ,"Karpov_white" ), karpov_plays_white_vs_kasparov, karpov_plays_white_beats_kasparov ) # Karpov wins playing white
H <- H + trial(c("Kasparov","Kasparov_white"), kasparov_plays_white_vs_karpov, kasparov_plays_white_beats_karpov ) # Kasparov wins playing white
H <- H + trial(c("Kasparov") , karpov_plays_white_vs_kasparov, karpov_plays_white_losesto_kasparov) # Kasparov wins playing black
H <- H + trial(c("Karpov" ) , kasparov_plays_white_vs_karpov, kasparov_plays_white_losesto_karpov) # Karpov wins playing black
H <- H + trial(D , karpov_plays_white_vs_kasparov, karpov_plays_white_draws_kasparov ) # Karpov white, draws
H <- H + trial(D , kasparov_plays_white_vs_karpov, kasparov_plays_white_draws_karpov ) # Kasparov white, draws
## Second: Karpov vs Anand
karpov_plays_white_vs_anand <- c("Karpov","Anand","Karpov_white","draw" )
anand_plays_white_vs_karpov <- c("Karpov","Anand","Anand_white","draw")
H <- H + trial(c("Karpov","Karpov_white"), karpov_plays_white_vs_anand, karpov_plays_white_beats_anand ) # Karpov wins playing white
H <- H + trial(c("Anand" ,"Anand_white" ), anand_plays_white_vs_karpov, anand_plays_white_beats_karpov ) # Anand wins playing white
H <- H + trial(c("Anand" ), karpov_plays_white_vs_anand, karpov_plays_white_losesto_anand) # Anand wins playing black
H <- H + trial(c("Karpov" ), anand_plays_white_vs_karpov, anand_plays_white_losesto_karpov) # Karpov wins playing black
H <- H + trial(D , karpov_plays_white_vs_anand, karpov_plays_white_draws_anand ) # Karpov white, draws
H <- H + trial(D , anand_plays_white_vs_karpov, anand_plays_white_draws_karpov ) # Anand white, draws
## Third: Kasparov vs Anand
anand_plays_white_vs_kasparov <- c("Anand","Kasparov","Anand_white","draw" )
kasparov_plays_white_vs_anand <- c("Anand","Kasparov","Kasparov_white","draw")
H <- H + trial(c("Kasparov","Kasparov_white"), kasparov_plays_white_vs_anand, kasparov_plays_white_beats_anand ) # Kasparov wins playing white
H <- H + trial(c("Anand" ,"Anand_white" ), anand_plays_white_vs_kasparov, anand_plays_white_beats_kasparov ) # Anand wins playing white
H <- H + trial(c("Anand" ), kasparov_plays_white_vs_anand, kasparov_plays_white_losesto_anand) # Anand wins playing black
H <- H + trial(c("Kasparov" ), anand_plays_white_vs_kasparov, anand_plays_white_losesto_kasparov) # Kasparov wins playing black
H <- H + trial(D , kasparov_plays_white_vs_anand, kasparov_plays_white_draws_anand ) # Kasparov white, draws
H <- H + trial(D , anand_plays_white_vs_kasparov, anand_plays_white_draws_kasparov ) # Anand white, draws
detach(results)
kka_3whites <- H
kka_3whites## log(Anand^15 * (Anand + Anand_white)^24 * (Anand + Anand_white + Karpov
## + draw)^-43 * (Anand + Anand_white + Kasparov + draw)^-37 * (Anand +
## Karpov + Karpov_white + draw)^-49 * (Anand + Kasparov + Kasparov_white
## + draw)^-43 * Karpov^12 * (Karpov + Karpov_white)^25 * (Karpov +
## Karpov_white + Kasparov + draw)^-99 * (Karpov + Kasparov +
## Kasparov_white + draw)^-94 * Kasparov^20 * (Kasparov +
## Kasparov_white)^45 * draw^224)Natural test for equality of the three white monsters’s strengths:
(kka_3whites_maxp <- maxp(kka_3whites))## Anand Anand_white draw Karpov Karpov_white
## 0.115703 0.101214 0.427401 0.063867 0.043929
## Kasparov Kasparov_white
## 0.096822 0.151064pie(kka_3whites_maxp)
samep.test(kka_3whites,c("Karpov_white","Kasparov_white","Anand_white"))##
## Constrained support maximization
##
## data: kka_3whites
## null hypothesis: Karpov_white = Kasparov_white = Anand_white
## null estimate:
## Anand Anand_white draw Karpov Karpov_white
## 0.124866 0.086168 0.440530 0.053169 0.086168
## Kasparov Kasparov_white
## 0.122929 0.086168
## (argmax, constrained optimization)
## Support for null: -328.3 + K
##
## alternative hypothesis: sum p_i=1
## alternative estimate:
## Anand Anand_white draw Karpov Karpov_white
## 0.115703 0.101214 0.427401 0.063867 0.043929
## Kasparov Kasparov_white
## 0.096822 0.151064
## (argmax, free optimization)
## Support for alternative: -326.72 + K
##
## degrees of freedom: 2
## support difference = 1.5792
## p-value: 0.20615(fail to reject the null).
We now create a 3x3x3 array of results for the dataset.
library("hyper2")
library("abind")
attach(as.list(kka))
players <- c("Anand","Karpov","Kasparov")
plays_white_wins <- matrix(NA,3,3)
dimnames(plays_white_wins) <- list(plays_white_wins=players,plays_black_loses=players)
plays_white_wins["Anand" ,"Karpov" ] <- anand_plays_white_beats_karpov
plays_white_wins["Anand" ,"Kasparov"] <- anand_plays_white_beats_kasparov
plays_white_wins["Karpov" ,"Anand" ] <- karpov_plays_white_beats_anand
plays_white_wins["Karpov" ,"Kasparov"] <- karpov_plays_white_beats_kasparov
plays_white_wins["Kasparov","Anand" ] <- kasparov_plays_white_beats_anand
plays_white_wins["Kasparov","Karpov" ] <- kasparov_plays_white_beats_karpov
plays_white_draws <- matrix(NA,3,3)
dimnames(plays_white_draws) <- list(plays_white_draws=players,plays_black_draws=players)
plays_white_draws["Anand" ,"Karpov" ] <- anand_plays_white_draws_karpov
plays_white_draws["Anand" ,"Kasparov"] <- anand_plays_white_draws_kasparov
plays_white_draws["Karpov" ,"Anand" ] <- karpov_plays_white_draws_anand
plays_white_draws["Karpov" ,"Kasparov"] <- karpov_plays_white_draws_kasparov
plays_white_draws["Kasparov","Anand" ] <- kasparov_plays_white_draws_anand
plays_white_draws["Kasparov","Karpov" ] <- kasparov_plays_white_draws_karpov
plays_white_loses <- matrix(NA,3,3)
dimnames(plays_white_loses) <- list(plays_white_loses=players,plays_black_wins=players)
plays_white_loses["Karpov" ,"Anand" ] <- karpov_plays_white_losesto_anand
plays_white_loses["Kasparov" ,"Anand" ] <- kasparov_plays_white_losesto_anand
plays_white_loses["Anand" ,"Karpov" ] <- anand_plays_white_losesto_karpov
plays_white_loses["Kasparov" ,"Karpov" ] <- kasparov_plays_white_losesto_karpov
plays_white_loses["Anand" ,"Kasparov"] <- anand_plays_white_losesto_kasparov
plays_white_loses["Karpov" ,"Kasparov"] <- karpov_plays_white_losesto_kasparov
detach(as.list(kka))
plays_white_wins## plays_black_loses
## plays_white_wins Anand Karpov Kasparov
## Anand NA 18 6
## Karpov 7 NA 18
## Kasparov 15 30 NA plays_white_draws## plays_black_draws
## plays_white_draws Anand Karpov Kasparov
## Anand NA 20 20
## Karpov 29 NA 72
## Kasparov 26 57 NA plays_white_loses## plays_black_wins
## plays_white_loses Anand Karpov Kasparov
## Anand NA 5 11
## Karpov 13 NA 9
## Kasparov 2 7 NAkka_array <- abind(
plays_white_wins,
plays_white_draws,
plays_white_loses,
along=3)
dimnames(kka_array)[[3]] <- c("plays_white_wins", "plays_white_draws", "plays_white_loses")
kka_array## , , plays_white_wins
##
## Anand Karpov Kasparov
## Anand NA 18 6
## Karpov 7 NA 18
## Kasparov 15 30 NA
##
## , , plays_white_draws
##
## Anand Karpov Kasparov
## Anand NA 20 20
## Karpov 29 NA 72
## Kasparov 26 57 NA
##
## , , plays_white_loses
##
## Anand Karpov Kasparov
## Anand NA 5 11
## Karpov 13 NA 9
## Kasparov 2 7 NA1 Some ideas for hyper3 analysis.
First we ignore the draws and create a matrix with real parts representing white wins (home wins in the context of football) and imaginary parts representing black (away) wins. A pairwise likelihood function would be
\[ \left(\frac{\lambda p_1}{\lambda p_1+p_2}\right)^a \left(\frac{ p_2}{\lambda p_1+p_2}\right)^b \left(\frac{ p_1}{p_1+\lambda p_2}\right)^c \left(\frac{\lambda p_1}{p_1+\lambda p_2}\right)^d \]
for the observation of \(+a\) \(\text{=}0\) \(-b\) for \(p_1\) playing white
and \(+c\) \(\text{=}0\) \(-d\) for \(p_2\) playing white. We then translate
this into a hyper3 likelihood function as follows
(M <- kka_array[,,1] + 1i*kka_array[,,3])## Anand Karpov Kasparov
## Anand NA 18+5i 6+11i
## Karpov 7+13i NA 18+ 9i
## Kasparov 15+ 2i 30+7i NAhome_away3(M,lambda=1.1)## log( (Anand=1)^15 * (Anand=1, Karpov=1.1)^-20 * (Anand=1,
## Kasparov=1.1)^-17 * (Anand=1.1)^24 * (Anand=1.1, Karpov=1)^-23 *
## (Anand=1.1, Kasparov=1)^-17 * (Karpov=1)^12 * (Karpov=1,
## Kasparov=1.1)^-37 * (Karpov=1.1)^25 * (Karpov=1.1, Kasparov=1)^-27 *
## (Kasparov=1)^20 * (Kasparov=1.1)^45)Above we use \(\lambda=1.1\), as a specific numeric value is required by the idiom.
l <- function(lambda){
H <- home_away3(M,lambda=lambda)
loglik(maxp(H),H)
}
lam <- seq(from=1.2,to=3.5,len=10)
like <- sapply(lam,l)and plot it:
plot(lam,like-max(like),type="b",pch=16)
abline(h=c(0,-2),lty=2)
Above we see a credible interval for \(\lambda\) being about \((1.4,2.9)\). Of course, this is crude and it would be better to have more transparent package idiom. But I’m working on this.
We can now introduce draws but first a change of notation. Considering repeated trials between entities \(1,2,\ldots, r\) with Bradley-Terry strengths \(p_1,\ldots, p_r\) and counts \(n_1,\ldots, n_r\) a suitable likelihood function would be
\[ \left(\frac{p_1}{\sum p_i}\right)^{n_1}\cdot \left(\frac{p_2}{\sum p_i}\right)^{n_2}\ldots \left(\frac{p_r}{\sum p_i}\right)^{n_r} \]
but we may represent this in the following compact form:
\[ \left(\frac{p_1,p_2,\ldots, p_r}{\sum p_i}\right)^{\left(n_1,\ldots n_r\right)} \]
Or, noting that the sum of the numerators is equal to the common denominator, even more compactly as \(\left(p_1,p_2,\ldots, p_r\right)^{\left(n_1,\ldots n_r\right)}\).
The previous likelihood function can be represented thus:
\[ \left(\frac{\lambda p_1, p_2}{\lambda p_1+p_2}\right)^{(a,b)} \left(\frac{p_1, \lambda p_2}{p_1+\lambda p_2}\right)^{(c,d)} \]
Draws would change this by introducing a weighted Draw monster \(D\):
\[ \left(\frac{\lambda p_1, D(p_1+p_2),p_2}{\lambda p_1+D(p_1+p_2)+p_2}\right)^{(a,b,c)} \left(\frac{p_1, D(p_1+p_2),\lambda p_2}{p_1+D(p_1+p_2)+\lambda p_2}\right)^{(d,e,f)} \]
or possibly an individual Draw monster:
\[ \left(\frac{\lambda p_1, D_1p_1+D_2p_2,p_2}{\lambda p_1+D_1p_1+D_2p_2+p_2}\right)^{(a,b,c)} \left(\frac{p_1, D_1p_1+D_2p_2),\lambda p_2}{p_1+D_1p_1+D_2p_2+\lambda p_2}\right)^{(d,e,f)} \]
Package idiom for this would require the following form:
\[ \left(\frac{\lambda p_1, D_1p_1+D_2p_2,p_2}{(\lambda+D_1)p_1+(1+D_2)p_2}\right)^{(a,b,c)} \left(\frac{p_1, D_1p_1+D_2p_2,\lambda p_2}{(1+D_1)p_1+(\lambda+D_2)p_2}\right)^{(d,e,f)} \]
Note that in neither of these models do we have the probability of a draw for \(p_1\) playing white being the same as for \(p_2\) playing white. In the first case the two probabilities are
\[ \frac{D(p_1+p_2)}{(\lambda +D)p_1 + (1+D)p_2},\qquad \frac{D(p_1+p_2)}{(1+D)p_1 + (\lambda+D)p_2} \]
and in the second they are
\[ \frac{D_1p_1+D_2p_2}{(\lambda +D_1)p_1 + (1+D_2)p_2},\qquad \frac{D_1p_1+D_2p_2}{(1 +D_1)p_1 + (\lambda+D_2)p_2} \]
With strictly positive \(D,D_1,D_2\) these are equal if and only if \((\lambda-1)(p_1-p_2)=0\), that is, if the white advantage is nonexistent, or if the players have the same strength.
We can use the bespoke function hyper2::white_draw3() to make a
likelihood function:
white_draw3(kka_array, 1.1, 2.3)## log( (Anand=1)^15 * (Anand=1.1)^24 * (Anand=2.3, Karpov=2.3)^49 *
## (Anand=2.3, Kasparov=2.3)^46 * (Anand=3.3, Karpov=3.4)^-49 *
## (Anand=3.3, Kasparov=3.4)^-43 * (Anand=3.4, Karpov=3.3)^-43 *
## (Anand=3.4, Kasparov=3.3)^-37 * (Karpov=1)^12 * (Karpov=1.1)^25 *
## (Karpov=2.3, Kasparov=2.3)^129 * (Karpov=3.3, Kasparov=3.4)^-94 *
## (Karpov=3.4, Kasparov=3.3)^-99 * (Kasparov=1)^20 * (Kasparov=1.1)^45)Then make a wrapper:
f <- function(v){
lambda <- v[1]
D <- v[2]
H <- white_draw3(kka_array, lambda,D)
max(maxp(H,n=1,justlikes=TRUE))
}
f(c(1.5,2.3))## [1] -328.77n <- 10
lambda <- seq(from=1.4,to=2.9,len=n)
D <- seq(from=1.6,to=3.4,len=n)
M <- as.matrix(expand.grid(lambda=lambda,D=D))
l <- matrix(apply(M,1,f),n,n)l <- l-max(l)
contour(lambda,D,l,nlevels=30,xlab="lambda",ylab="D")
abline(v=lambda,col='gray',lwd=0.2)
abline(h=D,col='gray',lwd=0.2)
lambda## [1] 1.4000 1.5667 1.7333 1.9000 2.0667 2.2333 2.4000 2.5667 2.7333 2.9000D## [1] 1.6 1.8 2.0 2.2 2.4 2.6 2.8 3.0 3.2 3.4Optimize:
(o <- optim(par=c(2.1,2.4),fn=f,control=list(fnscale = -1)))## $par
## [1] 2.0862 2.4330
##
## $value
## [1] -326.14
##
## $counts
## function gradient
## 37 NA
##
## $convergence
## [1] 0
##
## $message
## NULLjj <- round(o$par,2)
(chess3 <- white_draw3(kka_array, lambda=jj[1],D=jj[2]))## log( (Anand=1)^15 * (Anand=2.09)^24 * (Anand=2.43, Karpov=2.43)^49 *
## (Anand=2.43, Kasparov=2.43)^46 * (Anand=3.43, Karpov=4.52)^-49 *
## (Anand=3.43, Kasparov=4.52)^-43 * (Anand=4.52, Karpov=3.43)^-43 *
## (Anand=4.52, Kasparov=3.43)^-37 * (Karpov=1)^12 * (Karpov=2.09)^25 *
## (Karpov=2.43, Kasparov=2.43)^129 * (Karpov=3.43, Kasparov=4.52)^-94 *
## (Karpov=4.52, Kasparov=3.43)^-99 * (Kasparov=1)^20 *
## (Kasparov=2.09)^45)(chess3_maxp <- maxp(chess3))## Anand D Karpov Kasparov lambda
## 0.19282 0.19850 0.12223 0.29290 0.193541.0.1 Package dataset
Following lines create kka.rda, residing in the data/ directory of
the package.
save(kka,karpov_kasparov_anand,kka_3draws,kka_3whites,kka_array,chess3,chess3_maxp,file="kka.rda")hyper2 Package: Likelihood Functions for Generalized Bradley-Terry Models.” The R Journal 9 (2): 429–39.