Web-scraping to get an edge in the NBA fantasy league draft

www.basketball-reference.com/players/i/{player_code}/gamelog/{year}

# scrape game log table for a player in a given year
get_gamelog <- function(player_code, year){
  
  url <- paste0(glue('https://www.basketball-reference.com/players/i/{player_code}/gamelog/{year}'))
  # Scrape Player game log
  gamelog <- url %>%
    read_html() %>% 
    html_elements('table') %>%
    .[8] %>% 
    html_table() %>% 
    as.data.frame()
  
  return(gamelog)

}

get_gamelog("jokicni01", 2023) %>% 
  head() %>% 
  knitr::kable()

# Acknowledgement: code modified from github.com/djblechn-su/nba-player-team-ids/

# Create Function to Scrape Player codes
scrape_nba_main <- function(yr){
  # Create URL
  url <- glue('https://www.basketball-reference.com/leagues/NBA_{yr}_per_game.html')
  webpage <- read_html(url)
  
  # Scrape All Player Links on Page
  links <- webpage %>%
    html_nodes(xpath = "//td/a") %>% 
    html_attr("href")
  links <- links[grepl("/players", links)]
  links <- links[!duplicated(links)]
  
  # Scrape Player Information
  player_table <- webpage %>%
    html_nodes("table") %>%
    .[1] %>%
    html_table(fill = TRUE) %>%
    as.data.frame()
  player_table <- player_table %>% filter(Player != "Player")
  player_table <- player_table[!duplicated(player_table[c('Player', 'Age')]),]
  player_table <- player_table[,c(2,3,4,8)]
  player_table$Link <- links
  BBRefID <- strsplit(player_table$Link, '\\/')
  BBRefID <- sapply(BBRefID, function(x) x[4])
  BBRefID <- gsub(".html", "", BBRefID)
  player_table$BBRefID <- BBRefID

  return(player_table)
}

bbref_player_codes <- scrape_nba_main(2023)
bbref_player_codes <- bbref_player_codes[!duplicated(bbref_player_codes$BBRefID),]
bbref_player_codes <- bbref_player_codes[order(bbref_player_codes$BBRefID),]

bbref_player_codes_filtered <- bbref_player_codes %>%
  mutate(MP = as.numeric(MP)) %>% 
  filter(MP > 25)

bbref_player_codes_filtered %>%
  head() %>% 
  knitr::kable()

player_codes <- bbref_player_codes$BBRefID
year <- 2023

all_game_logs <- list()
for (i in seq_along(player_codes)) {
  player_code <- player_codes[i]
  player_game_log <- get_gamelog(player_code=player_code, year=year) %>% 
    mutate(player_code = player_code) %>% 
    filter(Rk != "Rk") %>%  # remove the extra column-name rows 
    mutate(across(everything(), as.character)) 
    all_game_logs[[player_code]] <- player_game_log
  
  if (i > 1) {
    Sys.sleep(5) # sleep 5 seconds to prevent the website throttling the webscraper
    } 
}

all_game_logs_df <- bind_rows(all_game_logs)

all_game_logs_df %>%
  head() %>% 
  knitr::kable()

# these values correspond to when a player did not play in the game
missing_values <- c("Inactive|Did Not Dress|Did Not Play|Not With Team|Player Suspended")

