Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# f1dataR (development version)

* Fixed a data conversion issue in `time_to_sec()` (#290)

# f1dataR 2.0.1

* Forced fail-over from Ergast to Jolpica (still deprecated at 'warn' level).
Expand Down
104 changes: 78 additions & 26 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,9 @@
#' Further processing is performed by specific functions
get_ergast_content <- function(url) {
# Function Deprecation Warning
lifecycle::deprecate_warn("at the end of 2024", "get_ergast_content()",
lifecycle::deprecate_warn(
"at the end of 2024",
"get_ergast_content()",
details = c(
"i" = "At the end of 2024 season the Ergast Motor Racing Database API was shut down.",
" " = "Update f1dataR to use the new jolpica-f1 API data source"
Expand Down Expand Up @@ -52,11 +54,15 @@ get_jolpica_content <- function(url) {
# Automatically retries request up to 5 times. Back-off provided in httr2 documentation
# Automatically retries at http if https fails after retries.


jolpica_raw <- httr2::request("https://api.jolpi.ca/ergast/f1/") %>%
httr2::req_url_path_append(url) %>%
httr2::req_retry(max_tries = 10, backoff = function(x) stats::runif(1, 1, 2^x)) %>%
httr2::req_user_agent(glue::glue("f1dataR/{ver}", ver = utils::installed.packages()["f1dataR", "Version"])) %>%
httr2::req_retry(max_tries = 10, backoff = function(x) {
stats::runif(1, 1, 2^x)
}) %>%
httr2::req_user_agent(glue::glue(
"f1dataR/{ver}",
ver = utils::installed.packages()["f1dataR", "Version"]
)) %>%
httr2::req_throttle(4 / 1) %>%
httr2::req_error(is_error = ~FALSE)

Expand All @@ -68,15 +74,24 @@ get_jolpica_content <- function(url) {
httr2::req_perform()
},
error = function(e) {
cli::cli_alert_danger(glue::glue("f1dataR: Error getting data from Jolpica:\n{e}", e = e))
cli::cli_alert_danger(glue::glue(
"f1dataR: Error getting data from Jolpica:\n{e}",
e = e
))
}
)

# Restart retries to Jolpica with http (instead of https)
# No testing penalty for Jolpica functioning correct
# nocov start
if (is.null(jolpica_res) || httr2::resp_is_error(jolpica_res) || httr2::resp_body_string(jolpica_res) == "Unable to select database") {
cli::cli_alert_warning("Failure at Jolpica with https:// connection. Retrying as http://.")
if (
is.null(jolpica_res) ||
httr2::resp_is_error(jolpica_res) ||
httr2::resp_body_string(jolpica_res) == "Unable to select database"
) {
cli::cli_alert_warning(
"Failure at Jolpica with https:// connection. Retrying as http://."
)
tryCatch(
{
jolpica_res <- jolpica_raw %>%
Expand All @@ -85,7 +100,10 @@ get_jolpica_content <- function(url) {
httr2::req_perform()
},
error = function(e) {
cli::cli_alert_danger(glue::glue("f1dataR: Error getting data from Jolpica:\n{e}", e = e))
cli::cli_alert_danger(glue::glue(
"f1dataR: Error getting data from Jolpica:\n{e}",
e = e
))
}
)
}
Expand All @@ -96,15 +114,18 @@ get_jolpica_content <- function(url) {
}

if (httr2::resp_is_error(jolpica_res)) {
cli::cli_alert_danger(glue::glue("Error getting Jolpica data, http status code {code}.\n{msg}",
cli::cli_alert_danger(glue::glue(
"Error getting Jolpica data, http status code {code}.\n{msg}",
code = httr2::resp_status(jolpica_res),
msg = httr2::resp_status_desc(jolpica_res)
))
return(NULL)
}

if (httr2::resp_body_string(jolpica_res) == "Unable to select database") {
cli::cli_alert_danger("Jolpica is having database trouble. Please try again at a later time.")
cli::cli_alert_danger(
"Jolpica is having database trouble. Please try again at a later time."
)
return(NULL)
}
# nocov end
Expand All @@ -121,7 +142,8 @@ get_jolpica_content <- function(url) {
#' @export
#' @return Year (four digit number) representation of current season, as numeric.
get_current_season <- function() {
return(ifelse(as.numeric(strftime(Sys.Date(), "%m")) < 3,
return(ifelse(
as.numeric(strftime(Sys.Date(), "%m")) < 3,
as.numeric(strftime(Sys.Date(), "%Y")) - 1,
as.numeric(strftime(Sys.Date(), "%Y"))
))
Expand All @@ -138,9 +160,11 @@ get_current_season <- function() {
time_to_sec <- function(time) {
subfun <- function(x) {
if (is.na(x)) {
NA
return(NA_real_)
} else if (is.numeric(x)) {
x
return(x)
} else if (x == "") {
return(NA_real_)
} else {
split <- as.numeric(strsplit(x, ":", fixed = TRUE)[[1]])
if (length(split) == 3) {
Expand Down Expand Up @@ -174,10 +198,16 @@ check_ff1_session_loaded <- function(session_name = "session") {
{
# Only returns a value if session.load() has been successful
# If it hasn't, retry
reticulate::py_run_string(glue::glue("{session_name}.t0_date", session_name = session_name))
reticulate::py_run_string(glue::glue(
"{session_name}.t0_date",
session_name = session_name
))
},
error = function(e) {
reticulate::py_run_string(glue::glue("{session_name}.load()", session_name = session_name))
reticulate::py_run_string(glue::glue(
"{session_name}.load()",
session_name = session_name
))
}
)
invisible(TRUE)
Expand Down Expand Up @@ -208,14 +238,20 @@ check_ff1_network_connection <- function(path = NA_character_) {
httr2::req_url_path_append(path) %>%
httr2::req_url_path_append("Index.json") %>%
httr2::req_retry(max_tries = 5) %>%
httr2::req_user_agent(glue::glue("f1dataR/{ver}", ver = utils::installed.packages()["f1dataR", "Version"])) %>%
httr2::req_user_agent(glue::glue(
"f1dataR/{ver}",
ver = utils::installed.packages()["f1dataR", "Version"]
)) %>%
httr2::req_throttle(4 / 1) %>%
httr2::req_error(is_error = ~FALSE)
status <- ff1raw %>%
httr2::req_perform()
},
error = function(e) {
cli::cli_alert_danger(glue::glue("f1dataR: Error getting data from F1 Live Timing:\n{e}", e = e))
cli::cli_alert_danger(glue::glue(
"f1dataR: Error getting data from F1 Live Timing:\n{e}",
e = e
))
}
)
if (is.null(status)) {
Expand All @@ -240,13 +276,15 @@ check_ff1_network_connection <- function(path = NA_character_) {
check_ff1_version <- function() {
version <- get_fastf1_version()
if (version < "3.1") {
cli::cli_abort(c("An old version of {.pkg FastF1} is in use. {.pkg f1dataR} requires {.pkg FastF1} version 3.1.0 or newer.",
cli::cli_abort(c(
"An old version of {.pkg FastF1} is in use. {.pkg f1dataR} requires {.pkg FastF1} version 3.1.0 or newer.",
x = "Support for older {.pkg FastF1} versions was removed in {.pkg f1dataR} v1.6.0",
i = "You can update your {.pkg FastF1} installation manually, or by running:",
" " = "{.code setup_fastf1()}"
))
} else if (version < "3.4") {
cli::cli_warn(c("An old version of {.pkg FastF1} is in use. {.pkg f1dataR} requires {.pkg FastF1} version 3.4.0 or newer for some functions.",
cli::cli_warn(c(
"An old version of {.pkg FastF1} is in use. {.pkg f1dataR} requires {.pkg FastF1} version 3.4.0 or newer for some functions.",
x = "Support for older {.pkg FastF1} versions may be removed soon.",
i = "You can update your {.pkg FastF1} installation manually, or by running:",
" " = "{.code setup_fastf1()}"
Expand All @@ -269,7 +307,8 @@ get_fastf1_version <- function() {
dplyr::filter(.data$package == "fastf1") %>%
dplyr::pull("version")
if (length(ver) == 0) {
cli::cli_warn("Ensure {.pkg fastf1} Python package is installed.",
cli::cli_warn(
"Ensure {.pkg fastf1} Python package is installed.",
i = "Please run this to install the most recent version:",
" " = "{.code setup_fastf1()}"
)
Expand All @@ -294,13 +333,19 @@ get_fastf1_version <- function() {
#' @keywords internal
add_col_if_absent <- function(data, column_name, na_type = NA) {
if (!is.na(na_type)) {
cli::cli_abort(x = "{.arg na_type} must be provided as an actual {.code NA_type_} (for example, {.val NA_character_}).")
cli::cli_abort(
x = "{.arg na_type} must be provided as an actual {.code NA_type_} (for example, {.val NA_character_})."
)
}
if (!(inherits(data, "data.frame"))) {
cli::cli_abort(x = "{.arg data} must be provided as a {.code data.frame} or {.code tibble}.")
cli::cli_abort(
x = "{.arg data} must be provided as a {.code data.frame} or {.code tibble}."
)
}
if (!(length(column_name) == 1) | !(inherits(column_name, "character"))) {
cli::cli_abort(x = "{.arg column_name} must be provided as a single {.code character} value.")
cli::cli_abort(
x = "{.arg column_name} must be provided as a single {.code character} value."
)
}
if (!(column_name %in% colnames(data))) {
data[, column_name] <- na_type
Expand Down Expand Up @@ -332,13 +377,20 @@ add_col_if_absent <- function(data, column_name, na_type = NA) {
#' # Reinstall fastf1 and recreate the environment.
#' setup_fastf1(envname = "f1dataR_env", new_env = TRUE)
#' }
setup_fastf1 <- function(..., envname = "f1dataR_env", new_env = identical(envname, "f1dataR_env")) {
setup_fastf1 <- function(
...,
envname = "f1dataR_env",
new_env = identical(envname, "f1dataR_env")) {
if (new_env && virtualenv_exists(envname)) {
cli::cli_alert_warning("The Python environment {.var {envname}} is being removed and rebuilt for {.pkg FastF1}f")
cli::cli_alert_warning(
"The Python environment {.var {envname}} is being removed and rebuilt for {.pkg FastF1}f"
)
virtualenv_remove(envname)
}

cli::cli_alert_info("Installing {.pkg FastF1} in current Python environment: {.var {envname}}.")
cli::cli_alert_info(
"Installing {.pkg FastF1} in current Python environment: {.var {envname}}."
)
reticulate::py_install("fastf1", envname = envname, ...)
}

Expand Down
15 changes: 11 additions & 4 deletions tests/testthat/test-utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,13 +35,18 @@ test_that("utility functions work", {
expect_equal(time_to_sec("12:34:56.789"), 45296.789)
expect_equal(time_to_sec("12.3456"), 12.3456)
expect_equal(time_to_sec(12.345), 12.345)
expect_equal(time_to_sec(""), NA_real_)
expect_equal(time_to_sec(NA), NA_real_)

expect_equal(
time_to_sec(c("12.345", "1:23.456", "12:34:56.789", "12.3456")),
c(12.345, 83.456, 45296.789, 12.3456)
)

expect_error(check_ff1_network_connection(), "f1dataR: Specific race path must be provided")
expect_error(
check_ff1_network_connection(),
"f1dataR: Specific race path must be provided"
)
})

test_that("Utility Functions work without internet", {
Expand All @@ -60,9 +65,11 @@ test_that("Utility Functions work without internet", {
# a byproduct of the without_internet call
suppressWarnings({
suppressMessages({
httptest2::without_internet((
expect_false(check_ff1_network_connection("/static/2024/2024-03-02_Bahrain_Grand_Prix/2024-03-02_Race/"))
))
httptest2::without_internet(
(expect_false(check_ff1_network_connection(
"/static/2024/2024-03-02_Bahrain_Grand_Prix/2024-03-02_Race/"
)))
)
})
})
}
Expand Down
Loading