In RobinHankin/hyper2: The Hyperdirichlet Distribution, Mark 2
knitr::opts_chunk$set(echo = TRUE)
library("hyper2")
library("partitions")
library("pdftools")
knitr::include_graphics(system.file("help/figures/hyper2.png", package = "hyper2"))
To cite the hyper2 package in publications, please use @hankin2017_rmd.
Here I modify standard Plackett-Luce likelihood functions to include
an element of non-independence among the competitors. There seem to
be a few distinct statistical models for nonindependence:
-
Runner $i$ might wish to support $j$. If runner $i$ finishes, once
his rank is established he might be able to help $j$ in some way.
He might cheer his still-running friend, spurring him to run faster
and augmenting his competitive strength.
-
In general, we can consider $n$ ordered pairs $(i_r,j_r)$, $1\leq
r\leq n$, with runner $i_1$ helping runner $j_1$, runner $i_2$
helping $j_2$, and so on. One simple case would be equivalence
classes of $[n]={1,2,\ldots,n}$ with each equivalence class
comprising mutually supporting runners. In this model, with a pair
of mutually supporting runners only the higher-placed competitor can
affect the other. Each equivalence class might have a different
supportive proclivity.
-
Runner $i$ might hate runner $j$. If $i$ finishes, he might expend
his spare energy hindering $j$ (by throwing stones or booing, for
example). Note that equivalence classes of mutual hatred might
exist.
-
Also, the help or hindrance might have a finite lifetime. Under one
model, if $i$ finishes then he can stay helping (or hindering) $j$
wherever $j$ places. Alternatively, suppose $i$ places $n$th. Then
perhaps he can affect $j$ only place $n+1$, and after a competitor
finishes in place $n+1$, then $i$ can exert no further influence.
-
The help or hindrance discussed above might be contingent on
placing: perhaps only the winnner (that is, first-placing
competitor) would be able to influence other competitors. Or maybe
competitors with any placing could influence other competitors.
-
Runners $i$ and $j$ might elect to cross the finishing line holding
hands, with the apparent tie broken randomly. This would be a
symmetrical relationship. In general, we could consider
hand-holding equivalence classes.
-
We might have a resource allocation problem, with runners having a
certain [possibly unknown] amount of "strength" but also the ability
to expend this strength on objectives other than ranking in the
race. A runner might be able to expend just enough energy to remain
slightly ahead of a rival, reserving energy for other purposes. If
runner $i$ wishes to beat runner $j$, and has sufficient resources
to do so, then runners $i$ and $j$ will finish consecutively with
$i$ ahead of $j$.
Start simple: three runners
The simplest nontrivial case is three runners, $\left\lbrace
1,2,3\right\rbrace$ where runner 1 helps runner 2 with multiplier
$\lambda$ [and that is the only non PL interaction]. Note that this
is not a symmetric interaction: 1 helps 2, but 2 does not help 1.
The model is that 1 helps 2 if and only if 1 has finished and 2 has
not.
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
(Above, the probabilities clearly sum to 1). Next simplest: 1 and 2
mutually support each other with $\lambda$:
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{\lambda p_1}{p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
Now we retain the mutual support between 1 and 2 but allow an
asymmetry: 1 helps 2 with $\lambda$ as before, but now in addition, 2
helps 1 with $\mu$:
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{\mu p_1}{\mu p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{\mu p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
Now how about 1 must beat 2. He does not care whether he comes first
or second, only that he must beat 2. Player 1 has sufficient energy
to win if he wants, but is subject to some sort of resource constraint
(money, perhaps) and wishes to expend only enough money to beat 2. So
conventional P-L likelihoods are modified for 1, but only if 2 is
still running.
123: $\frac{\lambda p_1}{\lambda p_1+p_2+p_3}\cdot\frac{p_2}{p_2+p_3}$
132: $\frac{\lambda p_1}{\lambda p_1+p_2+p_3}\cdot\frac{p_3}{p_2+p_3}$
213: $\frac{p_2}{\lambda p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_3}$
231: $\frac{p_2}{\lambda p_1+p_2+p_3}\cdot\frac{p_3}{p_1+p_3}$
312: $\frac{p_3}{\lambda p_1+p_2+p_3}\cdot\frac{\lambda p_1}{\lambda p_1+p_2}$
321: $\frac{p_3}{\lambda p_1+p_2+p_3}\cdot\frac{p_2}{\lambda p_1+p_2}$
Four runners
Now we have four runners $\left\lbrace 1,2,3,4\right\rbrace$, again
with the only interaction being runner 1 helping runner 2. Thus, in a
situation where $p_1$ has finished and $p_2$ is still running, we have
$p_2\longrightarrow\lambda p_2$ [although the $\lambda$ cancels if 2
is the only competitor still running, that is, if all the remaining
competitors are helped]
1234: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}$
1243: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
1342: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
1423: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{p_1+\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
1432: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{p_1+\lambda p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3}$
2xxx: P-L [no help given by 2 to 1]
3124: $\frac{p_3}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
3142: $\frac{p_3}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}$
32xx: P-L
3412: P-L [1 helps 2 but when 1 crosses the finishing line, only 2 is
still running; there are no non-helped competitors]
4123: $\frac{p_4}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
4132: $\frac{p_4}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
42xx: P-L
43xx: P-L
Now 1 and 2 mutually support one another by $\lambda$. Here I will
put the last term in, to show explicitly that the $\lambda$ term
remains in the expressions for numerator and denominator.
1234: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda
p_2+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}\cdot\frac{p_4}{p_4}$
1243: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda
p_2+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}\cdot\frac{p_3}{p_3}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda
p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda
p_2+p_4}\cdot\frac{p_4}{p_4}$
1342: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda
p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}\cdot\frac{\lambda
p_2}{\lambda p_2}$
1423: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{\lambda
p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda
p_2+p_3}\cdot\frac{p_3}{p_3}$
1432: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{\lambda
p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3}\cdot\frac{\lambda
p_2}{\lambda p_2}$
2134: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda
p_1+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}\cdot\frac{p_4}{p_4}$
2143: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda
p_1+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}\cdot\frac{p_3}{p_3}$
2314: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_3}{\lambda
p_1+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda
p_1+p_4}\cdot\frac{p_4}{p_4}$
2341: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_3}{\lambda
p_1+p_3+p_4}\cdot\frac{p_4}{\lambda p_1+p_4}\cdot\frac{\lambda
p_1}{\lambda p_1}$
We will calculate a Plackett-Luce likelihood function for four runners
$\left\lbrace 1,2,3,4\right\rbrace$ but with a reified Bradley-Terry
monster that corresponds to having subsets of mutual friends who
support one another. For example, we might have runners 1 and 2 being
friends, and runners 3 and 4 being friends: we would represent this as
$\left\lbrace\left\lbrace 1,2\right\rbrace,\left\lbrace
3,4\right\rbrace\right\rbrace$.
The runner metaphor is not the only one. We can apply the resulting
likelihood functions to other cases including the red bus-blue bus
problem (see inst/red_bus_blue_bus.Rmd for more discussion).
First do three runners, and suppose the equivalence classes are
$\left\lbrace\left\lbrace 1,2\right\rbrace,\left\lbrace
3\right\rbrace\right\rbrace$.
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_2+M}{p_2+p_3+M}\qquad\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_3+p_2}\cdot\frac{p_3}{p_3+p_2+M}\qquad\frac{p_1}{p_1+p_3+p_2}\cdot\frac{p_3}{p_3+\lambda p_2}$
213: $\frac{p_2}{p_2+p_1+p_3}\cdot\frac{p_1+M}{p_1+p_3+M}\qquad\frac{p_2}{p_2+p_1+p_3}\cdot\frac{\lambda p_1}{\lambda p_1+p_3}$
231: $\frac{p_2}{p_2+p_3+p_1}\cdot\frac{p_3}{p_3+p_1+M}\qquad\frac{p_2}{p_2+p_1+p_3}\cdot\frac{\lambda p_1}{p_3+\lambda p_1}$
312: $\frac{p_3}{p_3+p_1+p_2}\cdot\frac{p_1}{p_2+p_1}\qquad\frac{p_3}{p_3+p_1+p_2}\cdot\frac{\lambda p_1}{p_3+p_1}$
321: $\frac{p_3}{p_3+p_2+p_1}\cdot\frac{p_2}{p_2+p_1}\qquad\frac{p_3}{p_3+p_2+p_1}\cdot\frac{p_2}{p_2+p_1}$
Now four runners with classes $\left\lbrace\left\lbrace
1,2\right\rbrace,\left\lbrace 3,4\right\rbrace\right\rbrace$.
1234: $\frac{1}{1+2+3+4}\cdot\frac{2+M}{2+3+4+M}\cdot\frac{3}{3+4}$
1243: $\frac{1}{1+2+4+3}\cdot\frac{2+M}{2+4+3+M}\cdot\frac{4}{4+3}$
1324: $\frac{1}{1+3+2+4}\cdot\frac{3}{3+2+4+M}\cdot\frac{2}{2+4+M}$
1342: $\frac{1}{1+3+4+2}\cdot\frac{3}{3+4+2+M}\cdot\frac{4+M}{2+4+M}$
1423: $\frac{1}{1+4+2+3}\cdot\frac{4}{4+2+3+M}\cdot\frac{2}{2+3}$
1432: $\frac{1}{1+4+3+2}\cdot\frac{4}{4+3+2+M}\cdot\frac{3}{2+3}$
2134: $\frac{2}{2+1+3+4}\cdot\frac{1+M}{1+3+4+M}\cdot\frac{3}{3+4}$
2143: $\frac{2}{2+1+4+3}\cdot\frac{1+M}{1+4+3+M}\cdot\frac{4}{4+3}$
2314: $\frac{2}{2+3+1+4}\cdot\frac{3}{3+1+4+M}\cdot\frac{1}{1+4+M}$
2341: $\frac{2}{2+3+4+1}\cdot\frac{3}{3+4+1+M}\cdot\frac{4+M}{1+4+M}$
2413: $\frac{2}{2+4+1+3}\cdot\frac{4}{4+1+3+M}\cdot\frac{1}{1+3}$
2431: $\frac{2}{2+4+3+1}\cdot\frac{4}{4+3+1+M}\cdot\frac{3}{1+3}$
etc.
Now 123 tethered, 45 tethered:
12345: $\frac{1}{1+2+3+4+5}\cdot\frac{2+M}{2+3+4+5+M}\cdot\frac{3+M}{3+4+5+M}\cdot\frac{4}{4+5}$
12354: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{3+M}{3+5+4+M}\cdot\frac{5}{5+4}$
12435: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{4}{3+5+4+M}\cdot\frac{3}{3+5+M}$
12453: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{4}{3+5+4+M}\cdot\frac{5+M}{5+3+M}$
12534: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+5+3+4+M}\cdot\frac{5}{3+5+4+M}\cdot\frac{3}{3+4+M}$
12543: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+5+4+3+M}\cdot\frac{5}{3+5+4+M}\cdot\frac{4+M}{4+3+M}$
Might be better to consider ${5\choose 2\,3}$ arrangements of
$aaabb\ldots bbaaa$. FOLLOWING IS NOT RIGHT: THE PROBABILITY MODEL IS
NOT PRECISELY DEFINED.
aaabb: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{a+M}{a+b+b+M}\cdot\frac{b}{b+b+M}$
aabab: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{b}{a+b+b+M}\cdot\frac{a}{a+b+M}$
aabba: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{b}{a+b+b+M}\cdot\frac{b+M}{b+a+M}$
abaab: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{a}{a+a+b+M}\cdot\frac{a+M}{a+b+M}$
ababa: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{a}{a+a+b+M}\cdot\frac{b}{b+a+M}$
abbaa: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{b+M}{b+a+a+M}\cdot\frac{a}{a+a+M}$
baaab: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{a+M}{a+a+b+M}\cdot\frac{a+M}{a+b+M}$
baaba: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{a+M}{a+a+b+M}\cdot\frac{b}{a+b+M}$
babaa: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{b}{b+a+a+M}\cdot\frac{a}{a+a}$
bbaaa: $\frac{b}{a+a+a+b+b}\cdot\frac{b+M}{a+a+a+b+M}\cdot\frac{a}{a+a+a}\cdot\frac{a}{a+a}$
f <- function (a,b,M){
return(
factorial(3)*factorial(2)*(
a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(a+M)/(a+b+b+M)*(b )/(b+b+M) +
a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(b )/(a+b+b+M)*(a )/(a+b+M) +
a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(b )/(a+b+b+M)*(b+M)/(b+a+M) +
a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(a )/(a+a+b+M)*(a+M)/(a+b+M) +
a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(a )/(a+a+b+M)*(b )/(b+a+M) +
a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(b+M)/(b+a+a+M)*(a )/(a+a+M) +
b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(a+M)/(a+a+b+M)*(a+M)/(a+b+M) +
b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(a+M)/(a+a+b+M)*(b )/(a+b+M) +
b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(b )/(b+a+a )*(a )/(a+a ) +
b/(a+a+a+b+b)*(b+M)/(a+a+a+b+M)*(a )/(a+a+a )*(a )/(a+a )
)
)
}
f(4.4,3.3, 0.2)*12
f(4.4,3.3, 0.0)*12
```{tikz, label=tikzpartprobtree1,fig.cap = "Partial probability tree for five competitors $a-e$ with $a$ supporting $b$, hyper3 approach", fig.ext = 'png', echo=FALSE}
\usetikzlibrary{arrows}
\usetikzlibrary{patterns}
\begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm]
\fill (0,0) circle[radius=2pt]; % root; paths abcde
\draw (0,0) -- (2,3);
\draw (0,0) -- (2,2);
\draw (0,0) -- (2,1);
\draw (0,0) -- (2,0);
\draw (0,0) -- (2,-1);
\node at (0,2.5) (eq1) {$a\longrightarrow b$};
\node at (1.5,2.5) {$a$};
\node at (1.5,1.7) {$b$};
\node at (1.5,1.0) {$c$};
\node at (1.5,0.2) {$d$};
\node at (1.5,-0.5) {$e$};
\node at (3, 3) {$\frac{a}{a+b+c+d+e}$};
\node at (3, 2) {$\frac{b}{a+b+c+d+e}$};
\node at (3, 1) {$\frac{c}{a+b+c+d+e}$};
\node at (3, 0) {$\frac{d}{a+b+c+d+e}$};
\node at (3,-1) {$\frac{e}{a+b+c+d+e}$};
\fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde
\fill (4, 2) circle[radius=2pt]; % terminal node
\fill (4, 1) circle[radius=2pt]; % terminal node
\fill (4, 0) circle[radius=2pt]; % d finishes; paths abce
\fill (4,-1) circle[radius=2pt]; % terminal node
\draw (4,3) -- (5,5);
\draw (4,3) -- (5,4);
\draw (4,3) -- (5,3);
\draw (4,3) -- (5,2);
\node at (4.5,4.6) {$b$};
\node at (4.5,3.7) {$c$};
\node at (4.5,3.2) {$d$};
\node at (4.5,2.7) {$e$};
\newcommand{\lb}{\lambda b }
\newcommand{\lc}{\lambda c }
\newcommand{\lee}{\lambda e }
\node at (6, 5) {$\frac{\lb}{\lb+c+d+e}$};
\node at (6, 4) {$\frac{c}{\lb+c+d+e}$};
\node at (6, 3) {$\frac{d }{\lb+c+d+e}$};
\node at (6, 2) {$\frac{e }{\lb+c+d+e}$};
\fill (7.4, 5) circle[radius=2pt]; % ab finishes; paths cde
\draw (7.4,5) -- (8.4,6);
\draw (7.4,5) -- (8.4,5);
\draw (7.4,5) -- (8.4,4);
\node at (7.9,5.7) {$c$};
\node at (7.9,5.2) {$d$};
\node at (7.9,4.7) {$e$};
\node at (9.3, 6) {$\frac{c}{c+d+e}$};
\node at (9.3, 5) {$\frac{d }{c+d+e}$};
\node at (9.3, 4) {$\frac{e }{c+d+e}$};
\fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de
\draw (10.2, 6) -- (11.2,7);
\node at (10.7,6.8) {$d$};
\node at (11.8, 7) {$\frac{d}{d+e}$};
\draw (10.2, 6) -- (11.2,6.2);
\node at (11.8, 6.2) {$\frac{e}{d+e}$};
\node at (10.7,6.3) {$e$};
\fill (10.2, 5) circle[radius=2pt];
\draw (10.2, 5) -- (11.2,5.3);
\node at (11.8, 5.3) {$\frac{c}{c+e}$};
\node at (10.7,5.3) {$c$};
\draw (10.2, 5) -- (11.2,4.7);
\node at (11.8, 4.7) {$\frac{e}{c+e}$};
\node at (10.7,4.7) {$e$};
\fill (10.2, 4) circle[radius=2pt];
\draw (10.2, 4) -- (11.2,3.9);
\node at (11.8, 3.9) {$\frac{c}{c+e}$};
\node at (10.7,4.1) {$c$};
\draw (10.2, 4) -- (11.2,3.1);
\node at (11.8, 3.1) {$\frac{e}{c+e}$};
\node at (10.7,3.7) {$e$};
\draw (4, 0) -- (5,1);
\node at (6, 1) {$\frac{a}{a+b+c+e}$};
\draw (4, 0) -- (5,0);
\node at (6, 0) {$\frac{b}{a+b+c+e}$};
\draw (4, 0) -- (5,-1);
\node at (6, -1) {$\frac{c}{a+b+c+e}$};
\draw (4, 0) -- (5,-2);
\node at (6, -2) {$\frac{e}{a+b+c+e}$};
\node at (4.5,0.7) {$a$};
\node at (4.5,0.2) {$b$};
\node at (4.5,-0.3) {$c$};
\node at (4.5,-0.8) {$e$};
\fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc
\draw (7.4, -2) -- (8.4,-1);
\draw (7.4, -2) -- (8.4,-2);
\draw (7.4, -2) -- (8.4,-3);
\node at (7.9,-1.2) {$a$};
\node at (7.9,-1.8) {$b$};
\node at (7.9,-2.3) {$c$};
\node at (9.3, -1) {$\frac{a}{a+b+c}$};
\node at (9.3, -2) {$\frac{b}{a+b+c}$};
\node at (9.3, -3) {$\frac{c}{a+b+c}$};
\fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc
\fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac
\fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab
\draw (10.2, -1) -- (11.2,-0);
\node at (10.6,-0.4) {$b$};
\node at (10.6,-0.8) {$c$};
\node at (11.8, 0) {$\frac{\lb}{\lb+c}$};
\draw (10.2, -1) -- (11.2,-1);
\node at (11.8, -1) {$\frac{c}{\lb+c}$};
\draw (10.2, -2) -- (11.2,-1.6);
\node at (11.8, -1.6) {$\frac{a}{a+c}$};
\node at (10.6,-1.7) {$a$};
\node at (10.6,-2) {$c$};
\draw (10.2, -2) -- (11.2,-2.2);
\node at (11.8, -2.2) {$\frac{c}{a+c}$};
\draw (10.2, -3) -- (11.2,-2.9);
\node at (11.8, -2.9) {$\frac{a}{a+b}$};
\draw (10.2, -3) -- (11.2,-3.4);
\node at (11.8, -3.4) {$\frac{b}{a+b}$};
\node at (10.6,-2.8) {$a$};
\node at (10.6,-3.3) {$b$};
\fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (7.4, 1) -- (8.4,2);
\draw (7.4, 1) -- (8.4,1);
\draw (7.4, 1) -- (8.4,0);
\node at (7.9,1.7) {$b$};
\node at (7.9,1.2) {$c$};
\node at (7.9,0.7) {$e$};
\node at (9.3, 2) {$\frac{\lb}{\lb+c+e}$};
\node at (9.3, 1) {$\frac{ c}{\lb+c+e}$};
\node at (9.3, 0) {$\frac{e }{\lb+c+e}$};
\fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (10.2, 1) -- (11.2,2);
\node at (11.8, 2) {$\frac{\lb}{\lb+e}$};
\draw (10.2, 1) -- (11.2,1);
\node at (11.8, 1) {$\frac{e}{\lb+e}$};
\end{tikzpicture}
```{tikz, label=tikzpic2, fig.cap = "Partial probability tree for five competitors $a-e$ with mutually supporting group $abc$, hyper3 approach. If any competitor in the set {$a,b,c$} finishes, they lend their strength to the other competitors in the set who are still running", fig.ext = 'png', echo=FALSE}
\usetikzlibrary{arrows}
\usetikzlibrary{patterns}
\begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm]
\fill (0,0) circle[radius=2pt]; % root; paths abcde
\draw (0,0) -- (2,3);
\draw (0,0) -- (2,2);
\draw (0,0) -- (2,1);
\draw (0,0) -- (2,0);
\draw (0,0) -- (2,-1);
\node at (0,2.5) (eq1) {$\underbrace{\left\lbrace a,b,c\right\rbrace}_{\lambda}$};
\node at (1.5,2.5) {$a$};
\node at (1.5,1.7) {$b$};
\node at (1.5,1.0) {$c$};
\node at (1.5,0.2) {$d$};
\node at (1.5,-0.5) {$e$};
\node at (3, 3) {$\frac{a}{a+b+c+d+e}$};
\node at (3, 2) {$\frac{b}{a+b+c+d+e}$};
\node at (3, 1) {$\frac{c}{a+b+c+d+e}$};
\node at (3, 0) {$\frac{d}{a+b+c+d+e}$};
\node at (3,-1) {$\frac{e}{a+b+c+d+e}$};
\fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde
\fill (4, 2) circle[radius=2pt]; % terminal node
\fill (4, 1) circle[radius=2pt]; % terminal node
\fill (4, 0) circle[radius=2pt]; % d finishes; paths abce
\fill (4,-1) circle[radius=2pt]; % terminal node
\draw (4,3) -- (5,5);
\draw (4,3) -- (5,4);
\draw (4,3) -- (5,3);
\draw (4,3) -- (5,2);
\node at (4.5,4.6) {$b$};
\node at (4.5,3.7) {$c$};
\node at (4.5,3.2) {$d$};
\node at (4.5,2.7) {$e$};
\newcommand{\la}{\lambda a }
\newcommand{\lb}{\lambda b }
\newcommand{\lc}{\lambda c }
\newcommand{\lee}{\lambda e }
\node at (6, 5) {$\frac{\lb}{\lb+\lc+d+e}$};
\node at (6, 4) {$\frac{\lc}{\lb+\lc+d+e}$};
\node at (6, 3) {$\frac{d }{\lb+\lc+d+e}$};
\node at (6, 2) {$\frac{e }{\lb+\lc+d+e}$};
\fill (7.4, 5) circle[radius=2pt]; % ab finishes; paths cde
\draw (7.4,5) -- (8.4,6);
\draw (7.4,5) -- (8.4,5);
\draw (7.4,5) -- (8.4,4);
\node at (7.9,5.7) {$c$};
\node at (7.9,5.2) {$d$};
\node at (7.9,4.7) {$e$};
\node at (9.3, 6) {$\frac{\lc}{\lc+d+e}$};
\node at (9.3, 5) {$\frac{d }{\lc+d+e}$};
\node at (9.3, 4) {$\frac{e }{\lc+d+e}$};
\fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de
\draw (10.2, 6) -- (11.2,7);
\node at (10.7,6.8) {$d$};
\node at (11.8, 7) {$\frac{d}{d+e}$};
\draw (10.2, 6) -- (11.2,6.2);
\node at (11.8, 6.2) {$\frac{e}{d+e}$};
\node at (10.7,6.3) {$e$};
\fill (10.2, 5) circle[radius=2pt];
\draw (10.2, 5) -- (11.2,5.3);
\node at (11.8, 5.3) {$\frac{\lc}{\lc+e}$};
\node at (10.7,5.3) {$c$};
\draw (10.2, 5) -- (11.2,4.7);
\node at (11.8, 4.7) {$\frac{e}{\lc+e}$};
\node at (10.7,4.7) {$e$};
\fill (10.2, 4) circle[radius=2pt];
\draw (10.2, 4) -- (11.2,3.9);
\node at (11.8, 3.9) {$\frac{\lc}{\lc+e}$};
\node at (10.7,4.1) {$c$};
\draw (10.2, 4) -- (11.2,3.1);
\node at (11.8, 3.1) {$\frac{e}{\lc+e}$};
\node at (10.7,3.7) {$e$};
\draw (4, 0) -- (5,1);
\node at (6, 1) {$\frac{a}{a+b+c+e}$};
\draw (4, 0) -- (5,0);
\node at (6, 0) {$\frac{b}{a+b+c+e}$};
\draw (4, 0) -- (5,-1);
\node at (6, -1) {$\frac{c}{a+b+c+e}$};
\draw (4, 0) -- (5,-2);
\node at (6, -2) {$\frac{e}{a+b+c+e}$};
\node at (4.5,0.7) {$a$};
\node at (4.5,0.2) {$b$};
\node at (4.5,-0.3) {$c$};
\node at (4.5,-0.8) {$e$};
\fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc
\draw (7.4, -2) -- (8.4,-1);
\draw (7.4, -2) -- (8.4,-2);
\draw (7.4, -2) -- (8.4,-3);
\node at (7.9,-1.2) {$a$};
\node at (7.9,-1.8) {$b$};
\node at (7.9,-2.3) {$c$};
\node at (9.3, -1) {$\frac{a}{a+b+c}$};
\node at (9.3, -2) {$\frac{b}{a+b+c}$};
\node at (9.3, -3) {$\frac{c}{a+b+c}$};
\fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc
\fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac
\fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab
\draw (10.2, -1) -- (11.2,-0);
\node at (10.6,-0.4) {$b$};
\node at (10.6,-0.8) {$c$};
\node at (11.8, 0) {$\frac{\lb}{\lb+\lc}$};
\draw (10.2, -1) -- (11.2,-1);
\node at (11.8, -1) {$\frac{c}{\lb+\lc}$};
\draw (10.2, -2) -- (11.2,-1.6);
\node at (11.8, -1.6) {$\frac{\la}{\la+\lc}$};
\node at (10.6,-1.7) {$a$};
\node at (10.6,-2) {$c$};
\draw (10.2, -2) -- (11.2,-2.2);
\node at (11.8, -2.2) {$\frac{\lc}{\la+\lc}$};
\draw (10.2, -3) -- (11.2,-2.9);
\node at (11.8, -2.9) {$\frac{\la}{\la+\lb}$};
\draw (10.2, -3) -- (11.2,-3.4);
\node at (11.8, -3.4) {$\frac{\lb}{\la+\lb}$};
\node at (10.6,-2.8) {$a$};
\node at (10.6,-3.3) {$b$};
\fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (7.4, 1) -- (8.4,2);
\draw (7.4, 1) -- (8.4,1);
\draw (7.4, 1) -- (8.4,0);
\node at (7.9,1.7) {$b$};
\node at (7.9,1.2) {$c$};
\node at (7.9,0.7) {$e$};
\node at (9.3, 2) {$\frac{\lb}{\lb+\lc+e}$};
\node at (9.3, 1) {$\frac{\lc}{\lb+\lc+e}$};
\node at (9.3, 0) {$\frac{e }{\lb+\lc+e}$};
\fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (10.2, 1) -- (11.2,2);
\node at (11.8, 2) {$\frac{\lb}{\lb+e}$};
\draw (10.2, 1) -- (11.2,1);
\node at (11.8, 1) {$\frac{e}{\lb+e}$};
\end{tikzpicture}
```{tikz, label=tikz3,fig.cap = "Partial probability tree for five competitors $a$-$e$ with mutually supporting subsets $\left\lbrace a,b,c\right\rbrace$ [with support term $\lambda$] and $(de)$ [with support term $\mu$], hyper3 approach", fig.ext = 'png', echo=FALSE}
\usetikzlibrary{arrows}
\usetikzlibrary{patterns}
\begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm]
\fill (0,0) circle[radius=2pt]; % root; paths abcde
\draw (0,0) -- (2,3);
\draw (0,0) -- (2,2);
\draw (0,0) -- (2,1);
\draw (0,0) -- (2,0);
\draw (0,0) -- (2,-1);
\node at (0,2.5) (eq1) {$\underbrace{\left\lbrace a,b,c\right\rbrace}{\lambda}\underbrace{\left\lbrace d,e\right\rbrace}{\mu}$};
\node at (1.5,2.5) {$a$};
\node at (1.5,1.7) {$b$};
\node at (1.5,1.0) {$c$};
\node at (1.5,0.2) {$d$};
\node at (1.5,-0.5) {$e$};
\node at (3, 3) {$\frac{a}{a+b+c+d+e}$};
\node at (3, 2) {$\frac{b}{a+b+c+d+e}$};
\node at (3, 1) {$\frac{c}{a+b+c+d+e}$};
\node at (3, 0) {$\frac{d}{a+b+c+d+e}$};
\node at (3,-1) {$\frac{e}{a+b+c+d+e}$};
\fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde
\fill (4, 2) circle[radius=2pt]; % terminal node
\fill (4, 1) circle[radius=2pt]; % terminal node
\fill (4, 0) circle[radius=2pt]; % d finishes; paths abce
\fill (4,-1) circle[radius=2pt]; % terminal node
\draw (4,3) -- (5,5);
\draw (4,3) -- (5,4);
\draw (4,3) -- (5,3);
\draw (4,3) -- (5,2);
\node at (4.5,4.6) {$b$};
\node at (4.5,3.7) {$c$};
\node at (4.5,3.2) {$d$};
\node at (4.5,2.7) {$e$};
\newcommand{\la}[1]{\lambda{#1}}
\newcommand{\ld}[1]{\mu {#1}}
\node at (6, 5) {$\frac{\la{b}}{\la{b}+\la{c}+d+e}$};
\node at (6, 4) {$\frac{\la{c}}{\la{b}+\la{c}+d+e}$};
\node at (6, 3) {$\frac{d }{\la{b}+\la{c}+d+e}$};
\node at (6, 2) {$\frac{e }{\la{b}+\la{c}+d+e}$};
\fill (7.4, 5) circle[radius=2pt]; % ab finishes; pahts cde
\draw (7.4,5) -- (8.4,6);
\draw (7.4,5) -- (8.4,5);
\draw (7.4,5) -- (8.4,4);
\node at (7.9,5.7) {$c$};
\node at (7.9,5.2) {$d$};
\node at (7.9,4.7) {$e$};
\node at (9.3, 6) {$\frac{\la{c}}{\la{c}+d+e}$};
\node at (9.3, 5) {$\frac{d }{\la{c}+d+e}$};
\node at (9.3, 4) {$\frac{e }{\la{c}+d+e}$};
\fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de
\draw (10.2, 6) -- (11.2,7);
\node at (10.7,6.8) {$d$};
\node at (11.8, 7) {$\frac{d}{d+e}$};
\draw (10.2, 6) -- (11.2,6.2);
\node at (11.8, 6.2) {$\frac{e}{d+e}$};
\node at (10.7,6.3) {$e$};
\fill (10.2, 5) circle[radius=2pt];
\draw (10.2, 5) -- (11.2,5.3);
\node at (11.8, 5.3) {$\frac{\la{c}}{\la{c}+\ld{e}}$};
\node at (10.7,5.3) {$c$};
\draw (10.2, 5) -- (11.2,4.7);
\node at (11.8, 4.7) {$\frac{\ld{e}}{\la{c}+\ld{e}}$};
\node at (10.7,4.7) {$e$};
\fill (10.2, 4) circle[radius=2pt];
\draw (10.2, 4) -- (11.2,3.9);
\node at (11.8, 3.9) {$\frac{\la{c}}{\la{c}+\ld{e}}$};
\node at (10.7,4.1) {$c$};
\draw (10.2, 4) -- (11.2,3.1);
\node at (11.8, 3.1) {$\frac{\ld{e}}{\la{c}+\ld{e}}$};
\node at (10.7,3.7) {$e$};
\draw (4, 0) -- (5,1);
\node at (6, 1) {$\frac{a}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,0);
\node at (6, 0) {$\frac{b}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,-1);
\node at (6, -1) {$\frac{c}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,-2);
\node at (6, -2) {$\frac{\ld{e}}{a+b+c+\ld{e}}$};
\node at (4.5,0.7) {$a$};
\node at (4.5,0.2) {$b$};
\node at (4.5,-0.3) {$c$};
\node at (4.5,-0.8) {$e$};
\fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc
\draw (7.4, -2) -- (8.4,-1);
\draw (7.4, -2) -- (8.4,-2);
\draw (7.4, -2) -- (8.4,-3);
\node at (7.9,-1.2) {$a$};
\node at (7.9,-1.8) {$b$};
\node at (7.9,-2.3) {$c$};
\node at (9.3, -1) {$\frac{a}{a+b+c}$};
\node at (9.3, -2) {$\frac{b}{a+b+c}$};
\node at (9.3, -3) {$\frac{c}{a+b+c}$};
\fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc
\fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac
\fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab
\draw (10.2, -1) -- (11.2,-0);
\node at (10.6,-0.4) {$b$};
\node at (10.6,-0.8) {$c$};
\node at (11.8, 0) {$\frac{\la{b}}{\la{b}+\la{c}}$};
\draw (10.2, -1) -- (11.2,-1);
\node at (11.8, -1) {$\frac{\la{c}}{\la{b}+\la{c}}$};
\draw (10.2, -2) -- (11.2,-1.6);
\node at (11.8, -1.6) {$\frac{\la{a}}{\la{a}+\la{c}}$};
\node at (10.6,-1.7) {$a$};
\node at (10.6,-2) {$c$};
\draw (10.2, -2) -- (11.2,-2.2);
\node at (11.8, -2.2) {$\frac{\la{c}}{\la{a}+\la{c}}$};
\draw (10.2, -3) -- (11.2,-2.9);
\node at (11.8, -2.9) {$\frac{\la{a}}{\la{a}+\la{b}}$};
\draw (10.2, -3) -- (11.2,-3.4);
\node at (11.8, -3.4) {$\frac{\la{b}}{\la{a}+\la{b}}$};
\node at (10.6,-2.8) {$a$};
\node at (10.6,-3.3) {$b$};
\fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (7.4, 1) -- (8.4,2);
\draw (7.4, 1) -- (8.4,1);
\draw (7.4, 1) -- (8.4,0);
\node at (7.9,1.7) {$b$};
\node at (7.9,1.2) {$c$};
\node at (7.9,0.7) {$e$};
\node at (9.3, 2) {$\frac{\la{b}}{\la{b}+\la{c}+e}$};
\node at (9.3, 1) {$\frac{\la{c}}{\la{b}+\la{c}+e}$};
\node at (9.3, 0) {$\frac{e }{\la{b}+\la{c}+e}$};
\fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (10.2, 1) -- (11.2,2);
\node at (11.8, 2) {$\frac{\la{b}}{\la{b}+\ld{e}}$};
\draw (10.2, 1) -- (11.2,1);
\node at (11.8, 1) {$\frac{\ld{e}}{\la{b}+e}$};
\end{tikzpicture}
# Package idiom
We can investigate red bus-blue bus phenomenon (as discussed, in a
slightly different context, in `inst/red_bus_blue_bus.Rmd`). Here, we
consider a person who is given the choice of five transport methods:
* `C`, car
* `T`, train
* `RB` a red bus
* `BB` a blue bus
* `W` walking
Now, he does not really care what colour the bus is. If we ask him to
rank his options, it is highly probable that he will put `RB` and `BB`
consecutively (because they are essentially indistinguishable). Can
we quantify the strength of this effect? To do this, we define a
bespoke function `RB_BB_LF()` which returns a `hyper3` log-likelihood
function corresponding to repeated observations of our commuter's
reported ranks for the five options:
```r
`RB_BB_LF` <- function(s){
ec <- c(C=1,T=2,RB=3,BB=3,W=4) # equivalence classes
h <- c(1,1,s,1) # strength of support
(
cheering3(v=c("RB","BB","C" ,"T","W"),e=ec,h=h)*3 +
cheering3(v=c("BB","RB","T" ,"C","W"),e=ec,h=h)*2 +
cheering3(v=c("T" ,"BB","RB","C","W"),e=ec,h=h)*2 +
cheering3(v=c("W" ,"BB","RB","T","C"),e=ec,h=h)*4 +
cheering3(v=c("C" ,"RB","BB","W","T"),e=ec,h=h)*4 +
cheering3(v=c("BB","C" ,"RB","T","W"),e=ec,h=h)*3
)
}
Above, we see from the function body that he reported RB,BB,C,T,W
three times [first row], BB,RB,T,C,W twice [second row], and so on;
perhaps his ranking depends on the weather or how tired he is on any
given day. Observe that in almost every case he ranks RB and BB
consecutively. Function RB_BB_LF() takes argument s that
quantifies the perceived similarity between RB and BB. For
example:
(H <- RB_BB_LF(s=1.8888))
(mH <- maxp(H,n=1))
Now to find a profile likelihood function for s:
o <- function(s){maxp(RB_BB_LF(s),give=TRUE,n=1)$likes} # optimand
s <- exp(seq(from=log(1.3),to=log(47),len=17)) # putative similarity measures
L <- sapply(s,o)
L <- L-max(L)
We can plot these:
plot(s,L,type="b")
abline(h=c(0,-2))
abline(v=1)
plot(log(s),L,type="b")
abline(h=c(0,-2))
abline(v=0)
And formally maximize the likelihood:
(osup <- optimize(o,c(6,10),maximum=TRUE))
So a likelihood ratio test of the null that $S=1$ would be:
(suppdiff <- o(osup$maximum) - o(1))
Easily satisfying Edwards's two-units-of-support criterion; Wilks gives us an asymptotic $p$-value:
pchisq(suppdiff*2,df=1,lower.tail=FALSE)
University ranking analysis
Here we use a dataset of university rankings, timesData.csv, taken
from
https://github.com/arnaudbenard/university-ranking/blob/master/timesData.csv.
a <- read.table("timesData.csv",sep=",", header=TRUE)
wanted <- c("California Institute of Technology", "Harvard University",
"Massachusetts Institute of Technology", "Princeton University",
"Stanford University", "University of Cambridge", "University of Oxford")
names(wanted) <- c("cal","harv","mass","prin","stan","cam","ox")
a <- a[a$university_name %in% wanted,]
a <- cbind(a,"top7rank"=0)
for(y in unique(a$year)){
a[a$year==y,"top7rank"] <- order(
as.numeric(a[a$year==y,"world_rank"]) +
a[a$year==y,"research"]/1e6,
decreasing=TRUE)}
a <- a[,c("top7rank","university_name","year")]
a <- reshape(a,idvar="university_name",timevar="year",direction="wide")
for(i in seq_len(nrow(a))){
a$university_name[i] <- names(which(wanted == a$university_name[i]))
}
rownames(a) <- a$university_name
a <- a[,-1]
colnames(a) <- paste("Y",2011:2016,sep="")
a
H <- ordertable2supp(a)
equalp.test(H)
samep.test(H,c("ox","cam"))
Start to use hyper3 idiom:
H3 <- function(oxcam){
out <- hyper3()
for(i in seq_len(ncol(a))){
jj <- rep("",nrow(a))
jj[a[,i]] <- rownames(a)
out <- out + cheering3(v=jj,e=c(ox=1,cam=1,prin=2, stan=3, mass=4, harv=5, cal=6), help=c(oxcam,1,1,1,1,1))
}
return(out)
}
o <- function(oxcam){maxp(H3(oxcam),give=TRUE,n=1)$likes}
oc <- exp(seq(from=log(0.5),to=log(5),len=15))
L <- sapply(oc,o)
L <- L - max(L)
plot(log(oc),L,type="b")
abline(v=0)
Five nations championship
The five nations rugby championship was held from 1910 to 1999 and
file five_nations.txt shows the order statistic for England (E),
Scotland (S), Ireland (I), Wales (W), and France (F).
https://en.wikipedia.org/wiki/Six_Nations_Championship
Here is hyper2 analysis:
a <- as.matrix(read.table("five_nations.txt",header=FALSE))
head(a)
H <- hyper2()
for(i in seq_len(nrow(a))){
H <- H + race(a[i,-1])
}
mH <- maxp(H)
pie(mH)
equalp.test(H)
Now use hyper3 to see whether teams do better following a win:
rugby <- function(lambda){
H3a <- hyper3()
for(i in seq(from=2,to=nrow(a))){
last_year_winner <- a[i-1,2] # e.g. "W" or "E"
H3a <- H3a + ordervec2supp3a(a[i,-1],nonfinishers=NULL,helped=last_year_winner,lambda=lambda)
}
return(H3a)
}
rugby(1.888)
rugby(1.111111)
maxp(rugby(1.8),n=1,give=TRUE)
maxp(rugby(1.9),n=1,give=TRUE)
References {-}
RobinHankin/hyper2 documentation built on April 21, 2024, 11:38 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = TRUE) library("hyper2") library("partitions") library("pdftools")
knitr::include_graphics(system.file("help/figures/hyper2.png", package = "hyper2"))
To cite the hyper2 package in publications, please use @hankin2017_rmd.
Here I modify standard Plackett-Luce likelihood functions to include
an element of non-independence among the competitors. There seem to
be a few distinct statistical models for nonindependence:
-
Runner $i$ might wish to support $j$. If runner $i$ finishes, once his rank is established he might be able to help $j$ in some way. He might cheer his still-running friend, spurring him to run faster and augmenting his competitive strength.
-
In general, we can consider $n$ ordered pairs $(i_r,j_r)$, $1\leq r\leq n$, with runner $i_1$ helping runner $j_1$, runner $i_2$ helping $j_2$, and so on. One simple case would be equivalence classes of $[n]={1,2,\ldots,n}$ with each equivalence class comprising mutually supporting runners. In this model, with a pair of mutually supporting runners only the higher-placed competitor can affect the other. Each equivalence class might have a different supportive proclivity.
-
Runner $i$ might hate runner $j$. If $i$ finishes, he might expend his spare energy hindering $j$ (by throwing stones or booing, for example). Note that equivalence classes of mutual hatred might exist.
-
Also, the help or hindrance might have a finite lifetime. Under one model, if $i$ finishes then he can stay helping (or hindering) $j$ wherever $j$ places. Alternatively, suppose $i$ places $n$th. Then perhaps he can affect $j$ only place $n+1$, and after a competitor finishes in place $n+1$, then $i$ can exert no further influence.
-
The help or hindrance discussed above might be contingent on placing: perhaps only the winnner (that is, first-placing competitor) would be able to influence other competitors. Or maybe competitors with any placing could influence other competitors.
-
Runners $i$ and $j$ might elect to cross the finishing line holding hands, with the apparent tie broken randomly. This would be a symmetrical relationship. In general, we could consider hand-holding equivalence classes.
-
We might have a resource allocation problem, with runners having a certain [possibly unknown] amount of "strength" but also the ability to expend this strength on objectives other than ranking in the race. A runner might be able to expend just enough energy to remain slightly ahead of a rival, reserving energy for other purposes. If runner $i$ wishes to beat runner $j$, and has sufficient resources to do so, then runners $i$ and $j$ will finish consecutively with $i$ ahead of $j$.
Start simple: three runners
The simplest nontrivial case is three runners, $\left\lbrace 1,2,3\right\rbrace$ where runner 1 helps runner 2 with multiplier $\lambda$ [and that is the only non PL interaction]. Note that this is not a symmetric interaction: 1 helps 2, but 2 does not help 1. The model is that 1 helps 2 if and only if 1 has finished and 2 has not.
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
(Above, the probabilities clearly sum to 1). Next simplest: 1 and 2 mutually support each other with $\lambda$:
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{\lambda p_1}{p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
Now we retain the mutual support between 1 and 2 but allow an asymmetry: 1 helps 2 with $\lambda$ as before, but now in addition, 2 helps 1 with $\mu$:
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
213: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{\mu p_1}{\mu p_1+p_3}$
231: $\frac{p_2}{p_1+p_2+p_3}\cdot\frac{p_3}{\mu p_1+p_3}$
312: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_2}$
321: $\frac{p_3}{p_1+p_2+p_3}\cdot\frac{p_2}{p_1+p_2}$
Now how about 1 must beat 2. He does not care whether he comes first or second, only that he must beat 2. Player 1 has sufficient energy to win if he wants, but is subject to some sort of resource constraint (money, perhaps) and wishes to expend only enough money to beat 2. So conventional P-L likelihoods are modified for 1, but only if 2 is still running.
123: $\frac{\lambda p_1}{\lambda p_1+p_2+p_3}\cdot\frac{p_2}{p_2+p_3}$
132: $\frac{\lambda p_1}{\lambda p_1+p_2+p_3}\cdot\frac{p_3}{p_2+p_3}$
213: $\frac{p_2}{\lambda p_1+p_2+p_3}\cdot\frac{p_1}{p_1+p_3}$
231: $\frac{p_2}{\lambda p_1+p_2+p_3}\cdot\frac{p_3}{p_1+p_3}$
312: $\frac{p_3}{\lambda p_1+p_2+p_3}\cdot\frac{\lambda p_1}{\lambda p_1+p_2}$
321: $\frac{p_3}{\lambda p_1+p_2+p_3}\cdot\frac{p_2}{\lambda p_1+p_2}$
Four runners
Now we have four runners $\left\lbrace 1,2,3,4\right\rbrace$, again with the only interaction being runner 1 helping runner 2. Thus, in a situation where $p_1$ has finished and $p_2$ is still running, we have $p_2\longrightarrow\lambda p_2$ [although the $\lambda$ cancels if 2 is the only competitor still running, that is, if all the remaining competitors are helped]
1234: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}$
1243: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
1342: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
1423: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{p_1+\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
1432: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{p_1+\lambda p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3}$
2xxx: P-L [no help given by 2 to 1]
3124: $\frac{p_3}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}$
3142: $\frac{p_3}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}$
32xx: P-L
3412: P-L [1 helps 2 but when 1 crosses the finishing line, only 2 is still running; there are no non-helped competitors]
4123: $\frac{p_4}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
4132: $\frac{p_4}{p_1+p_2+p_3+p_4}\cdot\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_3}{\lambda p_2+p_3}$
42xx: P-L
43xx: P-L
Now 1 and 2 mutually support one another by $\lambda$. Here I will put the last term in, to show explicitly that the $\lambda$ term remains in the expressions for numerator and denominator.
1234: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}\cdot\frac{p_4}{p_4}$
1243: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}\cdot\frac{p_3}{p_3}$
1324: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_4}\cdot\frac{p_4}{p_4}$
1342: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_4}\cdot\frac{\lambda p_2}{\lambda p_2}$
1423: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_3+p_4}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}\cdot\frac{p_3}{p_3}$
1432: $\frac{p_1}{p_1+p_2+p_3+p_4}\cdot\frac{p_4}{\lambda p_2+p_3+p_4}\cdot\frac{p_3}{\lambda p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2}$
2134: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda p_1+p_3+p_4}\cdot\frac{p_3}{p_3+p_4}\cdot\frac{p_4}{p_4}$
2143: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda p_1+p_3+p_4}\cdot\frac{p_4}{p_3+p_4}\cdot\frac{p_3}{p_3}$
2314: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_3}{\lambda p_1+p_3+p_4}\cdot\frac{\lambda p_1}{\lambda p_1+p_4}\cdot\frac{p_4}{p_4}$
2341: $\frac{p_2}{p_1+p_2+p_3+p_4}\cdot\frac{\lambda p_3}{\lambda p_1+p_3+p_4}\cdot\frac{p_4}{\lambda p_1+p_4}\cdot\frac{\lambda p_1}{\lambda p_1}$
We will calculate a Plackett-Luce likelihood function for four runners $\left\lbrace 1,2,3,4\right\rbrace$ but with a reified Bradley-Terry monster that corresponds to having subsets of mutual friends who support one another. For example, we might have runners 1 and 2 being friends, and runners 3 and 4 being friends: we would represent this as $\left\lbrace\left\lbrace 1,2\right\rbrace,\left\lbrace 3,4\right\rbrace\right\rbrace$.
The runner metaphor is not the only one. We can apply the resulting
likelihood functions to other cases including the red bus-blue bus
problem (see inst/red_bus_blue_bus.Rmd for more discussion).
First do three runners, and suppose the equivalence classes are $\left\lbrace\left\lbrace 1,2\right\rbrace,\left\lbrace 3\right\rbrace\right\rbrace$.
123: $\frac{p_1}{p_1+p_2+p_3}\cdot\frac{p_2+M}{p_2+p_3+M}\qquad\frac{p_1}{p_1+p_2+p_3}\cdot\frac{\lambda p_2}{\lambda p_2+p_3}$
132: $\frac{p_1}{p_1+p_3+p_2}\cdot\frac{p_3}{p_3+p_2+M}\qquad\frac{p_1}{p_1+p_3+p_2}\cdot\frac{p_3}{p_3+\lambda p_2}$
213: $\frac{p_2}{p_2+p_1+p_3}\cdot\frac{p_1+M}{p_1+p_3+M}\qquad\frac{p_2}{p_2+p_1+p_3}\cdot\frac{\lambda p_1}{\lambda p_1+p_3}$
231: $\frac{p_2}{p_2+p_3+p_1}\cdot\frac{p_3}{p_3+p_1+M}\qquad\frac{p_2}{p_2+p_1+p_3}\cdot\frac{\lambda p_1}{p_3+\lambda p_1}$
312: $\frac{p_3}{p_3+p_1+p_2}\cdot\frac{p_1}{p_2+p_1}\qquad\frac{p_3}{p_3+p_1+p_2}\cdot\frac{\lambda p_1}{p_3+p_1}$
321: $\frac{p_3}{p_3+p_2+p_1}\cdot\frac{p_2}{p_2+p_1}\qquad\frac{p_3}{p_3+p_2+p_1}\cdot\frac{p_2}{p_2+p_1}$
Now four runners with classes $\left\lbrace\left\lbrace 1,2\right\rbrace,\left\lbrace 3,4\right\rbrace\right\rbrace$.
1234: $\frac{1}{1+2+3+4}\cdot\frac{2+M}{2+3+4+M}\cdot\frac{3}{3+4}$
1243: $\frac{1}{1+2+4+3}\cdot\frac{2+M}{2+4+3+M}\cdot\frac{4}{4+3}$
1324: $\frac{1}{1+3+2+4}\cdot\frac{3}{3+2+4+M}\cdot\frac{2}{2+4+M}$
1342: $\frac{1}{1+3+4+2}\cdot\frac{3}{3+4+2+M}\cdot\frac{4+M}{2+4+M}$
1423: $\frac{1}{1+4+2+3}\cdot\frac{4}{4+2+3+M}\cdot\frac{2}{2+3}$
1432: $\frac{1}{1+4+3+2}\cdot\frac{4}{4+3+2+M}\cdot\frac{3}{2+3}$
2134: $\frac{2}{2+1+3+4}\cdot\frac{1+M}{1+3+4+M}\cdot\frac{3}{3+4}$
2143: $\frac{2}{2+1+4+3}\cdot\frac{1+M}{1+4+3+M}\cdot\frac{4}{4+3}$
2314: $\frac{2}{2+3+1+4}\cdot\frac{3}{3+1+4+M}\cdot\frac{1}{1+4+M}$
2341: $\frac{2}{2+3+4+1}\cdot\frac{3}{3+4+1+M}\cdot\frac{4+M}{1+4+M}$
2413: $\frac{2}{2+4+1+3}\cdot\frac{4}{4+1+3+M}\cdot\frac{1}{1+3}$
2431: $\frac{2}{2+4+3+1}\cdot\frac{4}{4+3+1+M}\cdot\frac{3}{1+3}$
etc.
Now 123 tethered, 45 tethered:
12345: $\frac{1}{1+2+3+4+5}\cdot\frac{2+M}{2+3+4+5+M}\cdot\frac{3+M}{3+4+5+M}\cdot\frac{4}{4+5}$
12354: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{3+M}{3+5+4+M}\cdot\frac{5}{5+4}$
12435: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{4}{3+5+4+M}\cdot\frac{3}{3+5+M}$
12453: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+3+5+4+M}\cdot\frac{4}{3+5+4+M}\cdot\frac{5+M}{5+3+M}$
12534: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+5+3+4+M}\cdot\frac{5}{3+5+4+M}\cdot\frac{3}{3+4+M}$
12543: $\frac{1}{1+2+3+5+4}\cdot\frac{2+M}{2+5+4+3+M}\cdot\frac{5}{3+5+4+M}\cdot\frac{4+M}{4+3+M}$
Might be better to consider ${5\choose 2\,3}$ arrangements of $aaabb\ldots bbaaa$. FOLLOWING IS NOT RIGHT: THE PROBABILITY MODEL IS NOT PRECISELY DEFINED.
aaabb: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{a+M}{a+b+b+M}\cdot\frac{b}{b+b+M}$
aabab: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{b}{a+b+b+M}\cdot\frac{a}{a+b+M}$
aabba: $\frac{a}{a+a+a+b+b}\cdot\frac{a+M}{a+a+b+b+M}\cdot\frac{b}{a+b+b+M}\cdot\frac{b+M}{b+a+M}$
abaab: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{a}{a+a+b+M}\cdot\frac{a+M}{a+b+M}$
ababa: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{a}{a+a+b+M}\cdot\frac{b}{b+a+M}$
abbaa: $\frac{a}{a+a+a+b+b}\cdot\frac{b}{a+a+b+b+M}\cdot\frac{b+M}{b+a+a+M}\cdot\frac{a}{a+a+M}$
baaab: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{a+M}{a+a+b+M}\cdot\frac{a+M}{a+b+M}$
baaba: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{a+M}{a+a+b+M}\cdot\frac{b}{a+b+M}$
babaa: $\frac{b}{a+a+a+b+b}\cdot\frac{a}{a+a+a+b+M}\cdot\frac{b}{b+a+a+M}\cdot\frac{a}{a+a}$
bbaaa: $\frac{b}{a+a+a+b+b}\cdot\frac{b+M}{a+a+a+b+M}\cdot\frac{a}{a+a+a}\cdot\frac{a}{a+a}$
f <- function (a,b,M){ return( factorial(3)*factorial(2)*( a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(a+M)/(a+b+b+M)*(b )/(b+b+M) + a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(b )/(a+b+b+M)*(a )/(a+b+M) + a/(a+a+a+b+b)*(a+M)/(a+a+b+b+M)*(b )/(a+b+b+M)*(b+M)/(b+a+M) + a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(a )/(a+a+b+M)*(a+M)/(a+b+M) + a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(a )/(a+a+b+M)*(b )/(b+a+M) + a/(a+a+a+b+b)*(b )/(a+a+b+b+M)*(b+M)/(b+a+a+M)*(a )/(a+a+M) + b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(a+M)/(a+a+b+M)*(a+M)/(a+b+M) + b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(a+M)/(a+a+b+M)*(b )/(a+b+M) + b/(a+a+a+b+b)*(a )/(a+a+a+b+M)*(b )/(b+a+a )*(a )/(a+a ) + b/(a+a+a+b+b)*(b+M)/(a+a+a+b+M)*(a )/(a+a+a )*(a )/(a+a ) ) ) }
f(4.4,3.3, 0.2)*12 f(4.4,3.3, 0.0)*12
```{tikz, label=tikzpartprobtree1,fig.cap = "Partial probability tree for five competitors $a-e$ with $a$ supporting $b$, hyper3 approach", fig.ext = 'png', echo=FALSE} \usetikzlibrary{arrows} \usetikzlibrary{patterns} \begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm] \fill (0,0) circle[radius=2pt]; % root; paths abcde \draw (0,0) -- (2,3); \draw (0,0) -- (2,2); \draw (0,0) -- (2,1); \draw (0,0) -- (2,0); \draw (0,0) -- (2,-1); \node at (0,2.5) (eq1) {$a\longrightarrow b$};
\node at (1.5,2.5) {$a$}; \node at (1.5,1.7) {$b$}; \node at (1.5,1.0) {$c$}; \node at (1.5,0.2) {$d$}; \node at (1.5,-0.5) {$e$};
\node at (3, 3) {$\frac{a}{a+b+c+d+e}$}; \node at (3, 2) {$\frac{b}{a+b+c+d+e}$}; \node at (3, 1) {$\frac{c}{a+b+c+d+e}$}; \node at (3, 0) {$\frac{d}{a+b+c+d+e}$}; \node at (3,-1) {$\frac{e}{a+b+c+d+e}$};
\fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde \fill (4, 2) circle[radius=2pt]; % terminal node \fill (4, 1) circle[radius=2pt]; % terminal node \fill (4, 0) circle[radius=2pt]; % d finishes; paths abce \fill (4,-1) circle[radius=2pt]; % terminal node
\draw (4,3) -- (5,5); \draw (4,3) -- (5,4); \draw (4,3) -- (5,3); \draw (4,3) -- (5,2);
\node at (4.5,4.6) {$b$}; \node at (4.5,3.7) {$c$}; \node at (4.5,3.2) {$d$}; \node at (4.5,2.7) {$e$};
\newcommand{\lb}{\lambda b } \newcommand{\lc}{\lambda c } \newcommand{\lee}{\lambda e } \node at (6, 5) {$\frac{\lb}{\lb+c+d+e}$}; \node at (6, 4) {$\frac{c}{\lb+c+d+e}$}; \node at (6, 3) {$\frac{d }{\lb+c+d+e}$}; \node at (6, 2) {$\frac{e }{\lb+c+d+e}$};
\fill (7.4, 5) circle[radius=2pt]; % ab finishes; paths cde \draw (7.4,5) -- (8.4,6); \draw (7.4,5) -- (8.4,5); \draw (7.4,5) -- (8.4,4);
\node at (7.9,5.7) {$c$}; \node at (7.9,5.2) {$d$}; \node at (7.9,4.7) {$e$}; \node at (9.3, 6) {$\frac{c}{c+d+e}$}; \node at (9.3, 5) {$\frac{d }{c+d+e}$}; \node at (9.3, 4) {$\frac{e }{c+d+e}$};
\fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de \draw (10.2, 6) -- (11.2,7); \node at (10.7,6.8) {$d$};
\node at (11.8, 7) {$\frac{d}{d+e}$};
\draw (10.2, 6) -- (11.2,6.2); \node at (11.8, 6.2) {$\frac{e}{d+e}$}; \node at (10.7,6.3) {$e$};
\fill (10.2, 5) circle[radius=2pt]; \draw (10.2, 5) -- (11.2,5.3); \node at (11.8, 5.3) {$\frac{c}{c+e}$}; \node at (10.7,5.3) {$c$};
\draw (10.2, 5) -- (11.2,4.7); \node at (11.8, 4.7) {$\frac{e}{c+e}$}; \node at (10.7,4.7) {$e$};
\fill (10.2, 4) circle[radius=2pt]; \draw (10.2, 4) -- (11.2,3.9); \node at (11.8, 3.9) {$\frac{c}{c+e}$}; \node at (10.7,4.1) {$c$};
\draw (10.2, 4) -- (11.2,3.1); \node at (11.8, 3.1) {$\frac{e}{c+e}$}; \node at (10.7,3.7) {$e$};
\draw (4, 0) -- (5,1); \node at (6, 1) {$\frac{a}{a+b+c+e}$};
\draw (4, 0) -- (5,0); \node at (6, 0) {$\frac{b}{a+b+c+e}$};
\draw (4, 0) -- (5,-1); \node at (6, -1) {$\frac{c}{a+b+c+e}$};
\draw (4, 0) -- (5,-2); \node at (6, -2) {$\frac{e}{a+b+c+e}$};
\node at (4.5,0.7) {$a$}; \node at (4.5,0.2) {$b$}; \node at (4.5,-0.3) {$c$}; \node at (4.5,-0.8) {$e$};
\fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc \draw (7.4, -2) -- (8.4,-1); \draw (7.4, -2) -- (8.4,-2); \draw (7.4, -2) -- (8.4,-3);
\node at (7.9,-1.2) {$a$}; \node at (7.9,-1.8) {$b$}; \node at (7.9,-2.3) {$c$};
\node at (9.3, -1) {$\frac{a}{a+b+c}$}; \node at (9.3, -2) {$\frac{b}{a+b+c}$}; \node at (9.3, -3) {$\frac{c}{a+b+c}$};
\fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc \fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac \fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab
\draw (10.2, -1) -- (11.2,-0); \node at (10.6,-0.4) {$b$}; \node at (10.6,-0.8) {$c$};
\node at (11.8, 0) {$\frac{\lb}{\lb+c}$}; \draw (10.2, -1) -- (11.2,-1);
\node at (11.8, -1) {$\frac{c}{\lb+c}$};
\draw (10.2, -2) -- (11.2,-1.6); \node at (11.8, -1.6) {$\frac{a}{a+c}$};
\node at (10.6,-1.7) {$a$}; \node at (10.6,-2) {$c$};
\draw (10.2, -2) -- (11.2,-2.2); \node at (11.8, -2.2) {$\frac{c}{a+c}$};
\draw (10.2, -3) -- (11.2,-2.9); \node at (11.8, -2.9) {$\frac{a}{a+b}$};
\draw (10.2, -3) -- (11.2,-3.4); \node at (11.8, -3.4) {$\frac{b}{a+b}$};
\node at (10.6,-2.8) {$a$}; \node at (10.6,-3.3) {$b$};
\fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (7.4, 1) -- (8.4,2); \draw (7.4, 1) -- (8.4,1); \draw (7.4, 1) -- (8.4,0);
\node at (7.9,1.7) {$b$}; \node at (7.9,1.2) {$c$}; \node at (7.9,0.7) {$e$};
\node at (9.3, 2) {$\frac{\lb}{\lb+c+e}$}; \node at (9.3, 1) {$\frac{ c}{\lb+c+e}$}; \node at (9.3, 0) {$\frac{e }{\lb+c+e}$};
\fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce \draw (10.2, 1) -- (11.2,2); \node at (11.8, 2) {$\frac{\lb}{\lb+e}$}; \draw (10.2, 1) -- (11.2,1); \node at (11.8, 1) {$\frac{e}{\lb+e}$};
\end{tikzpicture}
```{tikz, label=tikzpic2, fig.cap = "Partial probability tree for five competitors $a-e$ with mutually supporting group $abc$, hyper3 approach. If any competitor in the set {$a,b,c$} finishes, they lend their strength to the other competitors in the set who are still running", fig.ext = 'png', echo=FALSE} \usetikzlibrary{arrows} \usetikzlibrary{patterns} \begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm] \fill (0,0) circle[radius=2pt]; % root; paths abcde \draw (0,0) -- (2,3); \draw (0,0) -- (2,2); \draw (0,0) -- (2,1); \draw (0,0) -- (2,0); \draw (0,0) -- (2,-1); \node at (0,2.5) (eq1) {$\underbrace{\left\lbrace a,b,c\right\rbrace}_{\lambda}$}; \node at (1.5,2.5) {$a$}; \node at (1.5,1.7) {$b$}; \node at (1.5,1.0) {$c$}; \node at (1.5,0.2) {$d$}; \node at (1.5,-0.5) {$e$}; \node at (3, 3) {$\frac{a}{a+b+c+d+e}$}; \node at (3, 2) {$\frac{b}{a+b+c+d+e}$}; \node at (3, 1) {$\frac{c}{a+b+c+d+e}$}; \node at (3, 0) {$\frac{d}{a+b+c+d+e}$}; \node at (3,-1) {$\frac{e}{a+b+c+d+e}$}; \fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde \fill (4, 2) circle[radius=2pt]; % terminal node \fill (4, 1) circle[radius=2pt]; % terminal node \fill (4, 0) circle[radius=2pt]; % d finishes; paths abce \fill (4,-1) circle[radius=2pt]; % terminal node \draw (4,3) -- (5,5); \draw (4,3) -- (5,4); \draw (4,3) -- (5,3); \draw (4,3) -- (5,2); \node at (4.5,4.6) {$b$}; \node at (4.5,3.7) {$c$}; \node at (4.5,3.2) {$d$}; \node at (4.5,2.7) {$e$}; \newcommand{\la}{\lambda a } \newcommand{\lb}{\lambda b } \newcommand{\lc}{\lambda c } \newcommand{\lee}{\lambda e } \node at (6, 5) {$\frac{\lb}{\lb+\lc+d+e}$}; \node at (6, 4) {$\frac{\lc}{\lb+\lc+d+e}$}; \node at (6, 3) {$\frac{d }{\lb+\lc+d+e}$}; \node at (6, 2) {$\frac{e }{\lb+\lc+d+e}$}; \fill (7.4, 5) circle[radius=2pt]; % ab finishes; paths cde \draw (7.4,5) -- (8.4,6); \draw (7.4,5) -- (8.4,5); \draw (7.4,5) -- (8.4,4); \node at (7.9,5.7) {$c$}; \node at (7.9,5.2) {$d$}; \node at (7.9,4.7) {$e$}; \node at (9.3, 6) {$\frac{\lc}{\lc+d+e}$}; \node at (9.3, 5) {$\frac{d }{\lc+d+e}$}; \node at (9.3, 4) {$\frac{e }{\lc+d+e}$}; \fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de \draw (10.2, 6) -- (11.2,7); \node at (10.7,6.8) {$d$}; \node at (11.8, 7) {$\frac{d}{d+e}$}; \draw (10.2, 6) -- (11.2,6.2); \node at (11.8, 6.2) {$\frac{e}{d+e}$}; \node at (10.7,6.3) {$e$}; \fill (10.2, 5) circle[radius=2pt]; \draw (10.2, 5) -- (11.2,5.3); \node at (11.8, 5.3) {$\frac{\lc}{\lc+e}$}; \node at (10.7,5.3) {$c$}; \draw (10.2, 5) -- (11.2,4.7); \node at (11.8, 4.7) {$\frac{e}{\lc+e}$}; \node at (10.7,4.7) {$e$}; \fill (10.2, 4) circle[radius=2pt]; \draw (10.2, 4) -- (11.2,3.9); \node at (11.8, 3.9) {$\frac{\lc}{\lc+e}$}; \node at (10.7,4.1) {$c$}; \draw (10.2, 4) -- (11.2,3.1); \node at (11.8, 3.1) {$\frac{e}{\lc+e}$}; \node at (10.7,3.7) {$e$}; \draw (4, 0) -- (5,1); \node at (6, 1) {$\frac{a}{a+b+c+e}$}; \draw (4, 0) -- (5,0); \node at (6, 0) {$\frac{b}{a+b+c+e}$}; \draw (4, 0) -- (5,-1); \node at (6, -1) {$\frac{c}{a+b+c+e}$}; \draw (4, 0) -- (5,-2); \node at (6, -2) {$\frac{e}{a+b+c+e}$}; \node at (4.5,0.7) {$a$}; \node at (4.5,0.2) {$b$}; \node at (4.5,-0.3) {$c$}; \node at (4.5,-0.8) {$e$}; \fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc \draw (7.4, -2) -- (8.4,-1); \draw (7.4, -2) -- (8.4,-2); \draw (7.4, -2) -- (8.4,-3); \node at (7.9,-1.2) {$a$}; \node at (7.9,-1.8) {$b$}; \node at (7.9,-2.3) {$c$}; \node at (9.3, -1) {$\frac{a}{a+b+c}$}; \node at (9.3, -2) {$\frac{b}{a+b+c}$}; \node at (9.3, -3) {$\frac{c}{a+b+c}$}; \fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc \fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac \fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab \draw (10.2, -1) -- (11.2,-0); \node at (10.6,-0.4) {$b$}; \node at (10.6,-0.8) {$c$}; \node at (11.8, 0) {$\frac{\lb}{\lb+\lc}$}; \draw (10.2, -1) -- (11.2,-1); \node at (11.8, -1) {$\frac{c}{\lb+\lc}$}; \draw (10.2, -2) -- (11.2,-1.6); \node at (11.8, -1.6) {$\frac{\la}{\la+\lc}$}; \node at (10.6,-1.7) {$a$}; \node at (10.6,-2) {$c$}; \draw (10.2, -2) -- (11.2,-2.2); \node at (11.8, -2.2) {$\frac{\lc}{\la+\lc}$}; \draw (10.2, -3) -- (11.2,-2.9); \node at (11.8, -2.9) {$\frac{\la}{\la+\lb}$}; \draw (10.2, -3) -- (11.2,-3.4); \node at (11.8, -3.4) {$\frac{\lb}{\la+\lb}$}; \node at (10.6,-2.8) {$a$}; \node at (10.6,-3.3) {$b$}; \fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce \draw (7.4, 1) -- (8.4,2); \draw (7.4, 1) -- (8.4,1); \draw (7.4, 1) -- (8.4,0); \node at (7.9,1.7) {$b$}; \node at (7.9,1.2) {$c$}; \node at (7.9,0.7) {$e$}; \node at (9.3, 2) {$\frac{\lb}{\lb+\lc+e}$}; \node at (9.3, 1) {$\frac{\lc}{\lb+\lc+e}$}; \node at (9.3, 0) {$\frac{e }{\lb+\lc+e}$}; \fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce \draw (10.2, 1) -- (11.2,2); \node at (11.8, 2) {$\frac{\lb}{\lb+e}$}; \draw (10.2, 1) -- (11.2,1); \node at (11.8, 1) {$\frac{e}{\lb+e}$}; \end{tikzpicture}
```{tikz, label=tikz3,fig.cap = "Partial probability tree for five competitors $a$-$e$ with mutually supporting subsets $\left\lbrace a,b,c\right\rbrace$ [with support term $\lambda$] and $(de)$ [with support term $\mu$], hyper3 approach", fig.ext = 'png', echo=FALSE} \usetikzlibrary{arrows} \usetikzlibrary{patterns} \begin{tikzpicture}[line cap=round,line join=round,>=triangle 45,x=1cm,y=1cm] \fill (0,0) circle[radius=2pt]; % root; paths abcde \draw (0,0) -- (2,3); \draw (0,0) -- (2,2); \draw (0,0) -- (2,1); \draw (0,0) -- (2,0); \draw (0,0) -- (2,-1); \node at (0,2.5) (eq1) {$\underbrace{\left\lbrace a,b,c\right\rbrace}{\lambda}\underbrace{\left\lbrace d,e\right\rbrace}{\mu}$};
\node at (1.5,2.5) {$a$}; \node at (1.5,1.7) {$b$}; \node at (1.5,1.0) {$c$}; \node at (1.5,0.2) {$d$}; \node at (1.5,-0.5) {$e$};
\node at (3, 3) {$\frac{a}{a+b+c+d+e}$}; \node at (3, 2) {$\frac{b}{a+b+c+d+e}$}; \node at (3, 1) {$\frac{c}{a+b+c+d+e}$}; \node at (3, 0) {$\frac{d}{a+b+c+d+e}$}; \node at (3,-1) {$\frac{e}{a+b+c+d+e}$};
\fill (4, 3) circle[radius=2pt]; % a finishes; paths bcde \fill (4, 2) circle[radius=2pt]; % terminal node \fill (4, 1) circle[radius=2pt]; % terminal node \fill (4, 0) circle[radius=2pt]; % d finishes; paths abce \fill (4,-1) circle[radius=2pt]; % terminal node
\draw (4,3) -- (5,5); \draw (4,3) -- (5,4); \draw (4,3) -- (5,3); \draw (4,3) -- (5,2);
\node at (4.5,4.6) {$b$}; \node at (4.5,3.7) {$c$}; \node at (4.5,3.2) {$d$}; \node at (4.5,2.7) {$e$};
\newcommand{\la}[1]{\lambda{#1}} \newcommand{\ld}[1]{\mu {#1}} \node at (6, 5) {$\frac{\la{b}}{\la{b}+\la{c}+d+e}$}; \node at (6, 4) {$\frac{\la{c}}{\la{b}+\la{c}+d+e}$}; \node at (6, 3) {$\frac{d }{\la{b}+\la{c}+d+e}$}; \node at (6, 2) {$\frac{e }{\la{b}+\la{c}+d+e}$};
\fill (7.4, 5) circle[radius=2pt]; % ab finishes; pahts cde \draw (7.4,5) -- (8.4,6); \draw (7.4,5) -- (8.4,5); \draw (7.4,5) -- (8.4,4);
\node at (7.9,5.7) {$c$}; \node at (7.9,5.2) {$d$}; \node at (7.9,4.7) {$e$}; \node at (9.3, 6) {$\frac{\la{c}}{\la{c}+d+e}$}; \node at (9.3, 5) {$\frac{d }{\la{c}+d+e}$}; \node at (9.3, 4) {$\frac{e }{\la{c}+d+e}$};
\fill (10.2, 6) circle[radius=2pt]; % abc finishes; paths de \draw (10.2, 6) -- (11.2,7); \node at (10.7,6.8) {$d$};
\node at (11.8, 7) {$\frac{d}{d+e}$};
\draw (10.2, 6) -- (11.2,6.2); \node at (11.8, 6.2) {$\frac{e}{d+e}$}; \node at (10.7,6.3) {$e$};
\fill (10.2, 5) circle[radius=2pt]; \draw (10.2, 5) -- (11.2,5.3); \node at (11.8, 5.3) {$\frac{\la{c}}{\la{c}+\ld{e}}$}; \node at (10.7,5.3) {$c$};
\draw (10.2, 5) -- (11.2,4.7); \node at (11.8, 4.7) {$\frac{\ld{e}}{\la{c}+\ld{e}}$}; \node at (10.7,4.7) {$e$};
\fill (10.2, 4) circle[radius=2pt]; \draw (10.2, 4) -- (11.2,3.9); \node at (11.8, 3.9) {$\frac{\la{c}}{\la{c}+\ld{e}}$}; \node at (10.7,4.1) {$c$};
\draw (10.2, 4) -- (11.2,3.1); \node at (11.8, 3.1) {$\frac{\ld{e}}{\la{c}+\ld{e}}$}; \node at (10.7,3.7) {$e$};
\draw (4, 0) -- (5,1); \node at (6, 1) {$\frac{a}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,0); \node at (6, 0) {$\frac{b}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,-1); \node at (6, -1) {$\frac{c}{a+b+c+\ld{e}}$};
\draw (4, 0) -- (5,-2); \node at (6, -2) {$\frac{\ld{e}}{a+b+c+\ld{e}}$};
\node at (4.5,0.7) {$a$}; \node at (4.5,0.2) {$b$}; \node at (4.5,-0.3) {$c$}; \node at (4.5,-0.8) {$e$};
\fill (7.4, -2) circle[radius=2pt]; % de finishes; paths abc \draw (7.4, -2) -- (8.4,-1); \draw (7.4, -2) -- (8.4,-2); \draw (7.4, -2) -- (8.4,-3);
\node at (7.9,-1.2) {$a$}; \node at (7.9,-1.8) {$b$}; \node at (7.9,-2.3) {$c$};
\node at (9.3, -1) {$\frac{a}{a+b+c}$}; \node at (9.3, -2) {$\frac{b}{a+b+c}$}; \node at (9.3, -3) {$\frac{c}{a+b+c}$};
\fill (10.2, -1) circle[radius=2pt]; % dea finishes; paths bc \fill (10.2, -2) circle[radius=2pt]; % deb finishes; paths ac \fill (10.2, -3) circle[radius=2pt]; % dec finishes; paths ab
\draw (10.2, -1) -- (11.2,-0); \node at (10.6,-0.4) {$b$}; \node at (10.6,-0.8) {$c$};
\node at (11.8, 0) {$\frac{\la{b}}{\la{b}+\la{c}}$}; \draw (10.2, -1) -- (11.2,-1);
\node at (11.8, -1) {$\frac{\la{c}}{\la{b}+\la{c}}$};
\draw (10.2, -2) -- (11.2,-1.6); \node at (11.8, -1.6) {$\frac{\la{a}}{\la{a}+\la{c}}$};
\node at (10.6,-1.7) {$a$}; \node at (10.6,-2) {$c$};
\draw (10.2, -2) -- (11.2,-2.2); \node at (11.8, -2.2) {$\frac{\la{c}}{\la{a}+\la{c}}$};
\draw (10.2, -3) -- (11.2,-2.9); \node at (11.8, -2.9) {$\frac{\la{a}}{\la{a}+\la{b}}$};
\draw (10.2, -3) -- (11.2,-3.4); \node at (11.8, -3.4) {$\frac{\la{b}}{\la{a}+\la{b}}$};
\node at (10.6,-2.8) {$a$}; \node at (10.6,-3.3) {$b$};
\fill (7.4, 1) circle[radius=2pt]; % da finishes; paths bce
\draw (7.4, 1) -- (8.4,2); \draw (7.4, 1) -- (8.4,1); \draw (7.4, 1) -- (8.4,0);
\node at (7.9,1.7) {$b$}; \node at (7.9,1.2) {$c$}; \node at (7.9,0.7) {$e$};
\node at (9.3, 2) {$\frac{\la{b}}{\la{b}+\la{c}+e}$}; \node at (9.3, 1) {$\frac{\la{c}}{\la{b}+\la{c}+e}$}; \node at (9.3, 0) {$\frac{e }{\la{b}+\la{c}+e}$};
\fill (10.2, 1) circle[radius=2pt]; % da finishes; paths bce \draw (10.2, 1) -- (11.2,2); \node at (11.8, 2) {$\frac{\la{b}}{\la{b}+\ld{e}}$}; \draw (10.2, 1) -- (11.2,1); \node at (11.8, 1) {$\frac{\ld{e}}{\la{b}+e}$};
\end{tikzpicture}
# Package idiom We can investigate red bus-blue bus phenomenon (as discussed, in a slightly different context, in `inst/red_bus_blue_bus.Rmd`). Here, we consider a person who is given the choice of five transport methods: * `C`, car * `T`, train * `RB` a red bus * `BB` a blue bus * `W` walking Now, he does not really care what colour the bus is. If we ask him to rank his options, it is highly probable that he will put `RB` and `BB` consecutively (because they are essentially indistinguishable). Can we quantify the strength of this effect? To do this, we define a bespoke function `RB_BB_LF()` which returns a `hyper3` log-likelihood function corresponding to repeated observations of our commuter's reported ranks for the five options: ```r `RB_BB_LF` <- function(s){ ec <- c(C=1,T=2,RB=3,BB=3,W=4) # equivalence classes h <- c(1,1,s,1) # strength of support ( cheering3(v=c("RB","BB","C" ,"T","W"),e=ec,h=h)*3 + cheering3(v=c("BB","RB","T" ,"C","W"),e=ec,h=h)*2 + cheering3(v=c("T" ,"BB","RB","C","W"),e=ec,h=h)*2 + cheering3(v=c("W" ,"BB","RB","T","C"),e=ec,h=h)*4 + cheering3(v=c("C" ,"RB","BB","W","T"),e=ec,h=h)*4 + cheering3(v=c("BB","C" ,"RB","T","W"),e=ec,h=h)*3 ) }
Above, we see from the function body that he reported RB,BB,C,T,W
three times [first row], BB,RB,T,C,W twice [second row], and so on;
perhaps his ranking depends on the weather or how tired he is on any
given day. Observe that in almost every case he ranks RB and BB
consecutively. Function RB_BB_LF() takes argument s that
quantifies the perceived similarity between RB and BB. For
example:
(H <- RB_BB_LF(s=1.8888)) (mH <- maxp(H,n=1))
Now to find a profile likelihood function for s:
o <- function(s){maxp(RB_BB_LF(s),give=TRUE,n=1)$likes} # optimand s <- exp(seq(from=log(1.3),to=log(47),len=17)) # putative similarity measures L <- sapply(s,o) L <- L-max(L)
We can plot these:
plot(s,L,type="b") abline(h=c(0,-2)) abline(v=1) plot(log(s),L,type="b") abline(h=c(0,-2)) abline(v=0)
And formally maximize the likelihood:
(osup <- optimize(o,c(6,10),maximum=TRUE))
So a likelihood ratio test of the null that $S=1$ would be:
(suppdiff <- o(osup$maximum) - o(1))
Easily satisfying Edwards's two-units-of-support criterion; Wilks gives us an asymptotic $p$-value:
pchisq(suppdiff*2,df=1,lower.tail=FALSE)
University ranking analysis
Here we use a dataset of university rankings, timesData.csv, taken
from
https://github.com/arnaudbenard/university-ranking/blob/master/timesData.csv.
a <- read.table("timesData.csv",sep=",", header=TRUE) wanted <- c("California Institute of Technology", "Harvard University", "Massachusetts Institute of Technology", "Princeton University", "Stanford University", "University of Cambridge", "University of Oxford") names(wanted) <- c("cal","harv","mass","prin","stan","cam","ox") a <- a[a$university_name %in% wanted,] a <- cbind(a,"top7rank"=0) for(y in unique(a$year)){ a[a$year==y,"top7rank"] <- order( as.numeric(a[a$year==y,"world_rank"]) + a[a$year==y,"research"]/1e6, decreasing=TRUE)} a <- a[,c("top7rank","university_name","year")] a <- reshape(a,idvar="university_name",timevar="year",direction="wide") for(i in seq_len(nrow(a))){ a$university_name[i] <- names(which(wanted == a$university_name[i])) } rownames(a) <- a$university_name a <- a[,-1] colnames(a) <- paste("Y",2011:2016,sep="") a H <- ordertable2supp(a)
equalp.test(H) samep.test(H,c("ox","cam"))
Start to use hyper3 idiom:
H3 <- function(oxcam){ out <- hyper3() for(i in seq_len(ncol(a))){ jj <- rep("",nrow(a)) jj[a[,i]] <- rownames(a) out <- out + cheering3(v=jj,e=c(ox=1,cam=1,prin=2, stan=3, mass=4, harv=5, cal=6), help=c(oxcam,1,1,1,1,1)) } return(out) }
o <- function(oxcam){maxp(H3(oxcam),give=TRUE,n=1)$likes} oc <- exp(seq(from=log(0.5),to=log(5),len=15)) L <- sapply(oc,o) L <- L - max(L)
plot(log(oc),L,type="b") abline(v=0)
Five nations championship
The five nations rugby championship was held from 1910 to 1999 and
file five_nations.txt shows the order statistic for England (E),
Scotland (S), Ireland (I), Wales (W), and France (F).
https://en.wikipedia.org/wiki/Six_Nations_Championship
Here is hyper2 analysis:
a <- as.matrix(read.table("five_nations.txt",header=FALSE)) head(a) H <- hyper2() for(i in seq_len(nrow(a))){ H <- H + race(a[i,-1]) } mH <- maxp(H) pie(mH) equalp.test(H)
Now use hyper3 to see whether teams do better following a win:
rugby <- function(lambda){ H3a <- hyper3() for(i in seq(from=2,to=nrow(a))){ last_year_winner <- a[i-1,2] # e.g. "W" or "E" H3a <- H3a + ordervec2supp3a(a[i,-1],nonfinishers=NULL,helped=last_year_winner,lambda=lambda) } return(H3a) } rugby(1.888) rugby(1.111111)
maxp(rugby(1.8),n=1,give=TRUE) maxp(rugby(1.9),n=1,give=TRUE)
References {-}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.