139: Game flow

geom_smooth
gt
nano_plots
cowplot
Published

April 9, 2025

Load data for decades

Code 
library(rlang)
library(cbbplotR)
options(chromote.headless = "new")

# ------- Decades data

# ---------- UNC data 
unc <- readr::read_csv("unc_data.csv")

# manually add in other numbers from sports-refernece and wikipedia 

unc_acct <- c(1981, 1982, 1989, 1991, 1994, 1997, 1998, 2007, 2008, 2016)

unc_rs <- c(1982, 1983, 1984, 1985, 1987, 1988, 1993, 1995, 2001, 2005, 
        2007, 2008, 2009, 2011, 2012, 2016, 2017, 2019, 2024)

unc_f4 <- c(1981, 1982, 1991, 1993, 1995, 1997, 1998, 2000, 2005, 2008, 2009, 2016, 2017, 2022)

unc_titles <- c(1982, 1993, 2005, 2009, 2017)
         
# function to count by decade 
convert_to_decade <- function(years) {
  paste0(floor(years / 10) * 10, "s")
}

unc_decade_counts <- data.frame(
  Decade = unique(c(convert_to_decade(unc_acct), convert_to_decade(unc_rs), convert_to_decade(unc_f4), convert_to_decade(unc_titles)))
) |>
  dplyr::mutate(
    ACCT = sapply(Decade, function(d) sum(convert_to_decade(unc_acct) == d)),
    RS = sapply(Decade, function(d) sum(convert_to_decade(unc_rs) == d)),
    F4 = sapply(Decade, function(d) sum(convert_to_decade(unc_f4) == d)),
    Titles = sapply(Decade, function(d) sum(convert_to_decade(unc_titles) == d)),
  ) |>
  dplyr::arrange(Decade)

# summarize the data
unc_summary <- unc |>
  dplyr::filter(Year > 1979) |> 
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Total_Wins = sum(W...6, na.rm = TRUE),
    Total_Losses = sum(L, na.rm = TRUE),
    Win_Percentage = Total_Wins / (Total_Wins + Total_Losses)
  ) |>
  dplyr::arrange(Decade)

# summarize the win percentages in a list 
unc_with_decade <- unc |>
  dplyr::filter(Year > 1979) |> 
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Yearly_Win_Pcts = list(rev(winpct))  # Store win percentages as a list per decade
  ) |>
  dplyr::arrange(Decade)

# all the tables 
unc_hist <- unc_summary |> 
  dplyr::left_join(unc_decade_counts, by = "Decade") |> 
  dplyr::left_join(unc_with_decade, by = "Decade") |> 
  dplyr::mutate(team = "North Carolina",
                team_two = "North Carolina")

# State --------------------
state <- readr::read_csv("state.csv")

st_acct <- c(1983, 1987, 2024)

st_rs <- c(1985, 1989)

st_f4 <- c(1983, 2024)

st_titles <- c(1983)

st_decade_counts <- data.frame(
  Decade = unique(c(convert_to_decade(st_acct), convert_to_decade(st_rs), convert_to_decade(st_f4), convert_to_decade(st_titles)))
) |>
  dplyr::mutate(
    ACCT = sapply(Decade, function(d) sum(convert_to_decade(st_acct) == d)),
    RS = sapply(Decade, function(d) sum(convert_to_decade(st_rs) == d)),
    F4 = sapply(Decade, function(d) sum(convert_to_decade(st_f4) == d)),
    Titles = sapply(Decade, function(d) sum(convert_to_decade(st_titles) == d)),
  ) |>
  dplyr::arrange(Decade)

# summarize the data
state_summary <- state |>
  dplyr::mutate(
    Wins = as.numeric(wins),
    Losses = as.numeric(losses)
  ) |> 
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Total_Wins = sum(Wins),
    Total_Losses = sum(Losses),
    Win_Percentage = Total_Wins / (Total_Wins + Total_Losses)
  ) |>
  dplyr::arrange(Decade)

# summarize the win percentages in a list 
state_with_decade <- state |>
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Yearly_Win_Pcts = list(rev(winpct))  # Store win percentages as a list per decade
  ) |>
  dplyr::arrange(Decade)

