Empirical DIII Hockey Power Rankings

An independent, data-driven ranking exposing bias in college hockey

Author

Carter Schram

Code

library(tidyverse)
library(janitor)
library(knitr)
library(kableExtra)

Introduction

This project analyzes the relationship between recruiting quality and team success in the NCAA Division III Men’s Hockey 2025-26 season, to give an accurate power ranking not based solely off wins and losses, or conference bias.

To start… I collected data of where every single player in Division III hockey played junior hockey prior to this season, unless they are a Division I or III transfer, which was also taken into account. Below is the amount of players in D3 hockey, split up by conference.

Conference Distribution
conference	n
NESCAC	306
LEC	296
NCHA	278
SUNYAC	277
CNE	270
MIAC	259
UCHC	250
MASCAC	229
MAC	222
WIAC	165
Independent	60

Conference & Team Recruiting Weights

Next… I found the percentage of each Junior/NCAA league per roster, and gave a weight (1-6) to these previous leagues that the players on these rosters came from.

Once that is done, I compiled the data to show each conference’s weight, and each team’s average recruit weight based off their junior league/previous NCAA team…

Code

library(tidyverse)
library(readr)
library(janitor)
library(scales)
library(tidyr)
library(knitr)
library(kableExtra)
library(DT)

# Calculate Junior/Previous Team % in D3 #
league_percentages <- real_team_data %>%
  count(prev_league) %>%
  mutate(
    pct_d3 = round(100 * n / sum(n), 3)) %>%
  arrange(desc(pct_d3)) 

# Calculate Junior/Previous Team % Per Conference #
conference_percentages <- real_team_data %>%
  count(conference, prev_league) %>%
  group_by(conference) %>%
  mutate(
    pct_conference = round(100 * n / sum(n), 3))

# Create Weights For Each League #
league_weights <- real_team_data %>%
  mutate(conference_group = ifelse(is.na(conference) | conference == "",
                              "Independent",
                              conference),
    recruit_weight = case_when(
      prev_league %in% c("NCAA DI", "USHL", "BCHL") ~ 6,
      prev_league %in% c("NAHL") ~ 5,
      prev_league %in% c("AJHL","MJHL", "SJHL", "NCDC", "CCHL", "OJHL", "NCAA DIII") ~ 4,
      prev_league %in% c("EHL", "USPHL", "Prep", "MN-HS", "Euro Junior", "MHL") ~ 3,
      prev_league %in% c("GOJHL", "NOJHL", "NA3HL", "ACHA", "SIJHL", "KIJHL", "GMHL", "MJAHL", "QJHL") ~ 2,
      prev_league %in% c("U18", "CAHS", "HS", "QCHL", "VIJHL", "PJHL", "OPJHL", "CJHL") ~ 1))



# Show Conference Tiers #
conference_scores <- league_weights %>%
  group_by(conference_group) %>%
  summarise(
    players = n(),
    conference_avg_weight =  mean(recruit_weight, na.rm = TRUE)) %>%
  arrange(desc(conference_avg_weight))

conference_scores %>%
  rename(
    "Conference" = conference_group,
    "Total Players in Conference" = players,
    "Conference Average Recruit Weight" = conference_avg_weight) %>%
  
  kable(digits = 3) %>%
  kable_styling(full_width = FALSE)

Conference	Total Players in Conference	Conference Average Recruit Weight
NCHA	278	4.144
NESCAC	306	4.141
MIAC	259	4.108
WIAC	165	4.042
SUNYAC	277	3.968
UCHC	250	3.904
CNE	270	3.785
MAC	222	3.491
LEC	296	3.426
Independent	60	3.333
MASCAC	229	3.266

Code

# Show All Teams #
team_scores <- league_weights %>%
  group_by(college_team, conference_group) %>%
  summarise(
    players = n(),
    avg_recruit_weight = mean(recruit_weight, na.rm = TRUE)) %>%
  arrange(desc(avg_recruit_weight))

team_scores %>%
  rename(
    "School" = college_team,
    "Conference" = conference_group,
    "Players on Roster" = players,
    "Average Recruit Weight" = avg_recruit_weight) %>%
  
  mutate(
    `Players on Roster` = round(`Players on Roster`, 0),
    `Average Recruit Weight` = round(`Average Recruit Weight`, 3)) %>%
  
  DT::datatable(
    options = list(pageLength = 20, scrollX = TRUE),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: center; font-weight: bold;",
      "Team Average Recruit Weight"))

