105: Defense

gt
nanoplots
Published

August 27, 2024

Scrape cfbfastR for schedules and matrix

Code 
library(cbbplotR)
# cfbfastR::cfbd_team_info(year = 2024) |>
#  dplyr::rename(team = school) -> cfb_teams

# full_teams <- cfb_teams |> 
#  dplyr::pull(team)

# cfbfastR function to pull schedules for all teams
# sched <- function(team) {
#  result_list <- purrr::map(team, function(team) {
#    cfbfastR::cfbd_game_info(year = 2024,
#                             season_type = "regular",
#                             team = team) |>
#      dplyr::select(date = start_date, week, neutral_site, conference, conference_game, home_team, away_team) |>
#      tidyr::pivot_longer(
#        cols = c(home_team, away_team),
#        names_to = "home_away",
#        values_to = "opponent"
#      ) |>
#      dplyr::filter(opponent != team) |>
#      dplyr::mutate(team = team) |>
#      dplyr::mutate(home_away = dplyr::case_match(home_away, "away_team" ~ "home", "home_team" ~ "away")) |>
#      dplyr::mutate(home_away = dplyr::if_else(neutral_site == TRUE, "neutral", home_away)) |>
#      dplyr::select(date, team, week, conference_game, home_away, opponent)
    
#  })
  
 # combined_result <- dplyr::bind_rows(result_list)
  
#  return(combined_result)
# }

# loop through teams to fetch schedules 
# combined_result <- sched_win_totals(full_teams)

# cfbfastR::cfbd_team_info(year = 2024) |>
#     dplyr::select(opponent = school, opp_conf = conference) -> opp_confs

# join opponent conferences 
# full_sched <- combined_result |> 
#  dplyr::left_join(opp_confs, by = "opponent")

# write.csv(full_sched, "2024_sched.csv")

sched <- readr::read_csv("2024_sched.csv")

sched |> 
    dplyr::mutate(conf = dplyr::case_match(conf,
                                           "American Athletic" ~ "American",
                                           "Pac-12" ~ "Pac-2",
                                           "Conference USA" ~ "CUSA",
                                           "FBS Independents" ~ "INDIE",
                                           "Mid-American" ~ "MAC",
                                           "Mountain West" ~ "MW",
                                          conf ~ conf  )) |> 
    dplyr::mutate(opp_conf = dplyr::case_match(opp_conf,
                                           "American Athletic" ~ "American",
                                           "Pac-12" ~ "Pac-2",
                                           "Conference USA" ~ "CUSA",
                                           "FBS Independents" ~ "INDIE",
                                           "Mid-American" ~ "MAC",
                                           "Mountain West" ~ "MW",
                                           opp_conf ~ opp_conf  )) |> 
    dplyr::group_by(conf, opp_conf) |> 
    dplyr::summarise(
        opp = dplyr::n(),
        .groups = "drop"  # Explicitly drop the grouping
    ) |> 
    tidyr::pivot_wider(
        names_from = opp_conf,
        values_from = opp,
        values_fill = 0
    ) |> 
    dplyr::mutate(
        dplyr::across(
            -conf,
            ~ifelse(dplyr::cur_column() == conf, "-", as.character(.))
        )
    ) |> 
    dplyr::select(-`NA`)-> conferences

GT Table for conferences