# all the tables 
state_hist <- state_summary |> 
  dplyr::left_join(st_decade_counts, by = "Decade") |> 
  dplyr::left_join(state_with_decade, by = "Decade") |> 
  dplyr::mutate(team = "North Carolina St.",
                team_two = "North Carolina St.")

# Duke 
duke <- readr::read_csv("duke.csv")

duke_acct <- c(1980, 1986, 1988, 1992, 1999, 2000, 2001, 2002, 2003, 2005, 2006, 
          2009, 2010, 2011, 2017, 2019, 2023, 2025)

duke_rs <- c(1986, 1991, 1992, 1994, 1997, 1998, 1999, 2000, 2001, 2004, 2006, 
        2010, 2022, 2025)

duke_f4 <- c(1986, 1988, 1989, 1990, 1991, 1992, 1994, 1999, 2001, 2004,
        2010, 2015, 2022, 2025)

duke_titles <- c(1991, 1992, 2001, 2010, 2015)

convert_to_decade <- function(years) {
  paste0(floor(years / 10) * 10, "s")
}

duke_decade_counts <- data.frame(
  Decade = unique(c(convert_to_decade(duke_acct), convert_to_decade(duke_rs), convert_to_decade(duke_f4), convert_to_decade(duke_titles)))
) |>
  dplyr::mutate(
    ACCT = sapply(Decade, function(d) sum(convert_to_decade(duke_acct) == d)),
    RS = sapply(Decade, function(d) sum(convert_to_decade(duke_rs) == d)),
    F4 = sapply(Decade, function(d) sum(convert_to_decade(duke_f4) == d)),
    Titles = sapply(Decade, function(d) sum(convert_to_decade(duke_titles) == d)),
  ) |>
  dplyr::arrange(Decade)

# summarize the data
duke_summary <- duke |>
  dplyr::mutate(
    Wins = as.numeric(wins),
    Losses = as.numeric(losses)
  ) |> 
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Total_Wins = sum(Wins),
    Total_Losses = sum(Losses),
    Win_Percentage = Total_Wins / (Total_Wins + Total_Losses)
  ) |>
  dplyr::arrange(Decade)

# summarize the win percentages in a list 
duke_with_decade <- duke |>
  dplyr::mutate(
    Decade = paste0(floor(Year / 10) * 10, "s")  # Convert Year to decade format
  ) |>
  dplyr::group_by(Decade) |>
  dplyr::summarize(
    Yearly_Win_Pcts = list(rev(winpct))  # Store win percentages as a list per decade
  ) |>
  dplyr::arrange(Decade)

# all the tables 
duke_hist <- duke_summary |> 
  dplyr::left_join(duke_decade_counts, by = "Decade") |> 
  dplyr::left_join(duke_with_decade, by = "Decade") |> 
  dplyr::mutate(team = "Duke", team_two = "Duke")

# --------------------------------------------- 

all_hist <- unc_hist |> 
  dplyr::bind_rows(state_hist, duke_hist) |> 
  dplyr::relocate(team)

Triangle decades table

Code 
tri_header <- glue::glue(
  "<div style='display: flex; justify-content: space-between; align-items: center;'>
      <div>
       <img src='https://a.espncdn.com/combiner/i?img=/redesign/assets/img/icons/ESPN-icon-basketball.png'
       style='height: 45px; width: auto; vertical-align: middle;'>
     </div>
     <div style='flex-grow:1; margin-left: 30px; margin-right: 30px'>
       <span style='display: block; font-weight: bold; text-align: center; font-size: 24px;'>Triangle hoops over the past five decades</span>
       <span style='font-size: 12.5px; font-weight: normal; display: block; text-align: center;'>Performance across the ACC, NCAA Tournament, and overall win percentage.</span>
     </div>
     <div>
       <img src='https://a.espncdn.com/combiner/i?img=/redesign/assets/img/icons/ESPN-icon-basketball.png' 
       style='height: 45px; width: auto; vertical-align: middle;'>
     </div>
   </div>
  <br>"
)


