---
title: "Quantifying the home ground advantage"
author: "Robin K. S. Hankin"
date: "`r Sys.Date()`"
vignette: >
  %\VignetteIndexEntry{home_ground_advantage}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

Here I analyse a small synthetic dataset for home ground advantage.


First load the package:
```{r}
library(hyper2)
```

Now generate the dataset:

```{r}
home_games_won <- matrix(c(
    NA, 16, 12, 11,
    19, NA, 19, 16,
    17, 12, NA, 11,
    11, 12, 12, NA),
    nrow=4,ncol=4,byrow=TRUE)

away_games_won <- matrix(c(
    NA, 05, 02, 02,
    02, NA, 10, 02,
    00, 04, NA, 07,
    02, 06, 04, NA),
    nrow=4,ncol=4,byrow=TRUE)

teams <- LETTERS[1:4]
dimnames(home_games_won) <- list("@home" = teams,"@away"=teams)
dimnames(away_games_won) <- list("@home" = teams,"@away"=teams)

home_games_won
away_games_won
```

Thus `home_games_won[1,2] == 16` means A played at home against B and
won 16 times; `home_games_won[2,1] == 19` means B played at home
against A and won 19 times.  Also, `away_games_won[1,2] == 5` means A
played away against B and won 5 times, and `away_games_won[2,1] == 2`
means B played away against A and won 2 times.  Alternatively, A
played B 16+19+5+2=45 times; A played at home 16+2=18 times and won 16
times and lost 2 times; and B played at home 19+5=24 times and won 19
times and lost 5 times.

We will create a hyper2 object with the teams and home ground advantage term:

```{r}
H <- hyper2(pnames=c(teams,"home"))
```


First include the home games won:

```{r}
for(i in seq_len(nrow(home_games_won))){
  for(j in seq_len(ncol(home_games_won))){
    if(i != j){  # diagonal means a team plays itself, meaningless
      game_winner <- teams[i]
      game_loser  <- teams[j]
      no_of_matches <- home_games_won[i,j] # won with home strength helping
      H[c(game_winner,           "home")] %<>% inc(no_of_matches)  # won with home strength helping
      H[c(game_winner,game_loser,"home")] %<>% dec(no_of_matches)
    }
  }
}
```

Now away games won:

```{r}
for(i in seq_len(nrow(away_games_won))){
  for(j in seq_len(ncol(away_games_won))){
    if(i != j){
      game_winner <- teams[i]
      game_loser  <- teams[j]
      no_of_matches <- away_games_won[i,j] # won without the benefit of home strength
      H[c(game_winner                  )] %<>% inc(no_of_matches)  # won without home ground helping...
      H[c(game_winner,game_loser,"home")] %<>% dec(no_of_matches)  # home strength nevertheless on denominator
    }
  }
}
```

Thus

```{r}
H
```

Visually:


```{r}
dotchart(maxp(H))
```
  
Now a likelihood ratio for the hypothesis that home strength (or home
advantage) is zero.  First define a function `f()` that maximises the
likelihood subject to the home strength being *less than* its
argument:


```{r}
f <- function(home){
	small <- 1e-3
	maxp(H,startp=rep((1-small)/4,4),give=TRUE,fcm=t(rep(1,4)),fcv=1-home)$value
}
```

See how the `fcm` and `fcv` constraints make the sum of a,b,c,d,
greater than `1-home`.  Thus 'home' [which is the fillup value,
$p_\mathrm{home}=1-(p_A+p_B+p_C+p_D)$] is constrained to be less than
argument `home`.  Using this function, the likelihood ratio test is
straightforward:

```{r}
Lambda <- -2*(f(0.01)-maxp(H,give=TRUE)$value)
Lambda
```

Under the null, Wilks's theorem gives us that Lambda is distributed as
a chi-square with 1 degree of freedom (clearly rejected).  However, it
is always interesting to plot likelihood functions.  To plot a profile
likelihood we can constrain the home to be greater than a particular
value:

```{r}
g <- function(home){
	small <- 1e-3
	maxp(H,startp=rep(small/4,4),give=TRUE,fcm=-t(rep(1,4)),fcv=home-1)$value
}
```


```{r}
home_strength <- seq(from=0.2,to=0.6,length=30)
support <- pmin(sapply(home_strength,f),sapply(home_strength,g))
plot(home_strength,support-max(support),
     xlab="home strength",ylab="support",main="profile likelihood for home advantage")
abline(h=c(0,-2))
```

The figure give a support interval between about 0.3 and 0.5 for home
ground advantage.
