Research goal

Super Bowl LI will be the 51st Super Bowl and the 47th modern-era National Football League (NFL) championship game. The American Football Conference (AFC) champion New England Patriots will play the National Football Conference (NFC) champion Atlanta Falcons to decide the league champion for the 2016 season.

We want to estimate chances of two leaders to win final game: New England Patriots (NEP) and Atlanta Falcons (AF). Though we have already known the outcome of this final: NEP - 34, AF - 28.

For more about Super Bowl LI see: https://en.wikipedia.org/wiki/Super_Bowl_LI.

Data

So we have got some information about two leaders of the final game: W - number of won points, L - number of lost points, WL - total number of points (W-L), WL2 - games won (1) and games lost (0).

#2016 Atlanta Falcons season
AFW<-c(23,24,17,35,45,48,23,33,43,38,42,41,33,38)
AFL<-c(6,24,30,15,28)
AFWL<-c(5,11,-11,2,-7,7,13,15,7,-2,-3,1,15,-9,19,-1,28,28,17,6)
AFWL2<-c(1,1,0,1,0,1,1,1,1,0,0,1,1,0,1,0,1,1,1,1)

#2016 New England Patriots season
NEPW<-c(34,23,19,23,31,27,33,35,27,41,30,22,26,30,16,41,35,34,36)
NEPL<-c(17,16,31)
NEPWL<-c(11,1,2,-8,2,7,-16,20,18,11,16,-7,13,5,16,7,13,38,21,18,21)
NEPWL2<-c(1,1,1,0,1,1,0,1,1,1,1,0,1,1,1,1,1,1,1,1,1)

Summary

#AF
summary(AFW)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   17.00   26.25   36.50   34.50   41.75   48.00
summary(AFL)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     6.0    15.0    24.0    20.6    28.0    30.0
summary(AFWL)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -11.00   -1.25    6.50    7.05   15.00   28.00
P_AF_W<-sum(AFWL2)/length(AFWL2) #Probability of win for AF
P_AF_W
## [1] 0.7
#NEP
summary(NEPW)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   16.00   24.50   30.00   29.63   34.50   41.00
summary(NEPL)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   16.00   16.50   17.00   21.33   24.00   31.00
summary(NEPWL)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -16.000   2.000  11.000   9.952  18.000  38.000
P_NEP_W<-sum(NEPWL2)/length(NEPWL2) #Probability of win for NEP
P_NEP_W
## [1] 0.8571429

Probability to win 6 points

mean(AFWL>=6)
## [1] 0.55
mean(NEPWL>=6)
## [1] 0.6666667

Graphical interpretation

SBWL<-cbind(AFWL,NEPWL)
## Warning in cbind(AFWL, NEPWL): number of rows of result is not a multiple
## of vector length (arg 1)
boxplot(SBWL,col=c("red","blue"),main="Total points won by teams")

hist(AFWL,main="Total points won by AF", col="red",breaks = 5)

hist(NEPWL,main="Total points won by NEP", col="blue")

Frequentist case

Student test for means

t.test(AFWL,NEPWL)
## 
##  Welch Two Sample t-test
## 
## data:  AFWL and NEPWL
## t = -0.79974, df = 38.987, p-value = 0.4287
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -10.243164   4.438402
## sample estimates:
## mean of x mean of y 
##  7.050000  9.952381

Binomial test

#AF
binom.test(x=sum(AFWL2),n = length(AFWL2), p = 0.9)
## 
##  Exact binomial test
## 
## data:  sum(AFWL2) and length(AFWL2)
## number of successes = 14, number of trials = 20, p-value = 0.01125
## alternative hypothesis: true probability of success is not equal to 0.9
## 95 percent confidence interval:
##  0.4572108 0.8810684
## sample estimates:
## probability of success 
##                    0.7
#NEP
binom.test(x=sum(NEPWL2),n = length(NEPWL2), p = 0.9)
## 
##  Exact binomial test
## 
## data:  sum(NEPWL2) and length(NEPWL2)
## number of successes = 18, number of trials = 21, p-value = 0.461
## alternative hypothesis: true probability of success is not equal to 0.9
## 95 percent confidence interval:
##  0.636576 0.969511
## sample estimates:
## probability of success 
##              0.8571429

Bayesian case

We try Bayesian math for our data converting confidence into credibility.

library(rjags)
## Loading required package: coda
## Linked to JAGS 4.1.0
## Loaded modules: basemod,bugs
library(stringr)

source("lib/generic_functions.R")
source("lib/utility_functions.R")
source("lib/BayesianFirstAid-package.R")
source("lib/bayes_binom_test.R")
source("lib/bayes_cor_test.R")
source("lib/bayes_poisson_test.R")
source("lib/bayes_prop_test.R")
source("lib/bayes_t_test.R")

Student test for means

