First load the packages and some data. load_4th_pbp() loads cfbfastR data and computes 4th down probabilities (depending on your computer, this may take up to a minute or two per season).

library(cfb4th)
library(tidyverse)
library(gt)
data <- cfb4th::load_4th_pbp(2020)

## Easy mode: using cfbfastR data

Here’s what the data obtained using load_4th_pbp() looks like:

data %>%
dplyr::filter(!is.na(go_boost)) %>%
dplyr::select(
pos_team, distance, yards_to_goal, go_boost, first_down_prob,
wp_fail, wp_succeed, go_wp, fg_make_prob, miss_fg_wp, make_fg_wp,
fg_wp, punt_wp
) %>%
knitr::kable(digits = 2)
pos_team distance yards_to_goal go_boost first_down_prob wp_fail wp_succeed go_wp fg_make_prob miss_fg_wp make_fg_wp fg_wp punt_wp
North Texas 2 41 1.14 0.69 0.95 0.97 0.96 0.28 0.95 0.97 0.95 0.95
Houston Baptist 2 5 0.25 0.47 0.03 0.07 0.05 0.93 0.03 0.05 0.05 NA
Houston Baptist 6 26 0.31 0.41 0.01 0.04 0.02 0.61 0.01 0.02 0.02 NA
Houston Baptist 5 64 -0.07 0.40 0.01 0.01 0.01 0.00 0.00 0.01 0.00 0.01
North Texas 3 48 0.19 0.62 0.97 0.98 0.98 0.00 0.97 0.98 0.97 0.97
North Texas 3 48 0.12 0.62 0.97 0.98 0.98 0.00 0.97 0.99 0.97 0.98
Houston Baptist 10 13 -0.36 0.18 0.02 0.07 0.03 0.83 0.02 0.04 0.03 NA
North Texas 13 13 -0.36 0.28 0.96 0.99 0.97 0.83 0.96 0.98 0.97 NA
Houston Baptist 9 33 -0.65 0.30 0.02 0.02 0.02 0.48 0.02 0.04 0.03 0.02
Houston Baptist 5 33 0.61 0.40 0.02 0.05 0.03 0.48 0.02 0.04 0.03 0.03

Or we can add some filters to look up a certain game:

data %>%
dplyr::filter(week == 12, pos_team == "Utah", down == 4) %>%
dplyr::select(
pos_team, distance, yards_to_goal, go_boost, first_down_prob,
wp_fail, wp_succeed, go_wp, fg_make_prob, miss_fg_wp, make_fg_wp,
fg_wp, punt_wp
) %>%
knitr::kable(digits = 2)
pos_team distance yards_to_goal go_boost first_down_prob wp_fail wp_succeed go_wp fg_make_prob miss_fg_wp make_fg_wp fg_wp punt_wp
Utah 10 75 -2.61 0.30 0.35 0.48 0.39 0.00 0.34 0.51 0.34 0.42
Utah 5 19 0.02 0.44 0.43 0.58 0.50 0.74 0.43 0.52 0.50 NA
Utah 8 73 -1.00 0.35 0.21 0.27 0.23 0.00 0.20 0.31 0.20 0.24
Utah 10 87 -1.34 0.30 0.22 0.29 0.24 0.00 0.21 0.35 0.21 0.26
Utah 18 83 -2.15 0.12 0.06 0.12 0.07 0.00 0.05 0.17 0.05 0.09
Utah 6 37 2.26 0.41 0.06 0.14 0.09 0.35 0.05 0.10 0.07 0.07
Utah 4 10 1.68 0.40 0.05 0.16 0.09 0.87 0.04 0.08 0.08 NA
Utah 11 73 0.05 0.27 0.01 0.01 0.01 0.00 0.01 0.01 0.01 0.01

## Calculations from user input

The below shows the bare minimum amount of information that has to be fed to cfb4th in order to compute 4th down decision recommendations. The main function on user-input data is add_4th_probs().

Teams are included to help the model easily track the simulations.

one_play <-
tibble::tibble(
# Game Info
home = "Utah",
away = "BYU",
pos_team = "Utah",
def_pos_team = "BYU",
over_under = 55,

# Situation Info
half = 2,
period = 3, # Quarter
TimeSecsRem = 900, # Half Seconds Remaining
adj_TimeSecsRem = 900, # Game Seconds Remaining
down = 4,
distance = 4,
yards_to_goal = 40,
pos_score_diff_start = 7,

pos_team_timeouts_rem_before = 3,
def_pos_team_timeouts_rem_before = 3

)
one_play %>%
dplyr::select(
pos_team, distance, yards_to_goal, go_boost, first_down_prob,
wp_fail, wp_succeed, go_wp, fg_make_prob, miss_fg_wp, make_fg_wp,
fg_wp, punt_wp
) %>%
knitr::kable(digits = 2)
#> Computing probabilities for 1 plays. . .
pos_team distance yards_to_goal go_boost first_down_prob wp_fail wp_succeed go_wp fg_make_prob miss_fg_wp make_fg_wp fg_wp punt_wp
Utah 4 40 1.4 0.49 0.81 0.92 0.87 0.3 0.81 0.91 0.84 0.85

## Make a summary table

Let’s put the play above into a table using the provided function make_table_data(), which makes it easier to interpret the recommendations for a play. This function only works with one play at a time since it makes a table using the results from the play.

one_play %>%
cfb4th::make_table_data() %>%
knitr::kable(digits = 1)
#> Computing probabilities for 1 plays. . .
choice choice_prob success_prob fail_wp success_wp
Go for it 86.5 49.4 81.2 92.0
Punt 85.1 NA NA NA
Field goal attempt 83.9 29.6 80.7 91.3

Looking at the table, the offense would be expected to have 86.5% win probability if they had gone for it and 85% if they punted.

## Getting 4th down plays from a live game

cfbfastR isn’t available for live games and typing all the plays in by hand is annoying. So how does the 4th down bot work? With thanks to the ESPN API, which can be accessed using get_4th_plays().

game <- cfbfastR::cfbd_game_info(2019, team = "Utah", week = 4)
plays <- cfb4th::get_4th_plays(game) %>%
tail(1)
plays %>%
select(desc, TimeSecsRem)
#> # A tibble: 1 × 2
#>   desc                        TimeSecsRem
#>   <chr>                             <dbl>
#> 1 Jadon Redding 38 yd FG GOOD         241
plays %>%
#> Computing probabilities for 1 plays. . .