baldwin-run-exp.R

library(tidyverse)
library(patchwork)
library(ggtext)

team_colors <- nflfastR::teams_colors_logos %>% filter(team_abbr == "TEN") %>% 
  select(team_color, team_color2) %>% 
  unlist()

# fake data
run_df <- tibble(
  down_distance = c(
    "1st & 10",
    "2nd & 8+",
    "2nd & 3-7",
    "2nd & 1-2",
    "3rd & 3+",
    "3rd & 1-2",
    "After pass for 1st",
    "After rush for 1st",
    "All plays"
  ),
  actual = c(
    38, 57, 63, 36, 89, 50, 39, 41, 54
  ),
  expected = c(
    56, 72, 66, 39, 92, 54, 54, 57, 64
  )
) %>% 
  mutate(
    down_distance = factor(down_distance),
    difference = actual - expected,
    diff_color = if_else(difference < 0, "#DC143C", "black")
    )



run_plot <- run_df %>%
  ggplot(aes(x = actual, y = fct_rev(down_distance))) +
  geom_text(
    aes(x = 100, label = paste0(difference, "%"), color = diff_color), 
    nudge_x = 10, hjust = 1, fontface= "bold", family = "Chivo", size = 10
  ) +
  geom_col(aes(x = 100), width = 0.7, color = "grey", alpha = 0.2) +
  geom_col(aes(x = expected), fill = team_colors[1], alpha = 0.5, width = 0.7) +
  geom_col(width = 0.4, fill = team_colors[2]) + 
  scale_fill_identity() +
  scale_x_continuous(breaks = c(25, 50, 75), labels = scales::percent_format(scale = 1)) +
  theme_minimal() +
  theme(
    text = element_text(family = "Chivo"),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(color = "grey", size = 0.2),
    panel.ontop = TRUE,
    axis.text.y = element_markdown(size = 14, margin = margin(r = -25, unit = "pt")),
    axis.text.x = element_text(size = 16, color = "grey"),
    plot.title = element_markdown(size = 36, face = "bold"),
    plot.subtitle = element_text(size = 24),
    plot.margin = unit(c(0.5, 1.5, 0.5, 1.5), "cm"),
    legend.position = "none"
  ) +
  labs(
    x = "", y = "", 
    title = glue::glue("Titans <span style='color:{team_colors[2]}'>Pass Frequency</span> over <span style='color:{team_colors[1]}'>Expected</span>, 2020")
  )


# Legend plot -------------------------------------------------------------


label_df <- tibble(
  x = c(15, 15, 77, 101),
  y = c(1.6, 0.35, 0.35, 1),
  label = c("Expected Pass Frequency ", "Actual Pass Frequency ", "Difference", "X%")
)

seg_df <- tibble(
  x1 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
  x2 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
  y1 = c(1.3, 1.3, rep(.7, 5)),
  y2 = c(1.61, 1.61, rep(.343, 5))
  
)

seg2_df <- tibble(
  x1 = c(0.2, 0.2, 75.3),
  x2 = c(90, 74.8, 103),
  y1 = c(1.6, .35, .35),
  y2 = c(1.6, .35, .35)
)

legend_plot <- tibble(
  x = 75,
  y = factor("Y"),
  x2 = 90
) %>%
  ggplot(aes(x = x, y = y)) +
  geom_col(aes(x = 100), fill = "white", color = "grey", width = 0.4) +
  geom_col(aes(x = x2), width = 0.4, fill = "black", alpha = 0.5) +
  geom_col(width = 0.2, color = "black", fill = "black") +
  geom_segment(
    data = seg_df,
    aes(x = x1, y = y1, xend = x2, yend = y2),
    color = c(rep("black", 4), rep("#DC143C", 3)),
    size = 1
  ) +
  geom_segment(
    data = seg2_df,
    aes(x = x1, y = y1, xend = x2, yend = y2),
    color = c("black", "black", "#DC143C"),
    size = 1
  ) +
  geom_label(
    data = label_df,
    aes(x = x, y = y, label = label),
    hjust = 0, size = 8, fontface = "bold", fill = "white",
    color = c("black", "black", "#DC143C", "#DC143C"),
    label.size = NA,
    family = "Oswald",
    label.padding = unit(0.05, "lines"),
  ) +
  theme_void() +
  theme(
    plot.margin = unit(c(0.5, 1.5, 0.5, 1.5), "cm"),
    plot.caption = element_markdown(size = 14)
  ) +
  coord_cartesian(ylim = c(0.7, 1.2), xlim = c(0, 108)) +
  labs(
    caption = "<br><br>**Plot**: @thomas_mock | **Inspiration**: @bburkeESPN"
  )

legend_plot

combo_plot <- run_plot / legend_plot + plot_layout(heights = c(5,1))

combo_plot

ggsave("ten_rush.png", combo_plot, height = 14, width = 16, units = "in", dpi = "retina")

# https://git.io/JkNfu