---
title: "Tennis doubles and ghosts"
output: bookdown::html_document2
---

```{r setup, include=FALSE}
set.seed(0)
knitr::opts_chunk$set(echo = TRUE)
library("hyper2")
library("magrittr")
options("digits" = 5)
```

<p style="text-align: right;">
![](`r system.file("help/figures/hyper2.png", package = "hyper2")`){width=10%}
</p>


This short document defines and analyses a small dataset originally
considered by Hankin (2010).  There, results from tennis games among
four players was considered:

```
       {p1,p2} vs {p3,p4}   9-2  
       {p1,p3} vs {p2,p4}   4-4  
       {p1,p4} vs {p2,p3}   6-7  
          {p1} vs {p3}     10-14 
          {p2} vs {p3}     12-14 
          {p1} vs {p4}     10-14 
          {p2} vs {p4}     11-10 
          {p3} vs {p4}     13-13 

```

It is suspected that $p_1$ and $p_2$ have some form of team cohesion
and play better when paired than when either solo or with other
players.  As the scores show, each player and, apart from the first
line, each doubles partnership is of approximately the same strength.

We will create two likelihood functions: a regular one that assumes
the stength of a doubles partnership is the sum of the strength of the
players; and one that accounts for team cohesion.


```{r defineHhyper2}
H <- hyper2()

## 1&3 vs 2&4, scoreline 4-4:
H[c("p1","p3")] %<>% inc(4)
H[c("p2","p4")] %<>% inc(4)
H[c("p1","p2","p3","p4")] %<>% dec(8)

## 1&4 vs 2&3, scoreline 6-7:
H[c("p1","p4")] %<>% inc(6)
H[c("p2","p3")] %<>% inc(7)
H[c("p1","p2","p3","p4")] %<>% dec(13)

## 1 vs 3, scoreline 10-14:
H["p1"] %<>% inc(10)
H["p3"] %<>% inc(14)
H[c("p1","p3")] %<>% dec(24)

## 2 vs 3, scoreline 12-14:
H["p2"] %<>% inc(12)
H["p3"] %<>% inc(14)
H[c("p2","p3")] %<>% dec(26)

## 1 vs 4, scoreline 10-14:
H["p1"] %<>% inc(10)
H["p4"] %<>% inc(14)
H[c("p1","p4")] %<>% dec(24)

## 2 vs 4, scoreline 11-10:
H["p2"] %<>% inc(11)
H["p4"] %<>% inc(10)
H[c("p2","p4")] %<>% dec(21)

## 3 vs 4, scoreline 13-13:
H["p3"] %<>% inc(13)
H["p4"] %<>% inc(13)
H[c("p3","p4")] %<>% dec(26)
```

Thus `H` is a hyper2 object corresponding to results except the first
line.  We include this in two ways.  Firstly, treating the first
scoreline like the others:

```{r addtohyper2H}
tennis <- H

## 1&2 vs 3&4, scoreline 9-2:
tennis[c("p1","p2")] %<>% inc(9)
tennis[c("p3","p4")] %<>% inc(2)
tennis[c("p1","p2","p3","p4")] %<>% dec(11)

tennis
```

And secondly, accounting for any possible team cohesion by way of a
ghost player `G`:



```{r doghoststuff}
tennis_ghost <- H

## 1&2 vs 3&4 (NB: includes ghost!), scoreline 9-2 (again):
tennis_ghost[c("p1","p2","G")] %<>% inc(9)
tennis_ghost[c("p3","p4")] %<>% inc(2)
tennis_ghost[c("p1","p2","p3","p4","G")] %<>% dec(11)

tennis_ghost
```

standard evaluates:

```{r maximizeghostlike,cache=TRUE}
(tennis_maxp <- maxp(tennis))
(tennis_ghost_maxp <- maxp(tennis_ghost))
```

First test the null of equal strength:


```{r doequalptest,cache=TRUE}
equalp.test(tennis)
```

not significant.  Is the ghost real?


```{r specificptesthere,cache=TRUE}
specificp.test(tennis_ghost,"G",0.0001)  # nonzero value needed to avoid triggering known R bug
```

so we can infer that the ghost is indeed real as we reject $H_0\colon
p_G=0$.

We can use the Hessian matrix:

```{r hessianmatrix}
(M <- hessian(tennis,indep(tennis_maxp),border=TRUE))
```

See how the fillup value `p4` takes up the unit sum constraint [it is
defined as $p_4=1-p_1-p_2-p_3$].  Matrix `M` should be
negative-semidefinite:


```{r eigenwork}
eigen(M,TRUE,TRUE)$values # one value is zero to numerical precision; the rest should be <0
```

See how one eigenvalue is zero (to numerical precision) and the rest
are strictly negative, corresponding to the support function having a
well-defined maximum.






### Analysis with `hyper3` {-}

The likelihood for the 9-2 scoreline between $\left\lbrace
p1,p2\right\rbrace$ and $\left\lbrace p3,p4\right\rbrace$ would have a
likelihood function of

$$
\frac{
\left(\lambda p_1 +\lambda p_2\right)^{9}
\left(p_2 + p_3\right)^{2}
}{
\left(\lambda p_1 +\lambda p_2+p_2 + p_3\right)^{11}
}
$$



```{r printH}
H3 <- as.hyper3(H)
H3

## 1&2 vs 3&4;  scoreline 9-2 (again), with lambda=1.2

f <- function(lambda){
  H3[c(p1=lambda,p2=lambda)] %<>% inc(9)
  H3[c(p3=1,p2=1)] %<>% dec(2)
  H3[c(p1=lambda,p2=lambda,p3=1,p2=1)] %<>% dec(11)
  return(H3)
}
f(1.1443345)
f(1.888888)
```


maximize:

```{r,maxH3,cache=TRUE}
tennis_H3_maxp <- maxp(H3)
tennis_H3_maxp
```

Compare the `hyper2` evaluates:

```{r}
tennis_maxp
tennis_ghost_maxp
```


### References {-}

* RKS Hankin 2010. "A generalization of the Dirichlet distribution". 
 _Journal of Statistical Software_ 33(11)
* RKS Hankin 2017. "Partial rank data with the hyper2 package:
  likelihood functions for generalized Bradley-Terry models".  _The R
  Journal_ 9(2)


### Package dataset {-}

Following lines create `tennis.rda`, residing in the `data/` directory of the package.

```{r,label=saveghosttennisdataset}
save(tennis,tennis_maxp,tennis_ghost, tennis_ghost_maxp,file="tennis.rda")
```
