rleid-streaks.R

library(tidyverse)

raw_df <- read.delim("Sheet_1_data.csv", header = TRUE, fileEncoding = "UTF-16", sep = "\t") %>%
  tibble() %>%
  janitor::clean_names()

all_weeks <- crossing(year = 2006:2020, week = c(1:17, 28:32)) %>%
  mutate(glued = glue::glue("{year}-{week}")) %>%
  pull(glued)

rle_expand <- function(x) {
  rle_lengths <- rle(x)$lengths
  length_of_rle <- length(rle_lengths)
  seq(rle_lengths) %>% rep(., rle_lengths)
}

myrleid <- function(x) {
  x <- rle(x)$lengths
  rep(seq_along(x), times = x)
}

rle(ex_vec)$lengths %>% {
  rep(seq(length(.)), .)
}

# data.table::rleid()


plot_df <- raw_df %>%
  filter(week <= 17) %>%
  arrange(team, season, week) %>%
  group_by(team) %>%
  mutate(
    lagged = lag(player),
    lagged = if_else(is.na(lagged), player, lagged),
    player_in_streak = 1, # if_else(lagged == player, 1, 0),
    grp = rle_expand(player),
    grp_dt = data.table::rleid(player)
  ) %>%
  group_by(team, player, grp) %>%
  mutate(
    streak_id = cumsum(player_in_streak),
    strk_id = cumsum(player_in_streak)
  ) %>%
  group_by(team) %>%
  mutate(game_id = row_number()) %>%
  ungroup() %>%
  group_by(team, player) %>%
  mutate(
    t_games = n(),
    ratio = t_games / 240
  ) %>% 
  ungroup()



small_df <- plot_df %>%
  filter(team %in% c("ARZ", "ATL", "PIT", "SEA", "LAC"))
small_plot <- small_df %>%
  ggplot(aes(x = game_id, y = streak_id)) +
  geom_col(fill = "blue", color = "white", size = 0.1) +
  geom_label(
    data = small_df %>% filter(game_id == 1),
    aes(x = -1, y = 100, label = team)
  ) +
  geom_text(
    data = label_df,
    aes(x = x, y = 220),
    label = "Current Streak"
  ) +
  facet_wrap(~team, ncol = 1) + # NULL
  theme_minimal() +
  scale_x_continuous(breaks = seq(0, 240, by = 16)) +
  labs(
    x = "Regular Season Games since 2006",
    y = "",
    title = "NFL Consecutive QBs Starts in a Row",
    subtitle = "Total consecutive QB starts for a single team since 2006",
    caption = "Data courtesty of PFF"
  ) +
  theme(
    strip.text = element_blank(),
    strip.background = element_blank(),
    axis.text.y = element_blank()
  )

small_plot

plotly::ggplotly(small_plot)

label_df <- tibble(
  label = c("Team", "Current<br>Streak", "Snap %<br>by 1x QB"),
  x = c(0, 0, 230),
  y = rep(max(plot_df$streak_id)*1.25, 3),
  team = factor("ARZ", levels = unique(plot_df$team))
)

label_df

plot_df

ex_plot <- plot_df %>%
  ggplot(aes(x = game_id, y = streak_id)) +
  geom_col(fill = "#003775", color = "white", size = 0.1) +
  geom_text(
    data = plot_df %>% filter(game_id == max(game_id)),
    aes(x = 0, y = 100, label = streak_id),
    position = position_nudge(x = -2),
    hjust = 1,
    family = "Chivo", fontface = "bold",
    color = "darkgrey"
  ) +
  geom_text(
    data = plot_df %>% filter(game_id == 1),
    aes(x = 0, y = 100, label = team),
    position = position_nudge(x = -25),
    hjust = 0,
    family = "Chivo", fontface = "bold",
    color = "darkgrey"
  ) +
  geom_text(
    data = plot_df %>% group_by(team) %>% filter(ratio == max(ratio)),
    aes(
      x = 250,
      y = 100,
      label = scales::percent(ratio, accuracy = 1),
      color = I(
        scales::col_numeric(
          c("#fd1b22", "lightgrey", "#003775"), 
          domain = c(0:1)
          )(ratio))
    ),
    family = "Chivo", fontface = "bold",
    position = position_nudge(x = 1),
    hjust = 1
  ) +
  ggtext::geom_richtext(
    inherit.aes = FALSE,
    data = label_df,
    aes(x = x, y = y, label = label),
    position = position_nudge(x = c(-28, -10, 5)),
    vjust = 0,
    hjust = 0, fontface = "bold",
    family = "Chivo",
    fill = NA,
    label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt") # remove padding
  ) +
  coord_cartesian(xlim = c(-16, 241), clip = "off") +
  scale_x_continuous(
    breaks = seq(0, 240, by = 16)
  ) +
  facet_wrap(~team, ncol = 1) +
  geom_hline(yintercept = 0, color = "#ECECEC") +
  theme_minimal() +
  labs(
    x = "Regular season games since 2006",
    y = "",
    title = "Consecutive starts in a row",
    subtitle = "Total consecutive QB starts for a single team since 2006",
    caption = "Data: PFF | Plot: @thomas_mock"
  ) +
  theme(
    text = element_text(family = "Chivo"),
    strip.text = element_blank(),
    axis.text.y = element_blank(),
    panel.background = element_rect(fill = "white", color = "transparent"),
    plot.background = element_rect(fill = "white"),
    panel.grid.minor = element_blank(),
    panel.grid.major.y = element_blank(),
    plot.margin = margin(l = 35, t = 25, b = 25, r = 20),
    plot.title = element_text(size = 26, face = "bold"),
    plot.subtitle = element_text(margin = margin(b = 45), size = 16),
    axis.title.x = element_text(
      margin = margin(t = 20, b = 5),
      face = "bold"
      )
    
  )

ex_plot

ggsave("ex-plot.png", ex_plot, height = 16, width = 10, dpi = 500)

basic_plot <- plot_df %>%
  filter(game_id <= 240) %>%
  ggplot(aes(x = game_id, y = fct_rev(team))) +
  geom_density_ridges(
    aes(height = streak_id),
    stat = "identity",
    scale = 0.85,
    color = "transparent",
    fill = "blue"
  ) +
  geom_text(
    data = filter(plot_df, game_id == max(game_id)),
    aes(x = -16, y = fct_rev(team), label = streak_id)
  ) +
  theme_minimal() +
  scale_x_continuous(
    breaks = seq(0, 240, by = 16),
    limits = c(-16, 240)
  ) +
  theme(panel.grid.minor = element_blank(), panel.grid.major.y = element_blank())

basic_plot
# ggridges::geom_ridgeline(aes(height = streak_id), scale = 0.0045)

basic_plot

ggsave("basic-plot.png", basic_plot, dpi = "retina", height = 15, width = 8)
x

d <- data.frame(
  x = rep(1:5, 3),
  y = c(rep(0, 5), rep(1, 5), rep(3, 5)),
  height = c(0, 1, 3, 4, 0, 1, 2, 3, 5, 4, 0, 5, 4, 4, 1)
)

ggplot(d, aes(x, y, height = height, group = y)) +
  geom_ridgeline(fill = "lightblue")

Ex: http://www.workout-wednesday.com/2021-week-34-how-many-consecutive-starts/
Ex: https://public.tableau.com/app/profile/stanke/viz/WorkoutWednesday2021Week34HowManyConsecutiveStartsinaRow/WW34QB1