Nothing
#' Get AFL Stats cookie
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' Replaced with a standard function to return cookies for either mens or womens data
#'
#' @examples
#' #
#' \dontrun{
#' get_aflw_cookie()
#' # ->
#' get_aflw_cookie()
#' }
#' @keywords internal
get_aflw_cookie <- function() {
lifecycle::deprecate_warn(
"1.0.0",
"get_aflw_cookie()",
"get_afl_cookie()"
)
get_afl_cookie()
}
#' Get rounds (internal function)
#'
#' Returns data frame for available round data. Includes the rounds played,
#' as well as identifiers to make further requests, importantly the roundId.
#'
#' @param cookie a cookie produced by `get_aflw_cookie()`
#'
#' @return A dataframe with information about each round
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @examples
#' \dontrun{
#' get_aflw_rounds(get_aflw_cookie())
#' }
#' @export
get_aflw_rounds <- function(cookie) {
years <- 2017:2100
match_data <- vector(mode = "list")
continue <- TRUE
i <- 1
while (continue == TRUE) {
meta_url <- paste0(
"http://api.afl.com.au/cfs/afl/season?seasonId=CD_S",
years[[i]], "264"
)
match_data_json <- httr::GET(
meta_url,
httr::add_headers(`X-media-mis-token` = cookie)
)
response_code <- match_data_json$status_code
# Status code should be 200 unless year missing
if (response_code != 200) {
continue <- FALSE
} else {
x <- httr::content(match_data_json,
as = "text",
encoding = "UTF-8"
) %>%
jsonlite::fromJSON() %>%
.$season %>%
.$competitions %>%
dplyr::as_tibble() %>%
tidyr::unnest(cols = c("rounds"), names_repair = "universal")
match_data[[i]] <- x
i <- i + 1
}
}
dplyr::bind_rows(match_data)
}
#' Get match data (internal function)
#'
#' For a given round ID, get the data for each match played in that round. Use
#' the column `roundId` in the dataframe created by the `get_rounds()` function
#' to specify matches to fetch.
#'
#' @param roundid a round ID string
#' @param cookie a cookie produced by `get_womens_cookie()`
#'
#' @return a dataframe containing match data
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#'
#' @examples
#' \dontrun{
#' get_aflw_round_data("CD_R201826401", get_aflw_cookie())
#' }
#' @export
get_aflw_round_data <- function(roundid, cookie) {
url_head <- paste0(
"http://api.afl.com.au/cfs/afl/matchItems/round/",
roundid
)
# Extract round data JSON and flatten into data frame
round_data <- httr::GET(
url_head,
httr::add_headers(`X-media-mis-token` = cookie)
) %>%
httr::content(as = "text", encoding = "UTF-8") %>%
jsonlite::fromJSON(flatten = TRUE) %>%
.$items %>%
# Select data from flattened JSON file
dplyr::as_tibble()
if (nrow(round_data) == 0) {
return(round_data)
}
round_data <- round_data %>%
dplyr::mutate(
match.venueLocalStartTime =
readr::parse_datetime(.data$match.venueLocalStartTime)
)
# If rounds have not been uploaded, "score..." columns will not be present yet
# Need to check if these are present, and return NULL if not.
round_data_colnames <- colnames(round_data)
scores_present <- stringr::str_detect(round_data_colnames, "score.") %>%
any() # TRUE if scores present, FALSE if not.
if (scores_present == FALSE) {
warning(stringr::str_c(
"Scores not present for round ", roundid,
", returning match fixture information only."
))
match_info <- round_data %>%
dplyr::select(
Match.Id = .data$match.matchId,
Round.Id = .data$round.roundId,
Competition.Id = .data$round.competitionId,
Venue = .data$venue.name,
Local.Start.Time = .data$match.venueLocalStartTime,
Round.Number = .data$round.roundNumber,
Round.Abbreviation = .data$round.abbreviation,
Home.Team = .data$match.homeTeam.name,
Away.Team = .data$match.awayTeam.name
)
return(match_info)
}
# Clean up data
round_data %>%
# There are more variables that could be added to these
# Rename variables
dplyr::select(
Match.Id = .data$match.matchId,
Round.Id = .data$round.roundId,
Competition.Id = .data$round.competitionId,
Venue = .data$venue.name,
Local.Start.Time = .data$match.venueLocalStartTime,
Round.Number = .data$round.roundNumber,
Round.Abbreviation = .data$round.abbreviation,
Weather.Type = .data$score.weather.weatherType,
Weather.Description = .data$score.weather.description,
Temperature = .data$score.weather.tempInCelsius,
Home.Team = .data$match.homeTeam.name,
Home.Goals = .data$score.homeTeamScore.matchScore.goals,
Home.Behinds = .data$score.homeTeamScore.matchScore.behinds,
Home.Points = .data$score.homeTeamScore.matchScore.totalScore,
Home.Left.Behinds = .data$score.homeTeamScoreChart.leftBehinds,
Home.Right.Behinds = .data$score.homeTeamScoreChart.rightBehinds,
Home.Left.Posters = .data$score.homeTeamScoreChart.leftPosters,
Home.Right.Posters = .data$score.homeTeamScoreChart.rightPosters,
Home.Rushed.Behinds = .data$score.homeTeamScoreChart.rushedBehinds,
Home.Touched.Behinds = .data$score.homeTeamScoreChart.touchedBehinds,
Away.Team = .data$match.awayTeam.name,
Away.Goals = .data$score.awayTeamScore.matchScore.goals,
Away.Behinds = .data$score.awayTeamScore.matchScore.behinds,
Away.Points = .data$score.awayTeamScore.matchScore.totalScore,
Away.Left.Behinds = .data$score.awayTeamScoreChart.leftBehinds,
Away.Right.Behinds = .data$score.awayTeamScoreChart.rightBehinds,
Away.Left.Posters = .data$score.awayTeamScoreChart.leftPosters,
Away.Right.Posters = .data$score.awayTeamScoreChart.rightPosters,
Away.Rushed.Behinds = .data$score.awayTeamScoreChart.rushedBehinds,
Away.Touched.Behinds = .data$score.awayTeamScoreChart.touchedBehinds
) # %>%
# Parse date/start time
# dplyr::mutate(Local.Start.Time = readr::parse_datetime(Local.Start.Time))
}
#' Get AFLW match data
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' All `get_` functions were replaced with `fetch_*` functions.
#' Please use `fetch_fixture_afl()` instead
#'
#' @examples
#' #
#' \dontrun{
#' get_aflw_match_data(2020)
#' # ->
#' fetch_results_afl(2020, comp = "AFLW")
#' }
#' @keywords internal
get_aflw_match_data <- function(start_year = 2017) {
lifecycle::deprecate_warn(
"1.0.0",
"get_aflw_match_data()",
"fetch_results_afl()"
)
end_year <- Sys.Date() %>%
format("%Y") %>%
as.numeric()
seasons <- start_year:end_year
seasons %>%
purrr::map_dfr(fetch_results_afl, NULL, "AFLW")
}
#' Get detailed AFLW data
#'
#' @param matchids vector of match IDs, like those returned by
#' `get_aflw_match_data()`
#'
#' @return Dataframe with detailed match data. Each row is a match.
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @export
#'
#' @examples
#' \dontrun{
#' get_aflw_detailed_data(c("CD_M20172640101", "CD_M20172640102"))
#' }
get_aflw_detailed_data <- function(matchids) {
cookie <- get_aflw_cookie()
# Round and competition IDs can be inferred from match Ids:
# Match ID: "CD_M20172640101"
# Round ID: "CD_R201726401" M->R, last two characters removed
# Competition ID: "CD_S2017264" R->S, last two characters removed
roundid_vector <- matchids %>%
stringr::str_sub(1, -3) %>% # Remove last two characters
stringr::str_replace("M", "R") # Replace R with S
compid_vector <- roundid_vector %>%
stringr::str_sub(1, -3) %>% # Remove last two characters
stringr::str_replace("R", "S")
purrr::pmap_dfr(
list(matchids, roundid_vector, compid_vector),
~ get_aflw_detailed_match_data(..1, ..2, ..3, cookie)
)
}
#' Get detailed womens match data (internal function)
#'
#' Gets detailed match data for a given match. Requires the match, round, and
#' competition IDs, which are given in the tables produced by
#' `get_aflw_round_data()`
#'
#' @param matchid matchid from `get_match_data()`
#' @param roundid roundid from `get_match_data()`
#' @param competitionid competitionid from `get_match_data()`
#' @param cookie cookie from `get_womens_cookie()`
#'
#' @return Dataframe with detailed match data (wide)
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @export
#'
#' @examples
#' \dontrun{
#' get_aflw_detailed_match_data(
#' "CD_M20172640101",
#' "CD_R201726401", "CD_S2017264", get_aflw_cookie()
#' )
#' }
get_aflw_detailed_match_data <- function(matchid, roundid, competitionid,
cookie) {
url <- "http://api.afl.com.au/cfs/afl/statsCentre/teams"
request_metadata <- httr::GET(url,
query = list(
matchId = matchid,
roundId = roundid,
competitionId = competitionid
),
httr::add_headers(`X-media-mis-token` = cookie)
) %>%
httr::content(as = "text", encoding = "UTF-8")
# Check that round info is available on web, if not return error
if (stringr::str_detect(request_metadata, "Page Not Found")) {
stop(paste0(
"Invalid match ID (", matchid, "). Have you checked that this ",
"game has been played yet?"
))
}
match_data <- request_metadata %>%
jsonlite::fromJSON(flatten = TRUE) %>%
.$lists %>%
dplyr::as_tibble() %>%
dplyr::mutate(
Match.Id = matchid,
Round.Id = roundid,
Competition.Id = competitionid
) %>%
# Assumption: row 1 is home, row 2 is away. Have tested for correctness.
dplyr::mutate(home.away = c("Home", "Away")) %>%
tidyr::gather(
"stat", "value",
.data$stats.averages.goals:.data$team.teamNickname
) %>%
dplyr::mutate(stat = dplyr::case_when(
.data$home.away == "Home" ~ stringr::str_c("home.", .data$stat),
.data$home.away == "Away" ~ stringr::str_c("away.", .data$stat)
)) %>%
dplyr::select(-.data$home.away) %>%
tidyr::spread(.data$stat, .data$value) %>%
dplyr::rename_at(
dplyr::vars(dplyr::contains(".lastUpdated")),
dplyr::funs(stringr::str_replace(., "stats", "STATS"))
) %>%
dplyr::mutate_at(
dplyr::vars(tidyselect::contains(".stats", ignore.case = FALSE)),
readr::parse_number
) %>%
dplyr::rename_at(
dplyr::vars(tidyselect::contains(".lastUpdated")),
dplyr::funs(stringr::str_replace(., "STATS", "stats"))
) %>%
dplyr::mutate_at(
dplyr::vars(tidyselect::contains(".lastUpdated")),
readr::parse_datetime
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.