It is not yet accompanied by a tutorial.

Source Code

The full source code can be found here.

This code works to recreate that visualization using ggplot2 and data from Sports Reference for Duke, North Carolina, Kentucky, Kansas, and UCLA players (the primary “Blue Bloods” of college basketball).

This is not yet accompanied by a tutorial.

Source Code

Full code can be found here.

Dealing with multiple tables in gt is a pain, whether it be with gt_two_column_layout or some messy htmltools hacking. A clever way to address this is to transform your data into a wide format before you pass it to gt. This tutorial covers the latter and teaches you how to add what I’m calling a “538-style” caption (two captions separated by a black line at the bottom of the table).

Using these ideas, we will be creating the table below – average team performance vs. top 100 opponents over the past five seasons in men’s college basketball.

The How

For this table, we will need:

library(tidyverse)
library(cbbdata)
library(cbbplotR)
library(gt)
library(gtExtras)
library(glue)
library(magick)

The Data

Grabbing the data

For this visualization, we will be pulling data from Barttorvik using the cbbdata package.

data <- cbd_torvik_game_stats() %>% 
  filter(year >= 2020) %>% 
  left_join(cbd_torvik_ratings_archive() %>% select(opp = team, date, barthag, rank)) %>%
  filter(rank <= 100) %>% 
  summarize(mean_score = mean(game_score), 
            games = n(),
            .by = team) %>% 
  filter(games >= 25) %>% 
  slice_max(mean_score, n = 100) %>% 
  arrange(desc(mean_score)) %>% 
  left_join(cbd_teams() %>% select(team = common_team, logo)) 

Let’s break this down, we’re:

1. Pulling game-level data for every contest over the past five seasons

2. Appending the opponent’s Barttorvik rank entering the game

3. Filtering to include games vs. opponents inside the top 100

4. Averaging each team’s game score (you can think of this as game-level performance) and summing the number of contests played

5. Only considering teams who have played at least 25 games

6. Arranging by highest average score

7. Joining on team logos

Creating an HTML column

Next, we’re going to create two important columns: group and formatted_score.

group is an indicator column on which we will split our data. For our table, we want to show the top 100 performing teams – and we’re going to do so with five 20-team columns. A simple way to indicate which team will be in which column is to create a new variable where teams 1-20 will be 1, teams 21-40 will be 2, and so on (any differentiation works). We can do this with rep(1:5, each = 20). The rep function will replicate the indicated set of values, in this case the sequence of [1, 2, 3, 4, 5], and the each parameter repeats each previous element 20 times. You can think of using the general form, rep(1:number_of_columns, each = total_rows_in_each_column).

formatted_score is an HTML column which will be rendered in using gt. Per usual, I’m not going to dive too deep into inline CSS or HTML. The basic functionality of this column is to show the team’s ranking, logo, average game score, and number of games played in a single cell. Our inline CSS forces the average game score to be bold and larger than the games text. The mean_score change simply rounds the average performance and formats it to show trailing zeros.

data <- data %>%
  mutate(rank = row_number(),
         group = rep(1:5, each = 20),
         mean_score = round(mean_score, 1),
         mean_score = ifelse(nchar(mean_score) == 2, glue("{mean_score}.0"), mean_score),
         formatted_score = glue(
           "<div style='display: flex; align-items: center;'>
      {rank}. &nbsp; 
      <img src='{logo}' alt='Logo' style='height:25px; margin-right: 8px;'> 
      <span style='font-weight: bold; font-size: 1.2em; color: black; vertical-align: middle;'>{mean_score}</span> 
      <span style='font-size: 0.8em; color: gray; vertical-align: middle;'>&nbsp; ({games})</span>
    </div>"
         ))

Splitting our data

Now that we have our group and formatted_score column, we can pivot our data wider by splitting on our group number and binding the resulting lists together. The group_split function returns a list of tibbles that are separated by the associated group (i.e., the group number). The map_dfc function iterates over each list, selects columns containing “formatted_score,” and column-binds them into a single tibble – leaving us with a 20-row, 5-column data frame as intended.

data <- data %>%
  group_split(group) %>%
  map_dfc(~ select(.x, contains("formatted_score")))

Onto the table!

The Table

The base

The base of our table uses the gt_theme_pl function from my cbbplotR package. The fmt_markdown function renders our HTML columns, cols_label removes all column labels, and cols_align center-aligns all columns. If you run this as-is and slap on a table header and caption, you’re honestly off to a pretty good start as the formatted_score columns and the gt_theme_pl function does much of the heavy lifting.

data %>%
  gt(id = "table") %>% 
  gt_theme_pl() %>% 
  fmt_markdown(contains("formatted_score")) %>% 
  cols_label(everything() ~ "") %>% 
  cols_align(columns = everything(), "center") 

Adding dividers and adjusting fonts

To spice things up a bit, we will use gt_add_dividers to mimic row borders and the gt_set_font function from cbbplotR to choose a new table font. We can make our table a bit more compact by dropping the data_row.padding option to 1. By default, the table font in gt_theme_pl is a dark purple, and we can adjust this by setting our font color inside rows to black with tab_style and the cells_body location helper.

... %>%
  gt_add_divider(columns = -last_col(), color = "black", weight = px(1.5), include_labels = FALSE) %>%  
  gt_set_font("Barlow") %>% 
  tab_options(data_row.padding = 1) %>% 
  tab_style(locations = cells_body(), cell_text(color = "black")) 

Annotations

You’re going to have to bear with me here. The way that I create the 538-style captions is by adding the top-level caption line, the one above the bottom border in the final table, as a footnote and later include some necessary CSS to make it work. Perhaps there is a way to do this by just using tab_source_note, and I bet there is, but I’m assuming that is a bit messier than my solution.

Importantly, if you do want this caption design, you’re going to have to sacrifice the ability to use table footnotes. You can easily write your footnote information in this top-level caption, but you won’t see the footnote marks.

... %>%
  tab_footnote(locations = cells_column_labels(), footnote = md("Opponent rank is determined by Barttorvik T-Rank on game date. Game score is game-level Barthag performance (the<br>probability that you beat an average team on a neutral floor). Total games played is next to mean score.")) %>% 
  tab_header(
    title = "Performance against top 100 teams over the past five seasons",
    subtitle = "Average T-Rank game score vs. then-top 100 opponents from 2020-2024; min. total 25 games"
  ) %>% 
  tab_source_note("Data by Barttorvik + cbbdata || Viz. + Analysis by @andreweatherman")

Necessary CSS

As promised, this table will rely on some CSS. I’m not really going to touch on anything but the footnote additions.

#table .gt_footnote adds a solid black line with width 1px below the table footnote, which we are treating as our top-level caption, and adjusts the font size.

#table .gt_footnote_marks hides the footnote marks in the column headers as they are irrelevant in this design.

#table .gt_sourcenote aligns our bottom-level caption, defined with tab_source_note, to the right of our table, mimicking the popular 538 table design.

... %>%
  opt_css(
    "
    #table .gt_column_spanner {
      border-bottom-style: none !important;
      display: none !important;
    }
    #table .gt_subtitle {
      line-height: 1.2;
      padding-top: 0px;
      padding-bottom: 0px;
    }
    #table .gt_footnote {
      border-bottom-style: solid;
      border-bottom-width: 1px;
      border-bottom-color: #000;
      font-size: 12px;
    }
    #table .gt_footnote_marks {
      display: none !important;
    }
    #table .gt_sourcenote {
      text-align: right;
    }
    #table .gt_row {
      border-top-color: black;
    }
    "
  )

Source Code

A link to the full source code can be found here.

This visualization is not yet accompanied by a tutorial.

Source Code

Full source code can be found here.

For this table, we will need:

library(cfbfastR)
library(gt)
library(gtExtras)
library(glue)
library(tidyverse) 
library(cbbdata)
library(rlang)
library(nflreadr)

The Data

Most of this is pretty straightforward. With schedule, we pull the 2024 college football schedule, filter for games that have occurred (NY6), select the relevant variables, and then convert the date column.

With weeks, we pull the week numbers associated with each range of dates in the 2024 season – since not all games in a given week are played on the same day.

Finally, we use the overlap join functionality in the dplyr::X_join family to match our game dates to week numbers between the start_date and end_date range in weeks.

Note: We don’t actually need to grab weeks (or join our data) because we could just infer the week numbers from game dates (ascending order) – but I did so for clarity and practice.

schedule <- espn_cfb_schedule(year = 2024, limit = 1000) %>% 
   filter(type != "postseason") %>% 
  select(home_team = home_team_location, away_team = away_team_location, date = game_date) %>% 
  mutate(date = as.Date(date, format = "%Y-%m-%dT%H:%MZ"))

weeks <- espn_cfb_calendar(year = 2024) %>% 
  select(week, start_date, end_date) %>% 
  mutate(across(-week, ~as.Date(.x, format = "%Y-%m-%dT%H:%MZ")))

schedule <- left_join(
  schedule,
  weeks,
  join_by(between(date, start_date, end_date))
)

Now, let’s create a vector of Big Ten teams and filter down.

b1g <- cfbd_team_info() %>% filter(conference == "Big Ten") %>% pull("school")

schedule <- schedule %>% filter(home_team %in% b1g | away_team %in% b1g)

Pivoting data with help from nflreadr

Right now, our data looks like this.

For plotting, however, we want 18 rows (number of Big Ten teams) and 15 columns (one for Big Ten teams and 14 others for week). There are a few ways to approach this problem, and the easiest is to simply “pivot” our data wider.

With pivoting, though, we’re going to run in a small problem: Our Big Ten team might be home or away. The two columns with team information are organized by location and not conference. We can fix this by first pivoting our data to a long format, using pivot_longer, and then filter the resulting value column for Big Ten teams.

For this case, pivot_longer works, but other times, you might have more statistics and want a more streamlined solution. I want to show off a nice utility function from {nflreadr} that will pivot data and convert your pipeline to something more standardized: nflreadr::clean_homeaway. It converts home_ and away_ prefixed columns to team_ and opponent_ while doubling the rows (one row per team, not per game).

If you relabel home_team and away_team to home and away, then schedule %>% pivot_longer(home:away) would accomplish the exact same thing. I wanted to take this opportunity to introduce this function.

schedule %>% 
  select(home_team, away_team, week) %>% 
  clean_homeaway()

After which, we can filter down to Big Ten teams.

plot_data <- schedule %>% 
  select(home_team, away_team, week) %>% 
  nflreadr::clean_homeaway() %>% 
  filter(team %in% b1g)

Adding logos

Before we can pivot our data, we need to add team logos and find a way to preserve our location data during the pivot without creating new columns. A nifty idea is to transition our opponent column to an HTML string with an <img> tag that includes the link to the team logo and uses the alt caption to encode location data. In a static table, the alt tag serves no purpose, so we can use glue to toss in the game location.

First, let’s grab team logos. Importantly, these team names are coming from ESPN, so let’s select those values to ensure an effortless join. We are going to use pull and set_names to create a named vector with team names and logo links.

logos <- cbd_teams() %>% select(team = espn_location, logo)
logos <- logos %>% pull(logo) %>% set_names(logos$team)

Remember that named vectors work like so, object_name[value], so to grab logo links for our opponent column, we can do: logos[opponent].

Our location data is stored inside of the alt tag shown below.

plot_data <- plot_data %>% 
  mutate(opponent = glue("<img src='{logos[opponent]}' alt={location} style='height:25px; vertical-align:middle;'>"))

Now that we have converted our opponent column, we can safely pivot our data wider by selecting team as the identifier column, grabbing our column names from the week variable, and setting our values as the opponent column.

Finally, we will arrange our data in alphabetical order by team and then convert our team column to the proper logo link using the named vector.

plot_data <- plot_data %>% 
  pivot_wider(id_cols = team, names_from = week, values_from = opponent) %>% 
  arrange(team) %>% 
  mutate(team = logos[team])

Plotting

Conditional Highlighting

In our table, we are going to highlight on two conditions: a) game location (home games are blue; away games are white) and b) bye weeks (gray).

But the problem is that conditional highlighting in gt is a bit weird because tab_style + cell_fill does not really work as one might expect. Namely, row and column vectors aren’t treated as separate pairs. If you pass through, e.g. rows = c(1, 2) and columns = c(5, 6) inside tab_style, you’ll fill four cells, not two, because tab_style doesn’t treat things as unique pairs.

Turns out, you can just build the CSS string for highlighting cells outside of the table and apply it directly with opt_css. The basic idea is this: We take a matrix of row-column indices, a table ID, and a color – and then inject those into a basic CSS string that targets cells and colors their background.

generate_css <- function(indices, css_id, color) {
    map2_chr(
    .x = indices[, 1],
    .y = indices[, 2],
    .f = ~glue("#{css_id} tbody tr:nth-child({.x}) td:nth-child({.y}) {{ background-color: {color}; }}")
  )
}

We are using which and str_detect to find the row and column indices where “home” is present inside the alt tag – the same with is.na for bye games – and then apply our generate_css function.

home_css <- arrayInd(which(str_detect(as.matrix(plot_data), 'alt=home')), .dim = dim(plot_data)) %>% 
  generate_css('table', '#cce7f5')

bye_css <- arrayInd(which(is.na(as.matrix(plot_data))), .dim = dim(plot_data)) %>% 
  generate_css('table', '#d9d9d9')

I’m going to add one more pieces of css, and to make things cleaner in the final plot code, I’m going to define that rule here. (This just decreases the spacing in my caption.)

additional_css <- "
  
  #table .gt_sourcenote {
    line-height: 1.3;
  }

"

Header + Legend

I like how the original table combines the legend with the title, and I’m going to do the same. I’m going to make two changes: a) I’m not using the Big Ten logo and b) I’m going to stack the title and legend (and center it).

This is all done with custom HTML, which will further inherit certain styles from the table theme (font family, size, weight, etc.). We can tweak a bit of that with in-line CSS.

html_content <- '
<div style="text-align: center;">
  <h1 style="margin: 0; font-size: 20px;">Big Ten Football Schedule | 2024</h1>
  <div style="display: flex; justify-content: center; align-items: center; margin-top: 5px;">
    <div style="border: 1.5px solid black; padding: 2px 10px; text-align: center; background-color: #cce7f5; font-size: 10px; margin-right: 5px;">Home</div>
    <div style="border: 1.5px solid black; padding: 2px 10px; text-align: center; font-size: 10px; margin-right: 5px;">Away</div>
    <div style="border: 1.5px solid black; padding: 2px 10px; text-align: center; background-color: #d9d9d9; font-size: 10px;">Bye</div>
  </div>
</div>
'

Building the table

The body of our table is pretty straightforward. fmt_image renders in our logo link for the team column, while fmt_markdown does the same thing for weeks 1:14. sub_missing is a great utility function to replace text in NA columns. We can use gt_add_divider to create more pronounced divisions between rows and weeks (I prefer this look over the original).

Since we built an HTML string for our opponent columns, to preserve the game location data, we need to use fmt_markdown, not fmt_image.

plot_data %>% 
  gt(id = 'table') %>% 
  gt_theme_538() %>% 
  fmt_image(team, height = 25) %>%
  fmt_markdown(-team) %>% 
  # use sub_missing to replace na with empty text string
  sub_missing(-team, missing_text = '') %>% 
  cols_align(columns = everything(), 'center') %>% 
  cols_label(team = '') %>% 
  # bold col. headers
  tab_style(locations = cells_column_labels(), style = cell_text(weight = 'bold')) %>% 
  # add dividers
  gt_add_divider(columns = -team, sides = 'all', include_labels = FALSE, color = 'black', weight = px(1.5)) %>% 
  tab_header(html(html_content)) %>% 
  tab_source_note(md("Data by cfbfastR<br>Viz. by @andreweatherman (h/t to @cobrastats)")) %>% 
  tab_options(data_row.padding = 1) %>% 
  # apply above css
  opt_css(c(home_css, bye_css, additional_css)) %>% 
  gtsave_extra("schedule.png", zoom = 5)