bst<-bayes.t.test(AFWL,NEPWL)
summary(bst)
##   Data
## AFWL, n = 20
## NEPWL, n = 21
## 
##   Model parameters and generated quantities
## mu_x: the mean of AFWL 
## sigma_x: the scale of AFWL , a consistent
##   estimate of SD when nu is large.
## mu_y: the mean of NEPWL 
## sigma_y: the scale of NEPWL 
## mu_diff: the difference in means (mu_x - mu_y)
## sigma_diff: the difference in scale (sigma_x - sigma_y)
## nu: the degrees-of-freedom for the t distribution
##   fitted to AFWL and NEPWL 
## eff_size: the effect size calculated as 
##   (mu_x - mu_y) / sqrt((sigma_x^2 + sigma_y^2) / 2)
## x_pred: predicted distribution for a new datapoint
##   generated as AFWL 
## y_pred: predicted distribution for a new datapoint
##   generated as NEPWL 
## 
##   Measures
##              mean     sd   HDIlo  HDIup %<comp %>comp
## mu_x        6.909  2.762   1.487 12.325  0.007  0.993
## sigma_x    11.659  2.237   7.860 16.289  0.000  1.000
## mu_y       10.024  2.763   4.653 15.522  0.000  1.000
## sigma_y    12.147  2.327   7.956 16.820  0.000  1.000
## mu_diff    -3.116  3.908 -10.645  4.670  0.791  0.209
## sigma_diff -0.488  3.171  -6.671  5.988  0.570  0.430
## nu         34.403 28.643   1.882 90.948  0.000  1.000
## eff_size   -0.266  0.328  -0.902  0.379  0.791  0.209
## x_pred      6.893 13.085 -19.664 32.438  0.283  0.717
## y_pred     10.009 13.514 -17.566 36.379  0.213  0.787
## 
## 'HDIlo' and 'HDIup' are the limits of a 95% HDI credible interval.
## '%<comp' and '%>comp' are the probabilities of the respective parameter being
## smaller or larger than 0.
## 
##   Quantiles
##              q2.5%   q25% median   q75%  q97.5%
## mu_x         1.524  5.085  6.892  8.702  12.385
## sigma_x      8.152 10.101 11.364 12.884  16.859
## mu_y         4.524  8.222 10.047 11.830  15.427
## sigma_y      8.356 10.525 11.890 13.472  17.471
## mu_diff    -10.743 -5.715 -3.116 -0.541   4.594
## sigma_diff  -6.753 -2.471 -0.499  1.477   5.915
## nu           4.504 13.818 26.145 46.130 110.679
## eff_size    -0.916 -0.486 -0.264 -0.046   0.369
## x_pred     -19.367 -1.250  6.995 15.044  32.858
## y_pred     -17.079  1.555 10.089 18.441  37.039
plot(bst)

Binomial test

fit.bs.AFWL <- bayes.binom.test(x=sum(AFWL2),n = length(AFWL2), cred.mass=0.95, p = 0.9, n.iter = 5000)
summary(fit.bs.AFWL)
##   Data
## number of successes = 14, number of trials = 20
## 
##   Model parameters and generated quantities
## theta: the relative frequency of success
## x_pred: predicted number of successes in a replication
## 
##   Measures
##          mean    sd HDIlo  HDIup %<comp %>comp
## theta   0.680 0.098 0.485  0.858  0.999  0.001
## x_pred 13.612 2.874 7.000 18.000  0.000  1.000
## 
## 'HDIlo' and 'HDIup' are the limits of a 95% HDI credible interval.
## '%<comp' and '%>comp' are the probabilities of the respective parameter being
## smaller or larger than 0.9.
## 
##   Quantiles
##        q2.5%   q25% median   q75% q97.5%
## theta  0.471  0.614  0.688  0.753  0.851
## x_pred 7.000 12.000 14.000 16.000 19.000
plot(fit.bs.AFWL)

fit.bs.NEPWL <- bayes.binom.test(x=sum(NEPWL2),n = length(NEPWL2), cred.mass=0.95, p = 0.9, n.iter = 5000)
summary(fit.bs.NEPWL)
##   Data
## number of successes = 18, number of trials = 21
## 
##   Model parameters and generated quantities
## theta: the relative frequency of success
## x_pred: predicted number of successes in a replication
## 
##   Measures
##          mean    sd HDIlo  HDIup %<comp %>comp
## theta   0.825 0.078  0.67  0.959  0.835  0.165
## x_pred 17.341 2.312 13.00 21.000  0.000  1.000
## 
## 'HDIlo' and 'HDIup' are the limits of a 95% HDI credible interval.
## '%<comp' and '%>comp' are the probabilities of the respective parameter being
## smaller or larger than 0.9.
## 
##   Quantiles
##         q2.5%   q25% median   q75% q97.5%
## theta   0.651  0.776  0.835  0.882  0.949
## x_pred 12.000 16.000 18.000 19.000 21.000
plot(fit.bs.NEPWL)

Probability to win 6 points

library(bayesboot)
## 
## Attaching package: 'bayesboot'
## The following object is masked _by_ '.GlobalEnv':
## 
##     plotPost
BS_AFWL <- bayesboot(AFWL, weighted.mean, use.weights = TRUE)
mean(BS_AFWL[,1]>6)
## [1] 0.67
BS_NEPWL <- bayesboot(NEPWL, weighted.mean, use.weights = TRUE)
mean(BS_NEPWL[,1]>6)
## [1] 0.94775

Conclusions

  1. Patriots had 66% probability to win 6 points, while Falcons had only 55%.
  2. Patriots had 85.7% mean probability to win final game compared to Falcons 70%.
  3. Patriots had 95% confidence interval for the probability to win final game \({0.636576}\leqslant{P_{NEP}}\leqslant{0.969511}\) compared to Falcons \({0.4572108}\leqslant{P_{AF}}\leqslant{0.8810684}\).
  4. Bayesian estimation gives Patriots 95% credible interval for the probability to win final game
    \({0.67}\leqslant{P_{NEP}}\leqslant{0.957}\) compared to Falcons \({0.491}\leqslant{P_{AF}}\leqslant{0.859}\).
  5. In fact Bayes gives for Patriots 94% probability to win 6 points compared to 66% for Falcons. The game is over!