Recruiting vs. Team Success

Now recruiting isn’t the only variable. I took each team’s record, found their win percentage, and created a regression model to look at how each team’s roster played a part in their record for this season, and the difficulty of their conference, if in one.

Code

library(tidyverse)
library(readr)
library(janitor)
library(scales)
library(tidyr)

# Separate Record into Wins-Losses-Ties For R #
Team_Stats <- Team_Stats %>%
  separate(`Record`,
           into = c("Wins", "Losses", "Ties"),
           sep = "-",
           remove = FALSE)
Team_Stats$Ties[is.na(Team_Stats$Ties)] <- 0

Team_Stats <- Team_Stats %>%
  mutate(conference_group = ifelse(is.na(Conference) | Conference == "",
                              "Independent",
                              Conference))

New_Stats <- Team_Stats %>%
  mutate(
    Ties = ifelse(is.na(Ties), 0, Ties),
    Wins = as.numeric(Wins),
    Losses = as.numeric(Losses),
    Ties = as.numeric(Ties),
    Games = Wins + Losses + Ties,
    WinPct = Wins / Games)


# Create Roster Analysis Table #
# Team's Avg Recruit Weight #
# Team Roster Balance by Standard Deviation #
# Player Total #
team_analysis <- league_weights %>%
  group_by(college_team, conference_group) %>%
  summarise(
    avg_recruit_weight = mean(recruit_weight, na.rm = TRUE),
    recruit_sd = sd(recruit_weight, na.rm = TRUE),
    players = n())

# Create Conference-Strength Table Based on Recruit Average #
conference_scores <- team_analysis %>%
  filter(conference_group != "Independent") %>%
  group_by(conference_group) %>%
  summarise(
    conference_avg_weight = mean(avg_recruit_weight, na.rm = TRUE))


# Create Master Table #
# Join Team Stats w/ Full Roster Analysis Table #
team_recruiting <- team_analysis %>%
  left_join( New_Stats,
    by = c(
      "college_team" = "Team",
      "conference_group" = "Conference"))

team_recruiting <- team_recruiting %>%
  select(-conference_group.y)

# Add in Conference Strength #
team_recruiting <- team_recruiting %>%
  left_join(
    conference_scores %>%
      select(conference_group, conference_avg_weight),
    by = "conference_group")

team_recruiting <- team_recruiting %>%
  relocate(conference_avg_weight, .after = avg_recruit_weight)

# Start a Correlation Between Wins & Team Recruiting #
cor_value <- cor(team_recruiting$avg_recruit_weight,
                 team_recruiting$WinPct,
                 use = "complete.obs")
# Correlation is .6117, meaning strong relationship in higher recruiting to success in D3 #

# Plot a linear model of the correlation #
model1 <- lm(
  WinPct ~ avg_recruit_weight + conference_avg_weight, 
  data = team_recruiting,
  na.action = na.exclude)
# Every +1 increase in recruit weight, win % increases by .272 #
# Recruiting combined with conference weight causes 45% variation in win % across D3 hockey # 

# Graph my Linear Model #
team_recruiting <- team_recruiting %>%
  mutate(
    independent_flag = ifelse(conference_group == 
                                "Independent",
                              "Independent",
                              "Teams In Conference"))

ggplot(team_recruiting,
  aes(
    x = avg_recruit_weight,
    y = WinPct,
    color = conference_avg_weight)) +

  geom_point(
    aes(shape = independent_flag),
    size = 2.5) +

  scale_color_gradient(
    low = "red",
    high = "blue") +

  scale_shape_manual(values = c(
    "Teams In Conference" = 16,
    "Independent" = 17)) +

  geom_smooth(method = "lm", color = "black", se = FALSE) +
  theme_minimal() +
  labs(
    title = "Recruiting Quality vs Team Success in Division III Hockey",
    x = "Team's Average Recruit Weight",
    y = "Team's Win Percentage",
    color = "Conference Strength",
    shape = "Team Type")

Code

ggsave(
  filename = "d3_hockey_plot.png",
  width = 10,
  height = 6,
  dpi = 300)

A couple of points from this data:

Being that there is an upward line, and a correlation of .612, the graph shows a pretty strong relationship in higher quality recruiting to success in D3 hockey, as well as the importance of a strong conference.
For every +1 increase in recruit weight, a team’s win percentage increases by 26%.
Recruiting quality combined with conference strength influence a 41.4% variation in win percentage across D3 hockey.

Under & Over Performers

But that’s only part of the picture..
From this model, residuals were used to identify the top 10 overachieving and underachieving teams this season based on the relationship between roster quality and actual performance.

These residuals highlight which programs exceeded expectations and which fell short relative to their roster strength. Positive, and higher values, represent teams outperforming their predicted win percentage, while negative values indicate under-performance.

Code

library(knitr)

# Find Residuals #
team_recruiting$residuals <- residuals(model1)

# Top 10 Overachievers #
team_recruiting %>%
  arrange(desc(residuals)) %>%
  select(
    Team = college_team, 
    Conference = conference_group, 
    "Average Recruit Weight" = avg_recruit_weight,
    "Conference Average Recruit Weight" = conference_avg_weight,
    "Win %" = WinPct,
    Residuals = residuals) %>%
  
  head(10) %>%
  knitr::kable(digits = 3, caption = "Top 10 Overachieving Programs")

Top 10 Overachieving Programs
Team	Conference	Average Recruit Weight	Conference Average Recruit Weight	Win %	Residuals
University of Wisconsin - Stout	WIAC	3.808	4.069	0.767	0.360
Bowdoin College	NESCAC	3.824	4.155	0.680	0.286
Babson College	LEC	3.538	3.457	0.741	0.283
Westfield State University	MASCAC	2.923	3.262	0.609	0.272
Suffolk University	CNE	3.394	3.768	0.630	0.271
Hobart College	SUNYAC	4.966	3.958	0.968	0.238
Fitchburg State University	MASCAC	3.321	3.262	0.667	0.227
Anna Maria College	MASCAC	3.536	3.262	0.714	0.219
Chatham University	UCHC	4.179	3.911	0.741	0.207
Aurora University	NCHA	4.560	4.155	0.781	0.196

Code

# Top 10 Underachievers #
team_recruiting %>%
  arrange(residuals) %>%
  select(
    Team = college_team, 
    Conference = conference_group, 
    "Average Recruit Weight" = avg_recruit_weight,
    "Conference Average Recruit Weight" = conference_avg_weight,
    "Win %" = WinPct,
    Residuals = residuals) %>%
  
  head(10) %>%
  knitr::kable(digits = 3, caption = "Top 10 Underachieving Programs")

Top 10 Underachieving Programs
Team	Conference	Average Recruit Weight	Conference Average Recruit Weight	Win %	Residuals
Augsburg University	MIAC	4.714	4.126	0.280	-0.351
Rivier University	MASCAC	3.167	3.262	0.095	-0.304
Lake Forest College	NCHA	4.143	4.155	0.222	-0.254
College of St. Scholastica	MIAC	4.185	4.126	0.240	-0.253
King’s College (PA)	MAC	3.391	3.502	0.160	-0.250
Morrisville State College (SUNY)	SUNYAC	3.308	3.958	0.080	-0.219
Milwaukee School of Engineering (MSOE)	NCHA	4.533	4.155	0.370	-0.208
Wentworth Institute of Technology	CNE	3.741	3.768	0.250	-0.199
Misericordia University	MAC	3.321	3.502	0.200	-0.192
Salem State University	MASCAC	3.452	3.262	0.292	-0.182

Next, I plotted those residuals on the previous regression model to really show how many teams succeeded, and didn’t, based off their roster quality and conference strength. Teams located near the regression line performed about as expected, while teams above the line exceeded expectations, and teams below the line underperformed based on their team makeups.

Code

team_recruiting$residuals <- residuals(model1)

team_recruiting <- team_recruiting %>%
  mutate(independent_flag = ifelse(conference_group == 
                                "Independent",
                              "Independent",
                              "Teams In Conference"))