decade_tbl <- all_hist |> 
  dplyr::mutate(
    dplyr::across(
      where(is.numeric),
      ~ tidyr::replace_na(.x, 0)
    )
  ) |> 
  dplyr::arrange(Decade, -Titles, -Win_Percentage) |> 
  dplyr::mutate(record = paste0(Total_Wins, "-", Total_Losses)) |> 
  dplyr::relocate(Win_Percentage, .after = Titles) |>
  dplyr::mutate(
    Titles = dplyr::case_when(
      Titles %% 1 == 0 ~ strrep("trophy,", Titles),
      Titles %% 1 != 0 ~ paste0(strrep("trophy,", floor(Titles)), "trophy"))
  ) |> 
  cbbplotR::gt_cbb_teams(team, team, include_name = FALSE) |> 
  cbbplotR::gt_cbb_teams(team_two, team_two, include_name = FALSE) |> 
  dplyr::group_by(Decade) |> 
  gt::gt() |> 
  gt::fmt_markdown(team) |> 
  gt::fmt_markdown(team_two) |> 
  gtUtils::gt_theme_gtutils() |> 
  gt::fmt_icon(
    columns = c(Titles),
    rows = c(1, 2, 4, 5, 7, 8, 10, 11),
    fill_color = "orange"
  ) |> 
  gt::cols_hide(columns = c(Total_Wins, Total_Losses)) |> 
  gt::fmt_number(Win_Percentage, decimals = 3) |> 
  gtExtras::gt_merge_stack(
    col1 = Win_Percentage,
    col2 = record,
    palette = c("black", "#333333")
  ) |> 
  gtUtils::gt_column_subheaders(
    Win_Percentage = list(heading = "Win %", subtitle = "W-L"),
    ACCT = list(heading = "Titles", subtitle = "Tournament"),
    RS = list(heading = "Regular", subtitle = "Season"),
    F4 = list(heading = "Final Fours", subtitle = "# of times"),
    Titles = list(heading = "Titles", subtitle = "# of titles"),
    heading_color = "black",
    subtitle_color = "gray"
  ) |> 
  gt::cols_label(team = "", team_two = "") |> 
  gt::tab_spanner(
    columns = c(ACCT, RS),
    label = "ACC Championships"
  ) |> 
  gt::tab_spanner(
    columns = c(F4, Titles),
    label = "NCAA Tournament"
  ) |> 
  gt::cols_label(
    Decade = ""
  ) |> 
  gt::cols_nanoplot(
    columns = Yearly_Win_Pcts,
    reference_line = .70,
    autohide = TRUE,
    plot_type = "line",
    new_col_label = "Over time",
    before = "team_two",
    options = gt::nanoplot_options(
      data_area_fill_color = "#C5C5FF",
      reference_line_color = "#333333",
      show_data_area = TRUE,
      show_data_points = FALSE
    )
  ) |> 
  gt::tab_header(title = gt::html(tri_header)) |>
  gt::tab_source_note(source_note = gt::html("<hr>Over time column shows win percentage by season throughout the decade (dashed line indicates a .700 win percentage)<br>Data grouped by each decade, and sorted by National titles first, and win percentage second <br>Decades include the season's final year (i.e. 2009-10 is part of the 2010s)<hr><br><b>Table by Chris at Bless your Chart | data via sports-reference.com | April 9, 2025</b>")) |> 
  gt::data_color(
    columns = c(ACCT, RS, F4, Win_Percentage),
    direction = c("column"),
    method = c("numeric"),
    palette = c("#d7191c", "#fdae61", 
                "#ffffbf", "#a6d96a", 
                "#1a9641"),
    alpha = 0.6
  ) |>
  gt::cols_align(team, align = "right") |> 
  gt::tab_style(
    locations = gt::cells_column_labels(),
    style = gt::cell_text(
      font = gt::google_font("Signika Negative"),
      weight = "650",
      size = gt::px(14)
    )
  ) |> 
  gt::tab_style(
    locations = gt::cells_body(columns = Decade),
    style = gt::cell_text(
      font = gt::google_font("Signika Negative"),
      weight = "bold"
    )
  ) |> 
  gt::tab_style(
    locations = gt::cells_column_spanners(),
    style = gt::cell_text(
      font = gt::google_font("Signika Negative"),
      weight = 850,
      size = gt::px(14)
    )
  ) |>
  gt::tab_style(
    locations = gt::cells_source_notes(),
    style = gt::cell_text(
      font = gt::google_font("Signika Negative"),
      size = gt::px(11.5),
      weight = 250
    )
  ) |>
  gt::tab_style(
    locations = gt::cells_row_groups(),
    style = list(
      gt::cell_text(
        font = gt::google_font("Signika Negative"),
        weight = 850,
        size = gt::px(16),
        color = "black",
        align = "left"
      ),
      gt::cell_fill(
        color = "#C5C5FF"
      )
    )
  ) |> 
  gt::tab_style(
    style = list(
      gt::cell_text(font = gt::google_font("Signika Negative")
      )
    ),
    locations = gt::cells_body(
      columns = c(team)
    )
  ) |> 
  gtUtils::gt_border_grid(color = "black",
                          weight = 1.5,
                          include_labels = FALSE) |> 
  gtUtils::gt_border_bars_bottom(c("#012169", "#56a0d3", "#CC0000")) |> 
  gt::tab_options(table.width = gt::px(600))


