R/plot_fastest.R

In f1dataR: Access Formula 1 Data

#' Plot Fastest Lap
#'
#' @description Creates a ggplot graphic that details the fastest lap for a driver in a race.
#' Complete with a gearshift or speed analysis.
#'
#' @param season number from 2018 to current season (defaults to current season).
#' @param race number from 1 to 23 (depending on season selected) and defaults
#' to most recent.
#' @param round number from 1 to 23 (depending on season selected) and defaults
#' to most recent.
#' @param session the code for the session to load Options are `'FP1'`, `'FP2'`, `'FP3'`,
#' `'Q'`, `'S'`, `'SS'`, `'SQ'`, and `'R'`. Default is `'R'`, which refers to Race.
#' @param driver three letter driver code (see load_drivers() for a list) or name to be
#' fuzzy matched to a driver from the session if FastF1 >= 3.4.0 is available.
#' @param color argument that indicates which variable to plot along the
#' circuit. Choice of `'gear'` or `'speed'`, default `'gear'`.
#' @importFrom magrittr "%>%"
#' @importFrom rlang .data
#' @return A ggplot object that indicates grand prix, driver, time and selected
#' color variable.
#' @export
#' @examples
#' # Plot Verstappen's fastest lap (speed) from Bahrain 2023:
#' if (interactive()) {
#'   plot_fastest(2023, 1, "R", "VER", "speed")
#' }
plot_fastest <- function(season = get_current_season(), round = 1, session = "R", driver, color = "gear",
                         race = lifecycle::deprecated()) {
  # Package Checks
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    cli::cli_abort("f1dataR::plot_fastest() requires ggplot2 package installation")
  }

  # Deprecation Check
  if (lifecycle::is_present(race)) {
    lifecycle::deprecate_stop("1.4.0", "plot_fastest(race)", "plot_fastest(round)")
  }

  # Function Code
  cli::cli_alert_info("If the session has not been loaded yet, this could take a minute\n\n")

  if (get_fastf1_version() >= "3.4") {
    driver_abbreviation <- get_driver_abbreviation(driver, season = season, round = round, session = session)
    driver_name <- get_driver_name(driver_abbreviation, season = season, round = round, session = session)
  } else {
    driver_abbreviation <- driver
  }

  s <- load_race_session(season = season, round = round, session = session)
  driver_data <- load_driver_telemetry(season, round, session, driver_abbreviation, "fastest")

  if (is.null(driver_data)) {
    # Failure to load - escape
    return(NULL)
  }

  driver_data <- driver_data %>%
    dplyr::mutate(
      x = .data$x - mean(range(.data$x, na.rm = TRUE)),
      y = .data$y - mean(range(.data$y, na.rm = TRUE))
    )

  season_drivers <- load_drivers(season = season)
  if (is.null(season_drivers)) {
    # Jolpica is down
    lap_time <- ""
    if (get_fastf1_version() < "3.4") {
      driver_name <- driver
    }
  } else {
    if (get_fastf1_version() < "3.4") {
      driver_name <- season_drivers %>%
        dplyr::filter(.data$code == driver_abbreviation) %>%
        dplyr::select("given_name", "family_name") %>%
        paste(collapse = " ")
    }
    driver_id <- season_drivers %>%
      dplyr::filter(.data$code == driver_abbreviation) %>%
      dplyr::pull("driver_id")
    lap_time <- load_laps(season, round) %>%
      dplyr::filter(.data$driver_id == driver_id) %>%
      dplyr::filter(.data$time_sec == min(.data$time_sec)) %>%
      dplyr::pull(.data$time)
    lap_time <- paste0(" | ", lap_time)
  }

  race_name <- s$event$EventName

  if (!(session %in% c("r", "R"))) {
    race_name <- dplyr::case_match(
      session,
      c("q", "Q") ~ paste0(race_name, " Qualifying"),
      c("s", "S") ~ paste0(race_name, " Sprint"),
      c("fp1", "FP1") ~ paste0(race_name, " FP1"),
      c("fp2", "FP2") ~ paste0(race_name, " FP2"),
      c("fp3", "FP3") ~ paste0(race_name, " FP3")
    )
  }

  if (color == "gear") {
    fastplot <- ggplot2::ggplot(driver_data, ggplot2::aes(.data$x, .data$y, color = as.factor(.data$n_gear), group = 1)) +
      ggplot2::geom_path(linewidth = 4, lineend = "round") +
      ggplot2::scale_color_manual(
        name = "Gear",
        values = c("#BC3C29", "#0072B5", "#E18727", "#20854E", "#7876B1", "#6F99AD", "#FFDC91", "#EE4C97"),
        aesthetics = c("color", "fill")
      ) +
      theme_dark_f1() +
      ggplot2::labs(
        title = glue::glue("{year} {race_name}", year = season, race = race_name),
        subtitle = glue::glue("{driver} Fastest Lap{lap_time}", driver = driver_name, lap_time = lap_time),
        caption = "Generated by {f1dataR} package"
      )
  } else if (color == "speed") {
    fastplot <- ggplot2::ggplot(driver_data, ggplot2::aes(.data$x, .data$y, color = .data$speed, group = 1)) +
      ggplot2::geom_path(linewidth = 4, lineend = "round") +
      ggplot2::scale_color_gradient(low = "white", high = "red") +
      theme_dark_f1() +
      ggplot2::labs(
        title = glue::glue("{year} {race_name}", year = season, race = race_name),
        subtitle = glue::glue("{driver} Fastest Lap{lap_time}", driver = driver_name, lap_time = lap_time),
        caption = "Generated by {f1dataR} package"
      )
  }
  return(correct_track_ratio(fastplot))
}