# Plot residuals on Regression map #
ggplot(team_recruiting,
       aes(x = avg_recruit_weight,
           y = WinPct)) +
  
  geom_point(
    aes(
      color = residuals,
      shape = independent_flag),
    size = 3) +
  scale_color_gradient2(
    low = "red",
    mid = "gray",
    high = "blue",
    midpoint = 0) +
  
  geom_smooth(method = "lm", color = "black") +
  scale_shape_manual(values = c(
    "Teams In Conference" = 16,
    "Independent" = 17),
    name = "Team Type") +
  theme_minimal() +
  labs(
    title = "Recruiting vs Team Success in Division III Hockey",
    x = "Team's Average Recruit Weight",
    y = "Team's Win Percentage",
    color = "Over / Under\nPerformance Score")

Code

ggsave(
  filename = "d3_residual_plot.png",
  width = 10,
  height = 6,
  dpi = 300)

Strength-of-Schedule

However, all conferences cannot be weighted the same before recruiting. So, I gathered the scores from every single game this year, and created each team and conference’s strength of schedule based off those scores as an ELO.

With the ELO, I assigned every team a starting rating of 1500, and it updates after each game based on opponent strength and game result. Wins against stronger opponents create larger gains, while losses to weaker teams result in declines.

Code

library(tidyverse)
library(readr)
library(stringr)
library(lubridate)
library(kableExtra)
library(DT)

# Call schedules from environment #
CNE_Schedule <- read_csv("CNE_Schedule.csv")
Independent_Schedules <- read_csv("Independent_Schedules.csv")
LEC_Schedule <- read_csv("LEC_Schedule.csv")
MAC_Schedule <- read_csv("MAC_Schedule.csv")
MASCAC_Schedule <- read_csv("MASCAC_Schedule.csv")
MIAC_Calendar <- read_csv("MIAC_Calendar.csv")
NCHA_Schedule <- read_csv("NCHA_Schedule.csv")
NESCAC_Schedule <- read_csv("NESCAC_Schedule.csv")
SUNYAC_Schedule <- read_csv("SUNYAC_Schedule.csv")
UCHC_Standings <- read_csv("UCHC_Standings.csv")
WIAC_Schedule <- read_csv("WIAC_Schedule.csv")


# Clean Each dataset first #

clean_schedule <- function(df) {
  df %>%
    mutate(
      Date = as.Date(Date, tryFormats = c("%m/%d/%y", "%m/%d/%Y", "%Y-%m-%d")),
      `Away Team` = str_squish(`Away Team`),
      `Home Team` = str_squish(`Home Team`),
      `Away Score` = as.numeric(`Away Score`),
      `Home Score` = as.numeric(`Home Score`)) %>%
    
    # remove duplicates INSIDE each file first
    distinct(Date, `Away Team`, `Home Team`, `Away Score`, `Home Score`, .keep_all = TRUE)}

CNE_Schedule <- clean_schedule(CNE_Schedule)
Independent_Schedules <- clean_schedule(Independent_Schedules)
LEC_Schedule <- clean_schedule(LEC_Schedule)
MAC_Schedule <- clean_schedule(MAC_Schedule)
MASCAC_Schedule <- clean_schedule(MASCAC_Schedule)
MIAC_Calendar <- clean_schedule(MIAC_Calendar)
NCHA_Schedule <- clean_schedule(NCHA_Schedule)
NESCAC_Schedule <- clean_schedule(NESCAC_Schedule)
SUNYAC_Schedule <- clean_schedule(SUNYAC_Schedule)
UCHC_Standings <- clean_schedule(UCHC_Standings)
WIAC_Schedule <- clean_schedule(WIAC_Schedule)

# Bind ALL Schedules #
nationwide_schedule <- bind_rows(
  CNE_Schedule,
  Independent_Schedules,
  LEC_Schedule,
  MAC_Schedule,
  MASCAC_Schedule,
  MIAC_Calendar,
  NCHA_Schedule,
  NESCAC_Schedule,
  SUNYAC_Schedule,
  UCHC_Standings,
  WIAC_Schedule)

nationwide_schedule <- nationwide_schedule %>%
  mutate(
    `Away Team` = str_replace(`Away Team`, "Milwaukee School of Engineering", "Milwaukee School of Engineering (MSOE)"),
    `Home Team` = str_replace(`Home Team`, "Milwaukee School of Engineering", "Milwaukee School of Engineering (MSOE)"),

    `Away Team` = str_squish(`Away Team`),
    `Home Team` = str_squish(`Home Team`))

