Data Source: Regular season skating data from the 2021-22 NHL season were used for this table. The data were downloaded from https://www.hockey-reference.com/leagues/NHL_2022_skaters.html as a .csv file and cleaned slightly in Microsoft Excel (for formatting only). All team logo .png files were downloaded from Wikipedia.

Purpose: The purpose of this table is to show various offensive statistics in hockey aggregated by team and averaged across an 82 game season. Of specific interest is the breakdown of goals and assists into even-strength and power-play categories. The number of power plays given up and converted by a team is increadibly important to its success. Additionally, information concerning teams’ relative shooting volumes and percentages are given. Viewers of this table should be able to discern what the best and worst offensive teams in the league are and which teams have the most successful power-play production.

Functionality: The table includes several interactive features. The first is a column of boxplots that visualize the distribution of point scoring on each team. All plots were placed on the same scale to be directly comparable. If the user hovers over these plots, the specific quantiles and outliers are displayed in a pop-up box. Additionally, hovering over a row will highlight it in gray to help users keep track of where they are in the table. Finally, the header was fixed so that it stays visible even when the user scroll down the long list.

Formatting: Several formatting choices were made to make this table more usable. The first was create super headers for even-strength, power-play, and shooting to clean up the previously long column names. Next, all values were rounded to two decimal places, right-aligned, and conditional formatting was applied to highlight the top and bottom 3 teams in each stat category. The last was done to help the user better understand who the top and bottom performers in the league are. An aesthetic theme was applied to the table to give it a clean look and to alternate its rows with white and grey shading to give the user more contrast between rows, making the table easier to read. Finally, team logos were added to the front of the table to assist users who may not wish to translate the abbrevaiated team names given.

# read in the data from a .csv file
data <- read.csv('players.csv') %>%
  # rename misnamed fields
  rename(PlusMinus = 'X...',
         SPer = 'S.') %>%
  # filter out unneeded data
  filter(Player != '',
         Tm != 'TOT')

head(data)
##               Player  Tm PTS PlusMinus PIM EVG PPG SHG EVA PPA SHA   S SPer
## 1 Nicholas Abruzzese TOR   1        -1   2   1   0   0   0   0   0   8 12.5
## 2       Noel Acciari FLA   8         2  11   3   0   0   5   0   0  32  9.4
## 3      Calen Addison MIN   4        -4   2   2   0   0   2   0   0  17 11.8
## 4    Andrew Agozzino OTT   0         0   0   0   0   0   0   0   0   1  0.0
## 5         Jack Ahcan BOS   1        -3   0   0   1   0   0   0   0   5 20.0
## 6      Sebastian Aho CAR  81        18  38  23  13   1  27  15   2 221 16.7
# aggregate data for display
plt_data <- data %>%
  # filter for players who have at least one point
  filter(PTS > 0) %>%
  # aggregate data by team
  group_by(Tm) %>%
  # calculate per game averages of stats
  summarize(Logo = NA,
            PTS = NA, 
            PIM = sum(PIM) / 82,
            EVG = sum(EVG)/ 82,
            EVA = sum(EVA)/ 82,
            PPG = sum(PPG)/ 82,
            PPA = sum(PPA) / 82,
            S = sum(S) / 82,
            SPer = mean(SPer, na.rm = TRUE)) %>%
  as.data.frame()

# conditional formatting for PIM column
top3 <- plt_data$PIM %in% (plt_data %>% 
                             arrange(desc(PIM)) %>% 
                             select(PIM) %>% 
                             top_n(3) %>%
                             pull(PIM))
bottom3 <- plt_data$PIM %in% (plt_data %>% 
                                arrange(desc(PIM)) %>% 
                                select(PIM) %>% 
                                top_n(-3) %>%
                                pull(PIM))
