## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = '#>', fig.align = 'center', out.width = '92%', fig.width = 7, fig.height = 4.8 ) make_table <- function(x, caption, digits = 3) { knitr::kable(x, caption = caption, digits = digits) } ## ----leaders------------------------------------------------------------------ # Pull team EDGE leaders. edge_leaders <- nhlscraper::team_edge_leaders( season = 20242025, game_type = 2 ) # Build compact leader table. leader_table <- data.frame( metric = c( 'Shots over 90 mph', 'Bursts over 22 mph', 'Distance per 60', 'High-danger shots on goal', 'Offensive-zone time', 'Neutral-zone time', 'Defensive-zone time' ), team = c( edge_leaders[['shotAttemptsOver90']][['team']][['abbrev']], edge_leaders[['burstsOver22']][['team']][['abbrev']], edge_leaders[['distancePer60']][['team']][['abbrev']], edge_leaders[['highDangerSOG']][['team']][['abbrev']], edge_leaders[['offensiveZoneTime']][['team']][['abbrev']], edge_leaders[['neutralZoneTime']][['team']][['abbrev']], edge_leaders[['defensiveZoneTime']][['team']][['abbrev']] ), value = c( as.character(edge_leaders[['shotAttemptsOver90']][['attempts']]), as.character(edge_leaders[['burstsOver22']][['bursts']]), sprintf('%.2f miles', edge_leaders[['distancePer60']][['distanceSkated']][['imperial']]), as.character(edge_leaders[['highDangerSOG']][['sog']]), sprintf('%.3f', edge_leaders[['offensiveZoneTime']][['zoneTime']]), sprintf('%.3f', edge_leaders[['neutralZoneTime']][['zoneTime']]), sprintf('%.3f', edge_leaders[['defensiveZoneTime']][['zoneTime']]) ), stringsAsFactors = FALSE ) make_table( leader_table, caption = 'Selected 2024-25 team EDGE leaders.' ) ## ----profiles----------------------------------------------------------------- # Define team set. team_ids <- c(CAR = 12, COL = 21, EDM = 22, FLA = 13, WSH = 15) # Define robust helpers. fetch_with_retry <- function(fetch_fun, validator, tries = 3) { for (i in seq_len(tries)) { value <- try(fetch_fun(), silent = TRUE) if (!inherits(value, 'try-error') && validator(value)) { return(value) } Sys.sleep(i / 4) } NULL } valid_df <- function(x, required_cols) { is.data.frame(x) && nrow(x) > 0 && all(required_cols %in% names(x)) } safe_num <- function(x) { out <- suppressWarnings(as.numeric(x)) ifelse(is.na(out), NA_real_, out) } safe_name <- function(first_name, last_name) { if ( is.na(first_name) || is.na(last_name) || first_name == '' || last_name == '' ) { return(NA_character_) } paste(first_name, last_name) } safe_summary_num <- function(x, path) { value <- tryCatch({ for (nm in path) x <- x[[nm]] x }, error = function(e) NA_real_) safe_num(value) } # Build one profile row. build_team_profile <- function(team_code, team_id) { team_summary <- fetch_with_retry( function() nhlscraper::team_edge_summary( team = team_id, season = 20242025, game_type = 2 ), function(x) is.list(x) ) zone_rows <- fetch_with_retry( function() nhlscraper::team_edge_zone_time( team = team_id, season = 20242025, game_type = 2, category = 'details' ), function(x) valid_df(x, c('strengthCode', 'offensiveZonePctg')) ) skating_rows <- fetch_with_retry( function() nhlscraper::team_edge_skating_speed( team = team_id, season = 20242025, game_type = 2, category = 'details' ), function(x) valid_df(x, c('positionCode', 'maxSkatingSpeed.imperial', 'burstsOver22.value')) ) shot_speed_rows <- fetch_with_retry( function() nhlscraper::team_edge_shot_speed( team = team_id, season = 20242025, game_type = 2, category = 'details' ), function(x) valid_df(x, c('position', 'topShotSpeed.imperial', 'shotAttempts90To100.value')) ) shot_location_rows <- fetch_with_retry( function() nhlscraper::team_edge_shot_location( team = team_id, season = 20242025, game_type = 2, category = 'details' ), function(x) valid_df(x, c('area', 'sog')) ) if ( is.null(zone_rows) || is.null(skating_rows) || is.null(shot_speed_rows) || is.null(shot_location_rows) ) { return(data.frame( team = team_code, points = safe_summary_num(team_summary, c('team', 'points')), wins = safe_summary_num(team_summary, c('team', 'wins')), offensiveZonePctg = NA_real_, maxSkatingSpeed = NA_real_, burstsOver22 = NA_real_, shotAttemptsOver90 = NA_real_, hardestShot = NA_real_, trackedShots = NA_real_, interiorShare = NA_real_, circleShare = NA_real_, pointShare = NA_real_, fastestSkater = NA_character_, hardestShooter = NA_character_, stringsAsFactors = FALSE )) } zone_row <- zone_rows[zone_rows[['strengthCode']] == 'all', , drop = FALSE] skating_row <- skating_rows[skating_rows[['positionCode']] == 'all', , drop = FALSE] shot_speed_row <- shot_speed_rows[shot_speed_rows[['position']] == 'all', , drop = FALSE] if (!nrow(zone_row)) zone_row <- zone_rows[1, , drop = FALSE] if (!nrow(skating_row)) skating_row <- skating_rows[1, , drop = FALSE] if (!nrow(shot_speed_row)) shot_speed_row <- shot_speed_rows[1, , drop = FALSE] interior_mask <- shot_location_rows[['area']] %in% c( 'Crease', 'Low Slot', 'L Net Side', 'R Net Side' ) circle_mask <- shot_location_rows[['area']] %in% c( 'High Slot', 'L Circle', 'R Circle' ) point_mask <- shot_location_rows[['area']] %in% c( 'Center Point', 'L Point', 'R Point', 'Outside L', 'Outside R', 'Beyond Red Line' ) total_shots <- sum(shot_location_rows[['sog']], na.rm = TRUE) data.frame( team = team_code, points = safe_summary_num(team_summary, c('team', 'points')), wins = safe_summary_num(team_summary, c('team', 'wins')), offensiveZonePctg = safe_num(zone_row[['offensiveZonePctg']][1]), maxSkatingSpeed = safe_num(skating_row[['maxSkatingSpeed.imperial']][1]), burstsOver22 = safe_num(skating_row[['burstsOver22.value']][1]), shotAttemptsOver90 = sum( safe_num(shot_speed_row[['shotAttemptsOver100.value']][1]), safe_num(shot_speed_row[['shotAttempts90To100.value']][1]), na.rm = TRUE ), hardestShot = safe_num(shot_speed_row[['topShotSpeed.imperial']][1]), trackedShots = total_shots, interiorShare = sum(shot_location_rows[['sog']][interior_mask], na.rm = TRUE) / total_shots, circleShare = sum(shot_location_rows[['sog']][circle_mask], na.rm = TRUE) / total_shots, pointShare = sum(shot_location_rows[['sog']][point_mask], na.rm = TRUE) / total_shots, fastestSkater = safe_name( skating_row[['maxSkatingSpeed.overlay.player.firstName.default']][1], skating_row[['maxSkatingSpeed.overlay.player.lastName.default']][1] ), hardestShooter = safe_name( shot_speed_row[['topShotSpeed.overlay.player.firstName.default']][1], shot_speed_row[['topShotSpeed.overlay.player.lastName.default']][1] ), stringsAsFactors = FALSE ) } # Build profile table. team_profiles <- Map( build_team_profile, team_code = names(team_ids), team_id = unname(team_ids) ) team_profiles <- do.call(rbind, team_profiles) rownames(team_profiles) <- NULL profile_table <- team_profiles[, c( 'team', 'points', 'wins', 'offensiveZonePctg', 'maxSkatingSpeed', 'burstsOver22', 'shotAttemptsOver90', 'hardestShot', 'interiorShare' )] make_table( profile_table, caption = 'Five-team 2024-25 EDGE profile comparison.', digits = 3 ) ## ----scorecard---------------------------------------------------------------- # Rescale profile metrics within sample. rescale01 <- function(x) { rng <- range(x, na.rm = TRUE) if (!all(is.finite(rng)) || diff(rng) == 0) { return(rep(NA_real_, length(x))) } (x - rng[1]) / diff(rng) } scorecard <- data.frame( team = team_profiles[['team']], territory = rescale01(team_profiles[['offensiveZonePctg']]), pace = rescale01(team_profiles[['burstsOver22']]), shotPower = rescale01(team_profiles[['shotAttemptsOver90']]), interior = rescale01(team_profiles[['interiorShare']]), hardestShot = rescale01(team_profiles[['hardestShot']]), stringsAsFactors = FALSE ) make_table( scorecard, caption = 'Within-sample EDGE archetype scores.', digits = 3 ) ## ----scorecard-plot, fig.cap = 'Within-sample archetype scorecard for five teams.'---- # Plot archetype scorecard. score_matrix <- t(as.matrix(scorecard[, -1])) colnames(score_matrix) <- scorecard[['team']] graphics::barplot( score_matrix, beside = TRUE, col = c('#264653', '#2a9d8f', '#e9c46a', '#f4a261', '#e76f51'), ylim = c(0, 1.35), ylab = 'Within-Sample Score', xlab = 'Team' ) graphics::legend( 'top', legend = rownames(score_matrix), fill = c('#264653', '#2a9d8f', '#e9c46a', '#f4a261', '#e76f51'), bty = 'n', cex = 0.75, ncol = 3 ) ## ----shot-mix-plot, fig.cap = 'Tracked shot-location mix by team.'------------ # Plot shot-location mix. shot_mix <- t(as.matrix(team_profiles[, c( 'interiorShare', 'circleShare', 'pointShare' )])) colnames(shot_mix) <- team_profiles[['team']] rownames(shot_mix) <- c('Interior', 'Circles / slot', 'Points / perimeter') graphics::barplot( shot_mix, beside = FALSE, col = c('#1b4332', '#52b788', '#b7e4c7'), ylim = c(0, 1.18), ylab = 'Share of Tracked Shots', xlab = 'Team' ) graphics::legend( 'top', legend = rownames(shot_mix), fill = c('#1b4332', '#52b788', '#b7e4c7'), bty = 'n', cex = 0.8, horiz = TRUE ) ## ----player-table------------------------------------------------------------- # Show players behind extreme traits. player_table <- team_profiles[, c( 'team', 'fastestSkater', 'maxSkatingSpeed', 'hardestShooter', 'hardestShot' )] make_table( player_table, caption = 'Players behind each team profile.' )