#' Get data for a unit by ID
#'
#' These functions return data about events, matches or players by
#' the vector(s) of respective identifiers.
#'
#' @param event_id Vector of event ids in character, integer or numeric form
#' @param round_id Vector of round ids in character, integer or numeric form
#' @param match_num Vector of match numbers in character, integer or
#' numeric form
#' @param player_id Vector of player ids in character, integer or numeric form
#' @param sleep_sec Number of seconds to wait before the next query
#' @param progress Boolean indicator of whether to show function progress
#'
#' @details Identifier for \strong{event} is \code{event_id}.
#'
#' Identifier for \strong{match} is combination of \code{event_id},
#' \code{round_id} and \code{match_num}. When using \code{get_matches} these
#' vectors are recycled by standard R rules.
#'
#' Identifier for \strong{player} is \code{player_id}.
#'
#' If there is no available data for particular identifier then it
#' will not be included in return value (with appropriate message).
#'
#' \code{sleep_sec} is introduced in order to not overload API servers.
#' It can be not less than 1 second. If \code{progress == TRUE} text progress
#' will be displayed in the console.
#'
#' @return \code{get_events} returns \link{event} data.frame. Rows are arranged
#' from the latest ended event to the earliest.
#'
#' \code{get_matches} returns \link{match} data.frame. Rows are arranged
#' from the latest ended match to the earliest.
#'
#' \code{get_players} returns \link{player} data.frame.
#' Column \code{status} is filled with \code{NA} because
#' there is no information from performed query.
#' Information about player status can be obtained from calls to
#' \link[=get_data_multiple]{get_season_pro_players},
#' \link[=get_data_multiple]{get_season_ama_players},
#' \link[=get_data_all]{get_all_players},
#' \link[=get_data_all]{get_all_pro_players},
#' \link[=get_data_all]{get_all_ama_players}.
#'
#' @seealso \link{get_data_multiple} for querying multiple data for one unit.
#'
#' \link{get_data_all} for querying all data for unit type.
#'
#' @examples \dontrun{
#' # Get data about events with IDs 1 and 2
#' get_events(event_id = 1:2)
#'
#' # Get data about match in event 398, round 4 and match number 1
#' get_matches(event_id = 398, round_id = 4, match_num = 1)
#'
#' # Get data about players with IDs from 1 to 10
#' get_players(player_id = 1:10)
#'}
#' @name get_data_by_id
NULL
#' @rdname get_data_by_id
#' @export
get_events <- function(event_id = integer(0),
sleep_sec = 1, progress = TRUE) {
if (length(event_id) == 0) {
return(event_template)
}
if (progress) {
pb <- initialize_pb(max = length(event_id))
}
res_event <- lapply(1:length(event_id), function(i) {
Sys.sleep(max(1, sleep_sec))
if (progress) {
setTxtProgressBar(pb, i)
}
query_snookerorg(get_event_arg(id = as.integer(event_id[i])))
})
bad_query_vec <- sapply(res_event, is_bad_query)
if (sum(bad_query_vec) > 0) {
message(
paste0("There are no events with the following IDs:\n",
paste0(event_id[bad_query_vec], collapse = ", "))
)
}
res_event <- res_event[!bad_query_vec]
if (length(res_event) == 0) {
event_template
} else {
res_event %>%
dplyr::bind_rows() %>%
format_event()
}
}
#' @rdname get_data_by_id
#' @export
get_matches <- function(event_id = integer(0),
round_id = integer(0),
match_num = integer(0),
sleep_sec = 1, progress = TRUE) {
args <- expand_args(
as.integer(event_id),
as.integer(round_id),
as.integer(match_num)
)
if ((nrow(args) == 0) ||
(sum(complete.cases(args)) == 0)) {
return(match_template)
}
if (progress) {
pb <- initialize_pb(max = nrow(args))
}
res_match <- lapply(1:nrow(args), function(i) {
Sys.sleep(max(1, sleep_sec))
if (progress) {
setTxtProgressBar(pb, i)
}
query_snookerorg(
get_event_arg(id = args[i, 1]),
get_round_arg(id = args[i, 2]),
get_match_num_arg(id = args[i, 3])
)
})
bad_query_vec <- sapply(res_match, is_bad_query)
if (sum(bad_query_vec) > 0) {
bad_params <- data.frame(
event_id = args[bad_query_vec, 1],
round_id = args[bad_query_vec, 2],
match_num = args[bad_query_vec, 3]
)
message(
paste0("There are no events with the following IDs:\n",
paste0(capture.output(bad_params), collapse = "\n"))
)
}
res_match <- res_match[!bad_query_vec]
if (length(res_match) == 0) {
match_template
} else {
res_match %>%
dplyr::bind_rows() %>%
format_match()
}
}
#' @rdname get_data_by_id
#' @export
get_players <- function(player_id = integer(0),
sleep_sec = 1, progress = TRUE) {
if (length(player_id) == 0) {
return(player_template)
}
if (progress) {
pb <- initialize_pb(max = length(player_id))
}
res_player <- lapply(1:length(player_id), function(i) {
Sys.sleep(max(1, sleep_sec))
if (progress) {
setTxtProgressBar(pb, i)
}
query_snookerorg(get_player_arg(id = as.integer(player_id[i])))
})
bad_query_vec <- sapply(res_player, is_bad_query)
if (sum(bad_query_vec) > 0) {
message(
paste0("There are players with the following IDs:\n",
paste0(player_id[bad_query_vec], collapse = ", "))
)
}
res_player <- res_player[!bad_query_vec]
if (length(res_player) == 0) {
player_template
} else {
res_player %>%
dplyr::bind_rows() %>%
format_player() %>%
add_player_status(status = NA_character_)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.