Monte Carlo Simulations: Week 6 TNF (Bucs @ Eagles)

Every Wednesday and Friday 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!

This file uses the early power ratings for Week 6 to simulate the Thursday Night Football game. The ratings are updated for injuries before publishing full picks on Fridays.

Load packages

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_tnf.csv")
scores <- read_csv("Week 06/inputs/common_scores.csv", col_types = "n")
df.logos <- read.csv("Week 06/inputs/nfl_logos.csv")

Function to simulate scores. Default line is 0, number of simulations is 100,000, home field advantage is 0 and average power rating is 25. These values will be used if not supplied in the schedule_tnf.csv file.

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_pf = VLOOKUP(hm, scores, rating, score)) %>%
    mutate(away_pf = VLOOKUP(aw, scores, rating, score)) %>%
    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 results for all games in the schedule_tnf.csv file.

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/tnf_predictions.csv")

predictions2

The variable “matchup” is a global variable created when mc_sim is run. It saves the data of the last game that was run through the function. Use this data to plot score frequencies.

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 = -6.5), color = "red", linetype = "dashed", size = 1) +
  ggtitle("Tampa Bay at Philadelphia \n Distribution of Projected Margin of Victory") +
  xlab("Eagles score minus Bucs score \n blue line = average margin \n red line = betting line") + ylab("Count") +
  scale_x_continuous(breaks = c(-35, -25, -20, -14, -10, -7, -3, 0, 3, 7, 10, 14, 20, 25)) +
  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
20	38	2786
24	38	2712
27	38	2633
20	31	2609
17	38	2568
24	31	2506
20	27	2479
24	27	2430
27	27	2410
14	38	2398

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	10637
0	8673
-14	8523
-10	6506
-17	5724
-3	5591
-11	5540
-4	4840
-21	4585
7	4132