gtUtils::gt_save_crop(
  decade_tbl,
  file = "tri_decade_tbl.png",
  whitespace = 60,
  bg = "#FFFDF5"
)

decade_tbl
Triangle hoops over the past five decades Performance across the ACC, NCAA Tournament, and overall win percentage.

ACC Championships NCAA Tournament
Win %
W-L
Over time
Titles
Tournament
Regular
Season
Final Fours
# of times
Titles
# of titles
1980s

3 6 2 Trophy
0.817
281-63
0.70 0.94 0.70 0.72 0.78 0.94 0.78 0.90 0.75 0.82 0.89 0.79 0.78

2 2 1 Trophy
0.657
211-110
0.70 0.75 0.52 0.71 0.52 0.69 0.72 0.58 0.70 0.62 0.57 0.75 0.71

3 1 3
0.691
226-101
0.70 0.92 0.37 0.73 0.57 0.37 0.39 0.71 0.74 0.92 0.73 0.80 0.78

1990s

2 6 5 Trophy Trophy
0.777
271-78
0.70 0.95 0.42 0.76 0.82 0.94 0.75 0.82 0.42 0.58 0.73 0.89 0.95

4 2 5 Trophy
0.776
270-78
0.70 0.90 0.62 0.62 0.83 0.70 0.90 0.80 0.82 0.66 0.80 0.90 0.71

0 0 0
0.492
149-154
0.70 0.70 0.30 0.60 0.64 0.40 0.30 0.37 0.44 0.48 0.53 0.53 0.58

2000s

2 5 4 Trophy Trophy
0.728
251-94
0.70 0.92 0.29 0.61 0.79 0.29 0.54 0.63 0.89 0.74 0.82 0.92 0.90

7 4 2 Trophy
0.829
291-60
0.70 0.90 0.67 0.85 0.90 0.89 0.79 0.84 0.82 0.89 0.67 0.82 0.81

0 0 0
0.585
189-134
0.70 0.70 0.45 0.59 0.45 0.68 0.58 0.68 0.60 0.69 0.56 0.48 0.53

2010s

4 1 2 Trophy Trophy
0.810
299-70
0.70 0.90 0.69 0.88 0.86 0.79 0.83 0.74 0.90 0.69 0.76 0.78 0.84

1 5 2 Trophy
0.743
277-96
0.70 0.84 0.54 0.54 0.78 0.84 0.69 0.71 0.68 0.82 0.82 0.70 0.81

0 0 0
0.588
203-142
0.70 0.70 0.47 0.56 0.48 0.65 0.69 0.61 0.61 0.48 0.47 0.64 0.67

2020s

2 2 2
0.776
159-46
0.70 0.90 0.54 0.81 0.54 0.82 0.75 0.75 0.90

0 1 1
0.639
133-75
0.70 0.78 0.42 0.42 0.62 0.74 0.61 0.78 0.62

1 0 1
0.544
106-89
0.70 0.70 0.34 0.62 0.56 0.34 0.68 0.63 0.39

Over time column shows win percentage by season throughout the decade (dashed line indicates a .700 win percentage)
Data grouped by each decade, and sorted by National titles first, and win percentage second
Decades include the season's final year (i.e. 2009-10 is part of the 2010s)

