016: ACC home records

gt tables
jitter plot
bar plots
Published

February 17, 2023

Make data

Code 
# function from hoopR to fetch data
# acc <- c("North Carolina", "Duke", "Wake Forest", "N.C. State", "Pittsburgh",
#        "Virginia Tech", "Georgia Tech", "Notre Dame", "Virginia", # "Boston College",
#        "Louisville", "Syracuse", "Clemson", "Florida St.", "Miami FL")

# acc_team <- function(id) {
# kp_team_schedule(team = id, year = 2023)
# }

# function to get ACC games 
# teams_acc <- lapply(acc, acc_team)

# build table of only conference games
# acc_results_2023 <- as.data.frame(do.call(rbind, teams_acc)) %>%
#           filter(conference_game == TRUE) %>%
#           filter(!is.na(w_conference)) %>%
#           mutate(full_result = str_split(result, ",", simplify = T),
#           points_for = str_split(full_result[,2], "-", simplify = T),
#           fr = full_result[,1],
#           pf = points_for[,1],
#           pa = points_for[,2]) %>%
#           select(game_date, game_id, team, opponent, location, fr, pf, pa) %>%
#           mutate(diff = as.numeric(pf) - as.numeric(pa),
#                     year = 2023) %>%
#           rename(result = fr, points_scored = pf, points_allowed = pa) %>%
#           filter(location == "Home")

# load csv to make it easier 
full_scores <- read_csv("acc_last_five_seasons_results.csv")

# make win prob table
win_pct <- tibble::tribble(
~Season,~WP,
2019,59.3,
2020,60.7,
2021,66.1,
2022,55.3,
2023,63.5,
)

# make close games data
close <- tibble::tribble(
~Season,~W,~L,~Pct,
2019,19,12,61.3,
2020,23,28,45.1,
2021,23,10,69.7,
2022,25,29,46.3,
2023,22,15,59.5,
)

# make home records by team
homew <- full_scores %>%
          filter(result == "W") %>%
          group_by(team, result) %>%
          count()

homel <- full_scores %>%
          filter(result == "L") %>%
          group_by(team, result) %>%
          count()

homers <- merge(homew, homel, by = "team")

acc_by_team <- homers %>%
               rename(W = n.x, L = n.y) %>%
               mutate(team = case_match(team,
                "Florida St." ~ "Florida State",
                "N.C. State" ~ "NC State",
                team ~ team
                )) %>%
               mutate(win_pct = round(W / (W+L), 3),
                logo = team) %>%
               select(logo, team, W, L, win_pct) %>%
               arrange(-win_pct)

Set the themes for plots

Code 
# theme
  theme_me <- function () {
    theme_minimal(base_size = 10, base_family = "RobotoCondensed-Regular") %+replace%
      theme (
        plot.title = element_text(
          hjust = 0.5,
          size = 24,
          face = "bold"
        ),
        plot.subtitle = element_text(
          hjust = 0.5,
          size = 10,
          lineheight = 0.25,
          vjust = -0.5
        ),
        plot.caption = element_text(
          hjust = 1,
          size = 6,
          lineheight = 0.35,
          margin = margin(t = 20)
        ),
        panel.grid.minor = element_blank(),
        plot.background = element_rect(fill = "floral white", color = "floral white")
      )
  }

Make gt tables

Code 
close_table <- close %>%
  arrange(-Season) %>%
  gt() %>%
  cols_label(# rename columns
    Pct = "Win %",) %>%
  fmt_number(columns = Pct,
             decimals = 1,
             use_seps = FALSE) %>%
  gt_theme_dot_matrix() %>%
  tab_header(title = md("ACC home team record in games decided by 5 or fewer points")) %>%
  tab_source_note(source_note = "@dadgumboxscores | February 17, 2023 | data via kenpom") %>%
  tab_options (
    source_notes.font.size = px(10),
    row.striping.background_color = '#ffffed',
    table.font.size = px(10),
    column_labels.text_transform = 'capitalize'
  )

gtsave_extra(close_table,
             "close_g_table.png",
             vwidth = 275,
             vheight = 275)

close_table
ACC home team record in games decided by 5 or fewer points
Season W L Win %
2023 22 15 59.5
2022 25 29 46.3
2021 23 10 69.7
2020 23 28 45.1
2019 19 12 61.3
@dadgumboxscores | February 17, 2023 | data via kenpom
Code 
rec_table <- acc_by_team %>%
  gt() %>%
  cols_label(# rename columns
    logo = "",
    team = "Team",
    win_pct = "Win %",) %>%
  gt_fmt_cfb_logo(columns = "logo") %>%
  tab_header(title = "ACC Home records by team since 2018-19 season",) %>%
  tab_source_note(source_note = "@dadgumboxscores | February 17, 2023 | data via kenpom")  %>%
  # adjust font sizes
  tab_options (source_notes.font.size = px(10),
               table.font.size = px(12),
  ) %>%
  # add theme using 538
  gt_theme_excel()

gtsave_extra(rec_table,
             "rec_table.png",
             vwidth = 650,
             vheight = 650)