# Make True Game ID #
nationwide_schedule <- nationwide_schedule %>%
  mutate(
    team_a = pmin(`Away Team`, `Home Team`),
    team_b = pmax(`Away Team`, `Home Team`),
    score_a = pmin(`Away Score`, `Home Score`),
    score_b = pmax(`Away Score`, `Home Score`),

    game_id = paste(Date, team_a, team_b, score_a, score_b)) %>%
  
  distinct(game_id, .keep_all = TRUE)

# Create full schedule #
games_long <- bind_rows(
  nationwide_schedule %>%
    transmute(
      game_id,
      team = `Away Team`,
      opponent = `Home Team`,
      team_score = `Away Score`,
      opponent_score = `Home Score`,
      Conf_Game),

  nationwide_schedule %>%
    transmute(
      game_id,
      team = `Home Team`,
      opponent = `Away Team`,
      team_score = `Home Score`,
      opponent_score = `Away Score`,
      Conf_Game))

games_long <- games_long %>%
  mutate(
    team = str_squish(team),
    opponent = str_squish(opponent),
    result = as.integer(team_score > opponent_score))

# ELO Setup #
# Give Each Team Start Rating #
team_elo <- games_long %>%
  distinct(team) %>%
  mutate(elo = 1500)

# ELO Function #
update_elo <- function(df, k = 20) {
  
  elo <- df %>%
    distinct(team) %>%
    mutate(elo = 1500)
  
  for (i in 1:nrow(df)) {
    
    t1 <- df$team[i]
    t2 <- df$opponent[i]
    r <- df$result[i]
    
    r1 <- elo$elo[elo$team == t1]
    r2 <- elo$elo[elo$team == t2]
    
    p1 <- 1 / (1 + 10 ^ ((r2 - r1) / 400))
    
    elo$elo[elo$team == t1] <- r1 + k * (r - p1)
    elo$elo[elo$team == t2] <- r2 + k * ((1 - r) - (1 - p1))
  }
  
  elo
  }


# Join national schedule with team info #
team_lookup <- team_scores %>%
  select(college_team, conference_group)

games_long <- games_long %>%
  left_join(team_lookup %>%
              rename(team_conference = conference_group),
            by = c("team" = "college_team")) %>%
  left_join(team_lookup %>%
              rename(opponent_conference = conference_group),
            by = c("opponent" = "college_team"))

# Put NAs as Non DIII #
invisible(
  games_long %>%
    filter(is.na(team_conference) | is.na(opponent_conference)) %>%
    select(team, opponent))
invisible(
  team_scores %>%
    filter(college_team %in% c("problem team here")))

games_long <- games_long %>%
  mutate(
    team_conference = ifelse(is.na(team_conference), "Non DIII", team_conference),
    opponent_conference = ifelse(is.na(opponent_conference), "Non DIII", opponent_conference))

# Run ELO and Join with Game Log #
team_elo <- update_elo(games_long)

team_ratings <- team_elo %>%
  arrange(desc(elo)) %>%
  mutate(rank = row_number())

# Attach ELO to opponent for SOS calculation
games_long <- games_long %>%
  left_join(team_elo, by = c("opponent" = "team")) %>%
  rename(opp_elo = elo)

# NEW: Weight postseason games more heavily


# Determine Team SOS #
team_sos <- games_long %>%
  group_by(team, team_conference) %>%
  summarise(
    sos = mean(opp_elo, na.rm = TRUE),
    win_pct = mean(result, na.rm = TRUE),
    games = n(),
    .groups = "drop")


team_sos <- team_sos %>%
  left_join(team_ratings %>% select(team, elo),
            by = "team")

# Graph Team SOS #
team_sos %>%
  filter(team_conference != "Non DIII") %>%
  select(
    Team = team,
    Conference = team_conference,
    "SOS" = sos,
    "Win %" = win_pct,
    Games = games) %>%
  
  mutate(
    SOS = round(SOS, 3),
    `Win %` = round(`Win %`, 3)) %>%
  
  arrange(desc(SOS)) %>%
  
  DT::datatable(
    options = list(pageLength = 20, scrollX = TRUE),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: center; font-weight: bold;",
      "Team Strength of Schedule Rankings"))

Code

# Determine Conference Strength Based off Team SOS #
conference_strength <- team_sos %>%
  group_by(team_conference) %>%
  summarise(
    avg_sos = mean(sos, na.rm = TRUE),
    avg_win_pct = mean(win_pct, na.rm = TRUE),
    avg_elo = mean(elo, na.rm = TRUE),
    teams = n(),
    .groups = "drop") %>%
  arrange(desc(avg_elo))