Source Code

The full source code can be found here.

For this table, we will need:

library(tidyverse)
library(janitor)
library(data.table)
library(gt)
library(gtExtras)
library(glue)

The Data

Grab the data

Typically, I try my best to find and scrape the original data source. But unfortunately, perhaps for security reasons, I could not locate the juror reponses to the screening questionnaire. So instead, I hard coded the data as a .CSV.

Grab the data with this:

data <- PUT HERE AFTER REPO IS UP AND LIVE

Manipulate the data

For exercise, I left us with a few required manipulations:

1) Transpose the data

Our data file is in a wide format relative to publication, but our table requires the jurors to be the column names. There are a number of ways to essentially “swap” rows and columns, and we are going to use the transpose function from data.table and specify keep.names to retain our column headers. Our headers, actually, are located in the first row of our table, so we will use row_to_names from janitor to “shift” everything up one row. Finally, let’s convert this back to a tibble and rename the first column.

data <- data %>% 
  transpose(keep.names = "news") %>% 
  row_to_names(1) %>% 
  as_tibble() %>% 
  rename("source" = "juror")

2) Create the boxes

This is the “trickiest” part of the visualization. There are probably a multitude of ways to go about this, but to plot the boxes in each cell, I am using an inline block, with equal height and width.

First, you will notice that the table labels each juror number in the first row, but it resets the “counter” after the 12th juror (13-18 are “alternates”). To handle this, we need to create a “display number” that that follows the same logic. Since our column headers are the juror numbers, we can simply refer to it using the cur_column function.

Next, our values are NA if the juror does not utilize that news “source,” so we can set that color to a light grey and use a yellow when the cell is not NA (does use it).

Finally, the “trickiest” part is to create an HTML string that builds the box. If you don’t know HTML or CSS, that’s okay, you can still follow along; the code is pretty intuitive.

• The “inline block” creates a small square with the height and width specified in the string.

• It is filled with the background-color referenced above.

• The shorthand margin property first sets the top and bottom margins and then the left and right margins. Having smaller left and right margins will make the boxes appear closer together.

• The text (and boxes) are then centered, set at a 12px font size, and bolded (which the original table does not do).

data <- data %>% 
   mutate(across(-source, ~{
     
    display_number <- ifelse(row_number() == 1, 
                             ifelse(as.numeric(cur_column()) > 12, as.numeric(cur_column()) - 12, cur_column()),
                             NA)

    color <- ifelse(is.na(.x), "#EEEEEE", "#FCCF10")

    glue("<span style='display:inline-block; width:20px; height:20px; line-height:20px; background-color: {color}; vertical-align:middle; margin:4px 1px; font-size: 12px; font-weight: bold; text-align:center;'>{ifelse(!is.na(display_number), display_number, '')}</span>")
  }))

3) Separator

In the original table, there is a small gap to separate the jurors from the alternates. We can mimic this same effect by creating a dummy column after our above mutations and then place it after the 13th column (the 12th and final juror).

data <- data %>% mutate(blank = '', .after = 13)

The Table

Most of our table can be created with stock gt functions, but we will need to add minimal CSS to top it off.

1) The Base Table

The “base” of our table will be created using fmt_markdown to render our HTML strings and gt_theme_nytimes to closely mirror the look of the original table. Importantly, we add an arbitrary “id” for later use with opt_css.

data %>% 
  gt(id = "table") %>% 
  gt_theme_nytimes() %>% 
  fmt_markdown(-c(source, blank))

2) Handling the Separator Column

To create the separation effect, we will need to relabel our column and adjust its width.

... %>% 
  cols_label(blank = "") %>% 
  cols_width(blank ~ px(15))

3) Column Labels

The original table does not have “traditional” column headers; instead, they appear to column spanners, which we can create with tab_spanner. To really drive home this effect, we’re going to need some CSS at the end. But for now, let’s add the column spanners, align them to the left, and make them a light grey.

... %>% 
  tab_spanner(columns = 1, label = "Source") %>% 
  tab_spanner(columns = 2:13, label = "Jurors") %>% 
  tab_spanner(columns = 15:20, label = "Alternates") %>% 
  tab_style(locations = cells_column_spanners(),
            style = cell_text(align = "left", size = px(16), color = "#7E7E7E"))

4) Table Annotations + Options

Let’s add our title and caption. We will also tweak our caption font size, force the line below the caption to white (not sure why this theme doesn’t do it by default), and compress our rows.

... %>% 
  tab_header(title = "Where the jurors in the Trump hush-money trial say they get their news") %>% 
  tab_source_note(md("Data and original table by New York Times<br>Recreation in R by @andreweatherman")) %>% 
    tab_options(data_row.padding = 1,
                source_notes.border.bottom.style = "solid",
                source_notes.border.bottom.color = "white",
                source_notes.font.size = 12)

5) Additional CSS

To make our column spanners look like headers – creating the spanner-header effect in the original table – we need some light css. When using opt_css, it is important to reference the same table id that you created in gt(id = ...).

The first line hides the column headers and sets their position to “relative,” allowing our spanners to “drop” in their place.

The second line “drops” our spanners with position: absolute, makes them visible, and adds some minor padding. Our spanners are already aligned left, done in step three, but remember that our boxes have slight left-right margins, so by default, our spanners look misaligned. We can “push” them to the right with padding-left: 3px.

... %>% 
   opt_css(
    css = "
      #table .gt_col_headings {
        visibility: hidden;
        position: relative;
      }
      #table .gt_column_spanner {
        position: absolute;
        visibility: visible;
        padding-left: 3px;
      }
    "
  )

Source Code

Full code can be found here.

The How

For this table, we will need:

library(tidyverse)
library(cbbdata)
library(cbbplotR)
library(vipor)

The Data

For this visualization, we will be pulling data from Barttorvik using the {cbbdata} package.

data <- cbd_torvik_ncaa_results(2000, 2024) %>% 
  filter(r64 >= 5) %>% 
  select(team, pase) %>% 
  mutate(pase_rk = dense_rank(-pase))

All we’re doing here is pulling tournament performance data, filtering for five or more appearances (r64), and calculating PASE rank – which will be used to highlight top teams.

Calculate the jitter

We want to “jitter” our plot, which is something made easy by using the ggbeeswarm package. “Jittering” broadly refers to offsetting points to minimize overlap. Unfourtantely, {cbbplotR} does not yet support jittering points, so we need to do it ourselves.

Behind the scenes, {ggbeeswarm} uses the {vipor} package and its offsetSingleGroup function to calculate new x-values for plotting. With this knowledge, we can create a small wrapper around offsetSingleGroup to achieve similar results.

calculate_quasirandom_jitter <- function(y, x, width = 0.2) {
  jittered_offset <- offsetSingleGroup(y, method = "quasirandom")
  jittered_offset <- jittered_offset * width
  x + jittered_offset
}

Next, we’ll apply this function to our data.

data <- data %>% 
  mutate(x = calculate_quasirandom_jitter(pase, 1))

Plotting

Now, time to plot! Let’s briefly go over some things:

geom_mean_lines

This is a utility function to add mean (or median) lines to any plot. Notice that you must refer to your values as either y0 or x0, not y or x.

scale_X_identity

Inside geom_cbb_teams, you might notice that we are conditionally defining widths (logo size) and alpha (logo transparency) values. The scale_x_identity family of functions are used when “your data is already scaled such that the data and aesthetic spaces are the same.” That is, whenever you are passing direct values for a scale inside of any aes, you must use the appropriate _identity function for ggplot to recognize those values as literal representations.

plot.margin

This is how you add padding to your plot. Sometimes padding makes your graph look a bit cleaner.

Using ggpreview with logo plots

If you are plotting numerous team logos, you might notice that RStudio can be slow to return the plot itself – which can possibly lead to your R session aborting. To fix this, {cbbplotR} borrows a function from the {ggpath} package called ggpreview – which saves a temporary image of your plot and returns it in the Viewer pane. It is recommend to then expand that window in your browser.

To use ggpreview, you need to store your plot as a variable and then pass it to the ggpreview function. The function also takes arguments for plot dimensions.

For example, if we were to draw a plot showing every team’s adjusted efficiencies, that would require rendering 362 logos, which would definitely cause us some problems. But with ggpreview, we can store our plot as a variable and view a temporary image of it! This entire process takes fewer than 10 seconds.

The plot

plot <- data %>% 
  ggplot(aes(x, pase)) +
  geom_mean_lines(aes(y0 = pase), color = "grey70") +
  geom_cbb_teams(aes(team = team,
                     width = ifelse(pase_rk <= 20, 0.07, 0.055),
                     alpha = ifelse(pase_rk <= 20, 1, 0.15))) +
  scale_alpha_identity() +
  scale_y_continuous(breaks = seq(-10, 20, 5), labels = c("- 10", as.character(seq(-5, 15, 5)), "+ 20"),
                     limits = c(-10, 20)) +
  theme_minimal() +
  theme(plot.title.position = "plot",
        plot.title = element_text(family = "RadioCanadaBig-Bold", hjust = 0.5, size = 14),
        plot.subtitle = element_text(family = "RadioCanadaBig-Regular", hjust = 0.5,
                                     vjust = 2.7, size = 10),
        plot.caption.position = "plot",
        plot.caption = ggtext::element_markdown(family = "RadioCanadaBig-Regular",
                                                lineheight = 1.2, size = 8),
        axis.text = element_text(family = "RadioCanadaBig-Regular"),
        axis.title = element_text(family = "RadioCanadaBig-SemiBold"),
        axis.title.y = element_text(vjust = 2),
        axis.text.x = element_blank(),
        plot.margin = margin(t = 20, r = 20, b = 20, l = 20, unit = "pt"),
        panel.grid.major.x = element_blank(),
        panel.grid.minor.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        plot.background = element_rect(fill = "#F6F7F2")) +
  labs(title = "The programs who routinely outperform March expectations",
       subtitle = "Sorted by PASE (performance against seed expectation) from 2000-2024.\nMin. five tournament appearances.",
       caption = "Data by cbbdata<br>Viz by @andreweatherman + cbbplotR",
       y = "Aggregate wins +/- seed expectation",
       x = NULL)

Saving the plot

When you’re using custom fonts, as we are, sometimes ggsave won’t properly render them. To sidestep this, you need to specify a device, shown below.

ggsave(plot = plot, "pase_graph.png", h = 6.5, w = 6, dpi = 600, device = grDevices::png)

Source Code

The full source can be found here.

To build this table, you will need an active KenPom subscription and a cbbdata account. Follow these steps to link your KenPom account to cbbdata.

If you do not have an active KenPom subscription, the cleaned data is provided in the source code linked at the bottom of the article.

For this table, we will need:

library(tidyverse)
library(rvest)
library(cbbdata)
library(gt)
library(gtExtras)
library(glue)
library(janitor)

The Data

Grab The Data

Coaching Changes

The first thing that we will need is a list of coaching changes by season. There are a few different places from which to grab this, but the most straightforward way is the Coaching Changes page at barttorvik.

The data is presented in a static HTML table by year, so we will write a function using rvest to scrape data between 2012 and 2024.

For some reason, the Barttorvik site blocks requests originating from Windows devices. To get around this, we will use withr and set a custom user-agent.

get_coaching_changes <- function(year) {
  
  suppressWarnings({
    withr::local_options(HTTPUserAgent='Not Windows')
    read_html(glue("https://barttorvik.com/coaching_moves.php?year={year}")) %>% 
      html_table() %>% 
      pluck(1) %>% 
      clean_names() %>% 
      mutate(year = year) %>% 
      select(team, year, new_coach)
  })
  
}

Now that we have our scraping function, let’s loop over it with map_dfr.

all_changes <- map_dfr(2012:2024, \(year) get_coaching_changes(year))

KenPom Ratings

Next, we need preseason and year-end KenPom ratings, which is possible with the cbd_kenpom_ratings_archive function from cbbdata.

archive <- cbd_kenpom_ratings_archive() %>% 
  filter(year >= 2008) %>% 
  summarize(
    start_em = adj_em[which.min(date)],
    end_em = adj_em[which.max(date)],
    final_rank = adj_em_rk[which.max(date)],
    .by = c(team, year)
  ) %>% 
  mutate(diff = end_em - start_em)

Season Record

For some added flair, let’s include team records too.

team_records <- cbd_torvik_game_box() %>%
  summarize(
    record = glue("{sum(result == 'W')}-{sum(result == 'L')}"),
    .by = c(team, year)
  )

Combine

Finally, let’s combine our data and calculate the rating difference. All join functions in dplyr only work with two data frames. However, we can place everything inside of a list and use reduce from purrr.

data <- list(all_changes, archive, team_records) %>% 
  reduce(left_join, by = c("team", "year"))

We’re only going to plot the 10 “best” rating jumps.

data <- data %>% slice_max(diff, n = 10)

Postseason Outcome

The final thing that we are going to include is a column on whether or not a team made the postseason (NCAA, NIT, CBI, etc.). The easiest way to do this is to scrape Sports Reference – which is why we’re adding this after we have combined our data and grabbed the 10 largest jumps.

Postseason information can be found on a team’s schedule page for a given season. We can use cbd_teams to grab the needed team slugs.

sr_ids <- cbd_teams() %>% select(team = common_team, sr_link)
grab_schedules <- function(team, year) {
  
  Sys.sleep(3) # sleep for 501
  
  slug <- filter(sr_ids, team == !!team)$sr_link
  url <- glue("https://www.sports-reference.com/cbb/schools/{slug}/men/{year}-schedule.html")
  
  read_html(url) %>% 
    html_nodes("#schedule") %>% 
    html_table() %>% 
    pluck(1) %>% 
    clean_names() %>% 
    slice_tail(n = 1) %>% 
    select("type") %>% 
    mutate(team = team, year = year)
  
}

Use purrr to iterate over all teams and then join the results.

postseason <- map2_dfr(data$team, data$year, \(team, year) grab_schedules(team, year))

data <- left_join(data, postseason, by = c('team', 'year')) %>% 
  mutate(type = ifelse(type == "CTOURN", "---", type))

The Table

Stack Function

To make things cleaner, here is a function that will plot team logos and stack some additional text to the right using HTML.

gt_cbb_stack <- function(data, upper_text1, upper_text2, lower_text1, lower_text2, lower_text3, logo) {

  data %>%
    mutate(stack = glue(
        "<div style='display: flex; align-items: center;'>
           <img src='{eval(expr({{logo}}))}' style='height: auto; width: 20px; padding-right: 5px;'>
           <div>
             <div style='line-height:14px;'><span style='font-weight:bold;color:black;font-size:14px'>{eval(expr({{upper_text1}}))}, {eval(expr({{upper_text2}}))}</span></div>
             <div style='line-height:10px;'><span style='font-weight:plain;color:grey;font-size:10px'>{eval(expr({{lower_text1}}))} --  #{eval(expr({{lower_text2}}))}, {eval(expr({{lower_text3}}))}</span></div>
           </div>
         </div>"
      )
    )
}

To use this, we need to add a column with team logo links. Then, let’s apply it.

data <- data %>% left_join(cbd_teams() %>% select(team = common_team, espn_nickname, logo))

data <- data %>% gt_cbb_stack(new_coach, year, espn_nickname, final_rank, record, logo)

Column Header + Subheader Function

In late January, Todd Whitehead (Synergy) posted a table with cool column headers + subheaders. I really liked this design, which pairs very well with stacked cells, so I created a function to mimic this effect in gt. We’ll use it in our table too.

This function does a few things, but most notably, it creates an HTML string for the “stacked” effect, parses it using htmltools, and then sets it as the header using cols_label.