rec_table
ACC Home records by team since 2018-19 season
Team W L Win %
Virginia 36 8 0.818
Duke 36 9 0.800
Florida State 35 10 0.778
North Carolina 32 12 0.727
Clemson 32 14 0.696
Virginia Tech 27 16 0.628
Syracuse 26 18 0.591
Miami FL 26 20 0.565
Louisville 24 19 0.558
Wake Forest 24 21 0.533
Georgia Tech 24 23 0.511
Notre Dame 23 22 0.511
NC State 22 22 0.500
Pittsburgh 22 24 0.478
Boston College 18 26 0.409
@dadgumboxscores | February 17, 2023 | data via kenpom

Make the bar plot

Code 
wp_plot <- win_pct %>%
  mutate(color = case_match(Season,
                            2023 ~ "#c994c7",
                            .default = "#acacac")) %>%
  arrange(-Season) %>%
  ggplot(aes(Season, WP, fill = color)) +
  geom_col(width = 0.5) +
  geom_text(aes(label = paste0(WP, "%"), hjust = 1.5),
            color = "#333333",
            size = 6) +
  coord_flip() +
  scale_y_continuous(breaks = seq(0, 70, 10), limits = c(0, 70)) +
  labs(
    x = "",
    y = "",
    title = "ACC <span style='color:#c994c7;'>Home</span> win percentage by season",
    caption = "dadgumboxscores | February 17, 2023 | data via kenpom"
  ) +
  theme_me() +
  scale_fill_identity(guide = "none") +
  theme(plot.title = element_textbox_simple(), axis.text = element_text(size = 12)) +
  annotate(
    "text",
    x = 2021,
    y = 30,
    label = "121 games \n COVID (empty arenas)",
    family = "Chalkboard Bold",
    size = 3,
    fontface = "bold",
    color = "#333333",
  ) +
  annotate(
    "text",
    x = 2020,
    y = 30,
    label = "150 games \n 10 home games for each team",
    family = "Chalkboard Bold",
    size = 3,
    fontface = "bold",
    color = "#333333",
  ) +
  annotate(
    "text",
    x = 2022,
    y = 30,
    label = "150 games",
    family = "Chalkboard Bold",
    size = 3,
    fontface = "bold",
    color = "#333333",
  ) +
  annotate(
    "text",
    x = 2023,
    y = 30,
    label = "115 games \n ~45 games remaining",
    family = "Chalkboard Bold",
    size = 3,
    fontface = "bold",
    color = "#333333",
  ) +
  annotate(
    "text",
    x = 2019,
    y = 30,
    label = "135 games \n 9 home games for each team",
    family = "Chalkboard Bold",
    size = 3,
    fontface = "bold",
    color = "#333333",
  )


ggsave(
  "wp.png",
  wp_plot,
  w = 7.5,
  h = 7.5,
  dpi = 600,
  type = 'cairo'
)

wp_plot

Make the jitter plot

Code 
acc_plot <- full_scores %>%
  ggplot(x = year) +
  geom_jitter(
    data = full_scores %>% filter(result == "L"),
    mapping = aes(y = diff, x = year),
    stroke = 0.8,
    color = "#e41a1c",
    size = 3,
    shape = 1
  ) +
  geom_jitter(
    data = full_scores %>% filter(result == "W"),
    mapping = aes(y = diff, x = year),
    stroke = 0.8,
    fill = "#4daf4a",
    size = 3,
    shape = 21
  ) +
  geom_hline(
    yintercept = c(5, 10, 20, 30, 40),
    linetype = 'dashed',
    color = "#acacac"
  ) +
  geom_vline(
    xintercept = c(2019.5, 2020.5, 2021.5, 2022.5),
    linetype = 'dashed',
    color = "#acacac"
  ) +
  coord_flip() +
  scale_y_continuous(breaks = seq(0, 50, 5), limits = c(0, 50)) +
  theme_me() +
  theme(legend.position = "none", plot.title = element_markdown()) +
  labs(
    x = "",
    y = "Point differential",
    title = "ACC games point differential by season  \nhome team: <span style='color:#4daf4a;'>win</span> | <span style='color:#e41a1c;'>loss</span>",
    caption = "dadgumboxscores | February 17, 2023 | data via kenpom + hoopR"
  ) +
  annotate(
    geom = 'text',
    y = 47.5,
    x = 2023.5,
    label = "Home win %",
    fontface = 'bold',
    colour = "#4daf4a",
    size = 4,
  ) +
  annotate(
    geom = 'text',
    y = 47.5,
    x = 2023,
    label = "63.5%",
    fontface = 'bold',
    colour = "#333333",
    size = 4,
  ) +
  annotate(
    geom = 'text',
    y = 47.5,
    x = 2022,
    label = "55.3%",
    fontface = 'bold',
    colour = "#333333",
    size = 4,
  ) +
  annotate(
    geom = 'text',
    y = 47,
    x = 2021,
    label = "66.1% (COVID)",
    fontface = 'bold',
    colour = "#333333",
    size = 4,
  ) +
  annotate(
    geom = 'text',
    y = 47.5,
    x = 2020,
    label = "60.7%",
    fontface = 'bold',
    colour = "#333333",
    size = 4,
  ) +
  annotate(
    geom = 'text',
    y = 47.5,
    x = 2019,
    label = "59.3%",
    fontface = 'bold',
    colour = "#333333",
    size = 4,
  )

ggsave(
  "acc_plot.png",
  acc_plot,
  w = 7.5,
  h = 7.5,
  dpi = 600,
  type = 'cairo'
)

acc_plot