Table by Chris at Bless your Chart | data via sports-reference.com | April 9, 2025

Game flow plot

Code 
# schedule <- bigballR::get_team_schedule(team.name="Houston",season="2024-25")

# pbp_hou <- bigballR::get_play_by_play(schedule$Game_ID[40])

pbp_hou <- readr::read_csv("pbp_houston.csv")

# set teams 
home_team <- "Houston"
away_team <- "Florida"
home_col <- "#C8102E"
away_col <- "#0021A5"

score_data <- pbp_hou |>
  dplyr::select(Game_Seconds, Home_Score, Away_Score) |>
  dplyr::distinct() |>
  dplyr::rename(secs_elapsed = Game_Seconds) |>
  tidyr::pivot_longer(
    cols = c(Home_Score, Away_Score),
    names_to = "team",
    values_to = "score"
  ) |>
  dplyr::mutate(
    team = dplyr::case_when(
      team == "Home_Score" ~ "Houston",
      team == "Away_Score" ~ "Florida"
    )
  )

# Field Goal Attempt data
fga_data <- pbp_hou |>
  dplyr::filter(Event_Type %in% c("Three Point Jumper", "Two Point Jumper", "Layup", "Hook", "Dunk")) |>
  dplyr::mutate(team = dplyr::case_when(
    Event_Team == home_team ~ home_team,
    Event_Team == away_team ~ away_team
  )) |>
  dplyr::group_by(team) |>
  dplyr::arrange(Game_Seconds, .by_group = TRUE) |>
  dplyr::mutate(fga_count = dplyr::row_number()) |>
  dplyr::ungroup() |>
  dplyr::rename(secs_elapsed = Game_Seconds)

# Foul data
foul_data <- pbp_hou |>
  dplyr::filter(Event_Type == "Commits Foul") |>
  dplyr::mutate(team = dplyr::case_when(
    Event_Team == home_team ~ home_team,
    Event_Team == away_team ~ away_team
  )) |>
  dplyr::group_by(team) |>
  dplyr::arrange(Game_Seconds, .by_group = TRUE) |>
  dplyr::mutate(foul_count = dplyr::row_number()) |>
  dplyr::ungroup() |>
  dplyr::rename(secs_elapsed = Game_Seconds)

# Turnovers
to_data <- pbp_hou |>
  dplyr::filter(Event_Type == "Turnover") |>
  dplyr::mutate(team = dplyr::case_when(
    Event_Team == home_team ~ home_team,
    Event_Team == away_team ~ away_team
  )) |>
  dplyr::group_by(team) |>
  dplyr::arrange(Game_Seconds, .by_group = TRUE) |>
  dplyr::mutate(foul_count = dplyr::row_number()) |>
  dplyr::ungroup() |>
  dplyr::rename(secs_elapsed = Game_Seconds)

# theme
my_theme <- function() {
  hrbrthemes::theme_ipsum(
    base_family = "Roboto Condensed",
    grid = "Y",
    plot_title_size = 16,
    subtitle_size = 12,
    axis_title_size = 14,
    base_size = 12
  ) +
    ggplot2::theme(
      plot.title = ggplot2::element_text(hjust = 0.5, face = "bold"),
      plot.subtitle = ggplot2::element_text(hjust = 0.5),
      axis.title = ggplot2::element_text(),
      plot.caption = ggplot2::element_text(size = 8),
      legend.position = "none",
      panel.grid.major.x = ggplot2::element_blank(),
      panel.grid.minor.x = ggplot2::element_blank(),
      plot.background = ggplot2::element_rect(fill = "white", color = "white")
    )
}