Code 
conferences |> 
    gt::gt() |> 
    gtExtras::gt_theme_dot_matrix() |> 
    gt::tab_options (
        source_notes.font.size = gt::px(10),
        row.striping.background_color = '#EEEEEE',
        table.font.size = gt::px(12),
        column_labels.text_transform = 'uppercase'
    ) |>
    gt::tab_style(style = list(gt::cell_borders(
        sides = c("left"),
        color = "#eeeeee",
        weight = gt::px(2)
    )),
    locations = list(gt::cells_body(
        columns = gt::everything()
    ))) |> 
  gt::cols_label(
    conf = ""
  ) |> 
  gt::tab_header(title = gt::html("<b>Games Scheduled Between FBS Conferences in 2024</b><hr>")) |> 
  gt::tab_source_note(source_note = gt::html("Data via cfbfastR<br>
  <hr>
                                       <b>Table by Chris (@dadgumboxscores) + Bless your chart | August 28, 2024</b>"))-> conf_tbl 

gtExtras::gtsave_extra(conf_tbl, 
                       filename = "conf_tbl.png",
                       vwidth = 650,
                       expand = 10)
  
conf_tbl
Games Scheduled Between FBS Conferences in 2024
ACC American Big 12 Big Ten CUSA INDIE MAC MW Pac-2 SEC Sun Belt
ACC - 3 5 5 4 8 4 4 1 11 7
American 3 - 4 2 6 6 0 4 0 5 11
Big 12 5 4 - 4 1 0 1 8 1 4 2
Big Ten 5 2 4 - 2 3 9 6 3 4 3
CUSA 4 6 1 2 - 1 3 5 0 5 5
INDIE 8 6 0 3 1 - 8 0 0 4 1
MAC 4 0 1 9 3 8 - 1 0 7 4
MW 4 4 8 6 5 0 1 - 15 2 3
Pac-2 1 0 1 3 0 0 0 15 - 0 0
SEC 11 5 4 4 5 4 7 2 0 - 7
Sun Belt 7 11 2 3 5 1 4 3 0 7 -
Data via cfbfastR
Table by Chris (@dadgumboxscores) + Bless your chart | August 28, 2024

Historical SP+ data for UNC defense

Code 
total_def <- readr::read_csv("sp_historical.csv") |> 
  dplyr::filter(team == "North Carolina") |> 
  dplyr::filter(year > 1987) |> 
  dplyr::mutate(def_pctile =  readr::parse_number(def_pctile)) |> 
  dplyr::select(year, team, `Def. SP+`, def_pctile, def_rk = rank...11)

# now just do 2023 - by scraping 2023 SP+ 
  data <- readr::read_csv("2023-sp.csv")

# function to clean table and correct names 
# this is sort of sloppy and anti-dry (oh well)
clean_sp_table <- function(sp) {
  sp |> 
    dplyr::mutate(team = gsub("[^a-zA-Z]", "", team),
                  sp_rating = `SP+`,
                  sp_off_rating = stringr::str_extract(`Off. SP+`, "\\d+\\.?\\d*"),
                  sp_off_rk = stringr::str_extract(`Off. SP+`,
                                                         pattern = "(?<=\\().*(?=\\))"),
                  sp_def_rk = stringr::str_extract(`Def. SP+`,
                                                         pattern = "(?<=\\().*(?=\\))"),
                  sp_def_rating = stringr::str_extract(`Def. SP+`, "\\d+\\.?\\d*"),
                  sp_st_rk = stringr::str_extract(`ST SP+`,
                                                    pattern = "(?<=\\().*(?=\\))"),
                  sp_st_rating = stringr::str_extract(`ST SP+`, "\\d+\\.?\\d*"),
    ) |> 
    dplyr::mutate_at(c('sp_rating', 'sp_off_rating', 'sp_off_rk', 'sp_def_rk', 'sp_def_rating', 
                       'sp_st_rk', 'sp_st_rating'), as.numeric) |> 
    dplyr::mutate(
      # change names to be abbreviated
      team = dplyr::case_match(team,
                               'NCarolina' ~ 'North Carolina',
                               'OhioSt' ~ 'Ohio State',
                               'TexasAM' ~ 'Texas A&M',
                               'PennSt' ~ 'Penn State',
                               'IowaSt' ~ 'Iowa State',
                               'NotreDame' ~ 'Notre Dame',
                               'ArizonaSt' ~ 'Arizona State',
                               'OleMiss' ~ 'Ole Miss',
                               'MichiganSt' ~ 'Michigan State',
                               'NCSt' ~ 'NC State',
                               'MissSt' ~ 'Mississippi State',
                               'OklahomaSt' ~ 'Oklahoma State',
                               'KansasSt' ~ 'Kansas State',
                               'CoastalCaro' ~ 'Coastal Carolina',
                               'WakeForest' ~ 'Wake Forest',
                               'SanDiegoSt' ~ 'San Diego State',
                               'AppSt' ~ 'Appalachian State',
                               'BoiseSt' ~ 'Boise State',
                               'FloridaSt' ~ 'Florida State',
                               'FresnoSt' ~ 'Fresno State',
                               'VaTech' ~ 'Virginia Tech',
                               "WVirginia" ~ "West Virginia",
                               "TexasTech" ~ "Texas Tech",
                               "BostonColl" ~ "Boston College",
                               "JMU" ~ "James Madison",
                               "WKU" ~ "Western Kentucky",
                               "ECU" ~ "East Carolina", 
                               "OregonSt" ~ "Oregon State",
                               "WashSt" ~ "Washington State",
                               "AirForce" ~ "Air Force",
                               "ODU" ~ "Old Dominion", 
                               'GaTech' ~ 'Georgia Tech',
                               "SCarolina" ~ "South Carolina", 
                               "SanJoseSt" ~ "San Jose State",
                               "ColoradoSt" ~ "Colorado State",
                               "FAU" ~ "Florida Atlantic", 
                               "MTSU" ~ "Middle Tennessee",
                               "EMU" ~ "Eastern Michigan",
                               "MiamiOH" ~ "Miami (OH)",
                               "GeorgiaSt" ~ "Georgia State",
                               "UtahSt" ~ "Utah State",
                               "KentSt" ~ "Kent State",
                               "BallSt" ~ "Ball State",
                               "SAlabama" ~ "South Alabama",
                               "NIU" ~ "Northern Illinois",
                               "USF" ~ "South Florida", 
                               "LaTech" ~ "Louisiana Tech",
                               "NTexas" ~ "North Texas",  
                               "GaSouthern" ~ "Georgia Southern",
                               "NewMexico" ~ "New Mexico",   
                               "SoMiss" ~ "Southern Mississippi",
                               "TexasSt" ~ "Texas State",
                               "ArkansasSt" ~ "Arkansas State",   
                               "CMU" ~ "Central Michigan",
                               "ULM" ~ "Louisiana Monroe",
                               "BGSU" ~ "Bowling Green",
                               "WMU" ~ "Western Michigan",
                               "NMSU" ~ "New Mexico State",
                               "ULMonroe" ~ "Louisiana Monroe",
                               "Massachusetts" ~ "UMass",
                               "FIU" ~ "Florida International",
                               "KennesawSt" ~ "Kennesaw State",
                               "SamHouston" ~ "Sam Houston State",
                               "SJSU" ~ "San Jose State",
                               "SDSU" ~ "San Diego State",
                               "JvilleSt" ~ "Jacksonville State",
                               team ~ team
      )
    ) |> 
    dplyr::select(team_name = team, sp_rating, sp_off_rk, sp_off_rating, sp_def_rk, 
                  sp_def_rating, sp_st_rk, sp_st_rating) |> 
    dplyr::arrange(-sp_rating) |> 
    dplyr::mutate(sp_rk = dplyr::row_number()) |> 
    dplyr::relocate(sp_rk, .before = team_name)
}

sp <- clean_sp_table(sp = data)

unc_2023 <- sp |> 
  dplyr::mutate(def_pctile = dplyr::percent_rank(sp_def_rating) * 100,
                year = 2023) |> 
  dplyr::filter(team_name == "North Carolina") |> 
  dplyr::select(year, team = team_name, `Def. SP+` = sp_def_rating, def_pctile, def_rk = sp_def_rk)

unc_defense <- total_def |> 
  dplyr::bind_rows(unc_2023) |> 
  dplyr::mutate(
    coach = dplyr::case_when(
      year %in% c(1988:1997) ~ "Mack Brown 1.0",
      year %in% c(1998:2000) ~ "Carl Torbush",
      year %in% c(2001:2006) ~ "John Bunting",
      year %in% c(2007:2010) ~ "Butch Davis",
      year == 2011 ~ "Everett Withers",
      year %in% c(2012:2018) ~ "Larry Fedora",
      year %in% c(2019:2023) ~ "Mack Brown 2.0"
    )
  ) |> 
  dplyr::group_by(coach) |> 
  dplyr::summarise(
    avg_rtg = mean(`Def. SP+`),
    avg_pct = mean(def_pctile),
    sum_data = list(def_pctile),
  ) |> 
  dplyr::mutate(
    record = dplyr::case_when(
      coach == "Mack Brown 1.0" ~ "69-46",
      coach == "Carl Torbush" ~ "17-18",
      coach == "John Bunting" ~ "27-45",
      coach == "Butch Davis" ~ "28-23",
      coach == "Everett Withers" ~ "7-6",
      coach == "Larry Fedora" ~ "45-43",
      coach == "Mack Brown 2.0" ~ "38-27",
  ),
  win_pct =  dplyr::case_when(
      coach == "Mack Brown 1.0" ~ .600,
      coach == "Carl Torbush" ~ .486,
      coach == "John Bunting" ~ .375,
      coach == "Butch Davis" ~ .549,
      coach == "Everett Withers" ~ .539,
      coach == "Larry Fedora" ~ .511,
      coach == "Mack Brown 2.0" ~ .585,
  ),
    rank =  dplyr::case_when(
      coach == "Mack Brown 1.0" ~ 1,
      coach == "Carl Torbush" ~ 2,
      coach == "John Bunting" ~ 3,
      coach == "Butch Davis" ~ 4,
      coach == "Everett Withers" ~ 5,
      coach == "Larry Fedora" ~ 6,
      coach == "Mack Brown 2.0" ~ 8,
  ),
  tenure =  dplyr::case_when(
      coach == "Mack Brown 1.0" ~ "1988-1997",
      coach == "Carl Torbush" ~ "1998-2000",
      coach == "John Bunting" ~ "2001-2006",
      coach == "Butch Davis" ~ "2007-2010",
      coach == "Everett Withers" ~ "2011",
      coach == "Larry Fedora" ~ "2012-2018",
      coach == "Mack Brown 2.0" ~ "2019-Present",
  )
  ) |> 
  dplyr::arrange(-rank) |> 
  dplyr::mutate(win_pct = sprintf("%.3f", win_pct))

GT Table for UNC defenses with custom header

Code 
# prepare the table by grabbing the widest range and slimmest range 


custom_header <- glue::glue(
  "<div style='display: flex; justify-content: space-between; align-items: center;'>
      <div>
       <img src='https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/153.png'
       style='height: 55px; 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;'>North Carolina defense under each coach since 1988</span>
       <span style='font-size: 14px; font-weight: normal; display: block; text-align: center;'>Shows the defensive performance using SP+ ratings and percentiles since the 1988 season.</span>
     </div>
     <div>
       <img src='https://a.espncdn.com/combiner/i?img=/redesign/assets/img/icons/ESPN-icon-football-college.png' 
       style='height: 45px; width: auto; vertical-align: middle;'>
     </div>
   </div>
  <br>"
)

unc_defense |> 
    dplyr::relocate(rank, .before = coach) |> 
  dplyr::relocate(record, .before = avg_rtg) |>
  dplyr::relocate(win_pct, .before = avg_rtg) |> 
    gt::gt() |> 
  gt::cols_hide(rank) |> 
    gtExtras::gt_merge_stack(
    col1 = coach,
    col2 = tenure,
    palette = c("black", "#848484")
  ) |> 
  gtExtras::gt_merge_stack(
    col1 = record,
    col2 = win_pct,
    palette = c("black", "#848484")
  ) |> 
  gtExtras::gt_add_divider(columns = c(coach), 
                           sides = "right", color = "black") |> 
  gt::cols_label(
    coach = "Coach",
    record = "Overall Record",
    avg_rtg = "Rating",
    avg_pct = "Percentile",
    sum_data = "",
  ) |> 
  gt::tab_spanner(columns = c(avg_rtg, avg_pct, sum_data),
                  label = gt::html("SP+ Defense<br>Averages over tenure")) |>
   gt::cols_nanoplot(
        columns = sum_data,
        reference_line = 70,
        autohide = TRUE,
        plot_type = "line",
        new_col_label = "Performance",
        options = gt::nanoplot_options(
            data_area_fill_color = "#eabfff",
            reference_line_color = "#333333",
            show_data_area = TRUE,
            show_data_points = FALSE
        )
    ) |> 
  gt::fmt_number(columns = c(avg_rtg, avg_pct), decimals = 1) |> 
  gt::tab_header(title = gt::html(custom_header)) |>
  gt::tab_source_note(source_note = gt::html("<hr>
                                       Data from Bill Connelly's SP+ system | Theme from cbbplotR and logos from ESPN.com<br>
                                       Shows the average <b>defensive</b> SP+ rating and percentile over the coaching tenure.<br>                                       The <b>lower</b> average SP+ rating, the <b>better</b> the defense.<br>
                                       The dotted line is the <b>70th percentile</b> and the <b>higher</b> the percentile, the <b>better</b> the defense.<br>
                                       <hr>
                                       <b>Table by Chris (@dadgumboxscores) + Bless your chart | August 28, 2024</b>")) |> 
  cbbplotR::gt_theme_savant() |> 
   gt::tab_style(
    style = gt::cell_borders(sides = "top", color = 'black', weight = gt::px(1.5), style = 'solid'),
    locations = gt::cells_body(
      rows = gt::everything()
    )
  ) |> 
  gt::tab_style(
    style = list(
      gt::cell_text(color = "#333333", size = gt::px(12), weight = "bold"),
      gt::cell_borders(sides = "bottom", color = "black", weight = gt::px(2))
    ),
    locations = list(
      gt::cells_column_spanners(
        spanners = gt::everything()
      )
    )
  ) |> 
    gt::tab_options(
    heading.align = "center",
  ) -> unc_def_tbl

gtExtras::gtsave_extra(unc_def_tbl, 
                       filename = "unc_def_tbl.png",
                       vwidth = 750,
                       expand = 10)
  
unc_def_tbl
North Carolina defense under each coach since 1988 Shows the defensive performance using SP+ ratings and percentiles since the 1988 season.

Coach Overall Record SP+ Defense
Averages over tenure		 Performance
Rating Percentile
Mack Brown 2.0
2019-Present
38-27
0.585
27.8 50.5
70.0 70.0 31.8 64.3 51.2 31.8 47.1 58.3
Larry Fedora
2012-2018
45-43
0.511
27.2 54.0
70.0 79.1 17.5 49.6 79.1 27.6 71.5 76.4 56.0 17.5
Everett Withers
2011
7-6
0.539
23.0 67.4
70.0 80.9 53.9 67.4
Butch Davis
2007-2010
28-23
0.549
19.1 79.0
70.0 85.5 68.7 68.7 82.6 85.5 79.3
John Bunting
2001-2006
27-45
0.375
27.1 45.2
70.0 70.0 13.5 69.9 39.7 13.5 48.9 65.8 33.7
Carl Torbush
1998-2000
17-18
0.486
23.1 60.2
70.0 70.0 52.4 68.9 52.4 59.3
Mack Brown 1.0
1988-1997
69-46
0.600
18.8 67.3
70.0 97.5 10.6 10.6 39.7 87.8 77.0 63.8 72.4 54.1 73.1 97.5 96.9
Data from Bill Connelly's SP+ system | Theme from cbbplotR and logos from ESPN.com
Shows the average defensive SP+ rating and percentile over the coaching tenure.
The lower average SP+ rating, the better the defense.
The dotted line is the 70th percentile and the higher the percentile, the better the defense.
Table by Chris (@dadgumboxscores) + Bless your chart | August 28, 2024