#' Correct Track Ratios
#'
#' @description
#' Correct Track Ratios helps ensure that ggplot objects are plotted with 1:1 unit ratio.
#' Without this function, plots have different x & y ratios and the tracks come out misshapen.
#' This is particularly evident at long tracks like Saudi Arabia or Canada.
#'
#' Note that this leaves the plot object on a dark background, any plot borders will be maintained
#'
#' @param trackplot A GGPlot object, ideally showing a track layout for ratio correction
#' @param x,y Names of columns in the original data used for the plot's x and y values.
#' Defaults to 'x' and 'y'
#' @param background Background colour to use for filling out the plot edges. Defaults to
#' `"grey10"` which is the default background colour if you use \code{\link[f1dataR]{theme_dark_f1}()}
#' to theme your plots.
#'
#' @return a ggplot object with `ggplot2::scale_x_continuous()` and `ggplot2::scale_y_continuous()` set to the
#' same limits to produce an image with shared x and y limits and with `ggplot2::coord_fixed()` set.
#'
#' @export
#' @examples
#' \dontrun{
#' # Note that plot_fastest plots have already been ratio corrected
#' fast_plot <- plot_fastest(season = 2022, round = 1, session = "Q", driver = V)
#' correct_track_ratio(fast_plot)
#' }
correct_track_ratio <- function(trackplot, x = "x", y = "y", background = "grey10") {
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    cli::cli_abort("f1dataR::correct_track_ratio() requires ggplot2 package installation")
  }
  if (!inherits(trackplot, "ggplot")) {
    cli::cli_abort("{.var trackplot} must be a `ggplot` object")
  }

  # determine limits and apply plot to square around them
  # expand by 500 units to add buffer for labels made with `load_circuit_details()`
  xrange <- range(trackplot$data$x, na.rm = TRUE) + c(-500, 500)
  yrange <- range(trackplot$data$y, na.rm = TRUE) + c(-500, 500)
  maxdiff <- max(abs(xrange[2] - xrange[1]), abs(yrange[2] - yrange[1]), na.rm = TRUE)

  xmid <- mean(xrange)
  ymid <- mean(yrange)

  newxlim <- c(xmid - 0.5 * maxdiff, xmid + 0.5 * maxdiff)
  newylim <- c(ymid - 0.5 * maxdiff, ymid + 0.5 * maxdiff)

  trackplot <- trackplot +
    ggplot2::coord_fixed(xlim = newxlim, ylim = newylim)

  # ensure the letterbox filler is a nice colour
  grid::grid.rect(gp = grid::gpar(fill = background, col = background))
  return(plot(trackplot, newpage = FALSE))
}