neither <- !top3 & !bottom3
plt_data$PIM[top3] <- cell_spec(round(plt_data$PIM[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$PIM[bottom3] <- cell_spec(round(as.numeric(plt_data$PIM[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$PIM[neither] <- cell_spec(round(as.numeric(plt_data$PIM[neither]), 2))

# conditional formatting for EVG column
top3 <- plt_data$EVG %in% (plt_data %>% 
                             arrange(desc(EVG)) %>% 
                             select(EVG) %>% 
                             top_n(3) %>%
                             pull(EVG))
bottom3 <- plt_data$EVG %in% (plt_data %>% 
                                arrange(desc(EVG)) %>% 
                                select(EVG) %>% 
                                top_n(-3) %>%
                                pull(EVG))
neither <- !top3 & !bottom3
plt_data$EVG[top3] <- cell_spec(round(plt_data$EVG[top3], 2),
                                color = 'green', 
                                bold = TRUE)
plt_data$EVG[bottom3] <- cell_spec(round(as.numeric(plt_data$EVG[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$EVG[neither] <- cell_spec(round(as.numeric(plt_data$EVG[neither]), 2))

# conditional formatting for EVA column
top3 <- plt_data$EVA %in% (plt_data %>% 
                             arrange(desc(EVA)) %>% 
                             select(EVA) %>% 
                             top_n(3) %>%
                             pull(EVA))
bottom3 <- plt_data$EVA %in% (plt_data %>% 
                                arrange(desc(EVA)) %>% 
                                select(EVA) %>% 
                                top_n(-3) %>%
                                pull(EVA))
neither <- !top3 & !bottom3
plt_data$EVA[top3] <- cell_spec(round(plt_data$EVA[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$EVA[bottom3] <- cell_spec(round(as.numeric(plt_data$EVA[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$EVA[neither] <- cell_spec(round(as.numeric(plt_data$EVA[neither]), 2))

# conditional formatting for PPG column
top3 <- plt_data$PPG %in% (plt_data %>% 
                             arrange(desc(PPG)) %>% 
                             select(PPG) %>% 
                             top_n(3) %>%
                             pull(PPG))
bottom3 <- plt_data$PPG %in% (plt_data %>% 
                                arrange(desc(PPG)) %>% 
                                select(PPG) %>% 
                                top_n(-3) %>%
                                pull(PPG))
neither <- !top3 & !bottom3
plt_data$PPG[top3] <- cell_spec(round(plt_data$PPG[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$PPG[bottom3] <- cell_spec(round(as.numeric(plt_data$PPG[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$PPG[neither] <- cell_spec(round(as.numeric(plt_data$PPG[neither]), 2))

# conditional formatting for PPA column
top3 <- plt_data$PPA %in% (plt_data %>% 
                             arrange(desc(PPA)) %>% 
                             select(PPA) %>% 
                             top_n(3) %>%
                             pull(PPA))
bottom3 <- plt_data$PPA %in% (plt_data %>% 
                                arrange(desc(PPA)) %>% 
                                select(PPA) %>% 
                                top_n(-3) %>%
                                pull(PPA))
neither <- !top3 & !bottom3
plt_data$PPA[top3] <- cell_spec(round(plt_data$PPA[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$PPA[bottom3] <- cell_spec(round(as.numeric(plt_data$PPA[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$PPA[neither] <- cell_spec(round(as.numeric(plt_data$PPA[neither]), 2))

# conditional formatting for S column
top3 <- plt_data$S %in% (plt_data %>% 
                             arrange(desc(S)) %>% 
                             select(S) %>% 
                             top_n(3) %>%
                             pull(S))
bottom3 <- plt_data$S %in% (plt_data %>% 
                                arrange(desc(S)) %>% 
                                select(S) %>% 
                                top_n(-3) %>%
                                pull(S))
neither <- !top3 & !bottom3
plt_data$S[top3] <- cell_spec(round(plt_data$S[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$S[bottom3] <- cell_spec(round(as.numeric(plt_data$S[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$S[neither] <- cell_spec(round(as.numeric(plt_data$S[neither]), 2))

# conditional formatting for SPer column
top3 <- plt_data$SPer %in% (plt_data %>% 
                             arrange(desc(SPer)) %>% 
                             select(SPer) %>% 
                             top_n(3) %>%
                             pull(SPer))
bottom3 <- plt_data$SPer %in% (plt_data %>% 
                                arrange(desc(SPer)) %>% 
                                select(SPer) %>% 
                                top_n(-3) %>%
                                pull(SPer))
neither <- !top3 & !bottom3
plt_data$SPer[top3] <- cell_spec(round(plt_data$SPer[top3], 2), 
                                color = 'green', 
                                bold = TRUE)
plt_data$SPer[bottom3] <- cell_spec(round(as.numeric(plt_data$SPer[bottom3]), 2), 
                                   color = 'red', 
                                   bold = TRUE)
plt_data$SPer[neither] <- cell_spec(round(as.numeric(plt_data$SPer[neither]), 2))

# add mini plots to table
for (team in plt_data$Tm) {
  # vector of player points by team
  team_pts <- data %>%
    filter(Tm == team) %>%
    pull(PTS)

  # construct boxplot for table
  plt_data$PTS[which(plt_data$Tm == team)] <- spk_chr(team_pts,
                                                      type = 'box',
                                                      chartRangeMin = 0,
                                                      chartRangeMax = max(
                                                        data$PTS),
                                                      width = 150)
}

# add team logos to table
for (team in 1:nrow(plt_data)) {
  plt_data$Logo[team] <- paste0('<img src=./Images/', 
                                team, 
                                '.png width=50 height=50>')
}

# make table of aggregated values
plt_data %>%
  select(c(Logo, Tm, PTS, PIM, EVG, EVA, PPG, PPA, S, SPer)) %>%
  kbl(escape = FALSE,
      # set table title
      caption = 'Per Game Averages by Team',
      # set column names
      col.names = c('', 'Team', 'Points', 'Penalty Mins', 'Goals', 'Assists', 
                    'Goals', 'Assists', 'Total', 'Percent'),
      # set column alignments
      align = c('l', 'c', rep('r', 7))) %>%
  # table styling
  kable_styling(font_size = 15,
                fixed_thead = TRUE) %>%
  # generate super headers
  add_header_above(c(rep('', 4), 
                     'Even-Strength' = 2, 
                     'Power-Play' = 2, 
                     'Shooting' = 2)) %>%
  # set table theme
  kable_material(lightable_options = c('striped', 'hover'))
Per Game Averages by Team
Even-Strength
Power-Play
Shooting
Team Points Penalty Mins Goals Assists Goals Assists Total Percent
ANA 8.67 2.12 3.54 0.59 1.12 29.05 8.18
ARI 9.95 2.13 3.57 0.34 0.67 25.56 9.96
BOS 9.35 2.41 4.02 0.61 1.16 36.02 7.36
BUF 7.94 2.15 3.39 0.57 1.11 29.83 10.13
CAR 8.88 2.71 4.54 0.62 1.2 33.99 9.78
CBJ 7.48 2.56 4.28 0.5 0.98 29.98 10.18
CGY 8.63 2.8 4.52 0.66 1.26 35.43 7.63
CHI 7.49 2 3.37 0.57 1.15 28.63 7.31
COL 8.68 2.87 4.8 0.82 1.56 34.41 8.62
DAL 6.57 2.1 3.54 0.66 1.28 30.3 10.13
DET 8.59 2.27 3.68 0.45 0.88 29.21 8.4
EDM 7.76 2.6 4.28 0.74 1.46 34.01 8.02
FLA 9.88 3.18 5.27 0.78 1.56 36.94 9.54
LAK 7.43 2.24 3.48 0.49 0.95 34.62 6.97
MIN 10.33 3.05 4.91 0.65 1.26 32.29 10.85
MTL 9.85 2.17 3.57 0.41 0.8 29.6 8.39
NJD 6.84 2.49 4.13 0.43 0.8 30.85 9.15
NSH 12.33 2.4 4.12 0.77 1.5 29.57 7.51
NYI 8.7 2.17 3.44 0.56 1.07 28.83 9.12
NYR 8.09 2.28 3.82 0.67 1.29 28.85 9.02
OTT 9.65 2.05 3.32 0.57 1.07 29.83 7.32
PHI 8.74 2.12 3.46 0.37 0.68 30.76 8.24
PIT 6.71 2.63 4.5 0.61 1.17 34.63 8.1
SEA 8.17 2.11 3.59 0.39 0.78 28.8 8.1
SJS 8.49 2.02 3.33 0.5 0.99 29.22 6.93
STL 7.11 2.87 5 0.79 1.52 30.39 9.81
TBL 10.62 2.63 4.39 0.76 1.48 30.68 10.37
TOR 8.1 2.88 4.93 0.77 1.44 34.32 8.67
VAN 7.54 2.23 3.51 0.71 1.37 31.48 8.44
VEG 7.32 2.6 4.16 0.48 0.91 34.32 10.44
WPG 8.43 2.3 3.78 0.63 1.24 31.8 7.31
WSH 7.45 2.61 4.07 0.59 1.11 31.39 12.42