Bayesian and Logit Probabilities to Predict the outcome of a 7 game playoff series in the fashion of Las Vegas betting odds.

SportsData.Rmd

Full code for the model is here
http://statsbylopez.netlify.com/post/a-state-space-model-to-evaluate-sports-teams/


```{r}
#Packages Used
library(tidyverse) 
library(rjags)
library(gsheet)
library(lubridate)
library(stringr)
library(knitr)
```

```{r}
#Home Advantage (logit scale)
colours <- c("#7fc97f", "#beaed4", "#fdc086")

hfas <- data.frame(round(z$alpha[,,], 3))  %>% mutate(draw = 1:n())
hfas %>% ggplot(aes(draw, X1)) +
  geom_line(colour = colours[1]) + 
  geom_line(data = hfas, aes(draw, X2), colour = colours[2]) + 
  geom_line(data = hfas, aes(draw, X3), colour = colours[3]) + 
  xlab("Draw") + 
  ggtitle("Home advantage (logit scale)") + 
  ylab("") + 
  theme_bw()
```  

```{r}
#NHL Team Strengths by week of Season

avgs <- apply(z$theta, c(1,2), mean)
dims <- dim(avgs)
names(dims) <- c("nweeks", "nteams")
df.beta <- data.frame(
    theta = as.vector(avgs),
    week = rep(1:dims["nweeks"]), 
    team_id = rep(Teams, each =dims["nweeks"]) )
toronto <- filter(df.beta, team_id == "Toronto Maple Leafs")
boston <- filter(df.beta, team_id == "Boston Bruins")
tampa <- filter(df.beta, team_id == "Tampa Bay Lightning")

ggplot(df.beta, aes(week, theta, group = team_id)) + 
  geom_point(colour = "grey") + 
  geom_line(colour = "grey") + 
  geom_line(data = toronto, colour = "blue", size = 1.1) + 
  geom_point(data = toronto, colour = "blue", alpha = 0.9, stroke = 2) + 
  geom_line(data = boston, colour = "black", size = 1.1) + 
  geom_point(data = boston, colour = "yellow", alpha = 0.9, stroke = 2) + 
  geom_line(data = tampa, colour = "blue", size = 1.1) + 
  geom_point(data = tampa, colour = "white", alpha = 0.9, stroke = 2) + 
  ggtitle("NHL team strengths by week of season, 2017-18") + 
  ylab("theta (log-odds scale)") + 
  ylim(c(-0.56, 0.56)) + 
  annotate("text",x = 5, y = 0.08, label = "Toronto", colour = "blue", size = 5) + 
   annotate("text",x = 5, y = -0.05, label = "Boston", colour = "black", size = 5) + 
   annotate("text",x = 5, y = 0.32, label = "Tampa", colour = "blue", size = 5) + 
  xlab("Week") + theme_bw(14)
```  

```{r}
#Posterior draws of Team Strength

teams <- c("Toronto Maple Leafs", "Boston Bruins", "Tampa Bay Lightning")
thetas <- z$theta[20:26, Teams %in% teams, ,]
colors <- teamcolors1$secondary[Teams %in% teams]
team.1 <- data.frame(team_id = teams[1], beta = c(thetas[,1,,]))
team.2 <- data.frame(team_id = teams[2], beta = c(thetas[,2,,]))
team.3 <- data.frame(team_id = teams[3], beta = c(thetas[,3,,]))

df.matchup <- rbind(team.1, team.2, team.3) 
lmin <- quantile(df.matchup$beta, 0.01)
umin <- quantile(df.matchup$beta, 0.99)

df.matchup %>% ggplot(aes(beta, fill = team_id, group = team_id)) + 
  geom_density(alpha = 0.5) + 
  scale_fill_manual(name = NULL, values = c("white", "yellow", "blue")) + 
  annotate("text", x = .18, y = 4, label = "Toronto", colour = "white", size = 5) + 
  annotate("text", x = .36, y = 4, label = "Boston", colour = "black", size = 5) + 
  annotate("text", x = .46, y = 4, label = "Tampa", colour = "blue", size = 5) +
  ggtitle("Posterior draws of team strength") + 
  xlab("Team strength: log-odds scale") + ylab("Density") + 
  guides(color = FALSE, fill = FALSE) + theme_bw(14) 
```