Monte Carlo Simulations: 2021 NFL Week 06

Twice per week during the NFL season I publish a Substack newsletter called Monte Carlo Football Picks. On Wednesday I publish projections for the Thursday Night game and Friday includes the picks for the rest of the week. If you are interested in the NFL, please subscribe, it’s FREE!

For RSTATS fans I publish my code on RPubs every week. Check it out here.

Use this file to run Monte Carlo Simulations after power ratings are complete.

library(tidyverse)
library(tidyquant)
library(ggimage)
library(ggrepel)
library(knitr)
library(kableExtra)

Load required data files

ratings <- read_csv("Week 06/inputs/power_ratings.csv") 
schedule <- read_csv("Week 06/inputs/schedule.csv")
scores <- read_csv("Week 06/inputs/common_scores.csv", col_types = "n")
df.logos <- read.csv("Week 06/inputs/nfl_logos.csv")

Create function to simulate scores. In between the Thursday Night Game and Sunday games I updated the function to eliminate tie games

mc_sim <- function(home, away, data = ratings, line = 0, n = 100000, hfa = 0, mean = 25){
  
  #pull ratings together for both teams in matchup
  h_off <-ratings %>%
    filter(Team == home & Type == "off_rating") %>%
    select(Team, Type, MC_PR, MC_STD)
  
  h_def <-ratings %>%
    filter(Team == home & Type == "def_rating") %>%
    select(Team, Type, MC_PR, MC_STD)
  
  
  a_off <-ratings %>%
    filter(Team == away & Type == "off_rating") %>%
    select(Team, Type, MC_PR, MC_STD)
  
  a_def <-ratings %>%
    filter(Team == away & Type == "def_rating") %>%
    select(Team, Type, MC_PR, MC_STD)
  
  
  #generate scores
  set.seed(13)
  
  h_score <- round(rnorm(n, mean = h_off$MC_PR, sd = h_off$MC_STD) + 
    hfa +
    rnorm(n, mean = a_def$MC_PR, sd = a_def$MC_STD) - mean, digits = 0)
  
  a_score <- round(rnorm(n, mean = a_off$MC_PR, sd = a_off$MC_STD) +
    rnorm(n, mean = h_def$MC_PR, sd = h_def$MC_STD) - mean, digits = 0)
  
  matchup <<- bind_cols(hm = h_score, aw = a_score) %>%
    mutate(home_pf1 = VLOOKUP(hm, scores, rating, score)) %>%
    mutate(away_pf1 = VLOOKUP(aw, scores, rating, score)) %>%
    mutate(home_pf = if_else(home_pf1 == away_pf1,
                             if_else(h_score >= a_score,
                                     home_pf1 + 1,
                                     home_pf1),
                             home_pf1)) %>%
    mutate(away_pf = if_else(home_pf1 == away_pf1,
                             if_else(a_score > h_score,
                                     away_pf1 +1,
                                     away_pf1),
                             away_pf1)) %>%
    mutate(margin = home_pf - away_pf) %>%
    mutate(cover = if_else(margin + line > 0, 1, 0)) %>%
    mutate(win = if_else(margin > 0, 1, 0)) %>%
    mutate(home_team = home, away_team = away) %>%
    select(home_team, home_pf, away_team, away_pf, margin, cover, win)
    
  win_pct <- sum(matchup$win)/n
  cover_pct <- sum(matchup$cover)/n
  
  tibble(home, away, line, win_pct, cover_pct) %>%
    pivot_longer(cols = win_pct:cover_pct, names_to = "Type",
                 values_to = "Home_Confidence") %>%
    mutate(Away_Confidence = 1 - Home_Confidence)

}

Iterate mc_sim function over schedule.csv to get predictions for all of the Sunday/Monday games

predictions <- pmap_dfr(schedule, mc_sim)

hwp <- predictions %>%
  filter(Type == "win_pct") %>%
  mutate(type = "SU", location = "home") %>%
  select(type, team = home, opponent = away, line, location, confidence = Home_Confidence)

awp <- predictions %>%
  filter(Type == "win_pct") %>%
  mutate(type = "SU", location = "away", line = line * -1) %>%
  select(type, team = away, opponent = home, line, location, confidence = Away_Confidence)