# Score Plot
score_plot <- ggplot2::ggplot(score_data, ggplot2::aes(x = secs_elapsed / 60, y = score, color = team)) +
  ggplot2::geom_line(size = 1) +
  ggplot2::labs(
    x = "Minutes",
    y = "",
    color = "",
    title = "Score"
  ) +
  my_theme() +
  ggplot2::scale_color_manual(
    values = c(Houston = home_col, Florida = away_col)
  ) +
  ggplot2::scale_x_continuous(
    breaks = seq(0, max(score_data$secs_elapsed, na.rm = TRUE) / 60, 5)
  ) +
  ggplot2::scale_y_continuous(
    breaks = seq(0, 70, 10), limits = c(0, 70)
  ) +
  ggplot2::geom_vline(xintercept = c(10, 20, 30),
                      linetype = "dashed",
                      color = "#acacac") +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 65,
    team = "Florida",
    height = .055
  ) +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 61,
    team = "Houston",
    height = .055
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 65,
    color = away_col,
    label = "65",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 61,
    color = home_col,
    label = "63",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 24.9,
    y = 27.6,
    color = away_col,
    label = "30",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 24.9,
    y = 46.5,
    color = home_col,
    label = "42",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "label",
    x = 37,
    y = 13.5,
    color = "#333333",
    fill = away_col,
    label = "Florida outscored  \nHouston 23-15  \nover last 10 minutes",
    size = 3,
    fontface = 'bold',
    family = 'Roboto condensed',
    alpha = 0.3
  ) 

# Field Goal Attempts Plot
fga_plot <- ggplot2::ggplot(score_data, ggplot2::aes(x = secs_elapsed / 60, y = score, color = team)) +
  ggplot2::geom_line(size = .75, alpha = 0.3) +
  ggplot2::labs(
    x = "Minutes",
    y = "",
    color = "",
    title = "Field goal attempts"
  ) +
  my_theme() +
  ggplot2::scale_color_manual(
    values = c(Houston = home_col, Florida = away_col)
  ) +
  ggplot2::scale_x_continuous(
    breaks = seq(0, max(score_data$secs_elapsed, na.rm = TRUE) / 60, 5)
  ) +
  ggplot2::scale_y_continuous(
    breaks = seq(0, 70, 10),  limits = c(0, 70)
  ) +
  ggplot2::geom_vline(xintercept = c(10, 20, 30),
                      linetype = "dashed",
                      color = "#acacac") +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 65,
    team = "Florida",
    height = .055
  ) +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 61,
    team = "Houston",
    height = .055
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 65,
    color = away_col,
    label = "65",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 61,
    color = home_col,
    label = "63",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 40,
    y = 53,
    color = away_col,
    label = "53",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 39.9,
    y = 69,
    color = home_col,
    label = "69",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::geom_step(
    data = fga_data,
    ggplot2::aes(x = secs_elapsed / 60, y = fga_count, color = team),
    size = 1
  ) +
  ggplot2::annotate(
    geom = "label",
    x = 5,
    y = 40,
    color = "#333333",
    fill = home_col,
    label = "Houston did not attempt  \na shot on its final  \n3 possessions",
    size = 3,
    fontface = 'bold',
    family = 'Roboto condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "curve",
    color = home_col,
    x = 5.5,
    y = 50,
    xend = 35,
    yend = 68,
    curvature = -.2,
    linewidth = 0.8,
    arrow = ggplot2::arrow(length = ggplot2::unit(2, "mm")),
    alpha = 0.3
  )

# Fouls Plot
foul_plot <- ggplot2::ggplot(score_data, ggplot2::aes(x = secs_elapsed / 60, y = score, color = team)) +
  ggplot2::geom_line(size = .75, alpha = 0.3) +
  ggplot2::labs(
    x = "Minutes",
    y = "",
    color = "",
    title = "Fouls"
  ) +
  my_theme() +
  ggplot2::scale_color_manual(
    values = c(Houston = home_col, Florida = away_col)
  ) +
  ggplot2::scale_x_continuous(
    breaks = seq(0, max(score_data$secs_elapsed, na.rm = TRUE) / 60, 5)
  ) +
  ggplot2::scale_y_continuous(
    breaks = seq(0, 70, 10),  limits = c(0, 70)
  ) +
  ggplot2::geom_vline(xintercept = c(10, 20, 30),
                      linetype = "dashed",
                      color = "#acacac") +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 65,
    team = "Florida",
    height = .055
  ) +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 61,
    team = "Houston",
    height = .055
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 65,
    color = away_col,
    label = "65",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 61,
    color = home_col,
    label = "63",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 39.5,
    y = 11,
    color = away_col,
    label = "11",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 40.9,
    y = 19,
    color = home_col,
    label = "19",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::geom_step(
    data = foul_data,
    ggplot2::aes(x = secs_elapsed / 60, y = foul_count, color = team),
    size = 1
  ) +
  ggplot2::annotate(
    geom = "label",
    x = 5,
    y = 50,
    color = "#333333",
    fill = away_col,
    label = "1st half  \nHouston 3, Florida 1  \n2nd half  \nHouston 16, Florida 10",
    size = 3,
    fontface = 'bold',
    family = 'Roboto condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "curve",
    color = away_col,
    x = 11,
    y = 50,
    xend = 25,
    yend = 11.5,
    curvature = -.4,
    linewidth = 0.8,
    arrow = ggplot2::arrow(length = ggplot2::unit(2, "mm")),
    alpha = 0.3
  )

