Reproducible R Markdown that pulls live nflverse data and auto-limits to Week ≤ 6.

1 Setup

need <- c(
  "dplyr","tidyr","ggplot2","readr","stringr","lubridate",
  "nflreadr","gt","gtExtras","forcats","scales"
)
to_install <- setdiff(need, rownames(installed.packages()))
if (length(to_install)) install.packages(to_install, repos = "https://cloud.r-project.org")
invisible(lapply(need, library, character.only = TRUE))

# Parameters
season <- 2025
target_week <- 6

# Load data
pbp <- nflreadr::load_pbp(seasons = season)
sched <- nflreadr::load_schedules(seasons = season)

# Filter regular-season plays
pbp_rs <- pbp %>%
  dplyr::filter(season_type == "REG", !is.na(week))

# Use data up to Week 6 (or max available if <6)
max_week_available <- suppressWarnings(max(pbp_rs$week, na.rm = TRUE))
use_week <- min(max_week_available, target_week)

# Helpers
has_col <- function(df, col) col %in% names(df)

# Detect whether the schedule spread sign needs flipping using EPA-based sanity check
detect_spread_flip <- function(sched_week, pbp_rs, use_week, spread_col_name){
  if (is.null(spread_col_name) || is.na(spread_col_name) || !has_col(sched_week, spread_col_name)) return(FALSE)

  # Team offensive EPA so far (through use_week)
  epa_team <- pbp_rs %>%
    dplyr::filter(week <= use_week, !is.na(epa), !is.na(posteam)) %>%
    dplyr::group_by(posteam) %>%
    dplyr::summarise(epa_off = mean(epa, na.rm = TRUE), .groups="drop")

  wk <- sched_week %>%
    dplyr::select(home_team, away_team, spread_raw = dplyr::all_of(spread_col_name)) %>%
    dplyr::mutate(spread_raw = suppressWarnings(as.numeric(spread_raw))) %>%
    dplyr::left_join(epa_team, by=c("home_team"="posteam")) %>%
    dplyr::rename(epa_home = epa_off) %>%
    dplyr::left_join(epa_team, by=c("away_team"="posteam")) %>%
    dplyr::rename(epa_away = epa_off) %>%
    dplyr::mutate(epa_diff = epa_home - epa_away) %>%
    dplyr::filter(!is.na(spread_raw), !is.na(epa_diff))

  if (nrow(wk) < 3) return(FALSE)  # not enough to be confident

  # Convention: negative spread favors home, so -spread should correlate with (home_epa - away_epa)
  c_standard <- suppressWarnings(stats::cor(-wk$spread_raw, wk$epa_diff, use="complete.obs"))
  c_flipped  <- suppressWarnings(stats::cor( wk$spread_raw, wk$epa_diff, use="complete.obs"))

  if (is.na(c_standard) || is.na(c_flipped)) return(FALSE)
  abs(c_flipped) > abs(c_standard) + 0.05  # small margin
}

# Keep only scrimmage plays
pbp_clean <- pbp_rs %>%
  dplyr::filter(week <= use_week,
                play_type %in% c("run","pass"),
                !is.na(posteam),
                !is.na(epa))

3 Part 1 — Team Offensive Summary (to-date)

