Merge pull request #251 from pbulsink/cran-again

Cran again

NEWS.md

@@ -1,5 +1,8 @@
 # f1dataR (development version)
 
+* Modified testing to satisfy CRAN requirements. 
+* Added vignette looking at telemetry plots through Alonso's 2024 Australia penalty.
+
 # f1dataR 1.5.1
 
 * Added (very soft) deprecation warning to Ergast functions in advance of the Ergast API being defunct in less than 12 months.

cran-comments.md

@@ -2,11 +2,6 @@
 
 This is a bugfix requested by CRAN after some failures of automated testing due to internet resource unavailability. 
 
-The package has been updated to fail gracefully if the web resource is unavailable (previous action was a warning or error, case dependent). Further, flexibility on incomplete responses from the web API have been drastically improved.
-
-This version update was requested by 17 March, should there be any issues with this submission please extend this deadline.
-
-Reduced image quality to comply with 5MB tarball limit
-
-## R CMD check results
+Our previous resubmission for the same issue corrected failure errors to graceful warnings but some testing failures snuck through. This is a testing update to match.
 
+This update also includes a new vignette.

tests/testthat/setup.R

@@ -1,22 +1,41 @@
 require(httptest2, quietly = TRUE)
 
+
 # helper function to skip tests if we don't have the fastf1 module
 skip_if_no_ff1 <- function() {
+  if (!require("reticulate", quietly = TRUE)) {
+    testthat::skip("Reticulate unavailable for testing")
+  }
   have_ff1 <- "fastf1" %in% reticulate::py_list_packages()$package
   if (!have_ff1) {
     testthat::skip("fastf1 not available for testing")
   }
 }
 
+
 # helper function to skip tests if we don't have ggplot2
 skip_if_no_ggplot2 <- function() {
   if (!require("ggplot2", quietly = TRUE)) {
     testthat::skip("ggplot2 not available for testing")
   }
 }
 
+
+# helper function to skip if python isn't available by reticulate
 skip_if_no_py <- function() {
+  if (!require("reticulate", quietly = TRUE)) {
+    testthat::skip("Reticulate unavailable for testing")
+  }
   if (!reticulate::py_available(initialize = TRUE)) {
     testthat::skip("Python not available for testing")
   }
 }
+
+
+# helper function to skip if ergast isn't working
+skip_if_no_ergast <- function() {
+  testthat::skip_if_offline("ergast.com") # This will also skip on CRAN
+  if (is.null(get_ergast_content("current/circuits.json?limit=40"))) {
+    testthat::skip("No ergast connection available for testing")
+  }
+}

tests/testthat/test-load_circuits.R