gt_column_subheaders <- function(gt_table, ...) {

  subheaders <- list(...)
  all_col_names <- colnames(gt_table[['_data']])

  for (col_name in all_col_names) {

    subtitle_info <- subheaders[[col_name]] %||% list(subtitle = "&nbsp;", heading = col_name)
    subtitle <- subtitle_info$subtitle
    new_header_title <- subtitle_info$heading

label_html <- htmltools::HTML(glue(
  "<div style='line-height: 1.05; margin-bottom: -2px;'>
    <span style='font-size: 14px; font-weight: bold; color: black;'>{new_header_title}</span>
    <br>
    <span style='font-size: 10px; font-weight: normal; color: #808080;'>{subtitle}</span>
  </div>"
))

    gt_table <- gt_table %>% 
      cols_label(!!sym(col_name) := label_html)
  }
  
  gt_table
}

1) The Base Table

Honestly, the code below outputs a pretty nice table, but there is definitely some room for improvement.

data %>% 
  select(stack, type, start_em, end_em, diff) %>% 
  gt(id = 'table') %>% 
  gt_theme_nytimes() %>% 
  fmt_markdown(stack) %>% 
  cols_move_to_start(stack) %>% 
  cols_align(columns = stack, 'left') %>% 
  cols_align(columns = -stack, 'center')

2) Applying Custom Column Function

Let’s apply our custom gt_column_subheaders function. To relabel a column, you need to pass a list with heading and subheading.

... %>%
  gt_column_subheaders(stack = list(heading = "Coach and Year",
                                    subtitle = "Team, Final Rank, and Record"),
                       type = list(heading = 'Post SZN',
                                    subtitle = "Tournament"),
                       start_em = list(heading = 'Pre',
                                    subtitle = "Rating"),
                       end_em = list(heading = 'End',
                                    subtitle = "Rating"),
                       diff = list(heading = 'Jump',
                                    subtitle = "End - Start"))

3) Table Borders

To give our table some more clarity and definition, we will add some borders around our cells.

... %>%
  tab_style(locations = cells_body(columns = c(type, ends_with("em"))), style = cell_borders()) %>% 
  tab_style(locations = cells_body(columns = -ends_with("em")), style = cell_borders(sides = "bottom")) %>% 
  tab_style(locations = cells_body(rows = 1), style = cell_borders(sides = "top", weight = px(2))) %>% 
  tab_style(locations = cells_body(columns = diff), style = cell_text(weight = 'bold')) 

4) Table Annotations + Options

Let’s add our title and caption. We will also tweak our caption font size, force the line below the caption to white (not sure why this theme doesn’t do it by default), and compress our rows.

... %>%
  tab_options(data_row.padding = 3.5,
              source_notes.border.bottom.style = "solid",
              source_notes.border.bottom.color = "white",
              source_notes.font.size = 10) %>% 
  tab_header(title = "New coaches beating KenPom expectations",
             subtitle = md("The largest pre-season vs. year-end KenPom rating improvements<br>by new head coaches since 2012")) %>% 
  tab_source_note(md("Data by cbbdata + Sports Reference<br>Viz. + Analysis by @andreweatherman"))

5) Additional CSS

Finally, let’s throw in some minor CSS changes. When using opt_css, it is important to reference the same table id that you created in gt(id = …).

The first two lines adjust the padding between the title and subtitles – “squishing” them together. The third line targets the bottom border of the table. It creates the same effect as the tab_style that targeted the first row (black border at 2px weight).

... %>%
    opt_css(
    "
    #table .gt_heading {
      padding-top: 6px;
      padding-bottom: 0px;
    }
    #table .gt_subtitle {
      padding-top: 2px;
      padding-bottom: 6px;
    }
    #table tbody tr:last-child {
    border-bottom: 2px solid #000000;
    }
    "
  )

Source Code

Full code can be found here.

Getting the data

First up, let’s load the necessary libraries.

library(tidyverse)
library(cbbdata)
library(cbbplotR)
library(glue)
library(hrbrthemes)

Per usual, this tutorial will make use of my {cbbdata} package. If you have not done so already, you will need to install it and register for an API key (entirely free). Please read on how to do so here.

Season schedule

Our first step is pulling the 2024 season schedule and filtering to include games played on January 19th or later (today to the end of the regular season). We further throw out all games played against non-Division 1 competition (where type does not equal “nond1”).

schedule <- cbd_torvik_season_schedule(year = 2024) %>% 
  filter(date >= Sys.Date() & type != 'nond1')

After, we need to adjust our data so that we get a “schedule” for each team. Only two factors affect quadrant boundaries, opponent NET and game location, so our team schedule only needs three columns: team, opponent, and game location. There are a myriad of possible ways to do this, but one of the shortest is by using mutate and setting the .keep argument to “none.”

Functionally, this is fairly similar to the superseded transmutate function, and if interested, you can read more about the slight discrepancies here. By setting .keep to “none,” our returned data only retains the columns that are specified in our mutate call (i.e., team, opp, and location). Again, we don’t care about the other stuff, so this is perfect.

plot_data <- schedule %>% 
  mutate(
    team = home, opp = away, location = if_else(neutral, 'N', 'H'),
    .keep = 'none'
  )

If you are following along in your own session — which I do encourage if you aren’t fully comfortable in R — you will notice that the number of rows in plot_data matches the number found in the schedule frame…but this isn’t good! cbd_torvik_season_schedule returns one row per game, but if we want to calculate the number of Q1 games remaining for every high-major team, we naturally need two rows per game (one for each team).

Perhaps the easiest and most intuitive way to solve this is by simply doing the reverse and binding the resulting rows — Occam's razor and all.

You can think of the code below as a short nested function. The first operation performed will be the inner-most chain: We take our schedule data and do the same mutate as above while swapping the home and away logic (changes are bolded). Then, that new data is passed to bind_rows and is combined with the existing plot_data object.

plot_data <- plot_data %>% 
  bind_rows(
    schedule %>% 
      mutate(
        team = away, opp = home,
        location = if_else(neutral, 'N', 'A'),
        .keep = 'none'
      )
  )

Adding conference, NET, and quadrant boundaries

Our plot_data object now includes two rows per game, with the proper team/opp and game location assignment, so we can move onto adding quadrant boundaries.

Shipped with {cbbdata} v0.2 is a function called cbd_add_net_quad, which takes data with a similar structure — must have columns representing opponent and game location — and adds columns for opponent NET and quadrant definition.

If you are unsure about which {cbbdata} version you have, you can run this line of code to check and update if needed. This might require an R session restart (if so, don’t forget to reload your libraries).

if(!packageVersion('cbbdata') %in% c('0.2.0', '0.3.0')) {
   pak::pak('andreweatherman/cbbdata')
}

We also need to add conference information and team NET for sorting purposes, so let’s do that here as well. We can grab conference information from the ratings endpoint and NET rankings with the current resume function.

plot_data <- plot_data %>% 
  cbd_add_net_quad() %>% 
  left_join(cbd_torvik_ratings(year = 2024) %>% select(team, conf),
            by = 'team') %>% 
  left_join(cbd_torvik_current_resume() %>% 
              select(team, team_net = net), by = 'team')

Getting our data ready for plotting

Before we start plotting, we need to sort our data, calculate per-conference medians, and clean up some names.

I hope that nothing here is too confusing. Because we want to plot with more “readable” conference names, let’s create a named vector that we’re going to use for filtering and relabeling.

Then we count the number of remaining quad 1 games with sum(quad == “Quadrant 1”) and leave a column showing team NET (since the latter will not change across each team, we can simply take the first observation of team_net with first).

For plotting purposes, we want our data to be ordered in a specific way, which we handle in the third line. We want to order by number of Q1 games remaining, and if a tie exists, we then sort by NET ranking.

Our last line is a basic mutate that achieves a few purposes: calculates median conference NET, relabels each conference using the named vector and places that median value inside the label (so that it will show in our facet), and finally creates a team label that we will place inside each bar. If the team is the last row in their conference (most Q1 games), we include a slightly more verbose label for easier interpretation. (We further restrict the verbose label to only appear if that team has eight or more Q1 games, else it will run over the bar.)

What is fct_inorder?

When dealing with categorical variables, such as teams, you might notice that {ggplot2} reorders your data to be shown alphabetically. Sometimes that is fine, but in others, you might have a particular plotting order.

To address this, you’ll often want to convert those categorical variables into factors. If you already have a defined data order, like we do below, the easiest way is to simply use the fct_inorder function, which creates factors in the order in which they first appear.

conf_relabel <- c('ACC' = 'ACC', 'BE' = 'Big East', 'B10' = 'Big Ten', 
                  'B12' = 'Big 12', 'SEC' = 'SEC', 'P12' = 'Pac-12')

plot_data <- plot_data %>% 
  filter(conf %in% names(conf_relabel)) %>% 
  summarize(Q1 = sum(quad == 'Quadrant 1'),
            median_net_left = median(net),
            team_net = first(team_net),
            .by = c(team, conf)) %>% 
  arrange(Q1, desc(team_net)) %>% 
  mutate(avg_conf_net = mean(team_net), 
         median_conf_net = median(team_net),
         conf = conf_relabel[conf],
         conf = glue("{conf} (Med. NET {round(median(median_net_left), 0)})"),
         team = fct_inorder(team),
         label = if_else(row_number() == n() & Q1 >= 8, 
                         glue('{Q1} Q1s left (NET {team_net})'), 
                         glue('{Q1} ({team_net})')),
         .by = conf
       )

Plotting

Now that we have our data analyzed and reshaped, let’s throw it over to {ggplot2} for plotting.

Our code itself is fairly straightforward. We are only using two geom_X functions (col and text) and some colors that I thought looked cool. We are borrowing a general theme from {hrbrthemes} and doing a few extra things to it.

Why are we converting Q1 to a factor in `fill`?

Our Q1 variable is numeric; it’s simply the count of remaining Q1 games for each team. When you set fill or color to a numeric variable in {ggplot2}, the scale becomes continuous by default. This is perfect if your variable is a floating number (a double in R, e.g. 5.3 or 19.7), but when working with integers, it usually makes more sense to have a discrete color scale (i.e. a color per distinct integer).

The easiest way to accomplish this without adjusting your data is to simply convert those values to a factor inside your aes call. A factor will treat values as categorical ones (variables that have a fixed and known set of possible values).

Facets? What in the world is fct_reorder? free_y?

The key part of this plot is building “small multiples,” or in R-speak, facets. Well, I guess the technical R-speak is, “a matrix of panels defined by row and column faceting variables.” Basically, that’s a complicated way of saying, “Hey, let’s just break this plot into smaller ones based on some group.”

If you run the code prior to facet_wrap, you’ll see that we just get one long bar plot with a bunch of team names on the side. This isn’t very helpful. What facets allow us to do is to break our plot into smaller ones based on conferences. Now try running the same code but include the facet_wrap line. You’ll see the exact same plot but in a 2x3 matrix — with each entry representing a different conference. Neat!

fct_reorder allows us to arrange our grid based on some variable. In this case, we want to arrange our small multiples in order of lowest median_conf_net to highest.

Try removing scales = “free_y” and see what happens. You should notice that our bars, well, aren’t quite aligned correctly. That’s because when you build facets, scales are fixed by default — meaning that each facet has the same x- and y-axis scale. This should be evaluated on a case-by-case basis, and with this plot, we definitely do not want our y-axis to be fixed. Instead, we want to plot only the teams observed in that facet — and we can do this by setting scales = “free_y”.