team_summary <- pbp_rs %>%
  dplyr::filter(week <= use_week, !is.na(epa), !is.na(posteam)) %>%
  dplyr::group_by(posteam) %>%
  dplyr::summarise(
    plays = dplyr::n(),
    epa_per_play = mean(epa, na.rm = TRUE),
    success_rate = mean(success, na.rm = TRUE),
    dropbacks = sum(pass == 1, na.rm = TRUE),
    rushes = sum(rush == 1, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  dplyr::arrange(dplyr::desc(epa_per_play)) %>%
  dplyr::mutate(rank_epa = dplyr::min_rank(dplyr::desc(epa_per_play)))

tbl <- team_summary %>%
  gt::gt() %>%
  gt::fmt_number(columns = c(epa_per_play), decimals = 3) %>%
  gt::fmt_percent(columns = c(success_rate), decimals = 1) %>%
  gt::tab_header(
    title = gt::md(sprintf("**Team Offensive Summary — 2025 REG (through Week %s)**", use_week)),
    subtitle = "Sorted by EPA per Play"
  )

if ("gtExtras" %in% loadedNamespaces()) {
  try({
    tbl <- gtExtras::gt_color_rows(data = tbl, columns = epa_per_play, palette = "Blues")
  }, silent = TRUE)
}
tbl
Team Offensive Summary — 2025 REG (through Week 6)
Sorted by EPA per Play
posteam plays epa_per_play success_rate dropbacks rushes rank_epa
IND 397 0.169 53.1% 181 143 1
BUF 427 0.152 49.4% 197 139 2
DAL 447 0.150 49.9% 227 122 3
DET 404 0.128 51.5% 162 148 4
WAS 394 0.109 51.3% 190 116 5
KC 406 0.102 49.5% 224 100 6
GB 333 0.099 48.0% 146 113 7
SEA 379 0.085 50.7% 154 144 8
BAL 355 0.071 49.9% 164 94 9
MIA 354 0.066 46.3% 187 91 10
NE 394 0.063 47.0% 199 109 11
PIT 286 0.042 49.7% 130 89 12
DEN 424 0.042 46.0% 209 127 13
TB 429 0.033 45.2% 215 124 14
JAX 418 0.030 47.1% 196 129 15
LA 405 0.018 52.1% 203 119 16
HOU 382 0.014 44.2% 188 123 17
SF 438 0.012 50.0% 225 130 18
NYJ 407 0.011 51.4% 207 113 19
PHI 465 0.011 45.6% 219 139 20
ARI 404 −0.005 43.6% 210 111 21
NYG 515 −0.016 45.6% 256 159 22
LAC 414 −0.018 46.6% 223 109 23
CAR 424 −0.022 46.0% 216 124 24
ATL 336 −0.033 45.8% 151 117 25
CHI 334 −0.036 42.8% 165 94 26
MIN 390 −0.043 45.9% 192 110 27
NO 440 −0.102 45.5% 213 136 28
LV 392 −0.116 44.9% 192 124 29
CIN 374 −0.129 43.6% 196 90 30
TEN 398 −0.135 42.0% 206 99 31
CLE 436 −0.160 39.2% 225 124 32

4 Part 1 — Dallas Schedule & Results

dal_games <- sched %>%
  dplyr::filter(season == season, home_team == "DAL" | away_team == "DAL") %>%
  dplyr::mutate(
    venue = ifelse(home_team == "DAL", "Home", "Away"),
    opponent = ifelse(venue == "Home", away_team, home_team),
    team_score = ifelse(venue == "Home", home_score, away_score),
    opponent_score = ifelse(venue == "Home", away_score, home_score),
    result = dplyr::case_when(
      is.na(team_score) | is.na(opponent_score) ~ NA_character_,
      team_score > opponent_score ~ "W",
      team_score < opponent_score ~ "L",
      TRUE ~ "T"
    )
  ) %>%
  dplyr::select(week, gameday, venue, opponent, team_score, opponent_score, result, game_id) %>%
  dplyr::arrange(week)

gt::gt(dal_games) %>%
  gt::tab_header(
    title = gt::md("**Dallas Cowboys — 2025 Regular Season Schedule & Results (to-date)**")
  ) %>%
  gt::fmt_date(columns = gameday, date_style = 3)
Dallas Cowboys — 2025 Regular Season Schedule & Results (to-date)
week gameday venue opponent team_score opponent_score result game_id
1 Thu, Sep 4, 2025 Away PHI 20 24 L 2025_01_DAL_PHI
2 Sun, Sep 14, 2025 Home NYG 40 37 W 2025_02_NYG_DAL
3 Sun, Sep 21, 2025 Away CHI 14 31 L 2025_03_DAL_CHI
4 Sun, Sep 28, 2025 Home GB 40 40 T 2025_04_GB_DAL
5 Sun, Oct 5, 2025 Away NYJ 37 22 W 2025_05_DAL_NYJ
6 Sun, Oct 12, 2025 Away CAR NA NA NA 2025_06_DAL_CAR
7 Sun, Oct 19, 2025 Home WAS NA NA NA 2025_07_WAS_DAL
8 Sun, Oct 26, 2025 Away DEN NA NA NA 2025_08_DAL_DEN
9 Mon, Nov 3, 2025 Home ARI NA NA NA 2025_09_ARI_DAL
11 Mon, Nov 17, 2025 Away LV NA NA NA 2025_11_DAL_LV
12 Sun, Nov 23, 2025 Home PHI NA NA NA 2025_12_PHI_DAL
13 Thu, Nov 27, 2025 Home KC NA NA NA 2025_13_KC_DAL
14 Thu, Dec 4, 2025 Away DET NA NA NA 2025_14_DAL_DET
15 Sun, Dec 14, 2025 Home MIN NA NA NA 2025_15_MIN_DAL
16 Sun, Dec 21, 2025 Home LAC NA NA NA 2025_16_LAC_DAL
17 Thu, Dec 25, 2025 Away WAS NA NA NA 2025_17_DAL_WAS
18 Sun, Jan 4, 2026 Away NYG NA NA NA 2025_18_DAL_NYG

5 Part 1 — Betting Snapshot (Week 6)

week_n <- target_week

possible_spread_cols <- c("spread_line","vegas_spread","home_spread")
possible_total_cols  <- c("total_line","over_under_line","vegas_total")
spread_col <- intersect(names(sched), possible_spread_cols)[1]
total_col  <- intersect(names(sched), possible_total_cols)[1]

# Flip detection using the full slate for the week
sched_week <- sched %>% dplyr::filter(season == season, week == week_n)
need_flip <- detect_spread_flip(sched_week, pbp_rs, use_week, spread_col)

# DAL row
dal_row <- sched_week %>% dplyr::filter(home_team == "DAL" | away_team == "DAL") %>% dplyr::slice(1)

if (nrow(dal_row) > 0) {
  spread_val <- if(!is.na(spread_col)) as.numeric(dal_row[[spread_col]]) else NA_real_
  total_val  <- if(!is.na(total_col))  as.numeric(dal_row[[total_col]])  else NA_real_
  dal_is_home <- dal_row$home_team == "DAL"
  opponent <- ifelse(dal_is_home, dal_row$away_team, dal_row$home_team)

  # Normalize to DAL perspective (positive => DAL favored)
  dal_spread <- if(!is.na(spread_val)) { if (dal_is_home) spread_val else -spread_val } else { NA_real_ }

  # If signs are flipped this week, invert
  if (isTRUE(need_flip) && !is.na(dal_spread)) dal_spread <- -dal_spread

  sd_pts <- 13
  dal_implied_win_prob <- if(!is.na(dal_spread)) stats::pnorm(dal_spread / sd_pts) else NA_real_

  out <- tibble::tibble(
    Season = season,
    Week = week_n,
    `DAL Home?` = ifelse(dal_is_home, "Yes", "No"),
    Opponent = opponent,
    `DAL Spread (+ favored)` = ifelse(is.na(dal_spread), NA, sprintf("%.1f", dal_spread)),
    `Total (OU)` = ifelse(is.na(total_val), NA, sprintf("%.1f", total_val)),
    `Implied DAL Win %` = ifelse(is.na(dal_implied_win_prob), NA, scales::percent(dal_implied_win_prob, accuracy = 0.1))
  )

  gt::gt(out) %>%
    gt::tab_header(
      title = sprintf("Week %s Betting Snapshot — Dallas Cowboys", week_n),
      subtitle = paste("Season", season, "| DAL perspective (auto-detect flip)")
    ) %>%
    gt::tab_footnote(
      footnote = if (isTRUE(need_flip))
        "Spread signs auto-corrected to standard (favorite = negative)." else
        "Spread signs appear standard (favorite = negative)."
    )
} else {
  gt::gt(tibble::tibble(Note = "No DAL game row found for this week in schedules."))
}
Week 6 Betting Snapshot — Dallas Cowboys
Season 2025 | DAL perspective (auto-detect flip)
Season Week DAL Home? Opponent DAL Spread (+ favored) Total (OU) Implied DAL Win %
2025 6 No CAR 3.0 48.5 59.1%
Spread signs appear standard (favorite = negative). 
week_n <- target_week

spread_col <- intersect(names(sched), c("spread_line","vegas_spread","home_spread"))[1]
total_col  <- intersect(names(sched), c("total_line","over_under_line","vegas_total"))[1]

week_tab <- sched %>%
  dplyr::filter(season == season, week == week_n) %>%
  dplyr::select(game_id, week, home_team, away_team,
                spread = dplyr::all_of(spread_col),
                total  = dplyr::all_of(total_col)) %>%
  dplyr::mutate(
    spread = as.numeric(spread),
    total  = as.numeric(total)
  )

need_flip <- detect_spread_flip(
  sched_week = sched %>% dplyr::filter(season == season, week == week_n),
  pbp_rs = pbp_rs, use_week = use_week, spread_col_name = spread_col
)

if (isTRUE(need_flip)) {
  week_tab <- week_tab %>% dplyr::mutate(spread = -spread)
}

week_tab <- week_tab %>%
  dplyr::mutate(
    home_favored = spread,        # negative => home favored
    away_favored = -spread,
    home_win_prob = stats::pnorm(home_favored / 13),
    away_win_prob = stats::pnorm(away_favored / 13)
  )

out <- week_tab %>%
  dplyr::transmute(
    Week = week,
    Matchup = paste0(away_team, " @ ", home_team),
    `Vegas Spread (away)` = ifelse(is.na(spread), NA, sprintf("%.1f", spread)),
    `Total (OU)` = ifelse(is.na(total), NA, sprintf("%.1f", total)),
    `Home Win %` = ifelse(is.na(home_win_prob), NA, scales::percent(home_win_prob, accuracy = 0.1)),
    `Away Win %` = ifelse(is.na(away_win_prob), NA, scales::percent(away_win_prob, accuracy = 0.1))
  )

gt::gt(out) %>%
  gt::tab_header(
    title = sprintf("Week %s Betting Snapshot — All Games", week_n),
    subtitle = paste("Season", season, "| from sched betting columns (auto-detect flip)")
  ) %>%
  gt::tab_footnote(
    footnote = if (isTRUE(need_flip))
      "Spread signs auto-corrected to standard (favorite = negative)." else
      "Spread signs appear standard (favorite = negative)."
  )
Week 6 Betting Snapshot — All Games
Season 2025 | from sched betting columns (auto-detect flip)
Week Matchup Vegas Spread (away) Total (OU) Home Win % Away Win %
6 PHI @ NYG -7.0 40.5 29.5% 70.5%
6 DEN @ NYJ -7.5 43.5 28.2% 71.8%
6 LA @ BAL -7.0 44.5 29.5% 70.5%
6 DAL @ CAR -3.0 48.5 40.9% 59.1%
6 ARI @ IND 9.5 46.5 76.8% 23.2%
6 SEA @ JAX -1.5 47.5 45.4% 54.6%
6 LAC @ MIA -4.5 44.5 36.5% 63.5%
6 NE @ NO -3.5 46.5 39.4% 60.6%
6 CLE @ PIT 5.5 37.5 66.4% 33.6%
6 TEN @ LV 4.5 41.5 63.5% 36.5%
6 CIN @ GB 14.5 44.5 86.8% 13.2%
6 SF @ TB 3.5 47.5 60.6% 39.4%
6 DET @ KC 2.5 52.5 57.6% 42.4%
6 BUF @ ATL -4.5 49.5 36.5% 63.5%
6 CHI @ WAS 4.5 49.5 63.5% 36.5%
Spread signs appear standard (favorite = negative).

6 Part 1 — Neutral Pass Rate (DAL vs League)

pbp_neu <- pbp_clean %>%
  dplyr::mutate(
    neutral = dplyr::case_when(
      has_col(., "wp") & !is.na(wp) ~ as.integer(wp >= 0.20 & wp <= 0.80),
      TRUE ~ as.integer(abs(score_differential) <= 7 & qtr %in% 1:3)
    )
  ) %>%
  dplyr::filter(neutral == 1)

nw <- pbp_neu %>%
  dplyr::mutate(group = if_else(posteam == "DAL", "DAL", "League")) %>%
  dplyr::group_by(group, week) %>%
  dplyr::summarise(npr = mean(pass == 1, na.rm = TRUE), .groups = "drop")

ggplot(nw, aes(week, npr, color = group)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_color_manual(values = c("DAL" = "blue", "League" = "black")) +
  scale_x_continuous(breaks = sort(unique(nw$week))) +
  scale_y_continuous(labels = scales::percent_format(1)) +
  labs(
    title = sprintf("Neutral Situation Pass Rate by Week (through Week %s)", use_week),
    subtitle = "DAL vs League",
    x = "Week", y = "Neutral Pass Rate", color = NULL
  ) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

7 Part 2 — SGPs & Players

# Enrich for situational flags
pbp_enriched <- pbp_clean %>%
  dplyr::mutate(
    explosive = dplyr::case_when(
      pass == 1 & yards_gained >= 20 ~ 1L,
      rush == 1 & yards_gained >= 10 ~ 1L,
      TRUE ~ 0L
    ),
    early_down = if_else(down %in% c(1,2), 1L, 0L),
    third_down = if_else(down == 3, 1L, 0L),
    neutral = dplyr::case_when(
      has_col(., "wp") & !is.na(wp) ~ as.integer(wp >= 0.20 & wp <= 0.80),
      TRUE ~ as.integer(abs(score_differential) <= 7 & qtr %in% 1:3)
    ),
    two_min = if_else(half_seconds_remaining <= 120, 1L, 0L),
    q1 = if_else(qtr == 1, 1L, 0L)
  )

# Third-down distance buckets
tdist <- pbp_enriched %>%
  dplyr::filter(third_down == 1, !is.na(ydstogo)) %>%
  dplyr::mutate(td_bucket = cut(
    ydstogo,
    breaks = c(-Inf, 2, 5, 10, Inf),
    labels = c("1-2", "3-5", "6-10", "11+")
  ))

# Red-zone trips/TDs (drive-level)
rz_trips <- pbp_enriched %>%
  dplyr::group_by(game_id, drive, posteam) %>%
  dplyr::summarise(
    any_rz = any(yardline_100 <= 20, na.rm = TRUE),
    td_for = any(touchdown == 1 & posteam == td_team, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  dplyr::filter(any_rz)

# Team-level aggregation
team_metrics <- function(df, team_code) {
  df_team <- df %>% dplyr::filter(posteam == team_code)

  plays <- nrow(df_team)
  epa_pp <- mean(df_team$epa, na.rm = TRUE)
  sr <- mean(df_team$success, na.rm = TRUE)

  exp_rate <- mean(df_team$explosive == 1, na.rm = TRUE)

  ed_sr <- df_team %>%
    dplyr::filter(early_down == 1) %>%
    dplyr::summarise(v = mean(success, na.rm = TRUE)) %>%
    dplyr::pull(v)

  td_team <- tdist %>% dplyr::filter(posteam == team_code)
  td_conv <- td_team %>%
    dplyr::summarise(
      `TD Conv 1-2`  = mean(first_down == 1 & td_bucket == "1-2",  na.rm = TRUE) / mean(td_bucket == "1-2",  na.rm = TRUE),
      `TD Conv 3-5`  = mean(first_down == 1 & td_bucket == "3-5",  na.rm = TRUE) / mean(td_bucket == "3-5",  na.rm = TRUE),
      `TD Conv 6-10` = mean(first_down == 1 & td_bucket == "6-10", na.rm = TRUE) / mean(td_bucket == "6-10", na.rm = TRUE),
      `TD Conv 11+`  = mean(first_down == 1 & td_bucket == "11+",  na.rm = TRUE) / mean(td_bucket == "11+",  na.rm = TRUE)
    ) %>%
    dplyr::mutate(dplyr::across(dplyr::everything(), ~ ifelse(is.nan(.x), NA_real_, .x)))

  rz_team <- rz_trips %>% dplyr::filter(posteam == team_code)
  rz_td_rate <- if (nrow(rz_team) > 0) mean(rz_team$td_for, na.rm = TRUE) else NA_real_

  neutral_team <- df_team %>% dplyr::filter(neutral == 1)
  npr <- if (nrow(neutral_team) > 0) mean(neutral_team$pass == 1, na.rm = TRUE) else NA_real_

  has_pa <- has_col(df_team, "play_action")
  has_shotgun <- has_col(df_team, "shotgun")
  has_pen <- has_col(df_team, "penalty")

  pa_rate <- pa_epa <- NA_real_
  if (has_pa) {
    pa_rate <- mean(df_team$play_action == 1, na.rm = TRUE)
    pa_epa <- df_team %>% dplyr::filter(play_action == 1) %>% dplyr::summarise(v = mean(epa, na.rm = TRUE)) %>% dplyr::pull(v)
  }

  sg_rate <- sg_epa <- NA_real_
  if (has_shotgun) {
    sg_rate <- mean(df_team$shotgun == 1, na.rm = TRUE)
    sg_epa <- df_team %>% dplyr::filter(shotgun == 1) %>% dplyr::summarise(v = mean(epa, na.rm = TRUE)) %>% dplyr::pull(v)
  }

  pen_epa <- NA_real_
  if (has_pen) {
    pen_epa <- df_team %>% dplyr::filter(penalty == 1) %>% dplyr::summarise(v = sum(epa, na.rm = TRUE)) %>% dplyr::pull(v)
  }

  two_min_df <- df_team %>% dplyr::filter(two_min == 1)
  two_min_epa <- if (nrow(two_min_df) > 0) mean(two_min_df$epa, na.rm = TRUE) else NA_real_

  q1_df <- df_team %>% dplyr::filter(q1 == 1)
  q1_epa <- if (nrow(q1_df) > 0) mean(q1_df$epa, na.rm = TRUE) else NA_real_
  q1_sr <- if (nrow(q1_df) > 0) mean(q1_df$success, na.rm = TRUE) else NA_real_

  tibble::tibble(
    team = team_code,
    plays = plays,
    epa_per_play = epa_pp,
    success_rate = sr,
    explosive_rate = exp_rate,
    early_down_sr = ed_sr,
    third_conv_1_2  = td_conv$`TD Conv 1-2`,
    third_conv_3_5  = td_conv$`TD Conv 3-5`,
    third_conv_6_10 = td_conv$`TD Conv 6-10`,
    third_conv_11p  = td_conv$`TD Conv 11+`,
    rz_td_rate = rz_td_rate,
    neutral_pass_rate = npr,
    pa_rate = pa_rate,
    pa_epa = pa_epa,
    shotgun_rate = sg_rate,
    shotgun_epa = sg_epa,
    penalty_epa = pen_epa,
    two_min_epa = two_min_epa,
    q1_epa = q1_epa,
    q1_sr = q1_sr
  )
}

dal_stats <- team_metrics(pbp_enriched, "DAL")
league_stats <- (function(df){
  df_league <- df %>% dplyr::mutate(posteam = "LEAGUE")
  team_metrics(df_league, "LEAGUE")
})(pbp_enriched)

out_tbl <- dplyr::bind_rows(
  dal_stats %>% dplyr::mutate(group = "DAL"),
  league_stats %>% dplyr::mutate(group = "League Avg")
) %>%
  dplyr::select(group, plays, epa_per_play, success_rate, explosive_rate, early_down_sr,
                third_conv_1_2, third_conv_3_5, third_conv_6_10, third_conv_11p,
                rz_td_rate, neutral_pass_rate, pa_rate, pa_epa, shotgun_rate, shotgun_epa,
                penalty_epa, two_min_epa, q1_epa, q1_sr)

gt::gt(out_tbl) %>%
  gt::fmt_number(columns = c(epa_per_play, pa_epa, shotgun_epa, two_min_epa, q1_epa), decimals = 3) %>%
  gt::fmt_percent(columns = c(success_rate, explosive_rate, early_down_sr,
                              third_conv_1_2, third_conv_3_5, third_conv_6_10, third_conv_11p,
                              rz_td_rate, neutral_pass_rate, pa_rate, shotgun_rate, q1_sr),
                  decimals = 1) %>%
  gt::tab_header(
    title = gt::md(sprintf("**DAL vs League — Advanced Offensive Profile (2025 REG through Week %s)**", use_week)),
    subtitle = "Explosive, Early/3rd Down, Red Zone, Neutral Pass, Play Action, Shotgun, Two-Minute, Q1"
  )
DAL vs League — Advanced Offensive Profile (2025 REG through Week 6)
Explosive, Early/3rd Down, Red Zone, Neutral Pass, Play Action, Shotgun, Two-Minute, Q1
group plays epa_per_play success_rate explosive_rate early_down_sr third_conv_1_2 third_conv_3_5 third_conv_6_10 third_conv_11p rz_td_rate neutral_pass_rate pa_rate pa_epa shotgun_rate shotgun_epa penalty_epa two_min_epa q1_epa q1_sr
DAL 329 0.166 48.6% 8.8% 48.7% 72.7% 63.2% 25.0% 20.0% 68.4% 63.2% NA NA 66.6% 0.165 12.04440 0.546 0.140 46.6%
League Avg 9553 0.024 44.8% 8.7% 44.7% NA NA NA NA NA 61.2% NA NA 69.2% 0.012 75.32632 0.078 0.042 46.1%

8 Part 2 — Visuals

bucket_dist <- function(x) cut(x, breaks = c(-Inf, 2, 5, 10, Inf), labels = c("1–2", "3–5", "6–10", "11+"))

# (1) Critical downs heatmap
crit <- pbp_clean %>%
  dplyr::filter(posteam == "DAL", down %in% c(3,4), !is.na(ydstogo)) %>%
  dplyr::mutate(dist_bucket = bucket_dist(ydstogo)) %>%
  dplyr::group_by(down, dist_bucket) %>%
  dplyr::summarise(plays = dplyr::n(),
                   conv_rate = mean(first_down == 1, na.rm = TRUE),
                   .groups = "drop")

ggplot(crit, aes(x = dist_bucket, y = factor(down), fill = conv_rate)) +
  geom_tile(color = "white") +
  geom_text(aes(label = scales::percent(conv_rate, 0.1)), size = 4) +
  scale_y_discrete(labels = c("3" = "3rd Down", "4" = "4th Down")) +
  scale_fill_continuous(labels = scales::percent_format(1)) +
  labs(title = "DAL Critical Downs: Conversion Rate by Distance",
       x = "Yards to Go", y = "Down", fill = "Conv %") +
  theme_minimal(base_size = 13)

# (2) QB efficiency bars
qb <- pbp_clean %>%
  dplyr::filter(posteam == "DAL", pass == 1, !is.na(passer_player_name)) %>%
  dplyr::group_by(passer_player_name) %>%
  dplyr::summarise(
    attempts = dplyr::n(),
    epa_per_dropback = mean(epa, na.rm = TRUE),
    success_rate = mean(success, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  dplyr::arrange(dplyr::desc(attempts)) %>%
  dplyr::mutate(passer_player_name = forcats::fct_reorder(passer_player_name, epa_per_dropback))

ggplot(qb, aes(passer_player_name, epa_per_dropback)) +
  geom_col() +
  geom_text(aes(label = sprintf("%.3f", epa_per_dropback)), vjust = -0.4, size = 3.5) +
  labs(title = "DAL QB Efficiency (EPA per Dropback)",
       subtitle = "Labels show EPA/dropback; consider attempts context",
       x = "Quarterback", y = "EPA per Dropback") +
  theme_minimal(base_size = 13) +
  coord_cartesian(ylim = c(min(0, min(qb$epa_per_dropback, na.rm=TRUE)) - 0.05,
                           max(qb$epa_per_dropback, na.rm=TRUE) + 0.1)) +
  theme(axis.text.x = element_text(angle = 20, hjust = 1))

# (3) Top skill players
skill <- pbp_clean %>%
  dplyr::filter(posteam == "DAL") %>%
  dplyr::mutate(player = if_else(play_type == "run", rusher_player_name, receiver_player_name)) %>%
  dplyr::filter(!is.na(player)) %>%
  dplyr::group_by(player) %>%
  dplyr::summarise(
    touches = dplyr::n(),
    epa_per_play = mean(epa, na.rm = TRUE),
    success_rate = mean(success, na.rm = TRUE),
    tds = sum(touchdown == 1, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  dplyr::arrange(dplyr::desc(touches)) %>%
  dplyr::slice_head(n = 12)

ggplot(skill, aes(touches, epa_per_play, size = tds)) +
  geom_point(alpha = 0.8) +
  geom_hline(yintercept = 0, linetype = 2) +
  labs(title = "DAL Top Offensive Contributors",
       subtitle = "Touches vs EPA/play (point size = TDs)",
       x = "Touches", y = "EPA per Play", size = "TDs") +
  theme_minimal(base_size = 13)

# (4) Red-zone by week
rz_drives <- pbp_clean %>%
  dplyr::filter(posteam == "DAL") %>%
  dplyr::group_by(game_id, drive) %>%
  dplyr::summarise(
    week = dplyr::first(week),
    any_rz = any(yardline_100 <= 20, na.rm = TRUE),
    td_for = any(touchdown == 1 & posteam == td_team, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  dplyr::filter(any_rz)

rz_week <- rz_drives %>%
  dplyr::group_by(week) %>%
  dplyr::summarise(rz_trips = dplyr::n(), rz_td_rate = mean(td_for, na.rm = TRUE), .groups = "drop")

ggplot(rz_week, aes(week, rz_td_rate)) +
  geom_col() +
  geom_text(aes(label = scales::percent(rz_td_rate, 0.1)), vjust = -0.3) +
  scale_x_continuous(breaks = unique(rz_week$week)) +
  scale_y_continuous(labels = scales::percent_format(1)) +
  labs(title = "DAL Red-Zone Touchdown Rate by Week", x = "Week", y = "RZ TD Rate") +
  theme_minimal(base_size = 13)

# (5) Neutral pass rate by week (reuse pbp_neu from prior chunk)
nw <- pbp_neu %>%
  dplyr::mutate(group = if_else(posteam == "DAL", "DAL", "League")) %>%
  dplyr::group_by(group, week) %>%
  dplyr::summarise(npr = mean(pass == 1, na.rm = TRUE), .groups = "drop")

ggplot(nw, aes(week, npr, color = group)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_color_manual(values = c("DAL" = "blue", "League" = "black")) +
  scale_x_continuous(breaks = sort(unique(nw$week))) +
  scale_y_continuous(labels = scales::percent_format(1)) +
  labs(title = "Neutral Situation Pass Rate by Week",
       subtitle = "DAL vs League",
       x = "Week", y = "Neutral Pass Rate", color = NULL) +
  theme_minimal(base_size = 13) +
  theme(legend.position = "bottom")

9 Brief Notes

EPA captures the value of each play in context (down, distance, field, clock). Through Week 6, Dallas trends versus the league are summarized above. Betting Snapshot tables auto-detect and correct a flipped spread column for the slate before computing implied win probabilities and DAL perspective numbers.