In the NFL, teams can score points in three ways:
A field goal attempt occurs when a team attempts to kick the ball through goal placed at both ends of the playing field. If the ball passes between the uprights, the team scores 3 points. Otherwise, the other team’s offense starts where the kicking team was on the field. If a team misses a field goal, not only do they lose out on three points, but the opponent has a higher probability of scoring points!
There are two types of stadium roofs that teams play in: open or closed. One common comment about stadiums with closed roofs (called domes) is teams have an easier time scoring since the weather doesn’t have any influence on the result of a play. We want to examine the data to determine if there is any legitimacy of these types of comments for field goal attempts.
The code chunk below will load all NFL plays from the last 5 years and clean it to keep only field goal attempts made by players that attempted at least 25 field goals.
We’ll start just by loading in the NFL plays data for the last 6 seasons and keeping just the field goal attempts
# Loading the most recent 6 seasons
pbp <- load_pbp((year(Sys.Date()) - 5):year(Sys.Date()))
FieldGoals <-
pbp |>
# Only keeping attempts without penalty during the regular season
filter(
field_goal_attempt == 1,
penalty==0,
season_type=="REG"
) |>
mutate(
# Changing roof_type to just indicate if the kick took place in or outdoors
roof_type = if_else(condition = roof %in% c("outdoors", "open"),
true = "outdoors",
false = "indoors"),
# If the field goal was successful or not
fg_result = if_else(condition = field_goal_result == "made",
true = 1,
false = 0)
) |>
# Changing the name to something simpler
rename(
kicker = kicker_player_name,
distance = kick_distance,
kicker_id = kicker_player_id
) |>
# Picking the variables we need
dplyr::select(
team = posteam, kicker, kicker_id, distance,
roof_type, fg_result, season
)
FieldGoals
## # A tibble: 5,759 × 7
## team kicker kicker_id distance roof_type fg_result season
## <chr> <chr> <chr> <dbl> <chr> <dbl> <int>
## 1 MIA J.Sanders 00-0034794 54 outdoors 1 2019
## 2 BAL J.Tucker 00-0029597 34 outdoors 1 2019
## 3 NYJ K.Vedvik 00-0034202 45 outdoors 0 2019
## 4 BUF S.Hauschka 00-0025944 43 outdoors 1 2019
## 5 CIN R.Bullock 00-0029421 39 outdoors 1 2019
## 6 CIN R.Bullock 00-0029421 45 outdoors 0 2019
## 7 CIN R.Bullock 00-0029421 27 outdoors 1 2019
## 8 DEN B.McManus 00-0029822 64 outdoors 0 2019
## 9 DEN B.McManus 00-0029822 26 outdoors 1 2019
## 10 DEN B.McManus 00-0029822 26 outdoors 1 2019
## # ℹ 5,749 more rows
# Removing the pbp data set since it is large and not used again
rm(pbp)
The seven variables are:
team: The team attempting the field goal
kicker: The player who attempted the field goa
distance: How far away the uprights are from the player attempting the field goal
roof_type: One of two different values:
The code below will count how many field goals each player attempted and only keep the field goals attempted by kickers with at least 25 attempts:
kicker_counts <-
FieldGoals |>
# Counting the number attempts for each player
count(kicker) |>
# Only keeping players with at least 25 kicks
filter(n >= 25)
kicker_counts |>
arrange(-n)
## # A tibble: 51 × 2
## kicker n
## <chr> <int>
## 1 G.Zuerlein 199
## 2 J.Tucker 197
## 3 Y.Koo 194
## 4 D.Carlson 191
## 5 J.Sanders 182
## 6 C.Boswell 180
## 7 B.McManus 178
## 8 M.Gay 178
## 9 H.Butker 172
## 10 J.Myers 169
## # ℹ 41 more rows
There are a total of 51 kickers that attempted at least 25 field goals during the most recent six seasons. We’ll keep only the field goals attempted by these kickers to remove any players that were not accurate enough to be an NFL quality field goal kicker.
fg_df <-
FieldGoals |>
filter(kicker %in% kicker_counts$kicker)
tibble(fg_df)
## # A tibble: 5,503 × 7
## team kicker kicker_id distance roof_type fg_result season
## <chr> <chr> <chr> <dbl> <chr> <dbl> <int>
## 1 MIA J.Sanders 00-0034794 54 outdoors 1 2019
## 2 BAL J.Tucker 00-0029597 34 outdoors 1 2019
## 3 BUF S.Hauschka 00-0025944 43 outdoors 1 2019
## 4 CIN R.Bullock 00-0029421 39 outdoors 1 2019
## 5 CIN R.Bullock 00-0029421 45 outdoors 0 2019
## 6 CIN R.Bullock 00-0029421 27 outdoors 1 2019
## 7 DEN B.McManus 00-0029822 64 outdoors 0 2019
## 8 DEN B.McManus 00-0029822 26 outdoors 1 2019
## 9 DEN B.McManus 00-0029822 26 outdoors 1 2019
## 10 DEN B.McManus 00-0029822 39 outdoors 1 2019
## # ℹ 5,493 more rows
Our cleaned data has a total of 5,503 kick attempts! They will be used to try to answer if it actually is easier to make a field goal indoors.
The main question we want to answer is “Is it easier to successfully kick a field goal if it is inside (dome and closed) vs outside (outdoors and open).”
Let’s start by creating a graph for 3 of the variables:
field goal success rate
field goal attempt distance
field goal attempt location:
# Kick attempts per location
gg_location_bar <-
ggplot(
data = fg_df,
mapping = aes(
x = roof_type,
y = after_stat(prop),
group = 1
)
) +
geom_bar(
fill = c("#624a2e", "#567d46"),
color = "black"
) +
theme_classic() +
labs(
x = NULL,
y = NULL
) +
# Changing the y-axis to a percentage and placing the bars on the x-axis
scale_y_continuous(
expand = c(0, 0, 0.05, 0),
labels = scales::percent
)
# Field Goal Result
gg_result_bar <-
ggplot(
data = fg_df,
mapping = aes(
x = factor(fg_result),
y = after_stat(prop),
group = 1
)
) +
geom_bar(
fill = c("tomato", "steelblue"),
color = "black"
) +
labs(
x = NULL,
y = NULL
) +
theme_classic() +
scale_x_discrete(labels = c("missed", "made")) +
scale_y_continuous(
expand = c(0, 0, 0.05, 0),
labels = scales::percent
)
# Boxplot of distance by location
gg_distance <-
ggplot(
data = fg_df,
mapping = aes(
x = distance,
y = roof_type,
fill = factor(fg_result)
)
) +
geom_boxplot(show.legend = F) +
theme_light() +
# Breaks at every 10 yards
scale_x_continuous(
breaks = 2:7*10,
labels = paste(2:7*10, "yds")
) +
# Changing the labels and colors for missed and made
scale_fill_manual(
labels = c("missed", "made"),
values = c("tomato", "steelblue")
) +
# Changing the labels
labs(
fill = "Field Goal\nResult",
title = "Field Goal Distance",
y = NULL,
x = "Field Goal Attempt Distance"
)
(gg_location_bar + gg_result_bar) / gg_distance
Descriptive plots about field goal attempts
About 70% of field goal attempts are attempted in outdoor stadiums. While it seems high, 22 out of the 32 stadiums have always open roofs, which accounts for about 68% of all stadiums. That percentage aligns with our attempts, so it doesn’t appear teams are more likely to attempt field goals in indoor stadiums.
Similarly, the attempted distances are fairly similar, indicating that the roof type doesn’t affect the distance a team attempts a field goal.
# Calculating the 5 number summary for each fg_result and roof_type combo
fg_df |>
summarize(
.by = c(fg_result, roof_type),
min = min(distance),
Q1 = quantile(distance, 0.25),
median = median(distance),
Q3 = quantile(distance, 0.75),
max = max(distance)
) |>
mutate(fg_result = if_else(fg_result == 1, "made", "missed")) |>
arrange(fg_result, roof_type) |>
gt::gt()
fg_result | roof_type | min | Q1 | median | Q3 | max |
---|---|---|---|---|---|---|
made | indoors | 19 | 29.00 | 38 | 47 | 66 |
made | outdoors | 19 | 29.00 | 37 | 45 | 63 |
missed | indoors | 24 | 44.00 | 49 | 54 | 65 |
missed | outdoors | 20 | 42.25 | 48 | 53 | 70 |
The second graph is a bar chart comparing the success rate between closed stadiums and open stadiums:
ggplot(
data = fg_df,
mapping = aes(
x = roof_type,
fill = factor(fg_result)
)
) +
geom_bar(
position = "fill",
color = "black"
) +
geom_text(
data =
fg_df |>
# Counting the number of made and missed fgs by rooftype
count(roof_type, fg_result, name = "count") |>
mutate(
.by = roof_type,
success_rate = count/sum(count)
) |>
# Positioning where to place the label
mutate(
.by = fg_result,
fg_result = factor(fg_result),
y_pos = mean(success_rate)
),
# Adding the label and telling it where to position the text
mapping = aes(label = scales::percent(success_rate),
y = y_pos),
# Positioning the text
position = "fill",
vjust = 2.5,
fontface = "bold",
size = 5,
color = "white"
) +
labs(
y = NULL,
x = NULL,
fill = "Field Goal \nAttempt"
) +
theme_classic() +
# Converting the y-axis to a percentage
scale_y_continuous(
labels = scales::percent,
expand = c(0, 0, 0.05, 0)
) +
# Changing the labels for the x-axis
scale_x_discrete(labels = c("Indoor", "Outdoor")) +
# Changing the labels and colors for made and missed
scale_fill_manual(
labels = c("Missed", "Made"),
values = c("tomato", "steelblue")
)
Difference in field goal results for indoor and outdoor stadiums
The difference in success rate appears pretty minimal, indicating there might not be a true difference in the actual success rate.
Let’s account for the kicking distance when examining the potential difference in success rates. To do that, let’s create a summary of the data first:
# Summarizing the data first:
fg_sum <-
fg_df |>
# Count for each combo of distance, roof_type, and result
count(distance, roof_type, fg_result) |>
# Calculating the total number of attempts per distance
mutate(
.by = distance,
dist_n = sum(n)
) |>
# Calculating the success rate by distance and roof type
mutate(
.by = c(distance, roof_type),
dist_field_n = sum(n),
success_rate = n/dist_field_n
) |>
# Only keeping rows for the success rate and distance above 20
filter(
fg_result == 1,
dist_n > 20
) |>
dplyr::select(-fg_result, -dist_n, -n) |>
rename(attempts = dist_field_n)
fg_sum
## # A tibble: 82 × 4
## distance roof_type attempts success_rate
## <dbl> <chr> <int> <dbl>
## 1 19 indoors 5 1
## 2 19 outdoors 16 1
## 3 20 indoors 16 1
## 4 20 outdoors 52 0.981
## 5 21 indoors 27 1
## 6 21 outdoors 66 1
## 7 22 indoors 31 1
## 8 22 outdoors 86 0.977
## 9 23 indoors 49 1
## 10 23 outdoors 85 1
## # ℹ 72 more rows
The scatterplot below compares the kicking distance, roof type, and success rate:
# Creating the data frame for the loess estimate at distance = 59
loess_est <-
data.frame(
# Roof type column
roof_type = c("indoors", "outdoors"),
# Max distance
distance = 59,
# Finding the estimated success rate using LOESS
success_rate = c(
# Indoor LOESS success rate
loess(data = fg_sum |>
filter(roof_type == "indoors"),
formula = success_rate ~ distance) |>
predict(newdata = fg_sum |>
filter(roof_type == "indoors") |>
filter(distance == max(distance))),
# Outdoor LOESS success rate
loess(data = fg_sum |>
filter(roof_type == "outdoors"),
formula = success_rate ~ distance) |>
predict(newdata = fg_sum |>
filter(roof_type == "outdoors") |>
filter(distance == max(distance)))
)
)
# Creating the graph
ggplot(
data = fg_sum,
mapping = aes(
x = distance,
y = success_rate,
color = roof_type
)
) +
# Drawing a line connecting the dots of success rate for in and outdoors
geom_line(
mapping = aes(group = distance),
color = "black",
linetype = 2,
linewidth = 0.5
) +
geom_point() +
# Adding the trendline for both groups
geom_smooth(
formula = y~x,
method = "loess",
se = F,
show.legend = F
) +
# Adding the roof type to the end of the line
geom_text(
loess_est,
mapping = aes(
label = roof_type
),
nudge_x = 2.3,
show.legend = F
) +
theme_bw() +
labs(
x = "Kicking Distance",
y = "Success Rate",
color = "Roof Type"
) +
# Changing the breaks and labels of the y-axis
scale_y_continuous(
breaks = 5:10/10,
labels = scales::percent,
minor_breaks = NULL
) +
# Changing the color choice to match for indoor and outdoor
scale_color_manual(
values = c("#624a2e", "#567d46"),
labels = c("Indoors", "Outdoors")
) +
# Adding "yds" to each label
scale_x_continuous(
breaks = 2:6*10,
labels = paste(2:6*10, "yds")
) +
# removing the theme
theme(legend.position = "none")
Comparing success rate accounting for field goal distance
When the distance is less than 30 yards, there doesn’t appear to be an advantage to kicking indoors. But beyond 30 yards, the benefit of kicking indoors starts to grow, with the difference in success rates holding roughly constant after 35 - 40 yards.
Let’s look at the 20 players with the most attempts and see how their success percentage differs between indoor and outdoor stadiums:
kicker_success <-
fg_df |>
# Finding how many kicks of each combo of kicker, roof, and result there are
count(kicker, roof_type, fg_result) |>
# Calculating the total number of attempts and success rate for kicker and roof
mutate(
.by = c(kicker, roof_type),
attempts = sum(n),
success_rate = n /sum(n)
) |>
# Finding the total number of attempts per kicker
mutate(
.by = kicker,
kicker_attempts = sum(n)
) |>
# Keeping only the successful kicks
filter(fg_result == 1) |>
# Picking the top 20 kickers
slice_max(kicker_attempts, n = 40) |>
# Arrange the kickers by alphabetical order
arrange(kicker)
kicker_success
## # A tibble: 40 × 7
## kicker roof_type fg_result n attempts success_rate kicker_attempts
## <chr> <chr> <dbl> <int> <int> <dbl> <int>
## 1 B.McManus indoors 1 29 34 0.853 178
## 2 B.McManus outdoors 1 117 144 0.812 178
## 3 C.Boswell indoors 1 23 24 0.958 180
## 4 C.Boswell outdoors 1 139 156 0.891 180
## 5 C.McLaughlin indoors 1 41 45 0.911 133
## 6 C.McLaughlin outdoors 1 71 88 0.807 133
## 7 C.Santos indoors 1 37 43 0.860 149
## 8 C.Santos outdoors 1 93 106 0.877 149
## 9 D.Carlson indoors 1 99 107 0.925 191
## 10 D.Carlson outdoors 1 71 84 0.845 191
## # ℹ 30 more rows
We’ll compare the success rate by looking at a dumbbell plot
# Creating a data set to place the number of attempts next to the dots
kicker_labels <-
left_join(
# Just indoor attempts
x = kicker_success |> filter(roof_type == "indoors") |> select(kicker, success_rate, attempts),
# Just outdoor attempts
y = kicker_success |> filter(roof_type == "outdoors") |> select(kicker, success_rate, attempts),
by = "kicker",
suffix = c("_in", "_out")
) |>
# Moving the labels to the left or right depending on which success rate is higher
mutate(
indoor_label = if_else(success_rate_in > success_rate_out,
success_rate_in + 0.01,
success_rate_in - 0.01),
outdoor_label = if_else(success_rate_in < success_rate_out,
success_rate_out + 0.01,
success_rate_out - 0.01)
)
# Starting ggplot and placing the order of the kickers by their overall success rate
ggplot(
data = kicker_success,
mapping = aes(y = fct_reorder(kicker, success_rate))
) +
# Line to connect the points
geom_line(mapping = aes(x = success_rate)) +
# point colored by if the attempt was indoor or outdoor
geom_point(
mapping = aes(
x = success_rate,
color = roof_type
),
size = 2
) +
# Adding the labels for number of attempts indoor and outdoor
geom_text(
data = kicker_labels,
mapping = aes(
label = attempts_in,
x = indoor_label,
y = fct_reorder(kicker, success_rate_out + success_rate_in)
),
color = "#624a2e"
) +
geom_text(
data = kicker_labels,
mapping = aes(
label = attempts_out,
x = outdoor_label,
y = fct_reorder(kicker, success_rate_out + success_rate_in)
),
color = "#567d46"
) +
# Removing the labels, adding a title and caption
labs(
x = NULL,
y = NULL,
title = "Field Goal Accuracy for the Twenty Kickers with the Most Attempts:
<span style='color:#624a2e;'>Indoors</span> vs
<span style='color:#567d46;'>Outdoors</span>",
subtitle = "Number of attempts shown beside the points",
caption = paste0("Regular season: ", min(FieldGoals$season), " - ", max(FieldGoals$season)),
color = NULL
) +
# Applyin the CSS colors and removing the legend
theme(
plot.title = ggtext::element_markdown(hjust = 0.5),
legend.position = "none"
) +
# Changing the x-axis to percent
scale_x_continuous(labels = scales::percent) +
# Changing the color choice
scale_color_manual(values = c("#624a2e", "#567d46"))
Dumbbell Plot comparing success rate by kicker
14 out of the 20 kickers have a higher field goal percentage when kicking indoors compared to outdoors.
Since some of the sample sizes are small, we want to account for the sampling variablility by calculating 95% confidence intervals for each kicker, displaying the results in a Cleveland Plot:
\[\hat{p}_{\textrm{I}} - \hat{p}_{\textrm{O}} \pm 1.96 \sqrt{\frac{\hat{p}_{\textrm{I}}(1-\hat{p}_{\textrm{I}})}{n_{\textrm{I}}} + \frac{\hat{p}_{\textrm{O}}(1-\hat{p}_{\textrm{O}})}{n_{\textrm{O}}}}\]
kicker_labels |>
# Creating the confidence interval, color coding based on where the kicker is better, and if the result is statistically significant
mutate(SE = sqrt(success_rate_in*(1-success_rate_in)/attempts_in +
success_rate_out*(1-success_rate_out)/attempts_out),
lower = success_rate_in - success_rate_out - 1.96*SE,
upper = success_rate_in - success_rate_out + 1.96*SE,
better = if_else(success_rate_in > success_rate_out,
"#624a2e",
"#567d46"),
signif = if_else(lower < 0 & upper > 0, "no", "yes")) |>
# Creating a cleveland plot to show the confidence intervals
ggplot(mapping = aes(x = success_rate_in - success_rate_out,
y = fct_reorder(kicker, success_rate_in - success_rate_out))) +
labs(x = NULL,
y = NULL,
title = "95% Confidence Intervals for Success Rate: <span style='color:#624a2e;'>Indoors</span> - <span style='color:#567d46;'>Outdoors</span>",
caption = "Significant Differences indicated by circles") +
geom_vline(xintercept = 0,
linewidth = 1,
linetype = "dashed") +
geom_segment(mapping = aes(xend = lower,
x = upper,
yend = fct_reorder(kicker, success_rate_in - success_rate_out),
color = better),
linewidth = 1) +
geom_point(mapping = aes(color = better,
shape = signif),
size = 3,
show.legend = F) +
scale_color_identity() +
scale_x_continuous(labels = scales::percent) +
scale_shape_manual(values = c("square", "circle")) +
theme(plot.title = ggtext::element_markdown(hjust = 0.5))
Confidence interval for the difference in success rate
The dashed black line represents a difference in success rate between indoor and outdoors success rate of 0 (\(p_I = p_O\)), indicating a non-statistically significant result.
Only one player has a confidence interval that does not contain zero, Tyler Bass. Looking back at the dumbbell plot, he had a 100% success rate for his 22 indoor attempts, which violates one of the conditions to create a confidence interval (the sample proportions can’t be too close to either 0% or 100%).
The other 19 kickers all have intervals that contain 0, so we can’t be confident that there is a true difference in their accuracy when kicking indoors vs outdoors.
We can estimate the probability a field goal is successful based on distance and location (indoor/outdoor) using logistic regression.
The logistic regression model is:
\[\log\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1x_1 + \beta^I_2 + \beta_{12}^Ix_1\]
where
\(\beta_0\) is the log odds of a successful attempt if it is 0 yards out and in an outdoor stadium
\(\beta_1\) is the effect of distance on the log odds of success for each 1 additional yard out
\(\beta^I_2\) is the difference in the log odds of a successful attempt being indoors vs outdoors
\(\beta_{12}^I\) is the interaction term between distance and roof type.
# Fitting a fixed effect logistic regression model with an interaction term
fg_fixed <-
glm(formula = success_rate ~ distance * roof_type,
# Swapping the order of indoor and outdoor so outdoor is the baseline
data = fg_sum |> mutate(roof_type = fct_rev(roof_type)),
weights = attempts,
family = binomial)
# Checking the model estimates using the tidy function and rounding them to 3 digits
library(broom)
tidy(fg_fixed) |>
mutate(across(.cols = where(is.numeric),
.fns = round,
digits = 3)) |>
gt::gt()
term | estimate | std.error | statistic | p.value |
---|---|---|---|---|
(Intercept) | 6.338 | 0.268 | 23.628 | 0.000 |
distance | -0.110 | 0.006 | -18.797 | 0.000 |
roof_typeindoors | 0.265 | 0.516 | 0.514 | 0.607 |
distance:roof_typeindoors | 0.000 | 0.011 | 0.033 | 0.974 |
When examining the necessity of each model term, we should always
start by examining the interaction term (we should always maintain a
hierarchical model). From the table above, the p-value for the
interaction term (distance:roof_typeindoors
) is 0.974,
indicating the interaction term is not statistically significant and the
effect of distance on the probability a field goal attempt is successful
the same for an indoor or outdoor stadium.
Let’s reparameterize and refit the model without the interaction term:
\[\log\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1x_1 + \beta^I_2\]
# Fitting a fixed effect logistic regression model without an interaction term
fg_fixed2 <-
glm(formula = success_rate ~ distance + roof_type,
data = fg_sum |> mutate(roof_type = fct_rev(roof_type)),
family = binomial,
weights = attempts)
# Checking the model estimates using the tidy function and rounding them to 3 digits
glm_estimates <-
tidy(fg_fixed2,
#exponentiate = T, # convert from log odds to odds
conf.int = T) |> # calculate a 95% confidence interval
# Rounding the numeric columns to 3 decimal places
mutate(
across(
.cols = where(is.numeric),
.fns = round,
digits = 3
)
)
glm_estimates |>
gt::gt()
term | estimate | std.error | statistic | p.value | conf.low | conf.high |
---|---|---|---|---|---|---|
(Intercept) | 6.333 | 0.229 | 27.694 | 0.000 | 5.893 | 6.790 |
distance | -0.110 | 0.005 | -22.164 | 0.000 | -0.120 | -0.100 |
roof_typeindoors | 0.282 | 0.091 | 3.113 | 0.002 | 0.106 | 0.461 |
Now both the effect of distance and roof_type are significant!
The odds a kick is successful when attempted indoors is about 33% higher if it is attempted at the same distance.
Interpreting the confidence interval effect, we are 95% confident that the odds an indoor kick is successful is 11% to 59% higher compared to an outdoor kick when attempted at the same distance.
The conclusions we can arrive from our model are only accurate if the model fits the data reasonably well. Let’s look at the fit statistics:
fit_stats_logit_fixed <-
glance(fg_fixed2) |>
mutate(p.val = pchisq(q = deviance, df = df.residual, lower.tail = F)) |>
select(nobs, deviance, df.residual, p.val)
gt::gt(fit_stats_logit_fixed)
nobs | deviance | df.residual | p.val |
---|---|---|---|
82 | 99.67 | 79 | 0.05802 |
The p-value is for a hypothesis test with the null hypothesis stating the model fits the data and the alternative hypothesis is that the model does not fit the data. With a p-value of 0.058, there is some evidence that the model doesn’t fit the data, but not strong evidence. We’ll continue on the assumption that the model is a (some-what) reliable generalization about the relationship between field goal success rate, distance, and roof type.
Let’s graph the results of the logistic regression:
# Adding the estimated probability of success at 59 yards away
pred_df <-
fg_sum |>
mutate(
est_success_rate = predict.glm(object = fg_fixed2,
newdata = fg_sum,
type = "response")
)
# Creating the graph
ggplot(
data = pred_df,
mapping = aes(
x = distance,
color = roof_type
)
) +
geom_point(
mapping = aes(y = success_rate)
) +
# Adding the line of estimated probabilities
geom_line(
mapping = aes(y = est_success_rate)
) +
# Adding indoor and outdoor and the end of their respective line
geom_text(
data = pred_df |> filter(distance == max(distance)),
mapping = aes(
y = est_success_rate,
label = roof_type
),
show.legend = F,
nudge_x = 2.3
) +
theme_bw() +
labs(
title = "Observed and Estimated Field Goal Success",
x = "Kicking Distance",
y = "Success Rate",
color = NULL
) +
scale_y_continuous(labels = scales::percent) +
scale_color_manual(values = c("#624a2e", "#567d46"),
labels = c("Indoors", "Outdoors")) +
scale_x_continuous(breaks = 2:5*10,
labels = paste(2:5*10, "yds")) +
theme(
plot.title = element_text(hjust = 0.5),
legend.position = c(0.1,0.2)
)
Logistic regression model: \(\log\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1x_1 + \beta^I_2\)
One big assumption most models have is that the rows in our data are independent once we account for the explanatory variables (distance and location in our data).
However, there is still one source of association between the rows (each field goal attempt): the players attempting the field goals!
We can account for the kickers attempting the field goals by including a random effect in the model:
\[\log\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1x_1 + \beta^I_2 + \beta_{12}^Ix_1 + u_i\]
where \(u_i\) is the random effect of a specific kicker (kicker \(i\)) on the log odds a field goal attempt is successful.
The difference between a fixed effect (like \(\beta_1\)) and a random effect (like \(u_i\)) is that we assume a probability distribution for the random effect. Typically, we assume the random effects are Normally distributed:
\[u_i \sim N(0, \sigma_u)\]
The code chunk below will estimate the mixed-effects logistic regression model. It’s called a mixed-effects model because it has both fixed effects and random effect(s).
# Fitting the mixed effects model using glmer in the lme4 package
library(lme4)
fg_mem <-
glmer(
fg_result ~ distance * roof_type + (1|kicker), # (1|kicker) -> random effect
data = fg_df |> mutate(roof_type = fct_rev(roof_type)),
nAGQ = 50, # How many quadrature points to use when estimating u_i
family = binomial,
control = glmerControl(optimizer = "bobyqa")
)
# Viewing the regression estimate table
summary(fg_mem)$coefficients |>
data.frame() |>
round(digits = 3) |>
rownames_to_column(var = "Term") |>
mutate(Estimate = exp(Estimate)) |>
rename(
SE = Std..Error,
`p-value` = Pr...z..,
`test stat` = z.value
) |>
gt::gt()
Term | Estimate | SE | test stat | p-value |
---|---|---|---|---|
(Intercept) | 603.653 | 0.266 | 24.050 | 0.000 |
distance | 0.894 | 0.006 | -19.527 | 0.000 |
roof_typeindoors | 1.219 | 0.502 | 0.396 | 0.692 |
distance:roof_typeindoors | 1.002 | 0.011 | 0.215 | 0.830 |
Like with the fixed effects model, the interaction term doesn’t appear to be needed since the p-value is large. It will be removed and the model reran:
fg_mem2 <-
glmer(
fg_result ~ distance + roof_type + (1|kicker),
data = fg_df |> mutate(roof_type = fct_rev(roof_type)),
nAGQ = 50,
family = binomial,
control = glmerControl(optimizer = "bobyqa")
)
summary(fg_mem2)$coefficients |>
data.frame() |>
round(digits = 3) |>
rownames_to_column(var = "Term") |>
mutate(Estimate = exp(Estimate)) |>
rename(
SE = Std..Error,
`p-value` = Pr...z..,
`test stat` = z.value
) |>
gt::gt()
Term | Estimate | SE | test stat | p-value |
---|---|---|---|---|
(Intercept) | 585.8126 | 0.227 | 28.055 | 0.000 |
distance | 0.8949 | 0.005 | -22.905 | 0.000 |
roof_typeindoors | 1.3566 | 0.093 | 3.283 | 0.001 |
Like with our fixed effects model, we have strong evidence that the location has an effect on the probability a field goal attempt is successful after accounting for the effect of distance and the person attempting the field goal.
If a kick is attempted at the same distance by the same player, the odds a kick is successful is about 35.7% higher if it is attempted in an indoor stadium compared to an outdoor stadium.
Let’s visualize the difference using the mixed effect model. We’ll start by creating a data frame that has each combo of distance, stadium type, kicker, and the success probability estimated by the mixed effects model.
# Creating a data frame that has a row for each combination of distance, roof_type, and kicker to use to estimate the probability a kick is successful:
pred_data <-
expand.grid(
distance = seq(20, 55, by = 0.250), # Distance by quarter yard increments
roof_type = unique(fg_df$roof_type), # Two types of roof
kicker = unique(fg_df$kicker) # kickers included in the model
)
# We can use the predict function to calculate the estimated probabilities
fg_predict <-
data.frame(
pred_data,
est_made = predict(fg_mem,
newdata = pred_data,
type = "response")
)
The graph below shows the median, middle 50%, and middle 90% of model probabilities that a field goal attempt is successful.
# Calculating the 5 number summary of success for each distance and roof_type combo
avg_probs_dist <-
fg_predict |>
summarize(
.by = c(roof_type, distance),
avg_prob_made = mean(est_made),
min_prob = min(est_made),
Q1_prob = quantile(est_made, prob = 0.25),
Q3_prob = quantile(est_made, prob = 0.75),
max_prob = max(est_made),
quantile95 = quantile(est_made, prob = 0.95),
quantile05 = quantile(est_made, prob = 0.05)
)
# Now we'll plot the results:
ggplot(
data = avg_probs_dist,
mapping = aes(
x = distance,
y = avg_prob_made,
fill = roof_type
)
) +
# Adding the line for the mean estimated probability
geom_line(
mapping = aes(color = roof_type),
linewidth = 1
) +
# Adding a confidence region for Q1 and Q3
geom_ribbon(
mapping = aes(
ymin = Q1_prob,
ymax = Q3_prob
),
alpha = 0.5,
linetype = "dashed"
) +
annotate(
geom = "text",
label = "Shaded regions indicate the estimated\nmiddle 50% and 90% ranges",
x = 26,
y = 0.8
) +
geom_ribbon(
mapping = aes(
ymin = quantile95,
ymax = quantile05
),
alpha = 0.25,
linetype = "dotted"
) +
#facet_wrap(~roof_type) +
# Changing the fill and color pallete to match the previous color choices
scale_color_manual(
values = c("#624a2e", "#567d46"),
aesthetics = c("colour","fill")
) +
# Changing the y-axis to percentages
scale_y_continuous(labels = scales::percent) +
# Changing the x-axis to include yards
scale_x_continuous(
breaks = 2:6*10,
labels = paste(2:6*10, "yds")
) +
# Adding context
labs(
title = "Probability of a Successful Field Goal by Distance for
<span style='color:#624a2e;'>Indoor</span> and
<span style='color:#567d46;'>Outdoor</span> Stadiums",
subtitle = "Seasons 2019-2024, Min 25 Attempts per Kicker, Between 19-58 Yards",
x = "Field Goal Distance",
y = "Model Probability of Success",
caption = "data: nflfastR"
) +
# Moving the legend and centering the subtitle
theme(
legend.position = 'none',
plot.title = ggtext::element_markdown(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)
)
Mixed effect regression: \(\log\left(\frac{p_i}{1-p_i}\right) = \beta_0 + \beta_1x_1 + \beta^I_2 + u_i\)
Indoor kicks are more likely to be made, and the further the distance, the larger the difference in the success rate! The difference is most notable for attempts 45 yards and further.
While it doesn’t help answer our original question “Is it easier to attempt a field goal indoors”, we can use the random effects generated from our mixed effects model to answer “Who is the best kicker over the last 6 seasons, accounting for distance and stadium type?”
If the random effect is positive, the kicker is better than league average and if the random effect is negative, the kicker is worse than league average. The larger in absolute value, the better (or worse) the player is.
# Let's look at the effectiveness of each player
kicker_eff <-
ranef(fg_mem) |>
data.frame() |>
select(kicker = grp, condval)
kicker_eff <-
left_join(
x = kicker_eff,
y = kicker_counts,
by = "kicker"
)
# The top and bottom 5 kickers
bind_rows(
.id = "type",
"best" = kicker_eff |> slice_max(condval, n = 5),
"worst" = kicker_eff |> filter(n > 50) |> slice_min(condval, n = 5)
) |>
arrange(-condval) |>
mutate(`odds of success` = exp(condval) |> round(2)) |>
select(kicker, attempts = n, `odds of success`) |>
gt::gt()
kicker | attempts | odds of success |
---|---|---|
C.Boswell | 180 | 1.33 |
B.Aubrey | 63 | 1.27 |
J.Tucker | 197 | 1.27 |
N.Folk | 166 | 1.27 |
C.Dicker | 78 | 1.24 |
R.Blankenship | 56 | 0.89 |
B.Maher | 103 | 0.88 |
R.Gould | 108 | 0.83 |
M.Badgley | 102 | 0.82 |
R.Succop | 105 | 0.80 |
According to the model, Chris Boswell has been the best kicker in the league over the last six years, with the odds of a successful field goal attempt 33% above the league average. Brandon Aubrey, Justin Tucker, and Nick Folk are tied for second place, all having 27% odds of a successful field goal attempt above league average.
The worst kicker in the league (with a minimum of 50 attempts) over the last 6 seasons is Ryan Succop. The odds his field goal attempt is successful is 20% below the league average. The worst 5 players are as bad as the best five players are good. This makes sense since NFL kickers aren’t given many chances, and if they start performing below the league average, they won’t have a job for very long!
Let’s visualize kickers’ random effects for players who have at least 100 attempts:
# Loading needed packages
pacman::p_load(nflplotR)
gg_kicker_effects <-
kicker_eff |>
# Only keeping rows with at least 100 attempts
filter(n >= 100) |>
left_join(y = FieldGoals |> select(kicker, kicker_id) |> distinct(),
by = "kicker") |>
# blue = above average, red = below average and reordering the kickers
mutate(
bar_col = if_else(condval > 0, "#013369", "#D50A0A"),
kicker = fct_reorder(kicker, condval)
) |>
# Bar chart for kicker effects
ggplot(
mapping = aes(
x = fct_rev(kicker),
y = abs(condval),
fill = bar_col
)
) +
# Adding a line for the bars to sit on at 0
geom_hline(
linewidth = 1,
yintercept = 0
) +
geom_col(
color = "black"
) +
annotate(
geom = "text",
color = "#013369",
label = "More likely to make the attempt",
x = "C.Santos",
y = .3,
fontface = "bold"
) +
annotate(
geom = "text",
color = "#D50A0A",
label = "More likely to miss the attempt",
x = "W.Lutz",
y = 0.3,
fontface = "bold"
) +
scale_fill_identity() +
scale_y_continuous(
limits = c(0, 0.35),
breaks = (0):5/10,
expand = c(0,0),
labels = round(exp(0:5/10), 1)
) +
labs(
x = NULL,
y = "Odd of success",
title = "Odds of success for NFL Kickers",
subtitle = "2019 - 2024 regular season; Minumum 100 attempts"
) +
theme(
axis.text.x = element_text(
angle = 90,
hjust = 0.95,
vjust = 0.15
)
) +
geom_nfl_headshots(
mapping = aes(player_gsis = kicker_id),
width = 0.075,
height = 0.075,
vjust = 0
)
gg_kicker_effects
Odds of success for a kicker accounting for distance and location
There are more players with a positive effect on the odds a field goal is successful. A possible explanation is if a kicker has a below average chance of success, they are cut from the team and are unlikely to get more than 100 attempts and wouldn’t be included in the graph.
The goal of the project is to compare the success rate of field goals between indoor and outdoor stadiums. A generalized mixed-effect logistic regression model was used to estimate the success rate after accounting for roof type, distance, and kicker. The results indicate that it is at least slightly easier to make a field goal in indoor stadiums, but the success rate isn’t much larger for attempts within 45 yards of the field goal uprights.
The difference in success rate is noticeably higher when the distance is greater than 50 yards (75% vs 68%) with a 10% higher probability when the kick is attempted 55 yards away (65% vs 55%).
Since the data includes all kick attempts for the 6 most recent seasons (as of 2023 anyway) for kickers with a minimum of 25 attempts in that 6 year span, the data should be representative for established players. However, like most positions in sports, over time players improve and these results may be out dated in the next decade. They also may not be applicable to new kickers that won’t last a full NFL season.