# Graph Conference SOS #
conference_strength %>%
  filter(team_conference != "Non DIII") %>%
  select(
    Conference = team_conference,
    "Conference SOS (Avg)" = avg_sos,
    "Conference Win %" = avg_win_pct,
    "Teams" = teams) %>%
  
  arrange(desc(`Conference SOS (Avg)`)) %>%
  knitr::kable(digits = 3, caption = "Conference Strength of Schedule Rankings") %>%
  kableExtra::kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE)

Conference Strength of Schedule Rankings
Conference	Conference SOS (Avg)	Conference Win %	Teams
NESCAC	1555.461	0.510	10
UCHC	1518.811	0.506	9
NCHA	1513.027	0.460	10
WIAC	1512.008	0.511	6
SUNYAC	1504.586	0.454	10
LEC	1503.379	0.465	10
MIAC	1502.997	0.435	9
CNE	1501.533	0.464	9
Independent	1482.774	0.417	2
MAC	1480.982	0.424	8
MASCAC	1472.105	0.424	8

Final Ranking

Now that we can see how many teams did well, and who disappointed all around, I made an accurate and representative power ranking that takes more into account than just winning, talent, or conference notoriety.

The ranking is based on a program score that combines each team’s performance in the previous three aspects, relative to the rest of Division III hockey. The weighted combination goes as such:

Win Percentage (35%)
Recruiting Strength (25%)
Conference Strength (20%)
Strength of Schedule (20%)

Winning remains the most heavily weighed factor, as success is the primary indicator of a team’s performance, followed by recruiting quality, overall conference strength, and strength of schedule. Higher program scores indicate teams that were better positioned to succeed this season based on both roster strength and competitive competition.

Code

library(knitr)
library(kableExtra)
library(stats)
library(DT)

# Ungroup rankings so final ranking is separate #
team_recruiting <- ungroup(team_recruiting)


# Join ELO into Table #

team_recruiting <- team_recruiting %>%
  select(-starts_with("elo"))

team_recruiting <- team_recruiting %>%
  left_join(
    team_ratings %>% select(team, elo),
    by = c("college_team" = "team"))

# Standardize recruiting strength, conference strength, and winning percentage #
# Arrange in order of program score #
final_rankings <- team_recruiting %>%
  mutate(
    avg_recruit_weight = as.numeric(avg_recruit_weight),
    WinPct = as.numeric(WinPct),
    elo = as.numeric(elo),

    recruit_z = (avg_recruit_weight - mean(avg_recruit_weight, na.rm = TRUE)) /
      sd(avg_recruit_weight, na.rm = TRUE),

    win_z = (WinPct - mean(WinPct, na.rm = TRUE)) /
      sd(WinPct, na.rm = TRUE),
    
    elo_z = (elo - mean(elo, na.rm = TRUE)) /
      sd(elo, na.rm = TRUE),

    conference_z = ifelse(
      conference_group == "Independent",
      0,
      (conference_avg_weight -
         mean(conference_avg_weight, na.rm = TRUE)) /
        sd(conference_avg_weight, na.rm = TRUE)),
    
     program_score =
      0.25 * recruit_z +
      0.35 * win_z +
      0.20 * conference_z +
      0.20 * elo_z) %>%
  
  arrange(desc(program_score)) %>%
  mutate(rank = row_number())

# Display Final Program Rankings #
final_rankings %>%
  mutate(
    program_score = round(program_score, 3),
    avg_recruit_weight = round(avg_recruit_weight, 2),
    conference_avg_weight = round(conference_avg_weight, 2),
    WinPct = round(WinPct, 3),
    elo = round(elo, 0)) %>%
  
  select(
    Rank = rank,
    Team = college_team,
    Conference = conference_group,
    "Program Score" = program_score,
    "Team's Avg Recruit Weight" = avg_recruit_weight,
    "Conference Avg Recruit Weight" = conference_avg_weight,
    "Team's Win %" = WinPct,
    "ELO Rating" = elo) %>%
  
  DT::datatable(
    options = list(pageLength = 20, scrollX = TRUE),
    caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: center; font-weight: bold;",
      "Final Program Rankings"))