# add in the player name
all_game_logs_df <- all_game_logs_df %>% 
  left_join(bbref_player_codes[c("BBRefID", "Player")],
            by = c("player_code" = "BBRefID")) %>% 
  mutate_all(~str_replace_all(., missing_values, NA_character_)) %>% 
  mutate(across(c(
    "GS",
    "FG",
    "FGA",  
    "FG.",
    "X3P",
    "X3PA",
    "X3P.",
    "FT",
    "FTA",
    "FT.",
    "ORB",
    "DRB",
    "TRB", 
    "AST",
    "BLK",
    "TOV",
    "STL",
    "PTS"),
    ~as.numeric(.))) %>% 
  # make columns for triple doubles and double doubles:
  # DD: (IF: 2/5 OF ASS/BLOCK/STEAL/REB/PTS > 9)
  # TD: (IF: 3/5 OF ASS/BLOCK/STEAL/REB/PTS > 9)
  rowwise() %>% 
  mutate("DD" = if_else(sum(TRB > 9, AST > 9, BLK > 9, STL > 9, PTS > 9) >= 2, 1, 0)) %>%
  mutate("TD" = if_else(sum(TRB > 9, AST > 9, BLK > 9, STL > 9, PTS > 9) >= 3, 1, 0)) %>% 
  mutate("QD" = if_else(sum(TRB > 9, AST > 9, BLK > 9, STL > 9, PTS > 9) >= 4, 1, 0)) %>% 
  # games played - 1 if they played the game or 0 if not
  ungroup() %>% 
  mutate(GP = if_else(is.na(GS), 0, 1)) %>% # if game was played, 1 else zero
  # calculate number missed for field goals, free throws, three pointers
  mutate(FGM = FGA - FG) %>% 
  mutate(FTM = FTA - FT) %>% 
  mutate(X3PM = X3PA - X3P)

all_game_logs_df %>% 
  head() %>% 
  knitr::kable()

# the sum of each metric * by a multiplier is used to calc the fantasy score 
# this is specific to the league 
multipliers_vector <- c(
  "GP" = 1,
  "FG" = 2,
  "FGM" = -1,
  "FT" = 1,
  "FTA" = 0.5,
  "FTM" = -1,
  "X3P" = 3.5,
  "X3PM" = -1.5,
  "ORB" = 3,
  "DRB" = 1,
  "TRB" = 1,
  "AST" = 4,
  "STL" = 5,
  "BLK" = 6,
  "TOV" = -2.5,
  "DD" = 10,
  "TD" = 30,
  "QD" = 1000,
  "PTS" = 1)

# calculate the fantasy score per game 
scores <- all_game_logs_df %>% 
  select(c(Player, names(multipliers_vector)))

weighted_scores = list()
for (i in seq_along(multipliers_vector)){
  name <- names(multipliers_vector[i])
  weighted_scores[[name]] <- scores[[name]] * multipliers_vector[name]
}
weighted_scores_df <- as.data.frame(weighted_scores)
agg_weighted_scores <- data.frame(
  player_name = scores$Player,
  weighted_scores = rowSums(weighted_scores_df, na.rm = T)
) %>%
  cbind(weighted_scores_df) %>% 
  mutate(weighted_scores_with_na = if_else(GP == 1, weighted_scores, NA)) # create another weighted score with NA's if they did not play, this will allow to calculate per-game stats 

final_weighted_scores_summarised <- agg_weighted_scores %>% 
  select(player_name, weighted_scores, weighted_scores_with_na, GP) %>% 
  group_by(player_name) %>%
  summarise(season_total_score = sum(weighted_scores),
            n_games_played = sum(GP), 
            season_mean = mean(weighted_scores), # season stats count missed games as zero
            season_median = median(weighted_scores),
            season_stdev = sd(weighted_scores), 
            games_played_mean = mean(weighted_scores_with_na, na.rm = TRUE), # games_played stats do not include missed games in the calculation
            games_played_median = median(weighted_scores_with_na, na.rm = TRUE),
            games_played_stdev = sd(weighted_scores_with_na, na.rm = TRUE)) %>%
  arrange(desc(season_median)) %>% 
  # add in other player stats from Basketball reference 
  left_join(bbref_player_codes, by = c("player_name" = "Player")) %>% 
  select(-Link, -BBRefID)

final_weighted_scores_summarised %>%
  head() %>% 
  knitr::kable()

theme_set(theme_bw())

medians_scatter <- final_weighted_scores_summarised %>% 
  ggplot(aes(x = season_median,
             y = games_played_median,
             colour = Pos,
             text = glue(
               "
               Player: {player_name}
               Position: {Pos}
               Total score for season: {season_total_score}
               Median score for season: {season_median}
               Median score for games played: {games_played_median}
               "
             ))) +
  labs(x = 'Median score for season',
       y = 'Median score for games played')+
  geom_point() +
  scale_color_brewer(palette = 'Set3')

