Data Dive Week 6 - Confidence

Start by setting up the packages to manipulate data.

suppressPackageStartupMessages({
  library(tidyverse)
  library(rio)
  library(effsize)
library(pwrss)
  source("aptheme.R") #Code that helps format graphs
  })

Import data

data <- import("plays.csv")

Play action vs Run Pass Option

There are typically two kinds of offensive passing plays, play action and a run pass option. In play action the quarter back moves around the offense pre snap, to try and read the defense to determine if it’s better to run the ball or pass it. In a run pass option play, the quarterback snaps the ball and then decides to either pass the ball or hand it off to the running back as the play develops. Run pass option style plays are becoming more common, so here we test to see if there is a difference in the yards gained with either play.

The null hypothesis is there is no difference in the average yards gained in a run pass option play vs a play action play.

ggplot(data = data) +
  geom_boxplot(mapping = 
                 aes(x = yardsGained, 
                     y = factor(playAction, levels = c(0, 1),
                                labels = c("RPO", "Play Action")))) +
  labs(title = "Yards Gained by Play Type",
       x = "Yards Gained",
       y = "Play Type") +
  theme_minimal()

First we need to get the standard error of the distributions, starting with our bootstrap function

bootstrap <- function (x, func=mean, n_iter=10^4) {
  # empty vector to be filled with values from each iteration
  func_values <- c(NULL)
  
  # we simulate sampling `n_iter` times
  for (i in 1:n_iter) {
    # pull the sample (a vector)
    x_sample <- sample(x, size = length(x), replace = TRUE)
    
    # add on this iteration's value to the collection
    func_values <- c(func_values, func(x_sample))
  }
  
  return(func_values)
}
set.seed(100)
avgs_play_action <- data %>%
  filter(playAction) %>%
  pluck("yardsGained") %>%
  bootstrap(n_iter = 100)

avgs_rpo <- data %>%
  filter(!playAction) %>%
  pluck("yardsGained") %>%
  bootstrap(n_iter = 100)

diffs_in_avgs <- avgs_play_action - avgs_rpo

sample_error <- sd(diffs_in_avgs)
print(paste("Sample error is:", sample_error ))
## [1] "Sample error is: 0.191672953279383"

Now we can choose our alpha level. The run pass option is a simplier play to learn, and a team generally hold on to a quarterback for 4-9 years (longer if they are franchise quareterbacks like Tom Brady). Because of that, it takes more time to develop a play action quarterback. Typically it can take between 3-4 years to develop a rookie player into a franchise quarterback, so given the fluxuation, if play action does produce more yards typically, taking 1 year or about 10% of a quarterback’s carrer seems worth it. Because we are comfortable with potentialy taking 10% longer to develop our quarterbacks, even if play action does not lead to more yards than RPO, we can set an alpha value of 1-0.1 or 90%.

Next we need an effect size. In an average NFL game, there are between 60-65 offensive plays. If changing the play style can result in even a single yard gained, that would be a gain of 60-65 yards more in any given football game. If a team can pick up 60 yards, even if the drive starts on their own one line yard, a 60 yard pick up puts a team in field goal range. Because of this, we set the effect size to 1 yard.

Then when we are thinking about a power level, we know that between 23%-28% of games are won by 3 points or fewer. If that’s the case, and we put the effect size at 1 yard, conservatively changing to play action can be the difference in winning and losing the game about 30% of the time. If power is the percentage of times we are okay with missing out on the potential effect, and the difference is meaningful in 30% of games, then we can set hte power to 70%

Now we can test for a sample size.

test <- pwrss.t.2means(mu1 = mean(data$yardsGained[data$playAction]), 
                       sd1 = sd(data$yardsGained[data$playAction]),
                       kappa = sum(data$playAction)/sum(!data$playAction),
                       power = .70,
                       alpha = 0.1, 
                       alternative = "not equal")
## Error:
## ! Design is not feasible.

Unfortunately the the data set we have cannot be used to test this hypothesis. There are plenty of data points, but only 17% of the plays were play action passes. If the data set was balenced between the two play styles, then we would have plenty of data.

pwrss.t.2means(mu1 = mean(data$yardsGained[data$playAction]), 
                       sd1 = sd(data$yardsGained[data$playAction]),
                       kappa = 1,
                       power = .70,
                       alpha = 0.1, 
                       alternative = "not equal")
## +--------------------------------------------------+
## |             SAMPLE SIZE CALCULATION              |
## +--------------------------------------------------+
## 
## Welch's T-Test (Independent Samples)
## 
## ---------------------------------------------------
## Hypotheses
## ---------------------------------------------------
##   H0 (Null Claim) : d - null.d = 0 
##   H1 (Alt. Claim) : d - null.d != 0 
## 
## ---------------------------------------------------
## Results
## ---------------------------------------------------
##   Sample Size            = 22 and 22  <<
##   Type 1 Error (alpha)   = 0.100
##   Type 2 Error (beta)    = 0.297
##   Statistical Power      = 0.703

QB Sneak

There has been a lot of discussion about the Phillidelphia Eagles “tush push” play, which is a variation on the quarterback sneak play. Some teams like the Packers have aksed to ban the tush push, saying it has a higher likelihood of injury, but some have suspected the Packers are just sore losers and upset that Philly does the sneak so well. Here we look at if there is any evidence that the Eagles convert the tush push more often than anyone else.

ggplot(data = data) +
  geom_boxplot(mapping = 
                 aes(x = yardsGained - yardsToGo, 
                     y = factor(possessionTeam == "PHI", levels = c(0, 1),
                                labels = c("NFL", "Eagles")))) +
  labs(title = "Down Conversion by Team",
       x = "Conversion",
       y = "Team") +
  theme_minimal()

philly <- data %>%
  filter(!is.na(qbSneak)) %>%
  filter(qbSneak) %>%
  mutate(is_eagles = possessionTeam == "PHI") %>%
  group_by(is_eagles) %>%
  summarise(share_converted = mean(yardsGained >= yardsToGo))

philly 
## # A tibble: 2 × 2
##   is_eagles share_converted
##   <lgl>               <dbl>
## 1 FALSE               0.887
## 2 TRUE                0.929

Here we can see a slight advantage to Philly when it comes to converting the down. But now it comes time to test.

set.seed(100)
eagles <- data %>%
  filter(!is.na(qbSneak)) %>%
  filter(qbSneak) %>%
  mutate(is_eagles = possessionTeam == "PHI") %>%
  filter(is_eagles) %>%
  mutate(converted = yardsGained > yardsToGo) %>%
  pluck(c("converted" )) %>%
  bootstrap(n_iter = 100)

others <- data %>%
  filter(!is.na(qbSneak)) %>%
  filter(qbSneak) %>%
  mutate(is_eagles = possessionTeam != "PHI") %>%
  filter(is_eagles) %>%
  mutate(converted = yardsGained > yardsToGo) %>%
  pluck(c("converted" )) %>%
  bootstrap(n_iter = 100)

diffs_in_avgs <- eagles - others

sample_error <- sd(diffs_in_avgs)
print(paste("Sample error is:", sample_error ))
## [1] "Sample error is: 0.135951446702902"

Now we can calculate the p value

sum(diffs_in_avgs > (philly$share_converted[2] - philly$share_converted[1]))/100
## [1] 0.05

Here we can see that in the sampled data, the Eagles only convert more often than the rest of the NFL by more than the 4% of the time in 5% of samples. This sugggests that the difference seen in our data is pretty compelling that the Eagles are better at the tush push than the rest of the league. However, they are only marginally better than the rest of the league, so while they are better, it probably doesn’t change much in game play.