Nothing
plackett_luce_monster
In hyper2: The Hyperdirichlet Distribution, Mark 2
knitr::opts_chunk$set(echo = TRUE)
library("hyper2")
library("partitions")
library("pdftools")
![](`r system.file("help/figures/hyper2.png", package = "hyper2")`){width=10%}
%
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$.
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. 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$.
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$.
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, 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, 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, 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)
Try the hyper2 package in your browser
Any scripts or data that you put into this service are public.
hyper2 documentation built on Aug. 21, 2022, 1:05 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")
![](`r system.file("help/figures/hyper2.png", package = "hyper2")`){width=10%}
%
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$.
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. 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$.
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$.
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, 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, 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, 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)
Try the hyper2 package in your browser
Any scripts or data that you put into this service are public.
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.