hcp <- predictions %>%
  filter(Type == "cover_pct") %>%
  mutate(type = "ATS", location = "home") %>%
  select(type, team = home, opponent = away, line, location, confidence = Home_Confidence)

acp <- predictions %>%
  filter(Type == "cover_pct") %>%
  mutate(type = "ATS", location = "away", line = line * -1) %>%
  select(type, team = away, opponent = home, line, location, confidence = Away_Confidence) 

predictions2 <- bind_rows(hwp, awp, hcp, acp) %>%
  pivot_wider(names_from = type, values_from = confidence)

write_csv(predictions2, file = "Week 06/predictions.csv")

predictions2

Create predictions plot

plot_data <- predictions2 %>%
  left_join(df.logos) %>%
  filter(ATS >= 0.5)

Joining, by = "team"

ggplot(plot_data, aes(ATS, SU)) +
  geom_image(aes(image = url), size = 0.05) +
  xlab("Probability of Covering ATS") +
  ylab("Probability of Winning Game") +
  theme_minimal() +
  labs(title = "Week 6 Predictions", subtitle = "Against the Spread & Straight Up") +
  geom_hline(aes(yintercept = .50), lty = 2, col = "red", alpha = 0.5) +
  geom_vline(aes(xintercept = .50), lty = 2, col = "red", alpha = 0.5) +
  xlim(c(.5,.7)) + ylim(c(.25,.75))

Generate Power Rankings Plot

ratings2 <- ratings %>% left_join(df.logos, by = c("Team" = "team")) %>%
  select(Team, Type, MC_PR, url) %>%
  pivot_wider(names_from = Type, values_from = MC_PR)

ggplot(ratings2, aes(x = off_rating, def_rating)) + 
  geom_image(aes(image = url), size = 0.04) + 
  xlab("Offense PR") + 
  ylab("Defense PR") + 
  theme_minimal() + 
  labs(title = "Team Power Ratings", subtitle = "2021 Week 5") + 
  geom_hline(aes(yintercept = 25), lty = 2, col = "red", alpha = 0.5)+ 
  geom_vline(aes(xintercept = 25), lty = 2, col = "red", alpha = 0.5) + 
  xlim(c(16, 34)) + ylim(c(30, 20))

Game of the Week - Generate plots for one game per week, similar to the TNF game sent out on Wednesdays.

mc_sim(home = "Baltimore Ravens", away = "Los Angeles Chargers", line = -2.5, hfa = 0.25)

MOV Distribution

ggplot(matchup, aes(x = margin)) +
  geom_histogram(binwidth = 1, color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean(margin)), color = "blue", linetype = "dashed", size = 1) +
  geom_vline(aes(xintercept = 2.5), color = "red", linetype = "dashed", size = 1) +
  ggtitle("LA Chargers at Baltimore Ravens \n Distribution of Projected Margin of Victory") +
  xlab("Ravens score minus Chargers score \n blue line = average margin \n red line = betting line") + ylab("Count") +
  scale_x_continuous(breaks = c(-40, -35, -25, -20, -14, -10, -7, -3, 0, 3, 7, 10, 14, 20, 25, 35, 40)) +
  theme_classic() +
  theme_linedraw() +
  theme(
    plot.title = element_text(color="red", size=14, face="bold.italic"),
    axis.title.x = element_text(color="blue", size=14, face="bold"),
    axis.title.y = element_text(color="#993333", size=14, face="bold"),
    panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
)

Top 10 Scores

score_n <- matchup %>% count(home_pf, away_pf) %>% arrange(desc(n)) %>%
  rename("Home" = home_pf, "Away" = away_pf, "Count" = n)

kable(head(score_n, 10)) %>%
  kable_styling(font_size = 24, bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

Home	Away	Count
27	31	1417
31	27	1411
34	27	1214
34	31	1189
27	34	1150
31	34	1139
45	27	1112
27	45	1085
45	31	1076
27	24	1054

NA

Top 10 Margins of Victory (Home score minus Away score)

margin_n <- matchup %>% count(margin) %>% arrange(desc(n)) %>%
  rename("Count" = n)

kable(head(margin_n, 10)) %>%
  kable_styling(font_size = 24, bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

margin	Count
7	6845
-7	6600
1	5417
14	4926
-14	4479
3	3983
4	3974
-4	3937
-3	3864
10	3672