Nothing
#' Fetch Ladder
#'
#' @description
#' `fetch_ladder` returns the Ladder for a given AFL Round. Internally, it calls
#' a corresponding `fetch_ladder_*` function that depends on the source given.
#' By default the source used will be the official AFL website.
#'
#' [fetch_ladder_afl()], [fetch_ladder_afltables()], [fetch_ladder_squiggle()]
#' can be called directly and return data from AFL website, AFL Tables and
#' Squiggle, respectively.
#'
#' @param season Season in YYYY format, defaults to NULL which returns the year
#' corresponding the `Sys.Date()`
#' @param round_number Round number, defaults to NULL which returns latest round
#' @param comp One of "AFLM" (default), "AFLW", "VFL", "VFLW", "WAFL", "U18B" or "U18G." Not all data sources will have non-AFL data
#' @param source One of "AFL" (default), "footywire", "fryzigg", "afltables", "squiggle"
#' @param ... Optional parameters passed onto various functions depending on source.
#'
#' @return A Tibble with the ladder from the relevant `season` and `round`.
#' @export
#'
#' @examples
#' \dontrun{
#' # Return data from AFL Website
#' fetch_ladder(2020, round = 1)
#'
#' # This is equivalent to
#' fetch_ladder(2020, round = 1, source = "AFL")
#' fetch_ladder_afl(2020, round = 1)
#'
#' # Return AFLW data
#' fetch_ladder(2020, round = 1, comp = "AFLW", source = "AFL")
#' fetch_ladder_afl(2020, round = 1, comp = "AFLW")
#'
#' # Not all sources have AFLW data and will return a warning
#' fetch_ladder(2020, round = 1, comp = "AFLW", source = "afltables")
#' fetch_ladder(2020, round = 1, comp = "AFLW", source = "squiggle")
#'
#' # Different sources
#' fetch_ladder(2015, round = 5, source = "afltables")
#' fetch_ladder(2015, round = 5, source = "squiggle")
#'
#' # Directly call functions for each source
#' fetch_ladder_afl(2018, round = 9)
#' fetch_ladder_afltables(2018, round = 9)
#' fetch_ladder_squiggle(2018, round = 9)
#' }
#'
#' @family fetch ladder functions
#' @seealso
#' * [fetch_ladder_afl] for official AFL data.
#' * [fetch_ladder_afltables] for AFL Tables data.
#' * [fetch_ladder_squiggle] for Squiggle data.
#'
#' @importFrom magrittr %>%
#' @importFrom rlang .data
fetch_ladder <- function(season = NULL,
round_number = NULL,
comp = "AFLM",
source = "AFL",
...) {
# Do some data checks
season <- check_season(season)
check_comp_source(comp, source)
dat <- switch(source,
"AFL" = fetch_ladder_afl(season, round_number, comp),
"afltables" = fetch_ladder_afltables(season, round_number, ...),
"squiggle" = fetch_ladder_squiggle(season, round_number),
NULL
)
if (is.null(dat)) cli::cli_warn("The source \"{source}\" does not have Ladder data. Please use one of \"AFL\", \"afltables\", or \"squiggle\"")
return(dat)
}
#' @rdname fetch_ladder
#' @export
fetch_ladder_afl <- function(season = NULL, round_number = NULL, comp = "AFLM") {
# check inputs
season <- check_season(season)
comp <- check_comp(comp)
# if (is.null(round_number)) round_number <- ""
if (length(season) > 1) {
cli::cli_inform("Multiple seasons specified, ignoring round_number")
round_number <- NULL
}
# fetch ids
season_id <- find_season_id(season, comp)
if (is.null(season_id)) {
cli::cli_warn("No ladder data found for season {season} on AFL.com.au for {comp}")
return(NULL)
}
if (is.null(round_number)) {
cli::cli_inform("No round number specified, trying to return most recent ladder for specified season")
round_id <- ""
} else {
round_id <- find_round_id(round_number,
season_id = season_id,
comp = comp, providerId = FALSE,
future_rounds = FALSE
)
}
if (is.null(round_id) || is.null(season_id)) {
return(NULL)
}
# Make request
api_url <- season_id %>%
purrr::map_chr(~ paste0(
"https://aflapi.afl.com.au/afl/v2/compseasons/",
.x,
"/ladders"
))
resp <- api_url %>%
purrr::map(httr::GET, query = list("roundId" = round_id), .progress = TRUE)
status_codes <- resp %>%
purrr::map_dbl(purrr::pluck, "status_code")
if (any(status_codes == 404) | any(status_codes == 400)) {
cli::cli_abort("No data found for specified round number and season. Does round number \"{round_number}\" exist for Season \"{season}\" on \"www.afl.com.au/ladder\"?")
}
cont <- resp %>%
purrr::map(httr::content, as = "text", encoding = "UTF-8") %>%
purrr::map(jsonlite::fromJSON, flatten = TRUE)
ladder_list <- cont %>%
purrr::map(purrr::pluck, "ladders", "entries")
ladder_list <- ladder_list %>%
purrr::map(dplyr::bind_rows, .id = "conference")
args <- list(
ladder_list = ladder_list,
season = season,
season_name = cont %>% purrr::map(purrr::pluck, "compSeason", "name"),
last_updated = cont %>% purrr::map(purrr::pluck, "lastUpdated"),
round_name = cont %>% purrr::map(purrr::pluck, "round", "name"),
round_number = cont %>% purrr::map(purrr::pluck, "round", "roundNumber")
)
ladder_df <- purrr::pmap_dfr(
args,
~ with(
list(...),
dplyr::mutate(ladder_list,
season = season,
season_name = season_name,
last_updated = last_updated,
round_name = round_name,
round_number = round_number
)
)
)
ladder_df <- ladder_df %>%
dplyr::select(
"season", "season_name", "round_name",
"round_number", "last_updated",
dplyr::everything()
)
dplyr::as_tibble(ladder_df)
}
#' @param match_results_df (optional) A dataframe from [fetch_results_afltables()], provide this to prevent having to download results again.
#' @rdname fetch_ladder
#' @export
fetch_ladder_afltables <- function(season = NULL, round_number = NULL, match_results_df = NULL) {
suppressWarnings(if (is.null(match_results_df)) {
match_results_df <- purrr::map_dfr(
.x = c(1:round_number),
.f = ~ fetch_results_afltables(season, .x)
)
})
# first some cleaning up
match_results_df <- match_results_df %>%
dplyr::filter(.data$Round.Type == "Regular") %>%
dplyr::mutate(winner = ifelse(.data$Home.Points > .data$Away.Points,
"Home",
ifelse(.data$Away.Points > .data$Home.Points,
"Away",
"Draw"
)
))
# create a long df, with each observation being a team, for the round, for the season
home_dat <- match_results_df %>%
dplyr::select(
Team = "Home.Team",
"Round.Number", "Season", "winner",
Score = "Home.Points",
OppScore = "Away.Points"
) %>%
dplyr::mutate(home_or_away = "Home")
away_dat <- match_results_df %>%
dplyr::select(
Team = "Away.Team",
"Round.Number",
"Season",
"winner",
Score = "Away.Points",
OppScore = "Home.Points"
) %>%
dplyr::mutate(home_or_away = "Away")
team_view <- home_dat %>%
dplyr::bind_rows(away_dat) %>%
dplyr::mutate(win = ifelse(.data$winner == "Draw", 0.5,
ifelse(.data$winner == .data$home_or_away,
1,
0
)
)) %>%
dplyr::mutate(points = .data$win * 4)
# because there were byes throughout, some teams are missing for ladder construction purposes
# ie in some rounds, there aren't the right amount of teams in each round
df <- team_view %>%
dplyr::distinct(.data$Season, .data$Team) %>%
dplyr::left_join(team_view %>% dplyr::distinct(.data$Season, .data$Round.Number),
by = "Season",
multiple = "all",
relationship = "many-to-many"
) %>%
dplyr::left_join(team_view,
by = c("Season", "Round.Number", "Team"),
multiple = "all",
relationship = "many-to-many"
) %>%
dplyr::select(-"winner", -"home_or_away")
# function to replace the missing results (ie where the team had a bye) with zeros
replace_with_zero <- function(x) {
if (is.na(x)) {
x <- 0
} else {
x <- x
}
}
# fill in the missing values with zeros
df <- df %>%
dplyr::mutate(
Score = mapply(replace_with_zero, .data$Score),
OppScore = mapply(replace_with_zero, .data$OppScore),
win = mapply(replace_with_zero, .data$win),
points = mapply(replace_with_zero, .data$points)
)
# calculate cumulative scores for each team
df <- df %>%
dplyr::arrange(.data$Season, .data$Team, .data$Round.Number) %>%
dplyr::group_by(.data$Season, .data$Team) %>%
# calculate running totals for the season
dplyr::mutate(
season_points = cumsum(.data$points),
score_for = cumsum(.data$Score),
score_against = cumsum(.data$OppScore),
percentage = .data$score_for / .data$score_against
) %>%
dplyr::ungroup()
# Round 1 in 2011, Gold Coast had a bye in round 1, so need to fix the NaN for their percentage (R doesn't like 0 / 0)
df$percentage[is.nan(df$percentage)] <- 0
# arrange teams so that the top ranked team is at the top
ladder <- df %>%
dplyr::arrange(.data$Season, .data$Round.Number, dplyr::desc(.data$season_points), dplyr::desc(.data$percentage))
# apply the ladder position for each round. Because there were different numbers of teams each season, need to find out how many teams
suppressWarnings(for (i in unique(ladder$Season)) {
num_teams <- length(unique(ladder$Team[ladder$Season == i]))
ladder$ladder_pos[ladder$Season == i] <- rep(1:num_teams)
})
# select final columns for output ladder table
ladder <- ladder %>%
dplyr::select("Season", "Team", "Round.Number",
Season.Points = "season_points",
Score.For = "score_for",
Score.Against = "score_against",
Percentage = "percentage",
Ladder.Position = "ladder_pos"
)
# Allowing for ladder filtering -------------------------------------------
# filtering the round of the season if not NA
suppressWarnings(if (!is.null(round_number)) {
ladder <- ladder %>%
dplyr::filter(.data$Round.Number %in% round_number)
})
# filtering the season if not NA
suppressWarnings(if (!is.null(season)) {
ladder <- ladder %>%
dplyr::filter(.data$Season %in% season)
})
if (nrow(ladder) == 0) {
cli::cli_abort("No data found for specified round number and season. Does round number \"{round_number}\" exist for Season \"{season}\" on \"www.afltables.com\"?")
}
return(ladder)
}
#' @rdname fetch_ladder
#' @export
fetch_ladder_squiggle <- function(season = NULL,
round_number = NULL) {
# check inputs
season <- check_season(season)
if (is.null(round_number)) {
cli::cli_progress_step(
"No round specified - returning most recent ladder in season {.val {season}}"
)
dat <- fetch_squiggle_data(
query = "standings",
year = season
)
} else {
cli::cli_progress_step(
"Returning ladder as of round {.val {round_number}} in season {.val {season}}"
)
dat <- fetch_squiggle_data(
query = "standings",
year = season,
round = round_number
)
}
return(dat)
}
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.