medians_scatter # %>% ggplotly(tooltip = 'text')

split_medians_scatter <- final_weighted_scores_summarised %>% 
  ggplot(aes(x = season_median,
             y = games_played_median,
             colour = Pos,
             text = glue(
               "
               Player: {player_name}
               Position: {Pos}
               Total score for season: {season_total_score}
               Median score for season: {season_median}
               Median score for games played: {games_played_median}
               "
             ))) +
  labs(x = 'Median score for season',
       y = 'Median score for games played')+
  geom_point() +
  facet_wrap(~Pos) +
  scale_color_brewer(palette = 'Set3')

split_medians_scatter # %>% ggplotly(tooltip = 'text')

total_scatter <- final_weighted_scores_summarised %>% 
  ggplot(aes(x = season_total_score,
             y = games_played_median,
             colour = Pos,
             text = glue(
               "
               Player: {player_name}
               Position: {Pos}
               Total score for season: {season_total_score}
               Median score for season: {season_median}
               Median score for games played: {games_played_median}
               "
             ))) +
  labs(x = 'Total score for season',
       y = 'Median score for games played')+
  geom_point() +
  scale_color_brewer(palette = 'Set3')

total_scatter # %>% ggplotly(tooltip = 'text')

split_total_scatter <- final_weighted_scores_summarised %>% 
  ggplot(aes(x = season_total_score,
             y = games_played_median,
             colour = Pos,
             text = glue(
               "
               Player: {player_name}
               Position: {Pos}
               Total score for season: {season_total_score}
               Median score for season: {season_median}
               Median score for games played: {games_played_median}
               "
             ))) +
  facet_wrap(~Pos) +
  labs(x = 'Total score for season',
       y = 'Median score for games played')+
  geom_point()+
  scale_color_brewer(palette = 'Set3')

split_total_scatter # %>% ggplotly(tooltip = 'text')

sessionInfo()

## R version 4.3.1 (2023-06-16)
## Platform: x86_64-apple-darwin20 (64-bit)
## Running under: macOS Ventura 13.2
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: Australia/Sydney
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] RColorBrewer_1.1-3 plotly_4.10.2      janitor_2.2.0      glue_1.6.2        
##  [5] XML_3.99-0.14      rvest_1.0.3        lubridate_1.9.2    forcats_1.0.0     
##  [9] stringr_1.5.0      dplyr_1.1.2        purrr_1.0.1        readr_2.1.4       
## [13] tidyr_1.3.0        tibble_3.2.1       ggplot2_3.4.2      tidyverse_2.0.0   
## 
## loaded via a namespace (and not attached):
##  [1] utf8_1.2.3        generics_0.1.3    xml2_1.3.5        stringi_1.7.12   
##  [5] hms_1.1.3         digest_0.6.33     magrittr_2.0.3    evaluate_0.21    
##  [9] grid_4.3.1        timechange_0.2.0  fastmap_1.1.1     jsonlite_1.8.7   
## [13] httr_1.4.6        selectr_0.4-2     fansi_1.0.4       viridisLite_0.4.2
## [17] scales_1.2.1      lazyeval_0.2.2    cli_3.6.1         rlang_1.1.1      
## [21] munsell_0.5.0     withr_2.5.0       yaml_2.3.7        tools_4.3.1      
## [25] tzdb_0.4.0        colorspace_2.1-0  curl_5.0.1        vctrs_0.6.3      
## [29] R6_2.5.1          lifecycle_1.0.3   snakecase_0.11.1  htmlwidgets_1.6.2
## [33] pkgconfig_2.0.3   pillar_1.9.0      gtable_0.3.3      data.table_1.14.8
## [37] highr_0.10        xfun_0.39         tidyselect_1.2.0  rstudioapi_0.15.0
## [41] knitr_1.43        farver_2.1.1      htmltools_0.5.5   labeling_0.4.2   
## [45] rmarkdown_2.23    compiler_4.3.1