@@ -7,11 +7,15 @@ test_that("load_ciruits works", {
   dir.create(file.path(tempdir(), "tst_load_circuits"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_circuits"))
 
-  ciruits_2021 <- load_circuits(2021)
+  skip_if_no_ergast()
 
-  expect_equal(nrow(ciruits_2021), 21)
-  expect_equal(ciruits_2021$circuit_id[3], "baku")
-  expect_equal(ciruits_2021$locality[1], "Austin")
+  circuits_2021 <- load_circuits(2021)
+
+  skip_if(is.null(circuits_2021))
+
+  expect_equal(nrow(circuits_2021), 21)
+  expect_equal(circuits_2021$circuit_id[3], "baku")
+  expect_equal(circuits_2021$locality[1], "Austin")
 
   expect_error(load_circuits(3050), "`season` must be between 1950 and *")
 })

tests/testthat/test-load_constructors.R

@@ -7,8 +7,12 @@ test_that("load_constructors works", {
   dir.create(file.path(tempdir(), "tst_load_constructors"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_constructors"))
 
+  skip_if_no_ergast()
+
   constructors <- load_constructors()
 
+  skip_if(is.null(constructors))
+
   expect_equal(ncol(constructors), 3)
   expect_equal(constructors[1, ]$constructor_id, "adams")
 })

tests/testthat/test-load_drivers.R

@@ -6,8 +6,12 @@ test_that("Drivers Load works", {
   dir.create(file.path(getwd(), "tst_load_drivers"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(getwd(), "tst_load_drivers"))
 
+  skip_if_no_ergast()
+
   drivers_2021 <- load_drivers(2021)
 
+  skip_if(is.null(drivers_2021))
+
   expect_equal(nrow(drivers_2021), 21)
   expect_equal(drivers_2021$driver_id[2], "bottas")
   expect_equal(drivers_2021$code[1], "ALO")

tests/testthat/test-load_laps.R

@@ -7,8 +7,12 @@ test_that("load_laps works", {
   dir.create(file.path(tempdir(), "tst_load_laps"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_laps"))
 
+  skip_if_no_ergast()
+
   laps_2021_1 <- load_laps(2021, 1)
 
+  skip_if(is.null(laps_2021_1))
+
   expect_equal(nrow(laps_2021_1), 1026)
   expect_equal(laps_2021_1$driver_id[3], "leclerc")
   expect_equal(laps_2021_1$position[1], "1")

tests/testthat/test-load_pitstops.R

@@ -7,8 +7,12 @@ test_that("load_pitstops works", {
   dir.create(file.path(tempdir(), "tst_load_pitstops"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_pitstops"))
 
+  skip_if_no_ergast()
+
   pitstop_2021_1 <- load_pitstops(2021, 1)
 
+  skip_if(is.null(pitstop_2021_1))
+
   expect_equal(nrow(pitstop_2021_1), 40)
   expect_equal(pitstop_2021_1$driver_id[1], "perez")
   expect_equal(pitstop_2021_1$stop[2], "1")

tests/testthat/test-load_quali.R

@@ -7,8 +7,12 @@ test_that("load_quali works", {
   dir.create(file.path(tempdir(), "tst_load_quali"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_quali"))
 
+  skip_if_no_ergast()
+
   quali_2021_1 <- load_quali(2021, 1)
 
+  skip_if(is.null(quali_2021_1))
+
   expect_equal(nrow(quali_2021_1), 20)
   expect_equal(quali_2021_1$driver_id[2], "hamilton")
   expect_equal(quali_2021_1$position[1], "1")

tests/testthat/test-load_results.R

@@ -7,8 +7,12 @@ test_that("load_results works", {
   dir.create(file.path(tempdir(), "tst_load_results"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_results"))
 
+  skip_if_no_ergast()
+
   results_2021_1 <- load_results(2021, 1)
 
+  skip_if(is.null(results_2021_1))
+
   expect_equal(nrow(results_2021_1), 20)
   expect_equal(results_2021_1$driver_id[4], "norris")
   expect_equal(results_2021_1$position[1], "1")

tests/testthat/test-load_schedule.R

@@ -7,8 +7,12 @@ test_that("load_schedule works", {
   dir.create(file.path(tempdir(), "tst_load_schedule"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_schedule"))
 
+  skip_if_no_ergast()
+
   schedule_2021 <- load_schedule(2021)
 
+  skip_if(is.null(schedule_2021))
+
   expect_equal(nrow(schedule_2021), 22)
   expect_equal(schedule_2021$season[1], "2021")
   expect_equal(schedule_2021$race_name[2], "Emilia Romagna Grand Prix")

tests/testthat/test-load_sprint.R

@@ -6,9 +6,13 @@ test_that("load_sprint works", {
   dir.create(file.path(tempdir(), "tst_load_sprint"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_sprint"))
 
+  skip_if_no_ergast()
+
   # A sprint exists for season = 2021, round = 10
   sprint_2021_10 <- load_sprint(2021, 10)
 
+  skip_if(is.null(sprint_2021_10))
+
   expect_equal(nrow(sprint_2021_10), 20)
   expect_equal(sprint_2021_10$driver_id[3], "bottas")
   expect_equal(sprint_2021_10$position[1], "1")

tests/testthat/test-load_standings.R

@@ -6,8 +6,12 @@ test_that("load_standings works", {
   dir.create(file.path(tempdir(), "tst_load_standings"), recursive = TRUE)
   withr::local_options(f1dataR.cache = file.path(tempdir(), "tst_load_standings"))
 
+  skip_if_no_ergast()
+
   standings_2021 <- load_standings(2021)
 
+  skip_if(is.null(standings_2021))
+
   expect_equal(nrow(standings_2021), 21)
 
   standings_2021_constructor <- load_standings(2021, type = "constructor")

vignettes/alonso-penalty-2024.Rmd

@@ -9,7 +9,7 @@ vignette: >
 
 
 
-In the closing laps of the 2024 Australian Grand Prix, the lone remaining Mercedes of George Russell was in a showdown with Aston Martin's Fernando Alonso. On the penultimate lap, Russell crashed out at turn 6-7, coming to a stop at an awkward angle skew across the track. Following the race, both drivers were called to the Stewards, who discussed the incident with both drivers and reviewed data and video. They handed Alonso a 20 second penalty for causing the crash, despite there not having been any contact between the two drivers. A large portion of the decision rested on the telemetry from the drivers' cars. While the Stewards, FIA and Teams have much more detailed data than we do, we can repeat their analysis using R, `f1dataR` and the Python FastF1 package. 
+In the closing laps of the 2024 Australian Grand Prix, the lone remaining Mercedes of George Russell was in a showdown with Aston Martin's Fernando Alonso. On the penultimate lap, Russell crashed out at turn 6-7, coming to a stop at an awkward angle and askew across the track. Following the race, both drivers were called to the Stewards, who discussed the incident with both drivers and reviewed data and video. They handed Alonso a 20 second penalty for causing the crash, despite there not having been any contact between the two drivers. A large portion of the decision rested on the telemetry from the drivers' cars. While the Stewards, FIA and teams have much more detailed data than we do, we can repeat their analysis using R, `f1dataR` and the Python FastF1 package. 
 
 # Accessing the Data
 We'll start by loading the `f1dataR` package, and preparing the Python virtual environment (including installing FastF1). This happens automatically with a call to `setup_fastf1()`, [see the setup_fastf1 vignette](setup_fastf1.Rmd) for more information.
@@ -20,15 +20,17 @@ library(f1dataR)
 setup_fastf1()
 ```
 
-Since the crash occurred on lap 57, we'll download telemetry for Alonso for the five previous laps to compare what Alonso did on the fateful lap compared to those before. We'll also load Russell's telemetry from lap 57 to see how he reacts before the crash. Note we use some `dplyr` for data manipulation.
+Since the crash occurred on lap 57, we'll download telemetry for Alonso for the five previous laps to compare what Alonso did on the fateful lap compared to those before. We'll also load Russell's telemetry from those same laps to see how he reacts before the crash. Note we use some `dplyr` for data manipulation.
 
 
 ```r
 alo_telem <- dplyr::bind_rows(lapply(c(52:57), function(l) load_driver_telemetry(season = 2024, round = "Australia", session = "R", driver = "ALO", laps = l) %>% dplyr::mutate(lap = l)))
 rus_telem <- dplyr::bind_rows(lapply(c(52:57), function(l) load_driver_telemetry(season = 2024, round = "Australia", session = "R", driver = "RUS", laps = l) %>% dplyr::mutate(lap = l)))
 ```
+
 A few manipulations now will make later plotting easier:
 
+
 ```r
 alo_telem$lap <- as.factor(alo_telem$lap)
 alo_telem$brake <- as.integer(alo_telem$brake)
@@ -56,9 +58,9 @@ ggplot2::ggplot(alo_telem, ggplot2::aes(x = distance, y = throttle, color = lap)
 <p class="caption">Throttle Percent by Distance, per lap, for Fernando Alonso at the 2024 Australian GP</p>
 </div>
 
-In this plot we can see that he let off the throttle starting about 180 m before any other lap, and had to put some throttle back on before the normal braking point. This doesn't line up with someone suffering from ERS deployment, but instead an intentional effort to drive the car differently then in the previous laps. 
+In this plot we can see that he let off the throttle about 180 m before any other lap, and had to put some throttle back on before the normal braking point. This doesn't line up with someone suffering from ERS deployment, but instead an intentional effort to drive the car differently then in the previous laps.
 
-Similarly, we can look at braking (on/off), selected gear, and speed traces to see all the differences:
+Similarly, we can look at braking (on/off), selected gear, and speed traces to see all the changes in driving style for that lap:
 
 
 ```r
@@ -96,7 +98,7 @@ Alonso at the Stewards visit claimed intent to drive a different line at T6 (Ste
 
 # Effect on Russell
 
-Russell, of course, was tailing Alonso, and the telemetry provides a (calculated) distance behind the driver in front. We can observe this (with his other telemetry lines too).
+Russell, of course, was tailing Alonso, and the telemetry provides a (calculated/interpolated) distance behind the driver in front. We can observe this (with his other telemetry lines too).
 
 
 ```r
@@ -133,7 +135,7 @@ ggplot2::ggplot(long_telem_rus, ggplot2::aes(x = distance, y = value, color = La
 </div>
 You can see a sudden and dramatic decrease in the distance between Alonso and Russell in lap 57 (starting around 1575 m). Russell reacted by applying brake earlier than other laps (by a few meters) and was off the throttle earlier than most laps. It was 1.271 s between when Alonso and Russel let off the throttle. 
 
-But Russell didn't expect Alonso to do this move there. The Stewards' decision rested on the lack of predictability of Alonso. There's typically only one line through turns 6 & 7, compromising your speed anywhere leaves you vulnerable down the road. Our telemetry access doesn't provide enough detail to prove that the decrease in distance between the cars (all we can see is they got to within 18.6 m, but the replays made it look much closer).
+Russell didn't expect Alonso to do this move there. The Stewards' decision rested on the lack of predictability of Alonso. There's typically only one line through turns 6 & 7, compromising your speed anywhere leaves you vulnerable down the road. Our telemetry access doesn't provide enough detail to prove that the decrease in distance between the cars caused the problem (all we can see is they got to within 18.6 m, but the replays made it look much closer). Would this have been a penalty if Russell hadn't crashed? Should Russell have reacted quicker? 
 
 # Limitations
 There's key limitations in this data - the most significant being that it's at a resolution of only about 4 Hertz. The nuances of car gap, reaction times, etc. are all lost in the coarse data we have access to. The FIA, Teams, and Stewards have a much higher resolution available, with many additional data sources too. They also have the testimony of the teams and drivers to consider in their decision, and lots of video sources.