plot <- plot_data %>% 
  ggplot(aes(Q1, team)) +
  geom_col(color = 'white', aes(fill = factor(Q1))) +
  geom_text(aes(label = label, x = Q1 - 0.25,
                color = ifelse(Q1 >= 4, 'grey20', 'white')),
            family = 'Roboto Condensed', fontface = 'bold',
            hjust = 1, size = 3.5) +
  scale_fill_manual(values = c('#2082E4', '#1C8FE7', '#169CE8',
                               '#0FB4EC', '#0AC1ED', '#06CDEF',
                               '#00DAF0', '#06DCD5', '#14DDAC')) +
  scale_color_identity() +
  facet_wrap(~ fct_reorder(conf, median_conf_net), scales = 'free_y') +
  theme_modern_rc() +
  theme(strip.text = element_text(color = 'white', face = 'bold'),
        axis.text.y = element_cbb_teams(logo_type = 'dark'),
        axis.title.x = element_text(vjust = -1.5),
        plot.title.position = 'plot',
        plot.caption.position = 'plot',
        plot.subtitle = element_text(vjust = 2.7),
        plot.caption = element_text(hjust = 0),
        legend.position = 'none',
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
   labs(title = 'Number of Q1 games remaining for high-majors',
       subtitle = 'NET rankings are current morning of Jan. 19, 2024. Conferences are sorted by median team NET.',
       y = NULL,
       x = 'Q1 games remaining',
       caption = 'Data by cbbdata + cbbplotR\nViz. + Analysis by @andreweatherman')

Viewing the plot

One thing that seems especially pertinent to mention: If you are building plots with more than ~20 logos, use ggpreview. RStudio can be very slow to render plots with many logos, and it might even terminate your session.

To address this, simply store your plot as a variable and pass that to the ggpreview function in {cbbplotR}. The function will save a temporary image of your plot — where you can further set a width and height — and display that in the Viewer pane. I then recommend to open the plot in a new browser window (example shown below).

ggpreview(plot, w = 8, h = 9.5)

Saving the plot

To save the plot, we’ll use ggsave.

ggsave(plot = p1, 'q1_remaining_0119.png', w = 8, h = 9.5, dpi = 350)

Full Code

Loading libraries

library(tidyverse)
library(cbbdata)
library(cbbplotR)
library(glue)
library(hrbrthemes)

Getting the data

conf_relabel <- c('ACC' = 'ACC', 'BE' = 'Big East', 'B10' = 'Big Ten', 
                  'B12' = 'Big 12', 'SEC' = 'SEC', 'P12' = 'Pac-12')

schedule <- cbd_torvik_season_schedule(year = 2024) %>% 
  filter(date >= Sys.Date() & type != 'nond1')


plot_data <- schedule %>%
  mutate(
    team = home, opp = away, location = if_else(neutral, "N", "H"),
    .keep = "none"
  ) %>%
  bind_rows(
    schedule %>%
      mutate(
        team = away, opp = home,
        location = if_else(neutral, "N", "A"),
        .keep = "none"
      )
  ) %>%
  cbd_add_net_quad() %>%
  left_join(cbd_torvik_ratings(year = 2024) %>% select(team, conf),
    by = "team"
  ) %>%
  left_join(cbd_torvik_current_resume() %>%
    select(team, team_net = net), by = "team") %>%
  filter(conf %in% names(conf_relabel)) %>%
  summarize(
    Q1 = sum(quad == "Quadrant 1"),
    median_net_left = median(net),
    team_net = first(team_net),
    .by = c(team, conf)
  ) %>%
  arrange(Q1, desc(team_net)) %>%
  mutate(
    avg_conf_net = mean(team_net),
    median_conf_net = median(team_net),
    conf = conf_relabel[conf],
    conf = glue("{conf} (Med. NET {round(median(median_net_left), 0)})"),
    team = fct_inorder(team),
    label = if_else(row_number() == n() & Q1 >= 8,
      glue("{Q1} Q1s left (NET {team_net})"),
      glue("{Q1} ({team_net})")
    ),
    .by = conf
  )

Plotting

plot <- plot_data %>% 
  ggplot(aes(Q1, team)) +
  geom_col(color = 'white', aes(fill = factor(Q1))) +
  geom_text(aes(label = label, x = Q1 - 0.25,
                color = ifelse(Q1 >= 4, 'grey20', 'white')),
            family = 'Roboto Condensed', fontface = 'bold',
            hjust = 1, size = 3.5) +
  scale_fill_manual(values = c('#2082E4', '#1C8FE7', '#169CE8',
                               '#0FB4EC', '#0AC1ED', '#06CDEF',
                               '#00DAF0', '#06DCD5', '#14DDAC')) +
  scale_color_identity() +
  facet_wrap(~ fct_reorder(conf, median_conf_net), scales = 'free_y') +
  theme_modern_rc() +
  theme(strip.text = element_text(color = 'white', face = 'bold'),
        axis.text.y = element_cbb_teams(logo_type = 'dark'),
        axis.title.x = element_text(vjust = -1.5),
        plot.title.position = 'plot',
        plot.caption.position = 'plot',
        plot.subtitle = element_text(vjust = 2.7),
        plot.caption = element_text(hjust = 0),
        legend.position = 'none',
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
   labs(title = 'Number of Q1 games remaining for high-majors',
       subtitle = 'NET rankings are current morning of Jan. 19, 2024. Conferences are sorted by median team NET.',
       y = NULL,
       x = 'Q1 games remaining',
       caption = 'Data by cbbdata + cbbplotR\nViz. + Analysis by @andreweatherman')

Viewing and saving

# view
ggpreview(plot, w = 8, h = 9.5)

# save
ggsave(plot = p1, 'q1_remaining_0119.png', w = 8, h = 9.5, dpi = 350)

Houston’s loss prompted a thought: We’re just two months into the season, and no perfect teams remain. How does that compare to past years? Are we seeing more parity at the top of the sport? It feels like we don’t have a truly “elite” team.

Today’s Buckets & Bytes is a two-part special — double the graphs for double the fun!

First, we’ll be taking a look at the former: When has the last unbeaten fallen in each season back to 2008? We’ll be using {dplyr} to isolate the last unbeaten and calculate how many days they lasted.

Next, we’ll use historical T-Rank data (2015-Present) from {cbbdata} to investigate per-day rating variation between top teams as a quick litmus test for hoops parity.

Before we start, let’s load all necessary libraries.

As a reminder: This tutorial will use the {cbbdata} package, and you must register for a free API key.

pkgs <- c('cbbdata', 'cbbplotR', 'tidyverse', 'ggtext', 'hrbrthemes', 'glue')
invisible(lapply(pkgs, library, character.only = TRUE))

Part 1: Unbeaten Bar Chart

Getting the data

To create the unbeaten bar chart, we need to calculate when the last perfect record fell relative to the start of the season. To do this, we first use {cbbdata} to pull game results.

Game results

Remember, we want to calculate how many days after the start of the season that the last unbeaten fell — so we are using first to select the earliest observed date in each year (i.e. the start of the season).

R allows for operations on date classes, and we can take advantage of this by subtracting game date from start date (first day of each season) to quickly calculate the number of days between the two.

game_results <- cbd_torvik_game_box() %>% 
  filter(team %in% cbd_teams()$common_team) %>% 
  arrange(date) %>% 
  mutate(start_date = first(date), 
         days_diff = date - start_date, 
         .by = year)

When did the last unbeaten fall?

Now that we have our game results, we need to calculate when each team lost their first game. We can do this by combining a few summarize logical statements. First, we calculate cumulative team losses, then we decide whether that team is still unbeaten (i.e. cum_loss is 0), and finally we pull the date associated with the first observation of is_unbeaten being “no.”

If you’re relatively new to R, pay careful attention to how we are counting observations inside a column where a query is true. A lot of beginners, and I did this too, will create a binary variable for game results, 0 or 1, and sum those to calculate wins. But you don’t need to do that! Instead, you can simply do sum(result == “W”) to count the number of rows where a team won a game. Simple things like this will help in writing clean, concise code.

game_results <- game_results %>% 
  summarize(
    cum_loss = cumsum(result == 'L'),
    is_unbeaten = ifelse(cum_loss == 0, 'yes', 'no'),
    first_loss = first(date[which(is_unbeaten == 'no')]),
    days_diff = first(days_diff[which(is_unbeaten == 'no')]),
    .by = c(team, year)
  ) %>% 
  slice_max(days_diff, n = 1, by = year) %>% 
  distinct(year, team, days_diff)

Stacking logos with custom vjust + fill colors

There are a few seasons where multiple teams ended as the last one standing. To address this, we are going to create a vjust column so that our logos can “stack” on top of one another (if multiple teams are present).

We can do this with a case_when statement and some simple logic. The dimensions of the USC logo are a bit different, for whatever reason, so we’re handling that specific year by separating our logic statements. Feel free to play around with these numbers, if you’d like, but these are the baselines that I found to work best with this plot.

We are grouping by year, evident through .by = year, so n() and row_number() refer to the total count and position in the group, respectively. This is a convenient way to avoid needing to create more variables to accomplish the same task.

game_results <- game_results %>% 
  mutate(vjust = case_when(n() == 1 ~ 0.465,
                           !team %in% c('Baylor', 'USC') &
                               n() > 1 ~ 0.51 - (row_number() * 0.045),
                           team == 'Baylor' ~ 0.465,
                           team == 'USC' ~ 0.408),
         .by = year)

Fill color

Finally, we want to highlight years in which the last unbeaten fell within 65 days of the season tip. We are going to use another mutate call to assign one of two colors based on the days_diff value. I like this magenta color, but feel free to switch either one.

game_results <- game_results %>% 
  mutate(fill = ifelse(days_diff <= 65, '#B08CCF', 'grey70'))

Plotting the data

That’s all of the data that we need! {dplyr} provides some powerful tools for making data analysis intuitive and quick. Let’s throw it over to {ggplot2} and {cbbplotR}.

Coloring and filling with strings

Sometimes you might have columns with either color names (e.g., “red”) or hex strings, as we do above, but when you try to color or fill based on those columns, you’ll notice that the colors default to red and blue! The scale_X_identity family of functions allow you to map pre-scaled values directly — in this case, color names or hex strings.

To handle this, we must use scale_fill_identity and scale_color_identity while referencing our fill column inside the aes argument. To not interfere with the fill and color of team logos, it’s vital that your fill and color aes only appear in geom_col. By default, every geom will inherit any aes placed inside the initial ggplot() function.

If you are unsure about what this means, please reference the code below, or — better yet — experiment with placing the fill and color aes in different places to see what happens (you won’t break anything).

Expanding axes

When you make a standard plot, you might notice that the points do not “hug” the y-axis, meaning that there is some separation between the first plotted observation and the y-axis. Normally, this space is fine and lets the plot “breathe,” but sometimes it looks a bit funky. I think the latter applies in our case, and to remove that separation, we need to use the expand argument inside scale_x_continuous. You can see how this works below, and again, I encourage you to play around with the values to see how the graph responds.

Panel grid redundancy

A point of clarification: I don’t believe that a panel grid is appropriate for our visualization. To remove them, you would typically place panel.grid = element_blank() inside a theme call. However, there is a peculiarity with the {hrbrthemes} package, which we are using here, where doing so does not remove them. Instead, you need to individually set the major and minor grid lines to be blank. If you are following along and notice the former redundancy, just understand that this package is requiring us to separate those lines (shrugs).

game_results %>% 
  ggplot(aes(year, days_diff, team = team)) +
  geom_col(aes(fill = fill, color = fill), position = "identity") +
  geom_cbb_teams(aes(vjust = vjust), width = 0.055) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_y_continuous(limits = c(0, 145)) +
  scale_x_continuous(expand = c(0,0)) +
  geom_text(
    aes(label = glue("{days_diff} ({year})")), 
    angle = 90, color = 'white', nudge_y = -10,
    family = 'Roboto Condensed', fontface = 'bold',
    size = 4.5
  ) +
  theme_ipsum_rc() +
  theme(plot.title.position = 'plot',
        plot.subtitle = element_text(vjust = 2.8, size = 16),
        plot.title = element_text(size = 24),
        plot.caption = element_text(size = 12),
        axis.text.x = element_blank(),
        axis.title.y = element_text(size = 12),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_blank()) +
  labs(title = 'Unbeatens are losing earlier and earlier',
       subtitle = 'Number of days needed for the final unbeaten to fall (2008-2024)',
       caption = 'Data by cbbdata + cbbplotR\nViz. + Analysis by @andreweatherman',
       x = NULL, y = 'Days since season start')

Part 2: Rating Variation Line Plot

Getting the data

For the variation line chart, we only need one piece of data: T-Rank archive ratings. If you have authorized your {cbbdata} account with KenPom, feel free to swap this data with KenPom ratings (accessed with cbd_kenpom_ratings_archive) for a more complete look (three extra seasons available). For the purpose of this blog, however, we are going to use the freely available T-Rank archive ratings.

Archive ratings

This graph doesn’t require much data; the focus is more on plotting techniques. In fact, we can grab all necessary data with just a few lines.

To avoid making two separate data frames, we can create a year_group variable that we will group by to calculate standard deviations. We can also add a column for an alpha value, which will help us in distinguishing our groups when plotting.

As useful as performing operations on dates can be, as illustrated by the previous plot, you do need to coerce them to a numeric before you are able to filter.

You might notice that we add a day to each date: T-Rank archive ratings are day-end, which means that, e.g., the final ratings on November 6, 2023 are also the ratings on the morning of November 7, 2023. It follows that this step isn’t logically needed for our plot, of course, but it’s a good idea to get into the practice of doing this with T-Rank data, especially if you are later adding on games, e.g., so that everything is on the same time scale.

plot_data <- cbd_torvik_ratings_archive() %>% 
  mutate(date = date + 1,
         start = first(date),
         days_diff = date - start,
         year_group = ifelse(year == 2024, 'current', 'past'),
         .by = year) %>% 
  filter(rank <= 50 & between(as.numeric(days_diff), 0, 144)) %>% 
  summarize(top_sd = sd(barthag),
            .by = c(days_diff, year_group)) %>% 
  mutate(alpha_group = ifelse(year_group == 'current', 1, 0.35))

Annotation data

Our plot is going to have some brief annotations, and instead of using three separate geoms for labeling, we can create a quick data frame that can be passed through to take advantage of the principles of aes in {ggplot2}.

label_data <- data.frame(
  label = c('Avg. Selection Sunday', '2015-2023', '2024'),
  x = c(124, 0, 0),
  y = c(0.0415, mean(filter(plot_data, year_group == 'past')$top_sd),
        mean(filter(plot_data, year_group == 'current')$top_sd)),
  angle = c(270, 0, 0)
)

Plotting the data

This plot is a tad more complex than our first one, but there aren’t too many more moving parts. Again, if you’re confused about what particular functions do in the code, I recommend iterating over each line to experiment with what changes when you add or remove certain things. The best way to learn is by doing.

What’s that tilde doing (data = ~ …)?

In our geom_mean_lines functions, you might notice that we are doing some weird looking thing → data = ~ filter(.x, …). As briefly mentioned earlier, each geom “inherits” all data and aesthetic calls, but we want to plot average lines for both year groups. We could create a new data frame that includes the average values, but that feels unnecessary: After all, our data is there but we just need to find a way to intuitively access it.

Enter: the tilde (~). The tilde operator is allowing us to essentially “pass through” the data object being inherited, i.e., plot_data, to a filter function that queries by year_group. The .x is a “placeholder” for that inherited data; if you’ve used across or {purrr}, you’ll quickly recognize it.

plot_data %>% 
  ggplot(aes(days_diff, top_sd)) +
  geom_mean_lines(data = ~ filter(.x, year_group == 'past'), 
                  aes(y0 = top_sd), alpha = .3, color = 'white') +
  geom_mean_lines(data = ~ filter(.x, year_group == 'current'), 
                  aes(y0 = top_sd), color = 'white') +
  geom_vline(xintercept = 124, color = 'white', linetype = 'dashed') +
  geom_line(linewidth = 1, aes(group = year_group, 
                               alpha = alpha_group)) +
  geom_richtext(data = label_data, 
                aes(x, y, label = label, angle = angle), 
                family = 'Roboto Condensed', fontface = 'bold',
                text.color = 'white', hjust = 0, label.color = NA, 
                fill = '#1e1e1e', size = 3.6) +
  scale_alpha_identity() +
  scale_y_continuous(labels = scales::label_percent()) +
  scale_x_continuous(labels = c('Pre.', '50', '100', '150')) +
  hrbrthemes::theme_modern_rc() +
  theme(legend.position = 'none',
        plot.title.position = 'plot',
        plot.subtitle = element_text(vjust = 2.7),
        plot.caption.position = 'plot',
        plot.caption = element_text(hjust = 0),
        axis.title.x = element_text(vjust = -2),
        axis.title.y = element_text(vjust = 2)) +
  labs(title = "There's finally more parity in men's college basketball",
       subtitle = 'Standard deviation between top 50 T-Rank teams through each day of the season (2015-2024). Values are represented\nas projected win percentage vs. average team on neutral floor. Average year-long SD is shown.',
       x = 'Days into the season',
       y = 'Top 50 Barthag SD',
       caption = 'Data by cbbdata\nViz. + Analysis by @andreweatherman') 

Full Code

Plot 1: Bar Chart

Getting the data

game_results <- cbd_torvik_game_box() %>% 
  # ensure we only account for D-1 teams
  filter(team %in% cbd_teams()$common_team) %>% 
  arrange(date) %>% 
  mutate(start_date = first(date), 
         days_diff = date - start_date, 
         .by = year) %>% 
  summarize(
    cum_loss = cumsum(result == 'L'),
    is_unbeaten = ifelse(cum_loss == 0, 'yes', 'no'),
    first_loss = first(date[which(is_unbeaten == 'no')]),
    days_diff = first(days_diff[which(is_unbeaten == 'no')]),
    .by = c(team, year)
  ) %>% 
  slice_max(days_diff, n = 1, by = year) %>% 
  distinct(year, team, days_diff) %>% 
  mutate(vjust = case_when(n() == 1 ~ 0.465,
                           !team %in% c('Baylor', 'USC') &
                             n() > 1 ~ 0.51 - (row_number() * 0.045),
                           team == 'Baylor' ~ 0.465,
                           team == 'USC' ~ 0.408),
         fill = ifelse(days_diff <= 65, '#B08CCF', 'grey70'),
         .by = year)

Plotting

game_results %>% 
  ggplot(aes(year, days_diff, team = team)) +
  geom_col(aes(fill = fill, color = fill), position = "identity") +
  geom_cbb_teams(aes(vjust = vjust), width = 0.055) +
  scale_fill_identity() +
  scale_color_identity() +
  scale_y_continuous(limits = c(0, 145)) +
  scale_x_continuous(expand = c(0,0)) +
  geom_text(
    aes(label = glue("{days_diff} ({year})")), 
    angle = 90, color = 'white', nudge_y = -10,
    family = 'Roboto Condensed', fontface = 'bold',
    size = 4.5
  ) +
  theme_ipsum_rc() +
  theme(plot.title.position = 'plot',
        plot.subtitle = element_text(vjust = 2.8, size = 16),
        plot.title = element_text(size = 24),
        plot.caption = element_text(size = 12),
        axis.text.x = element_blank(),
        axis.title.y = element_text(size = 12),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_blank()) +
  labs(title = 'Unbeatens are losing earlier and earlier',
       subtitle = 'Number of days needed for the final unbeaten to fall (2008-2024)',
       caption = 'Data by cbbdata + cbbplotR\nViz. + Analysis by @andreweatherman',
       x = NULL, y = 'Days since season start')

Saving

ggsave(plot = last_plot(), 'last_unbeaten.png', dpi = 600, bg = 'white', w = 7.54, h = 9.31)

Plot 2: Line Chart

Getting the data

plot_data <- cbd_torvik_ratings_archive() %>% 
  mutate(date = date + 1,
         start = first(date),
         days_diff = date - start,
         year_group = ifelse(year == 2024, 'current', 'past'),
         .by = year) %>% 
  filter(rank <= 50 & between(as.numeric(days_diff), 0, 144)) %>% 
  summarize(top_sd = sd(barthag),
            .by = c(days_diff, year_group)) %>% 
  mutate(alpha_group = ifelse(year_group == 'current', 1, 0.3))

label_data <- data.frame(
  label = c('Avg. Selection Sunday', '2015-2023', '2024'),
  x = c(124, 0, 0),
  y = c(0.0415, mean(filter(plot_data, year_group == 'past')$top_sd),
        mean(filter(plot_data, year_group == 'current')$top_sd)),
  angle = c(270, 0, 0)
)

Plotting

plot_data %>% 
  ggplot(aes(days_diff, top_sd)) +
  geom_mean_lines(data = ~ filter(.x, year_group == 'past'), 
                  aes(y0 = top_sd), alpha = .3, color = 'white') +
  geom_mean_lines(data = ~ filter(.x, year_group == 'current'), 
                  aes(y0 = top_sd), color = 'white') +
  geom_vline(xintercept = 124, color = 'white', linetype = 'dashed') +
  geom_line(linewidth = 1, aes(group = year_group, 
                               alpha = alpha_group)) +
  geom_richtext(data = label_data, 
                aes(x, y, label = label, angle = angle), 
                family = 'Roboto Condensed', fontface = 'bold',
                text.color = 'white', hjust = 0, label.color = NA, 
                fill = '#1e1e1e', size = 3.6) +
  scale_alpha_identity() +
  scale_y_continuous(labels = scales::label_percent()) +
  scale_x_continuous(labels = c('Pre.', '50', '100', '150')) +
  hrbrthemes::theme_modern_rc() +
  theme(legend.position = 'none',
        plot.title.position = 'plot',
        plot.subtitle = element_text(vjust = 2.7),
        plot.caption.position = 'plot',
        plot.caption = element_text(hjust = 0),
        axis.title.x = element_text(vjust = -2),
        axis.title.y = element_text(vjust = 2)) +
  labs(title = "There's finally more parity in men's college basketball",
       subtitle = 'Standard deviation between top 50 T-Rank teams through each day of the season (2015-2024). Values are represented\nas projected win percentage vs. average team on neutral floor. Average year-long SD is shown.',
       x = 'Days into the season',
       y = 'Top 50 Barthag SD',
       caption = 'Data by cbbdata\nViz. + Analysis by @andreweatherman')

Saving

ggsave(plot = last_plot(), w = 8.9, h = 7, 'parity_trank.png', dpi = 600)

If you found this walkthrough and code useful, please consider subscribing below and sharing the post! It helps me a ton.

Today, we will be using my new package, {cbbplotR}, which provides {ggplot2} and {gt} extensions for visualizing college basketball team and conference logos + player headshots.

Specifically, we will be creating this neat game performance table, highlighting team-wide four factors on a game-by-game basis — and underscoring the powerful combination of {cbbdata} and {cbbplotR} in the process!

Getting the data

This visualization uses data from {cbbdata}. If you have not yet installed the package and created an account, follow the steps outlined here. As a caveat: This visualization will utilize KenPom data. To access this data, you need to authorize your KenPom account on CBBData, which can be done using this function.

If you do not have an active KenPom subscription, don’t worry! The data that we need is public and front-facing, and I will include the necessary script to pull the data so you can produce the same table.

The process needed to grab our data involves using a few joins, so to simplify the process, we will walk through each “segment” individually. The full source code, included at the bottom of this post, will be more concise.

This code relies on v0.2 of both {cbbdata} and {cbbplotR}, which were released on January 5th. Please run this chunk to load the required libraries and update both packages.

pak::pak(c('andreweatherman/cbbdata', 'andreweatherman/cbbplotR'))
pkgs <- c('cbbdata', 'cbbplotR', 'gt', 'gtExtras', 'tidyverse', 'glue')
invisible(lapply(pkgs, library, character.only = TRUE))

Data: Game Stats and NET

The most important piece of our table, evidently, is game data. We are plotting “Four Factors,” which is a group of statistics defined by Dean Oliver as integral to winning basketball games. It’s a decades-old concept that has held true against the test of time. Using {cbbdata}, we can quickly get these data on a per-game level (caveat: D-1 vs. D-1 games only).

We also want to include the score of the game, and we can use the {glue} package to build the score by concatenate two columns. We are also going to adjust our game date to be more readable.

Finally, we want to include NET rankings and quadrant boundaries. As hinted earlier, the new update to {cbbdata} includes a function to do this for us. If you are not familiar with the NET or quadrants, you can learn more here.

Since we are plotting Duke’s performance, we only need to request the Blue Devils’ game results. If you wish to plot another team (or year), remember to switch out all instances of Duke for your own team (or year). The process is the same.

factors_net <- cbd_torvik_game_stats(year = 2024, team = 'Duke') %>% 
    arrange(date) %>%
    cbd_add_net_quad() %>%
    mutate(score = glue('{pts_scored}-{pts_allowed}'),
           date = format(date, '%b. %e'))  %>% 
    select(date, result, opp, score, off_ppp, off_efg,
           off_to, off_or, off_ftr, def_ppp, def_efg, def_to,
           def_or, def_ftr, game_score, net, quad)

Data: Relative Performance

Barttorvik includes a neat stat called Game Score, which is denoted as game_score in our data above. Game score can be thought of as a composite look at how well your team played in a given game. In a nutshell, game score is a per-game Barthag rating, which — while typically viewed across the aggregate where it down-weights mismatches — is an estimation of a team’s winning chances vs. the average team on a neutral floor. Game score is judged on a [0, 100] scale and is positive (scores closer to 100 are better).

With this information, we can create a data column that says, “In this game, my team played similar to how the T-Rank #X team would be expected to play against the same opponent.” Another appropriate interpretation would be a quick view of team consistency; this can be judged by looking at both the game_score column and our new one. Obviously, game score is pretty volatile at a per-game level, but it’s still nice to look at.

To do this, we need to create a function that pulls the closest current national ranking that corresponds to that game score.

find_closest_rank <- function(scores) {
  map_int(scores, function(score) {
    differences <- abs(ratings$barthag - score / 100)
    closest_index <- which.min(differences)
    ratings$barthag_rk[closest_index]
  })
}

ratings <- cbd_torvik_ratings(year = 2024) # get current rankings

Now, we can apply it to our data.

factors_net <- factors_net %>% 
  mutate(closest_rank = find_closest_rank(game_score))

Data: KenPom Rankings

Finally, we want to include KenPom rankings in our table. If you have an active KenPom subscription, I recommend authorizing it using {cbbdata} to make the process much more streamlined. But if you do not have one, current rankings are public information, and I will include the necessary code below.

KenPom Rankings through {cbbdata}

If you have authorized your account, here is how you would grab current rankings and join them over.

current_kp <- cbd_kenpom_ratings(year = 2024) %>% 
  select(opp = team, rank = rk)

factors_net <- left_join(factors_net, current_kp, by = 'opp')

KenPom Rankings with {rvest}

If you do not have a KenPom account, you can still grab current rankings. Since KenPom is a static site and current rankings are public-facing (no paywall), we can use a combination of {rvest}, {janitor}, and {tidyverse} to retrieve and clean them.

Since not all KenPom team names natively match over to conventions found in {cbbdata}, we need to create a matching dictionary. Then, we use {rvest} to parse the KenPom index page (current data) and pull the static HTML table. html_table will natively return a list, even if only one table is found, so we use the pluck function from {purrr} to “lift” the first element from the nested list. We then use a few functions from {janitor} to clean the data and later employ our matching dictionary created at the start of the chunk.

teams <- cbd_teams() %>% select(team = common_team, kp = kp_team)

team_matching <- teams %>% pull('team') %>% 
  rlang::set_names(cbbdata::cbd_teams()$kp)

current_kp <- rvest::read_html('https://kenpom.com') %>% 
  rvest::html_table() %>% 
  pluck(1) %>% 
  janitor::row_to_names(1) %>% 
  janitor::clean_names() %>% 
  select(opp = team, rank = rk) %>% 
  mutate(opp = team_matching[opp]) %>% 
  filter(!is.na(opp))

factors_net <- left_join(factors_net, current_kp, by = 'opp')

This isn’t terribly complicated code, but you can see the evident advantage to using {cbbdata} — which also includes daily KenPom rating archives back to 2011-12 for subscribers.

Visualizing in {gt}

{cbbplotR} utility functions

Our table will use a few functions from {cbbplotR} to aid in creating our table. Here is a quick overview of each.

Adding opponent logos

Our table includes logos of each Duke opponent, which is a nice way of quickly identifying any game of interest. This process involves mashing together some HTML, but {cbbplotR} includes a function called gt_cbb_teams that will do this for us!

Our table will have some dark fill colors for wins and losses, so let’s use dark mode logos for our opponents. By default, gt_cbb_teams pulls normal logos, but you can set logo_color = “dark” to get dark ones.

We also want to include the KenPom rank of each opponent, but we need to add it after we have called gt_cbb_teams. Then, let’s create a new frame called table_data.

table_data <- factors_net %>% 
  # we want to add HTML in the opp col. and rewrite it -> so: opp, opp
  gt_cbb_teams(opp, opp, logo_color = 'dark') %>% 
  mutate(opp = glue('{opp} (#{rank})'))

Creating the title

If you notice, our table header is pretty cool. It includes Duke’s logo, which is a nice way of quickly identifying the subject of our data. Making a header like this includes tinkering with some HTML — but luckily, {cbbplotR} ships with a function that will build the header for us! More specifically, it will allow us to include a team logo, conference logo, player headshot, or a custom image by passing through an external link. As you’ll see later in the code, we will eventually need to wrap this object in HTML.

To include a logo for Duke, we set the value to Duke and the type to “team”. We can set a table title + subtitle and adjust the fonts, weights, and line-heights of both as well (which we won’t do).

gt_title <- gt_cbb_logo_title(
  title = 'Game-by-game efficiency performance for Duke in 2023',
  subtitle = 'D1 vs. D1 only. Data, rankings, and quadrants are current
  as of Jan. 5.',
  value = 'Duke',
  type = 'team'
)

Coloring win/loss rows

{cbbplotR} ships with another utility function, gt_color_results, that will take a column of game results — either W/L characters or 1/0 binaries — and fill each row relative to the game result. It’s a tidy way of replicating two tab_style calls in a single line. You can also adjust the win/loss_color (fill) and the wins/loss_text_color. By default, the font color is white, which we will keep.

Setting the table font

The final {cbbplotR} utility function is gt_set_font, which is a quick and dirty way of changing the font in all customizable parts of your table. You’ll notice that we will still use tab_style to adjust the weights of our column labels, however, and it should be noted that gt_set_font does not yet offer customization aside from changing the font family. You can think of it as a nice way to test different fonts in your table.

Building the table

Now that we have briefly explored each {cbbplotR} function, created our table header, and finalized our data, let’s throw it over to {gt}!

Okay, there’s a lot going on here. If you’re relatively new to {gt}, I really recommend that you step through each line. It might seem overwhelming, but many of the functions are intuitively named, and running the code line-by-line should help you understand what’s happening.

Optional CSS

I’m not going to walk through every function, but I did want to briefly mention the opt_css line at the end. opt_css is a way of adding CSS to your tables, which really extends table possibilities. In fact, {gt} is just converting everything to HTML — which is why we can get some neat customization with our table header.

In our table, specifically, we use this CSS to decrease the spacing between each footnote and our caption lines. To make this work, we need to set a table ID, which we do in the second line with gt(id = 'duke') and then reference that ID as a selector.

table_data %>% 
  gt(id = 'duke') %>% 
  gt_theme_538() %>% 
  fmt_markdown(opp) %>% 
  cols_move(date, opp) %>% 
  cols_move_to_end(quad) %>% 
  cols_hide(c(result, rank, net)) %>% 
  cols_align(columns = everything(), 'center') %>% 
  cols_align(columns = opp, 'left') %>% 
  cols_label(opp = 'opponent (KenPom Rk.)', off_ppp = 'PPP', 
             def_ppp = 'PPP',off_efg = 'eFG%', off_to = 'TOV%', 
             off_or = 'Reb%',off_ftr = 'FTA/FGA', def_efg = 'eFG%',
             def_to = 'TOV%', def_or = 'Reb%', def_ftr = 'FTA/FGA',
             game_score = 'Eff. Score', quad = 'NET Quad',
             closest_rank = 'Like #') %>% 
  gt_color_results() %>% 
  tab_style(locations = cells_column_labels(),
            style = cell_text(font = 'Oswald', weight = 'bold')) %>% 
  tab_style(locations = cells_title(), style =
              cell_text(font = 'Oswald')) %>% 
  tab_options(table.font.names = 'Oswald', data_row.padding = 2) %>% 
  gt_add_divider(score, include_labels = FALSE, color = 'black') %>% 
  gt_add_divider(off_ftr, include_labels = FALSE, color = 'black') %>% 
  gt_add_divider(def_ftr, include_labels = FALSE, color = 'black') %>% 
  tab_spanner(off_ppp:off_ftr, label = 'Offensive Performance',
              id = 'offense') %>% 
  tab_spanner(def_ppp:def_ftr, label = 'Defensive Performance',
              id = 'defense') %>% 
  tab_footnote(cells_column_spanners(spanner = c('offense', 'defense')),
               footnote = "Points per possession + 'Four Factors'
               (effective FG%, turnover rate, off/def rebound rate,
               and FTA per 100 FGA)") %>% 
  tab_footnote(cells_column_labels(columns = game_score),
               footnote = 'This value is used to calculate the
               proceeding column and can be viewed as a [0-100]
               composite game performance score') %>%
  tab_footnote(cells_column_labels(columns = closest_rank),
               footnote = 'This game performance is roughly
               equivalent to how #X would be expected to play in the
               same game (Barttorvik)') %>% 
  tab_header(title = html(gt_title)) %>% 
  tab_source_note(md('Data by cbbdata + cbbplotR
                     <br>Viz. + Analysis by @andreweatherman')) %>% 
  opt_css(
    '
      #duke .gt_sourcenote{
        line-height: 1.2;
        padding-top: 9px !important;
      }
      #duke .gt_footnote {
        padding-top: 7px !important;
        padding-bottom: 7px !important;
        line-height: 0.2;
      }
      '
  )

Full Code

Loading libraries

pak::pak(c('andreweatherman/cbbdata', 'andreweatherman/cbbplotR'))
pkgs <- c('cbbdata', 'cbbplotR', 'gt', 'gtExtras', 'tidyverse', 'glue')
invisible(lapply(pkgs, library, character.only = TRUE))

Finding closest rank function

find_closest_rank <- function(scores) {
  map_int(scores, function(score) {
    differences <- abs(ratings$barthag - score / 100)
    closest_index <- which.min(differences)
    ratings$barthag_rk[closest_index]
  })
}
ratings <- cbd_torvik_ratings(year = 2024)

KenPom data

If you have authorized your KenPom account on {cbbdata}.

current_kp <- cbd_kenpom_ratings(year = 2024) %>% 
  select(opp = team, rank = rk)

If you have not authorized your KenPom account.

teams <- cbd_teams() %>% select(team = common_team, kp = kp_team)

team_matching <- teams %>% pull('team') %>%
  rlang::set_names(cbbdata::cbd_teams()$kp)

current_kp <- read_html('https://kenpom.com') %>%
  html_table() %>%
  pluck(1) %>%
  row_to_names(1) %>%
  clean_names() %>%
  select(opp = team, rank = rk) %>% 
  mutate(opp = team_matching[opp]) %>%
  filter(!is.na(opp))

Table data

table_data <- cbd_torvik_game_stats(year = 2024, team = 'Duke') %>% 
  arrange(date) %>%
  cbd_add_net_quad() %>% 
  mutate(score = glue('{pts_scored}-{pts_allowed}'),
         closest_rank = find_closest_rank(game_score),
         date = format(date, '%b. %e'),
         location = NULL) %>% 
  select(date, result, opp, score, off_ppp, off_efg,
         off_to, off_or, off_ftr, def_ppp, def_efg, def_to,
         def_or, def_ftr, game_score, closest_rank, net, quad) %>% 
  left_join(current_kp, by = 'opp') %>% 
  gt_cbb_teams(opp, opp, logo_color = 'dark') %>%
  mutate(opp = glue('{opp} (#{rank})'))

Table header

gt_title <- gt_cbb_logo_title(
  title = 'Game-by-game efficiency performance for Duke in 2023',
  subtitle = 'D1 vs. D1 only. Data, rankings, and quadrants are current
  as of Jan. 5.',
  value = 'Duke',
  type = 'team'
)

Creating the table

table <- table_data %>% 
  gt(id = 'duke') %>% 
  gt_theme_538() %>% 
  fmt_markdown(opp) %>% 
  cols_move(date, opp) %>% 
  cols_move_to_end(quad) %>% 
  cols_hide(c(result, rank, net)) %>% 
  cols_align(columns = everything(), 'center') %>% 
  cols_align(columns = opp, 'left') %>% 
  cols_label(opp = 'opponent (KenPom Rk.)', off_ppp = 'PPP', 
             def_ppp = 'PPP',off_efg = 'eFG%', off_to = 'TOV%', 
             off_or = 'Reb%',off_ftr = 'FTA/FGA', def_efg = 'eFG%',
             def_to = 'TOV%', def_or = 'Reb%', def_ftr = 'FTA/FGA',
             game_score = 'Eff. Score', quad = 'NET Quad',
             closest_rank = 'Like #') %>% 
  gt_color_results() %>% 
  tab_style(locations = cells_column_labels(),
            style = cell_text(font = 'Oswald', weight = 'bold')) %>% 
  tab_style(locations = cells_title(), style =
              cell_text(font = 'Oswald')) %>% 
  tab_options(table.font.names = 'Oswald', data_row.padding = 2) %>% 
  gt_add_divider(score, include_labels = FALSE, color = 'black') %>% 
  gt_add_divider(off_ftr, include_labels = FALSE, color = 'black') %>% 
  gt_add_divider(def_ftr, include_labels = FALSE, color = 'black') %>% 
  tab_spanner(off_ppp:off_ftr, label = 'Offensive Performance',
              id = 'offense') %>% 
  tab_spanner(def_ppp:def_ftr, label = 'Defensive Performance',
              id = 'defense') %>% 
  tab_footnote(cells_column_spanners(spanner = c('offense', 'defense')),
               footnote = "Points per possession + 'Four Factors'
               (effective FG%, turnover rate, off/def rebound rate,
               and FTA per 100 FGA)") %>% 
  tab_footnote(cells_column_labels(columns = game_score),
               footnote = 'This value is used to calculate the
               proceeding column and can be viewed as a [0-100]
               composite game performance score') %>%
  tab_footnote(cells_column_labels(columns = closest_rank),
               footnote = 'This game performance is roughly
               equivalent to how #X would be expected to play in the
               same game (Barttorvik)') %>% 
  tab_header(title = html(gt_title)) %>% 
  tab_source_note(md('Data by cbbdata + cbbplotR
                     <br>Viz. + Analysis by @andreweatherman')) %>% 
  opt_css(
    '
      #duke .gt_sourcenote{
        line-height: 1.2;
        padding-top: 9px !important;
      }
      #duke .gt_footnote {
        padding-top: 7px !important;
        padding-bottom: 7px !important;
        line-height: 0.2;
      }
      '
  )

Saving the table

Sometimes, gtsave_extra can be a bit finicky. If your table is not saving, try restarting your R Session (you’ll then need to re-load the libraries).

gtsave_extra(table, 'team_performance.png')

If you found this walkthrough and code useful, please consider subscribing below and sharing the post!

Today, we will be recreating a recent Todd Whitehead post. This is a neat grid that gives a creative spin on visualizing career distributions. I am really digging the 2048-vibe and the ‘Scorigami’ potential.

Let’s get started!

Getting the data

This visualization is going to use the {cbbdata} R package. If you missed it, I recently released cbbdata after eight months of development. To use it, you need to install the package, register for an API key, and set-up your credentials in R. Everything is entirely free, and the process takes less than one minute. You can learn more on the package website.

For this visualization, we are going to plot point and rebound combinations for Purdue’s Zach Edey — the reigning national player of the year and the odds-on favorite to repeat. You can choose a different player, and/or you can choose to plot different statistical combinations.

Let’s start by loading the required libraries.

library(tidyverse)
library(cbbdata)
library(ggtext)
library(nflplotR)

We need to define “bins” for point and rebound totals. After which, we will create new columns that define where each total falls relative to our bins. I am using increments of five for points and increments of three for rebounds. Feel free to play around with the data and find which bins work best for you.

data <- cbd_torvik_player_game(player = 'Zach Edey') %>%
  mutate(reb = oreb + dreb) %>% # fixes one `reb` NA
  select(player, team, pts, reb) %>% 
  mutate(pts_bucket = case_when(
    pts < 10 ~ '<10',
    pts >= 10 & pts < 15 ~ '10-14',
    pts >= 15 & pts < 20 ~ '15-19',
    pts >= 20 & pts < 25 ~ '20-24',
    pts >= 25 ~ '25+'
  ),
  reb_bucket = case_when(
    reb < 5 ~ '<5',
    reb >= 5 & reb < 8 ~ '5-7',
    reb >= 8 & reb < 11 ~ '8-10',
    reb >= 11 & reb < 14 ~ '11-13',
    reb >= 14 ~ '14+'
  ))

We want to make sure that our plot includes point + rebound combinations that might be zero (not achieved yet). To do this, we are going to create a tibble with our bin definitions and use expand.grid to create a new object that includes all possible bin combinations.

bins <- tibble(
  pts_bucket = c('<10', '10-14', '15-19', '20-24', '25+'),
  reb_bucket = c('<5', '5-7', '8-10', '11-13', '14+')
)

bins_grid <- bins %>% expand.grid()

Next, we need to summarize our data to count the number of games where Edey achieved each bin pair. In other words, if Edey put up 15 points and 10 rebounds in one game, that would count for an observation with a 15-19 point bin and an 8-10 rebound bin. We are also going to join on our bins data after we count pairs so that our graph will include possible combinations that have not yet been achieved.

We are going to add levels to our bucket columns so that our plot axes are in the correct order (small → large). If you don’t do this, your bins (X-Y axes) will likely be misordered when you plot them.

plot_data <- data %>%
  count(pts_bucket, reb_bucket) %>%
  full_join(bins_grid, by = c('pts_bucket', 'reb_bucket')) %>%
  mutate(pts_bucket = fct(pts_bucket,
                          levels = c('<10', '10-14', '15-19', 
                                     '20-24', '25+')),
         reb_bucket = fct(reb_bucket,
                          levels = c('<5', '5-7', '8-10', 
                                     '11-13', '14+')),
         n = replace_na(n, 0))

Finally, we want to plot a picture of Edey, so we will grab his headshot from ESPN. You can get a headshot of any player by going to their ESPN college career page, right clicking on their headshot, and selecting Copy Image Address.

headshot = 'https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4600663.png&w=350&h=254'

Plot the data

That’s all of the data that we need! {cbbdata} makes accessing clean and tidy college basketball data in R a breeze. Now for the fun part: Let’s use {ggplot2} to create a 2048-style player grid for Zach Edey.

This plot is going to make use of the {nflplotR} package to render in our player headshot. If you are doing anything with team logos, I highly recommend using it. While the geom_from_path function is pulled from the {ggpath} package (same developer), {nflplotR} does include a very handy ggpreview function that is a life-saver when plotting multiple team logos. We will not be using that function in this code, but out of habit, I usually import {nflplotR}.

Custom fonts

We will be using the Oswald font from Google Fonts. If you do not have that installed on your machine, you can download it for free. If you are on a Windows machine, you might have to do a few more things to get your font to work with {ggplot2}. In my experience, custom fonts on Mac OS might only require an R session restart if you just downloaded Oswald.

Clipping and drawing outside of the panel

We want to plot the headshot “outside” of the coordinate system, i.e. above our plot and in-line with the title, so we need to specify coord_fixed(clip = “off”) — which will allow plotting outside of the panel (X-Y).

And specifically, we are going to set our x and y values inside geom_from_path to Inf so that our headshot is forced to the top right of our plot. We are going to use hjust and vjust to tweak the position of the headshot. If you are plotting a different player, be sure to adjust these values so that your headshot is properly positioned.

Theme

We adjusted a number of things in the theme function to get our grid to look just right. Most of what we did is mess around with margins to create distance between elements in our plot. If you aren’t exactly sure what each parameter does, I encourage you to change the values to see what happens!

plot_data %>% 
  ggplot(aes(x = pts_bucket, y = reb_bucket)) +
  geom_tile(aes(fill = n), color = 'white', linewidth = 3) +
  geom_from_path(aes(path = headshot), x = Inf, y = Inf,  width = 0.25,
                 hjust = 1.05, vjust = 0.41) +
  geom_richtext(aes(label = n, color = '#2C2F2B'), size = 7,
                label.color = NA, fill = NA,
                family = 'Oswald-Medium') +
  scale_color_identity() +
  scale_fill_gradient(low = '#F2F2F2', high = '#F7565A') +
  coord_fixed(clip = 'off') +
  theme_minimal() +
  theme(legend.position = 'none',
        plot.title = element_text(family = 'Oswald-Medium',
                                  size = 20, vjust = 0),
        plot.subtitle = element_text(family = 'Oswald-Regular',
                                     color = 'grey40',
                                     size = 10, vjust = 0.5),
        plot.caption = element_markdown(family = 'Oswald-Regular',
                                        lineheight = 1.3,
                                        margin = margin(t = 20),
                                        color = 'grey40', hjust = 0,
                                        size = 8),
        plot.title.position = 'plot',
        plot.caption.position = 'plot',
        axis.text.x = element_text(family = 'Oswald-Regular',
                                   size = 10, color = 'grey40',
                                   margin = margin(t = -4, b = -4)),
        axis.text.y = element_text(family = 'Oswald-Regular',
                                   size = 10, color = 'grey40',
                                   margin = margin(l = -4, r = -4)),
        axis.title.x = element_text(family = 'Oswald-Medium',
                                    vjust = -3, size = 12),
        axis.title.y = element_text(family = 'Oswald-Medium',
                                    vjust = 3, size = 12),
        plot.margin = margin(30, 30, 30, 30),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
  labs(x = 'POINTS',
       y = 'REBOUNDS',
       title = 'Box Scorigami: Zach Edey',
       subtitle = 'No. of career games with different combinations of points + rebounds',
       caption = 'Data by cbbdata through Dec. 27, 2023<br>Viz.
       + Analysis by @andreweatherman<br>Inspiration from @CrumpledJumper')

Saving

One more thing to note: When I was making this plot, ggsave was giving me lots of trouble, and I had to resort to using png to save it. If you experience similar issues, run the above code — ensuring that your graph is showing in your Plots pane — and use this to save it (replacing the file name as needed).

png('plot.png', res = 600, width = 7, height = 7,
    bg = 'white', units = 'in')
print(p)
dev.off()

Full code

And that’s it! The 2048-tile graph doesn’t take much to make, but it’s an effective, intuitive, and clean way of displaying statistic distributions for players. This code can be used to reproduce graphs for college basketball or as a general framework with which to build similar plots for other sports. My example uses a width and height of 7 inches and a DPI of 600 when saving.

library(tidyverse)
library(cbbdata)
library(ggtext)
library(nflplotR)


data <- cbd_torvik_player_game(player = 'Zach Edey') %>%
  mutate(reb = oreb + dreb) %>% # fixes one `reb` NA
  select(player, team, pts, reb) %>% 
  mutate(pts_bucket = case_when(
    pts < 10 ~ '<10',
    pts >= 10 & pts < 15 ~ '10-14',
    pts >= 15 & pts < 20 ~ '15-19',
    pts >= 20 & pts < 25 ~ '20-24',
    pts >= 25 ~ '25+'
  ),
  reb_bucket = case_when(
    reb < 5 ~ '<5',
    reb >= 5 & reb < 8 ~ '5-7',
    reb >= 8 & reb < 11 ~ '8-10',
    reb >= 11 & reb < 14 ~ '11-13',
    reb >= 14 ~ '14+'
  ))

###

bins <- tibble(
  pts_bucket = c('<10', '10-14', '15-19', '20-24', '25+'),
  reb_bucket = c('<5', '5-7', '8-10', '11-13', '14+')
)

bins_grid <- bins %>% expand.grid()

###

headshot = 'https://a.espncdn.com/combiner/i?img=/i/headshots/mens-college-basketball/players/full/4600663.png&w=350&h=254'

plot_data <- data %>%
  count(pts_bucket, reb_bucket) %>%
  full_join(bins_grid, by = c('pts_bucket', 'reb_bucket')) %>%
  mutate(pts_bucket = fct(pts_bucket,
                          levels = c('<10', '10-14', '15-19', 
                                     '20-24', '25+')),
         reb_bucket = fct(reb_bucket,
                          levels = c('<5', '5-7', '8-10', 
                                     '11-13', '14+')),
         n = replace_na(n, 0))

###

plot_data %>% 
  ggplot(aes(x = pts_bucket, y = reb_bucket)) +
  geom_tile(aes(fill = n), color = 'white', linewidth = 3) +
  geom_from_path(aes(path = headshot), x = Inf, y = Inf,  width = 0.25,
                 hjust = 1.05, vjust = 0.41) +
  geom_richtext(aes(label = n, color = '#2C2F2B'), size = 7,
                label.color = NA, fill = NA,
                family = 'Oswald-Medium') +
  scale_color_identity() +
  scale_fill_gradient(low = '#F2F2F2', high = '#F7565A') +
  coord_fixed(clip = 'off') +
  theme_minimal() +
  theme(legend.position = 'none',
        plot.title = element_text(family = 'Oswald-Medium',
                                  size = 20, vjust = 0),
        plot.subtitle = element_text(family = 'Oswald-Regular',
                                     color = 'grey40',
                                     size = 10, vjust = 0.5),
        plot.caption = element_markdown(family = 'Oswald-Regular',
                                        lineheight = 1.3,
                                        margin = margin(t = 20),
                                        color = 'grey40', hjust = 0,
                                        size = 8),
        plot.title.position = 'plot',
        plot.caption.position = 'plot',
        axis.text.x = element_text(family = 'Oswald-Regular',
                                   size = 10, color = 'grey40',
                                   margin = margin(t = -4, b = -4)),
        axis.text.y = element_text(family = 'Oswald-Regular',
                                   size = 10, color = 'grey40',
                                   margin = margin(l = -4, r = -4)),
        axis.title.x = element_text(family = 'Oswald-Medium',
                                    vjust = -3, size = 12),
        axis.title.y = element_text(family = 'Oswald-Medium',
                                    vjust = 3, size = 12),
        plot.margin = margin(30, 30, 30, 30),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()) +
  labs(x = 'POINTS',
       y = 'REBOUNDS',
       title = 'Box Scorigami: Zach Edey',
       subtitle = 'No. of career games with different combinations of points + rebounds',
       caption = 'Data by cbbdata through Dec. 27, 2023<br>Viz.
       + Analysis by @andreweatherman<br>Inspiration from @CrumpledJumper')

What does this mean?

We will use Barttorvik data (T-Rank; a leading college basketball metric) to compute venue-adjusted win totals for each AP Preseason Top 25 team and then compare to how the average ranked team would be expected to perform against the exact same schedule. We will walk through the process of how to visualize our results in the table below, all using R and open-source data!

This code will work throughout the season, so keep it handy if you want to create similar graphics as the season progresses!

How do I use Buckets & Bytes

Buckets & Bytes aims to provide a comprehensive code walkthrough, from start to finish, using engaging data. For some, the code discussion might not be necessary. For others, I hope you find some value in this tutorial. Our walkthrough is spread across three sections: Extraction, analysis, and visualization.

If you are just interested in the full source code, that can be found here and at the bottom of the article.

What do I need to know?

Each post in this series will assume different levels of R and analytics knowledge. Today’s code will use rvest, dplyr, purrr, and gt — but you should have a foundational understanding of R and the tidyverse. I will provide detailed explanations at times but might gloss over true beginner concepts.

Part 1: Data Extraction

You can run this code to install and load all necessary packages.

needed_packages <- c('tidyverse', 'rvest', 'gt', 'gtExtras', 'withr')
installed_packages <- needed_packages %in% rownames(installed.packages())
if (any(installed_packages == FALSE)) {
  install.packages(packages[!installed_packages])
}

invisible(lapply(needed_packages, library, character.only = TRUE))

Grabbing the season schedule

The first thing we must do is grab the season schedule. Luckily, Barttorvik has this easily accessible in .CSV form — so we can simply pass that url to the read_csv function. Importantly, the loaded CSV has no pre-defined column headers, so to ensure that R does not infer the first row to be the column headers, causing us to lose one game, we need to specify `col_names = FALSE` and manually set our own headers. Once we do that, let’s simplify some things and only choose the needed columns (neutral, home, and away).

Important: If you are on Windows, you will need to run this line before you try to scrape the website to avoid 403 errors. For some reason, his site blocks the User-Agent of Windows machines.

withr::local_options(HTTPUserAgent='Buckets & Bytes')

withr::local_options(HTTPUserAgent='Buckets & Bytes')
schedule <- read_csv("https://barttorvik.com/2024_master_sked.csv", col_names = FALSE) %>%
  setNames(c('game_id', 'game_date', 'game_type', 'neutral', 'away', 'home')) %>%
  select(neutral, home, away)

Our `schedule` data should look like this. `neutral` is essentially a boolean column, with 1 indicating a neutral-site game.

Scraping preseason team ratings

Next up: Web scraping! Now that we have our season schedule, we need to have some reference point for team strength: For this visualization, we are going to stick with Barttorvik and use his T-Rank metric rating. Lucky for us, this metric is easily accessible on the home page!

Navigating to it, we can see that the data is nicely visualized inside an HTML table. If you are new to web scraping in R, a general rule of thumb is that if data is contained inside a static HTML table, the html_table() function in `rvest` should be able to retrieve it. Let’s check:

I have run into a few issues in the past scraping his website on Windows. If you run into connection errors, you can pull in the data using this code. You will then be able to run across() on it below. There’s nothing we can do about connection errors.

read_csv('https://gist.github.com/andreweatherman/f7c5e850a88f22b0577599fbc9d26da9/raw/928588a1afbddf1c49266cf3b56892be6682793f/bytes_ratings_connection_error.csv')

# withr::local_options(HTTPUserAgent='Buckets & Bytes')
read_html('https://barttorvik.com/trankpre.php') %>%
   html_table()

When we run that code, a tibble with all data is properly returned — awesome! What you might notice, however, is that our column headers are a bit inconvenient — e.g. `Proj. Rec`, `Ret Mins`, etc. We won’t be touching any of these columns, but out of habit, I always run the clean_names() function from the `janitor` package to quickly tidy headers. Again, that line isn’t necessary for our analysis — it just renames column headers with a more friendly syntax — but my code will assume you run it.

If you look closely at our data, you might notice that all columns are character types. Since we will be running quantitative analysis, we must covert a few columns to the numeric type. Specifically, we want `adj_oe` and `adj_de` to be numbers. (These represent the estimated points allowed/scored per 100 possessions, adjusted for team and opponent strength.)

We can use the `mutate` function from the `dplyr` package (part of the `tidyverse`) to essentially “modify” both columns with as.numeric(). Using mutate(), there are two ways to approach this problem. The first is to iterate over every column, one variable at a time; the second, and a more rigorous option, is to use across() to apply identical transformations to a range of columns at once. Looking back on my early days of self-teaching R, I wish that I had grasped the concept of across() sooner: The syntax might look strange at first, but trust me, it will save you loads of typing!

across() requires two arguments — the range of columns and the function(s) to apply. Diving deep into across() is out of scope for this blog entry, but let’s see how it works with our data. (`.x` is simply telling as.numeric() to run on the two referenced columns.)

ratings <- read_html('https://barttorvik.com/trankpre.php') %>%
   html_table() %>%
   pluck(1) %>%
   janitor::clean_names() %>%
   mutate(across(c(adj_oe, adj_de), ~ as.numeric(.x))) %>%
   select(team, adj_oe, adj_de)

# if you run into connection errors, replace the code from read_html to clean_names with the ratings data in the link above

A brief aside about the use of `pluck` above: html_table() returns a list. To access our tibble and perform any sort of analysis or visualization, we need to “retrieve” our data from the list (well, not really but only Sickos would reference an index position throughout this code). pluck() is a simple way to index within a list and “pluck” out the desired element. In this case, our data is just at index position 1.

A tibble for the preseason top 25 teams

Necessary for this analysis, of course, is data for the Associated Press’ ‘Preseason Top 25’ poll. Now, you could scrape this information from the poll website itself, but to be honest, it might be quicker to hard-encode the data yourself. (Importantly, we will need team names to match later on, so I decided to manually write the data.)

ap_top_25 <- tibble(
  rank = 1:25,
  team = c('Kansas', 'Duke', 'Purdue', 'Michigan St.', 'Marquette', 'Connecticut', 'Houston', 'Creighton', 'Tennessee',
           'Florida Atlantic', 'Gonzaga', 'Arizona', 'Miami FL', 'Arkansas', 'Texas A&M', 'Kentucky', 'San Diego St.', 'Texas',
           'North Carolina', 'Baylor', 'USC', 'Villanova', "Saint Mary's", 'Alabama', 'Illinois')
)

Join on T-Rank ratings

Now that we have the preseason ranked teams, we can use our `ratings` table to “join” or “merge” with the `ap_top_25` data. Essentially, we want the `adj_oe` and `adj_de` of each ranked team. There are a few ways to approach this, and we are going to use the `left_join` function.

left_join() adds the columns from “y,” the second data frame, to “x,” the first data frame listed, based on matching keys. Importantly, left_join() ensures that all observations in “x” are kept, regardless of whether a match was found in “y.” For our use, it helps identify whether we misspelt a team in the manual tibble above.

At first, joins can be difficult to understand. Below is how we are structuring our code. We're combining the `ap_top_25` dataset with the `ratings` data, matching by team names. This means each team in the `ap_top_25` frame will now be supplemented with their `adj_oe` and `adj_de` values from the `ratings` table.

ap_top_25 <- left_join(ap_top_25, ratings, by = 'team')

What have we done in Part 1?

Part 1 is all about data extraction with a splash of cleaning. Let’s break down what we’ve done.

1. We used read_csv() to access a .CSV file of the 2023-24 season schedule on the barttorvik website. We renamed and selected the necessary columns.

2. We used read_html() from the `rvest` package to scrape the ratings table on the barttorvik website. We introduced the clean_names() function from `janitor` and touched on how to use across() to apply the same function to a range of columns.

3. We manually encoded data for the preseason AP Top 25.

4. We used left_join() to join the ratings data with the AP Top 25 data.

Part 2: Data Analysis

That’s all the data we need! Now for the next part: Analysis! Remember that we are trying to calculate the difference in expected wins between each AP Top 25 team and the average AP Top 25 team.

Function Building

For our analysis, we are going to write a general function that adds all required information and then simply loop over it for each team. Writing functions is a good way to clean up your code and make your work reproducible.

As a note: When “team” is referenced in the explanations below, keep in mind that we are building a function. In other words, `team` is an argument that will be filled by whichever school we insert into the function. It could be Duke or Kansas or Purdue, etc.

Game location + opponent

parse_wp <- function(team) {
  
  schedule %>%
    filter(home == team | away == team) %>%

    mutate(
      # add game location
      game_location = case_when(
      home == team & neutral == 0 ~ 'home',
      away == team & neutral == 0 ~ 'away',
      .default = 'neutral'
    ),

    team = team,

    opponent = if_else(team == home, away, home),

    avg_ap_adj_oe = mean(ap_top_25$adj_oe),
    avg_ap_adj_de = mean(ap_top_25$adj_de))

   # FUNCTION LOGIC WILL CONTINUE BELOW...
  
}

Importantly, we want to adjust for venue, but our schedule data frame doesn’t have any explicit “game location” column, so we must write that logic ourselves. For this, we can use a `case_when` statement inside `mutate` — which you can think of as chaining together multiple if/else statements. The logic is simple: If the game is not at a neutral site (`neutral == 0`) and the team is listed under the `home` column, it is a home game. This is reversed for road trips. If neither condition is matched (i.e. `neutral == 1`), then case_when() will return the `.default` statement, which we have coded as ‘neutral’.

We will also create a column to indicate the opponent for each game using an `if/else` statement. Lastly, let’s go ahead and on the average AP Top 25 team’s offensive and defensive efficiency. We will use this in a later section.

Team and opponent ratings

Now let’s add the ratings that we previously scraped for both the team and their opponents. There are multiple ways to “merge” data in R, but to keep things consistent, we are again going to fall back on left_join(). Adding on team ratings is fairly straightforward.

For opponent ratings, however, we need to rename columns to specify that they indicate opponent ratings. We can quickly do this using select() with the form `new_column_name = old_column_name` (e.g. `opp_adj_oe = adj_oe`). If you’ve used SQL, you might notice that this runs parallel to SELECT old_name AS new_name.

Equality Joins

Before we can run this join, however, we need to reference the “keys” (or columns) to match on. If you look at the column names of `ratings` with `names(ratings)`, you see that we have `team`, `adj_oe`, and `adj_de`. If we do not specify the key to merge on, `left_join` will pick the only matching one — `team`. But these are opponent ratings, not the `team` rating, so we need to merge with the `opponent` column that we created in the last step.

Merging on keys with different names is called an “equality” join, and `dplyr` makes this very simple with the `join_by` function: just supply the column names and separate with `==`. If you want to learn more about joins, you can read more here!

You might notice that we could have just renamed the `team` column to `opponent` in the `select` step; in practice, this is an easier implementation, but I wanted to demonstrate a use of `join_by`.

parse_wp <- function(team) {
  
   # ... PREVIOUS CODE ...

    left_join(ratings %>% select(team, opp_adj_oe = adj_oe, opp_adj_de = adj_de), join_by('opponent' == 'team')) %>%
    
    left_join(ap_top_25 %>% select(-rank), by = 'team')

   # ... FUNCTION LOGIC WILL CONTINUE BELOW...
  
}

Venue-adjust the ratings

Now that we have ratings and game location, let’s adjust efficiencies for each game. Barttorvik uses a 1.3% adjustment constant. For home games, offensive efficiency is multiplied by 1.013 and defensive efficiency is multiplied by 0.987. For away games, offensive efficiency is multiplied by 0.987 and defensive efficiency is multiplied by 1.013. For neutral site games, no adjustment is made. (Remember that defensive efficiency is points allowed per 100 possessions, so a lower value is better.)

Helper Function

To make our code cleaner, let’s write a “helper function” that we can apply to our data. There are ways to make this function shorter, but in effort to keep use consistent, we will stick with case_when().

adjust_efficiency <- function(df) {
  adjusted <- df %>%
    mutate(
      # off. ratings for team and AP average (NOT opponent)
      across(ends_with("oe") & !starts_with("opp"), 
             ~ case_when(
               game_location == "home" ~ . * 1.013,
               game_location == "away" ~ . * 0.987,
               .default = . # no change for neutral
             )),
      # def. ratings for team and AP average (NOT opponent)
      across(ends_with("de") & !starts_with("opp"), 
             ~ case_when(
               game_location == "home" ~ . * 0.987,
               game_location == "away" ~ . * 1.013,
               .default = .
             )),
      # off. ratings for opponent (game location is switched!)
      across(opp_adj_oe, 
             ~ case_when(
               game_location == "home" ~ . * 0.987, 
               game_location == "away" ~ . * 1.013,
               .default = .
             )),
      # def. ratings for opponent (game location is switched!)
      across(opp_adj_de, 
             ~ case_when(
               game_location == "home" ~ . * 1.013,
               game_location == "away" ~ . * 0.987,
               .default = .
             ))
    )
  
  return(adjusted)
}

Let’s briefly explore the logic: Again, we are using across(), but we are introducing the ends_with() and starts_with() functions. They select columns based on some suffix or prefix. Because our columns follow a naming standard, we can use those functions here to avoid typing out all columns. For a quick refresh on our column names at this point in the (larger) function:

We are iterating over every column that ends with “oe,” which are our offensive efficiency columns, and those which end with “de,” our defensive efficiency columns. For example, this is the same thing typing `across(c(‘avg_opp_adj_oe’, ‘adj_oe’, ‘opp_adj_oe’))` but less typing!

Importantly, remember that our `game_location` column is in reference to the team, so a home game is an away one for the opponent and should be treated as such. Because of this, we need to not select the opponent columns — so we use `!starts_with(‘opp’)`, which removes all matching columns that start with ‘opp’.

To adjust opponent columns, we simply iterate over the opponent ratings columns using the same logic but switch our adjustment constant!

To apply the helper function, we just add it to our piping chain.

parse_wp <- function(team) {
  
   # ... PREVIOUS CODE ...

    adjust_efficiency()

   # ... FUNCTION LOGIC WILL CONTINUE BELOW...
  
}

Calculate per-game winning percentage

Pythag Metric

Now that we have our location-adjusted efficiencies, we are one step closer towards calculating win percentages. Barttorvik uses the Pythagorean expectation to estimate the win probability for a given game — a formula first created by Bill James for baseball. For our use, we need to calculate each team’s `pythag` with their location-adjusted efficiencies. The formula is:

We can just throw this into a mutate() step!

parse_wp <- function(team) {
  
   # ... PREVIOUS CODE ...

    mutate(team_pythag = (adj_oe^11.5) / (adj_oe^11.5 + adj_de^11.5),
      avg_ap_pythag = (avg_ap_adj_oe^11.5) / (avg_ap_adj_oe^11.5 + avg_ap_adj_de^11.5),
      opp_pythag = (opp_adj_oe^11.5) / (opp_adj_oe^11.5 + opp_adj_de^11.5))

   # ... FUNCTION LOGIC WILL CONTINUE BELOW...
  
}

Win probability

Now that we have ‘pythag’ values, we can calculate win probability for every game. The formula that Barttorvik uses is below and directly uses the values that we just appended.

Again, we can just throw this in mutate(). Importantly, we will only calculate win probabilities for each team and the average AP team; we do not care about opponent win probabilities. At this point, we have 17 columns in our data frame, but we only need three, so we will select the pertinent ones.

parse_wp <- function(team) {
  
   # ... PREVIOUS CODE ...

     team_wp = (team_pythag - team_pythag * opp_pythag) / (team_pythag + opp_pythag - 2 * team_pythag * opp_pythag),
    ap_wp = (avg_ap_pythag - avg_ap_pythag * opp_pythag) / (avg_ap_pythag + opp_pythag - 2 * avg_ap_pythag * opp_pythag)) %>%
    select(team, team_wp, ap_wp)

   # ... FUNCTION LOGIC WILL CONTINUE BELOW...
  
}

Our full function

Great — now our function is finished. Let’s put it all together:

parse_wp <- function(team) {
  
  win_percentages <- schedule %>%
    filter(home == team | away == team) %>%
    mutate(
      game_location = case_when(
      home == team & neutral == 0 ~ 'home',
      away == team & neutral == 0 ~ 'away',
      .default = 'neutral'
    ),
    team = team,
    opponent = if_else(team == home, away, home),
    avg_ap_adj_oe = mean(ap_top_25$adj_oe),
    avg_ap_adj_de = mean(ap_top_25$adj_de)) %>%
    left_join(ratings %>% select(team, opp_adj_oe = adj_oe, opp_adj_de = adj_de), join_by('opponent' == 'team')) %>%
    left_join(ap_top_25 %>% select(-rank), by = 'team') %>%
    adjust_efficiency() %>%
    mutate(
      team_pythag = (adj_oe^11.5) / (adj_oe^11.5 + adj_de^11.5),
      avg_ap_pythag = (avg_ap_adj_oe^11.5) / (avg_ap_adj_oe^11.5 + avg_ap_adj_de^11.5),
      opp_pythag = (opp_adj_oe^11.5) / (opp_adj_oe^11.5 + opp_adj_de^11.5),
      team_wp = (team_pythag - team_pythag * opp_pythag) / (team_pythag + opp_pythag - 2 * team_pythag * opp_pythag),
      ap_wp = (avg_ap_pythag - avg_ap_pythag * opp_pythag) / (avg_ap_pythag + opp_pythag - 2 * avg_ap_pythag * opp_pythag)
    ) %>%
    select(team, team_wp, ap_wp)
  
  return(win_percentages)
  
}

If you’ve followed along to this point and have questions about what specific things do in the function, please reach out to me on Twitter! This is the first post in the series, so I am still figuring out what might be “too much” — or not enough! — explanation.

Loop over the function

Now that we have our function, we can “loop over it” to get data for each ranked team. For full transparency, I hate for-loops. I think they are unintuitive, clunky, and need precise writing to ensure optimization. (They aren’t necessarily bad to use, though!) Lucky for us, we can lean on the `map` family of functions in `purrr`. These mapping functions essentially apply a function(s) to each element in a vector or list. If you want to learn more about `purrr` — and I highly recommend that you do — check out this great introduction by package maintainer, and R GOAT, Hadley Wickham.

For our use, we are going to use map_dfr(). This function will iterate over the input vector (in this case, the teams in our `ap_top_25` data frame) and bind the rows of the result. In other words, it will output a single tibble with all data!

game_preds <- map_dfr(ap_top_25$team, \(team) parse_wp(team))

Let’s walk through our code. map_dfr() takes a single input (map2_dfr will take two and pmap_dfr will take unlimited as a list). Our first argument is our input, which we will feed into our second argument (our function). Remember that we want to iterate over all preseason AP top 25 teams, and those are listed in the `team` column in `ap_top_25` frame — so we will pull those out using `ap_top_25$team`.

Let’s explore that “weird” syntax in the second argument. `\(team)` is essentially saying, “We want to reference our input vector as `team`.” We could have put basically any other thing here as our reference name — “school,” “program,” “university,” etc. All this is doing is telling our function what to expect our input vector to be referred to as in the function. After that, we simply call our `parse_wp` function and pass our input vector — named `team` — to the function and run it!

Summarize the results

Now that we have our game predictions, we can quickly add up the expected wins using summarize(). Expected wins can simply be calculated as the summation of win percentage. First, though, we need to remove all games with no win percentage (these are games versus non-D1 teams).

game_preds_summarized <- game_preds %>%
  filter(!is.na(team_wp)) %>%
  summarize(
    team_wins = sum(team_wp),
    ap_wins = sum(ap_wp),
    diff = team_wins - ap_wins,
    .by = team
  )

The `.by` argument is another way to “group” our summarization without writing a group_by() step. We want to group by each team to return the expected team wins and AP wins by team schedule. This will apply the set of calculations to each team instead of every row at once.

Add team logos and rank

To make our table easier to read, let’s add team logos to plot. You can grab a .CSV of team logos from my GitHub. Again, we are using an equality join between `team` and `common_team`. We are also adding a column to indicate AP preseason rank. We know this will simply be the row number of each team as they are already in order. `.before` is telling `mutate` where we want the rank column to appear.

Lastly, we will create a column that includes the HTML we need to correctly format the team logos and names column. The idea here is to place the team names to the right of their respective logo in a single column, with the text aligned in the middle relative to the logo. If you aren’t familiar with HTML, that’s completely okay. This step isn’t necessary for understanding how to make the visualization.

teams <- read_csv('https://gist.github.com/andreweatherman/cd2a258b7a75dc75cd86940e29f28af9/raw/12a2cd5f919a681ab4711c4b5082385bacd78c2e/teams.csv') %>%
    select(common_team, logo)

game_preds_summarized <- game_preds_summarized %>%
    left_join(teams, join_by('team' == 'common_team')) %>%
    mutate(ap_rank = row_number(), .before = team) %>%
    mutate(team_logo = glue::glue("<img src='{logo}' style='height: 25px; width: auto; vertical-align: middle;'> {team}"))

What have we done in Part 2?

Part 2 is all about analyzing our data. Let’s break down what we’ve done.

1. Used case_when() to identify game location relative to `team`.

2. Introduced equality joins to merge on rating data.

   1. join_by(“first_column” == “second_column”)

3. Defined a helper function using case_when() and selection helpers — starts_with() and ends_with() — to compute venue-adjusted ratings.

4. Applied pre-defined Pythag and win probability formulas.

5. Used map_dfr() to loop over our parse_wp() function and return results for all teams in a single tibble.

6. Summarized the resulting table per-team with the `.by` argument in summarize().

7. Brought in team logos for plotting using an equality join.

Part 3: Data Visualizing

Now for the fun part: Visualizing our data! For this visualization, we will be using the `gt` and `gtExtras` packages to create a table. For this section, I will break up the code in chunks, explaining each step, and include the final table code at the bottom.

Step 1: Basic table construction

game_preds_summarized %>%
   gt(id='ap') %>%
   gt_theme_excel() %>%
   fmt_markdown(team_logo) %>%
   cols_hide(c(team, logo)) %>%
   cols_move(team_logo, after = ap_rank) %>%
   cols_align(columns = c(team_wins, ap_wins, diff, ap_rank), align = 'center') %>%
   cols_align(columns = team_logo, align = 'left') %>%
   cols_label(
    ap_rank = 'Rank',
    team_logo = 'Team',
    team_wins = 'TM Wins',
    ap_wins = 'AP Wins',
    diff = 'Diff.')

A `gt` table can be initialized by passing data to gt(). Because we will be adding custom CSS at the end, we also need to pass an arbitrary table id to gt(). We will add on the appearance of our table later, but we can start with a base theme now, which will be gt_theme_excel() from the `gtExtras` package.

fmt_markdown() renders our HTML column from earlier. cols_hide(), cols_move(), and cols_align() simply hide, move, and align our columns. cols_label() renames our column headers in the form of `old_name` = “New Name”.

Step 2: Format numbers

game_preds_summarized %>%
  # ... PREVIOUS CODE ...

  fmt_number(columns = c(team_wins, ap_wins, diff), decimals = 2) %>%
  gt_hulk_col_numeric(diff)

fmt_number() will do a few things, but we are employing it to trim our columns to show only two decimals places. gt_hulk_col_numeric() uses a diverging purple-green color palette — one that is colorblind safe! — to fill the `diff` cell background based on its value relative to the range in the column.

Right now, our table looks like this: Pretty solid but we can still tweak a few things!

Step 3: Title, subtitle, and caption

game_preds_summarized %>%
   # ... PREVIOUS CODE ...

   tab_header(title = md('How Teams Stack Up to Avg. AP Top 25 Expectation'), subtitle = md('Venue-adjused team wins vs. expected wins by the average top 25 team')) %>%
  tab_source_note(source_note = md('Data by Barttorvik<br>Analysis + Viz. by @andreweatherman'))

tab_header() and tab_source_note() will allow us to add a title, subtitle, and caption (source note). Wrapping our text in md() lets us use Markdown-formatted text, which can be useful if we want to style text or insert purposeful line breaks (like we did in our source note).

Step 4: Table styles and options

game_preds_summarized %>%
   # ... PREVIOUS CODE ...
  
  # bold diff col. text
  tab_style(
    style = cell_text(weight = 'bold'),
    location = cells_body(columns = diff)
  ) %>%
  # control padding on header
  tab_options(
    heading.padding = 3,
    table.font.size = 15
  ) %>%
  # title font
  tab_style(
    locations = cells_title('title'),
    style = cell_text(
      font = google_font('Fira Sans'),
      weight = 600,
      size = px(19)
    )
  ) %>%
  # subtitle font
  tab_style(
    locations = cells_title('subtitle'),
    style = cell_text(
      font = google_font('Fira Sans'),
      weight = 400,
      size = px(14)
    )
  ) %>%
  # source note font
  tab_style(
    locations = cells_source_notes(),
    style = cell_text(
      font = google_font('Fira Sans'),
      weight = 400,
      size = px(12)
    )
  ) %>%
  # columns labels
  tab_style(
    locations = cells_column_labels(columns = everything()),
    style = cell_text(
      font = google_font('Fira Sans'),
      weight = 600,
      size = px(14),
      transform = 'uppercase',
      align = 'center'
    )
  ) %>%
  # table font
  opt_table_font(
    font = google_font('Fira Sans'),
    weight = 450
  )

This might seem like a lot of code — but most of it is just repeating styles for different sections!

The first tab_style() is bolding the text in the `diff` column. We can refer to a particular column’s values by referencing it in `cells_body`. The second tab_style() adjusts the padding and table font size.

The next three tab_style() calls specifies the font family, weight, and size of text in our title, subtitle, and source note. The google_font() function allows us to easily use a font from Google Fonts without having to download it. Feel free to play around with different fonts; I am using Fira Sans for this visualization.

We next modify the column labels’ font, weight, size, alignment and force them to be capitalized. We indicate that we want to change all column headers by using everything() inside cells_column_labels(). Finally, we set the table font to Fira Sans.

Step 5: Custom CSS

game_preds_summarized %>%
   # ... PREVIOUS CODE ...

   opt_css(
     css = "
     #ap .gt_heading {
      padding-bottom: 0px;
      padding-top: 6px
     }
     #ap .gt_subtitle {
      padding-top: 2px;
      padding-bottom: 6px;
     }
    "
  ) 

To put finishing touches on our table, we add brief CSS. All this does is adjust the padding on the header and subtitle: The padding was bugging me. Importantly, this only works because we set a table id at the start of our code — which we now reference here (#ap …).

Full table code and saving the table

All together, here is our final table code! We can place gtsave_extra() at the end of our code to save our table!

game_preds_summarized %>%
   gt(id='ap') %>%
   gt_theme_excel() %>%
   fmt_markdown(team_logo) %>%
   cols_hide(c(team, logo)) %>%
   cols_move(team_logo, after = ap_rank) %>%
   cols_align(columns = c(team_wins, ap_wins, diff, ap_rank), align = 'center') %>%
   cols_align(columns = team_logo, align = 'left') %>%
   cols_label(
     ap_rank = 'Rank',
     team_logo = 'Team',
     team_wins = 'TM Wins',
     ap_wins = 'AP Wins',
     diff = 'Diff.') %>%
   fmt_number(columns = c(team_wins, ap_wins, diff), decimals = 2) %>%
   gt_hulk_col_numeric(diff) %>%
   tab_header(title = md('How Teams Stack Up to Avg. AP Top 25 Expectation'), subtitle = md('Venue-adjused team wins vs. expected wins by the average top 25 team')) %>%
   tab_source_note(source_note = md('Data by Barttorvik<br>Analysis + Viz. by @andreweatherman')) %>%
   tab_style(style = cell_text(weight = 'bold'), location = cells_body(columns = diff)) %>%
   tab_options(heading.padding = 3, table.font.size = 15) %>%
   tab_style(
     locations = cells_title('title'),
     style = cell_text(
       font = google_font('Fira Sans'),
       weight = 600,
       size = px(19)
     )
   ) %>%
   tab_style(
     locations = cells_title('subtitle'),
     style = cell_text(
       font = google_font('Fira Sans'),
       weight = 400,
       size = px(14)
     )
   ) %>%
   tab_style(
     locations = cells_source_notes(),
     style = cell_text(
       font = google_font('Fira Sans'),
       weight = 400,
       size = px(12)
     )
   ) %>%
   tab_style(
     locations = cells_column_labels(columns = everything()),
     style = cell_text(
       font = google_font('Fira Sans'),
       weight = 600,
       size = px(14),
       transform = 'uppercase',
       align = 'center'
     )
   ) %>%
   opt_table_font(
     font = google_font('Fira Sans'),
     weight = 450
   ) %>%
   opt_css(
     css = "
      #ap .gt_heading {
       padding-bottom: 0px;
       padding-top: 6px
      }
      #ap .gt_subtitle {
       padding-top: 2px;
       padding-bottom: 6px;
      }
     "
   ) %>%
  gtsave_extra('ap_25_expected.png')

What have we done in Part 3?

Part 3 is all about visualizing our data. Let’s break down what we’ve done.

1. Initialized our table using gt() and piping in the summarized data.

2. Applied a basic table theme using gt_theme_excel().

3. Rendered in our HTML content using fmt_markdown().

4. Adjusted our columns using cols_hide(), cols_move(), and cols_align() and renamed column headers with cols_label().

5. Truncated numeric columns using fmt_number() and applied a colorblind-safe conditional fill with gt_hulk_col_numeric().

6. Added a table title, subtitle, and caption with tab_header() and tab_source_note().

7. Modified the font, weight, and size of our column headers, table text, and titles with tab_style().

8. Applied custom CSS using opt_css() to adjust padding.

9. Saved our table using gtsave_extra().

Full Source Code

The full source code is hosted here on GitHub.

If you found value in today’s post, I kindly ask that you please subscribe to Buckets & Bytes and consider sharing the blog with others. Subscribing is entirely free! It just ensures that you never miss a post. Sharing is never expected but always appreciated. It helps me understand what content is most valuable.

My journey with R started in the thick of COVID, with self-learning at the core, aided immensely by hands-on tutorials that made sense of complex data. It was a blend of passion, persistence, and a touch of trial and error.

Here, we’re taking a leaf out of Owen Phillips’ book, inspired by his incredible blog, The F5. We'll be exploring the world of college basketball through the lens of R programming, backed by a wealth of open-source data.

Each post here is two-fold: offering you insightful visualizations and giving you access to the source code. It’s about demystifying the process, unraveling the ‘why’ and ‘how’ behind each piece of code, aiming to arm you with the skills to forge your own path in analytics.

Who is this for?

The explanations in Buckets & Bytes will assume some foundational understanding of R. You need not be an expert by any means, but it would be helpful to have a grasp of core principles. Buckets & Bytes will walk through every step — start to finish — but for brevity, some basic knowledge will be assumed. If you are at least a few weeks into your R journey, Buckets & Bytes will be the perfect learning companion. If you are more advanced, you might still find the visualization code and accompanying walk-through helpful!

But I don’t like basketball

That’s okay! The data we will be using is mostly basketball, yes, but the concepts and skills are applicable across all fields. Feel free to bring your own data and make spin-offs of the visualizations!

I have questions about the code

Please don’t be scared to reach out! You can find me on Twitter (I will never call it X), and my DMs are always open. I would be more than happy to answer any questions and provide deeper explanations where needed.

When do you post?

My hope is to post once per week, but I’m also a full-time student, with outside obligations, and applying to graduate schools — so in reality, it will be whenever I have the time.

How can I support you?

Subscribe and share the blog! If you have feedback, you can leave a comment on the article itself, tweet me, or shoot me a direct message on Twitter.

Buckets & Bytes is completely free! I’m doing this because I genuinely learned so much from Owen Phillips’ The F5 and want to offer an alternative now that The F5 is over.

If you feel so inclined, however, you can leave a small “tip” on my KoFi page. Anything is very much appreciated.

So, let’s get to it. Your deep dive into the intricate dance between college basketball and data analytics starts now.