Take many variables, fit a model to them all at once, and visualize them all at once

many_models.R

library(tidyverse)
library(espnscrapeR)
library(broom)
library(glue)

# Get data from espnscrapeR
all_off <- 2000:2019 %>% 
  map_dfr(scrape_team_stats_nfl)

# Many LMs ----------------------------------------------------------------

# Our goal is to get all of the measures into a `long` form tibble 
# so that we can fit all of the models at once, and plot it all at once

# Offense -----------------------------------------------------------------

# I got the concept for season vs season 2 from Josh Hermsmeyer's 538 article
# https://fivethirtyeight.com/features/why-the-nfl-cant-rely-on-defense/
# His code: https://github.com/friscojosh/defensive-metric-stability

long_off_stats <- all_off %>% 
  select(team, pts_game:third_pct, season) %>% 
  mutate(season2 = season + 1,
         pts_game = as.double(pts_game),
         plays_scrimmage = as.double(plays_scrimmage)) %>% 
  pivot_longer(cols = c(-team, -season, -season2), names_to = "metric", values_to = "value")

(off_stability <- long_off_stats %>% 
    inner_join(long_off_stats, by = c("season2" = "season", "team", "metric")) %>% 
    select(everything(), -season2.y) %>% 
    nest(data = c(-metric)) %>% 
    mutate(
      fit = map(data, ~ lm(value.y ~ value.x, data = .x)),
      glanced = map(fit, glance)
    ) %>% 
    hoist(glanced, r.squared = "r.squared") %>% 
    arrange(desc(r.squared)) %>% 
    mutate(metric_label = glue::glue("{metric} (R^2 = {round(r.squared, 3)})")))

(off_plot <- long_off_stats %>% 
    inner_join(long_off_stats, by = c("season2" = "season", "team", "metric")) %>% 
    mutate(metric = factor(metric,
                           levels = pull(off_stability, metric),
                           labels = pull(off_stability, metric_label))) %>% 
    ggplot(aes(x = value.x, y = value.y)) +
    geom_point(color = "black", alpha = 0.5) +
    geom_smooth(method = "lm", color = "#ff2b4f", se = FALSE) +
    facet_wrap(~metric, scales = "free") +
    labs(x = "\nYear Y Metric", 
         y = "Year Y + 1 Metric\n",
         title = "Offense Stats - 2000-2019",
         subtitle = "Linear model fit comparing Year and Year + 1",
         caption = "Plot: @thomas_mock | Data: espnscrapeR")  +
    theme_minimal() +
    theme(strip.background = element_rect(fill = "black"),
          strip.text = element_text(face = "bold", color = "white")))

ggsave("plots/off_stability_plot.png", off_plot, height = 10, width = 10, dpi = 450)