# Turnovers Plot
to_plot <- ggplot2::ggplot(score_data, ggplot2::aes(x = secs_elapsed / 60, y = score, color = team)) +
  ggplot2::geom_line(size = .75, alpha = 0.3) +
  ggplot2::labs(
    x = "Minutes",
    y = "",
    color = "",
    title = "Turnovers"
  ) +
  my_theme() +
  ggplot2::scale_color_manual(
    values = c(Houston = home_col, Florida = away_col)
  ) +
  ggplot2::scale_x_continuous(
    breaks = seq(0, max(score_data$secs_elapsed, na.rm = TRUE) / 60, 5)
  ) +
  ggplot2::scale_y_continuous(
    breaks = seq(0, 70, 10),  limits = c(0, 70)
  ) +
  ggplot2::geom_vline(xintercept = c(10, 20, 30),
                      linetype = "dashed",
                      color = "#acacac") +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 65,
    team = "Florida",
    height = .055
  ) +
  ggplot2::annotate(
    cfbplotR::GeomCFBlogo,
    x = 40.9,
    y = 61,
    team = "Houston",
    height = .055
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 65,
    color = away_col,
    label = "65",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 42.5,
    y = 61,
    color = home_col,
    label = "63",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed',
    alpha = 0.3
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 31.5,
    y = 13,
    color = away_col,
    label = "13",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::annotate(
    geom = "text",
    x = 40.9,
    y = 9.5,
    color = home_col,
    label = "9",
    size = 4,
    fontface = 'bold',
    family = 'Roboto Condensed'
  ) +
  ggplot2::geom_step(
    data = to_data,
    ggplot2::aes(x = secs_elapsed / 60, y = foul_count, color = team),
    size = 1
  ) +
  ggplot2::annotate(
    geom = "label",
    x = 37,
    y = 30,
    color = "#333333",
    fill = home_col,
    label = "Houston  \n3 turnovers on \nfinal 3 possessions",
    size = 3,
    fontface = 'bold',
    family = 'Roboto condensed',
    alpha = 0.3
  ) 

# grid
plot_grid_main <- cowplot::plot_grid(
  score_plot, fga_plot,
  foul_plot, to_plot,
  ncol = 2, align = "hv"
)

# title
title_text <- cowplot::ggdraw() + 
  cowplot::draw_label(
    "Florida 65, Houston 63  \n2025 National Championship | April 7, 2025", 
    fontface = 'bold', 
    size = 16, 
    hjust = 0.5,
    fontfamily = "Roboto Condensed"
  )

# title to grid
plot_with_title <- cowplot::plot_grid(
  title_text,
  plot_grid_main,
  ncol = 1,
  rel_heights = c(0.1, 1)
)

# footer
footer_text <- cowplot::ggdraw() + 
  cowplot::draw_label(
    "data via bigballR, stats.ncaa.org | Viz by Chris at Bless your Chart", 
    size = 10, 
    hjust = 0.5, 
    fontfamily = "Roboto Condensed",
  )

final_plot <- cowplot::plot_grid(
  plot_with_title,
  footer_text,
  ncol = 1,
  rel_heights = c(1, 0.05)  # Footer is 5% height
)

final_plot

Code 
ggplot2::ggsave("florida_houston_championship.png", final_plot, width = 12, height = 9.5, dpi = 600, bg = "white")