#' @title **PHF Player Stats**
#' @description phf_player_stats: loads the player stats
#'
#' @param player_id The unique ID code for the player that you are interested in viewing the data for
#' @return A named list of data frames: career, game_log
#' @import rvest
#' @import janitor
#' @import httr
#' @import stringr
#' @import jsonlite
#' @importFrom glue glue
#' @export
#' @examples
#' \donttest{
#' try(phf_player_stats(player_id = 431611))
#' try(phf_player_stats(player_id = 532475))
#' }
phf_player_stats <- function(player_id) {
tryCatch(
expr = {
y <- player_id
base_url <- "https://web.api.digitalshift.ca/partials/stats/player?player_id="
full_url <- paste0(base_url, player_id)
# setting the ticket as something that can be changed in case the API decides to change it's authorization
# rather than hard-coding it in
auth_ticket <- getOption(
"fastRhockey.phf_ticket",
default = 'ticket="4dM1QOOKk-PQTSZxW_zfXnOgbh80dOGK6eUb_MaSl7nUN0_k4LxLMvZyeaYGXQuLyWBOQhY8Q65k6_uwMu6oojuO"'
)
# the link for the game + authorization for accessing the API
res <- httr::RETRY("GET", full_url,
httr::add_headers(`Authorization`= auth_ticket))
# Check the result
check_status(res)
resp_all <- res %>%
httr::content(as = "text", encoding="utf-8") %>%
jsonlite::parse_json() %>%
purrr::pluck("content") %>%
rvest::read_html()
resp <- resp_all %>%
rvest::html_elements("table")
resp <- unique(resp)
goalie_position <- resp_all %>%
rvest::html_elements(".stats-table.game_logs_goalies")
position <- ifelse(length(goalie_position) > 0, "Goalie", "Player")
player_name <- resp_all %>%
rvest::html_elements(".title") %>%
rvest::html_text()
player_image <- resp_all %>%
rvest::html_elements(".photo") %>%
rvest::html_elements("img") %>%
rvest::html_attr("src")
if (position == "Player"){
regular_season_href <- (resp_all %>%
rvest::html_elements("#career_players_Regular_Season"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
playoffs_href <- (resp_all %>%
rvest::html_elements("#career_players_Playoffs"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
player_game_log_href <- (resp_all %>%
rvest::html_elements(".stats-table.game_logs_players"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
regular_season_href <- append(regular_season_href,NA_character_)
playoffs_href <- append(playoffs_href,NA_character_)
player_game_log_href <- player_game_log_href
regular_season_stats <- (resp_all %>%
rvest::html_elements("#career_players_Regular_Season"))[[1]] %>%
rvest::html_table()
playoff_stats <- (resp_all %>%
rvest::html_elements("#career_players_Playoffs"))[[1]] %>%
rvest::html_table()
player_game_log_stats <- (resp_all %>%
rvest::html_elements(".stats-table.game_logs_players"))[[1]] %>%
rvest::html_table()
player_game_log_stats <- player_game_log_stats %>%
dplyr::mutate(
Pos = ifelse(.data$Pos == FALSE, 'F', .data$Pos)
)
position <- player_game_log_stats$Pos[[1]]
} else {
regular_season_href <- (resp_all %>%
rvest::html_elements("#career_goalies_Regular_Season"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
playoffs_href <- (resp_all %>%
rvest::html_elements("#career_goalies_Playoffs"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
player_game_log_href <- (resp_all %>%
rvest::html_elements(".stats-table.game_logs_goalies"))[[1]] %>%
rvest::html_elements("tr") %>%
rvest::html_elements("td > a") %>%
rvest::html_attr("href")
regular_season_href <- append(regular_season_href,NA_character_)
playoffs_href <- append(playoffs_href,NA_character_)
player_game_log_href <- player_game_log_href
regular_season_stats <- (resp_all %>%
rvest::html_elements("#career_goalies_Regular_Season"))[[1]] %>%
rvest::html_table()
playoff_stats <- (resp_all %>%
rvest::html_elements("#career_goalies_Playoffs"))[[1]] %>%
rvest::html_table()
player_game_log_stats <- (resp_all %>%
rvest::html_elements(".stats-table.game_logs_goalies"))[[1]] %>%
rvest::html_table()
player_game_log_stats <- player_game_log_stats %>%
dplyr::mutate(
Pos = position
)
position <- player_game_log_stats$Pos[[1]]
}
regular_season_href <- data.frame(
player_name = player_name,
player_id = y,
position = position,
player_image_href = player_image,
team_href = regular_season_href,
season_type = "Regular Season")
playoffs_href <- data.frame(
player_name = player_name,
player_id = y,
position = position,
player_image_href = player_image,
team_href = playoffs_href,
season_type = "Playoffs")
player_game_log_href <- data.frame(
player_name = player_name,
player_id = y,
position = position,
player_image_href = player_image,
game_href = player_game_log_href)
regular_season_stats <- dplyr::bind_cols(regular_season_stats, regular_season_href)
playoff_stats <- dplyr::bind_cols(playoff_stats, playoffs_href)
game_log_stats <- dplyr::bind_cols(player_game_log_stats, player_game_log_href)
yearly_stats <- dplyr::bind_rows(regular_season_stats, playoff_stats)
if (position != "Goalie") {
suppressWarnings(
yearly_stats <- yearly_stats %>%
tidyr::separate("FoW/L",into = c("faceoffs_won", "faceoffs_lost"),
sep = " - ", remove = FALSE) %>%
dplyr::mutate_at(c("faceoffs_won","faceoffs_lost"), function(x){
as.integer(x)
})
)
suppressWarnings(
game_log_stats <- game_log_stats %>%
tidyr::separate("FoW/L",into = c("faceoffs_won", "faceoffs_lost"),
sep = " - ", remove = FALSE) %>%
dplyr::mutate_at(c("faceoffs_won","faceoffs_lost"), function(x){
as.integer(x)
})
)
yearly_stats <- yearly_stats %>%
dplyr::rename(dplyr::any_of(c(
"season" = "Season",
"team_name" = "Team",
"division" = "Division",
"games_played" = "GP",
"goals" = "G",
"assists" = "A",
"points" = "Pts",
"points_per_game_average" = "PPGA",
"penalty_minutes" = "PIM",
"plus_minus" = "+/-",
"shots_on_goal" = "SOG",
"scoring_pct" = "S%",
"blocks" = "Blk",
"giveaways" = "GvA",
"takeaways" = "TkA",
"faceoffs_won_lost" = "FoW/L",
"faceoffs_win_pct" = "Fo%",
"powerplay_goals" = "PPG",
"shorthanded_goals" = "SHG",
"game_winning_goals" = "GWG",
"shots" = "Sh",
"shots_blocked" = "ShBl"))) %>%
dplyr::mutate(
player_id = player_id,
team_id = as.integer(stringr::str_extract(stringr::str_remove(.data$team_href,"stats#/100/team"), "\\d+"))) %>%
dplyr::select(-"Pos") %>%
make_fastRhockey_data("PHF Skaters Yearly Stats Information from PremierHockeyFederation.com",Sys.time())
game_log_stats <- game_log_stats %>%
dplyr::rename(dplyr::any_of(c(
"date" = "Date",
"game" = "Game",
"goals" = "G",
"assists" = "A",
"points" = "Pts",
"penalty_minutes" = "PIM",
"plus_minus" = "+/-",
"shots_on_goal" = "SOG",
"blocks" = "Blk",
"giveaways" = "GvA",
"takeaways" = "TkA",
"faceoffs_won_lost" = "FoW/L",
"faceoffs_win_pct" = "Fo%",
"shots" = "Sh",
"shots_blocked" = "ShBl"))) %>%
dplyr::mutate(
game_id = as.integer(stringr::str_extract(stringr::str_remove(.data$game_href,"stats#/100/game"), "\\d+"))) %>%
make_fastRhockey_data("PHF Skaters Game Log Stats Information from PremierHockeyFederation.com",Sys.time())
} else {
yearly_stats <- yearly_stats %>%
dplyr::rename(dplyr::any_of(c(
"season" = "Season",
"team_name" = "Team",
"division" = "Division",
"shots_against" = "SA",
"goals_against" = "GA",
"saves" = "Sv",
"save_percent" = "Sv%",
"minutes_played" = "MP",
"penalty_minutes" = "PIM",
"goals" = "G",
"assists" = "A"))) %>%
dplyr::mutate(
team_id = as.integer(stringr::str_extract(stringr::str_remove(.data$team_href,"stats#/100/team"), "\\d+"))) %>%
make_fastRhockey_data("PHF Goalies Yearly Stats Information from PremierHockeyFederation.com",Sys.time())
game_log_stats <- game_log_stats %>%
dplyr::rename(dplyr::any_of(c(
"date" = "Date",
"game" = "Game",
"shots_against" = "SA",
"goals_against" = "GA",
"saves" = "Sv",
"save_percent" = "Sv%",
"minutes_played" = "MP",
"penalty_minutes" = "PIM",
"goals" = "G",
"assists" = "A"))) %>%
dplyr::mutate(
game_id = as.integer(stringr::str_extract(stringr::str_remove(.data$game_href,"stats#/100/game"), "\\d+"))) %>%
make_fastRhockey_data("PHF Goalies Game Log Stats Information from PremierHockeyFederation.com",Sys.time())
}
player_stats <- c(list(yearly_stats),list(game_log_stats))
names(player_stats) <- c("career","game_log")
},
error = function(e) {
message(glue::glue("{Sys.time()}: Invalid game_id or no player box data available! Try using `phf_schedule` to find a game ID to look up!"))
},
warning = function(w) {
},
finally = {
}
)
return(player_stats)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.