/
plot_fastest.R
161 lines (144 loc) · 6.57 KB
/
plot_fastest.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
#' 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).
#' @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")
driver_data <- load_driver_telemetry(season, round, session, driver, "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))
)
selected_driver_id <- load_drivers(season) %>%
dplyr::filter(.data$code == driver) %>%
dplyr::pull(.data$driver_id)
lap_time <- load_laps(season, round) %>%
dplyr::filter(.data$driver_id == selected_driver_id) %>%
dplyr::filter(.data$time_sec == min(.data$time_sec)) %>%
dplyr::pull(.data$time)
rnd <- round
# I can't figure out why but for some reason the filter .data$round == round doesn't work. Rename to rnd fixes.
race_name <- load_schedule(season) %>%
dplyr::filter(.data$round == rnd) %>%
dplyr::pull(.data$race_name)
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, 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, 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))
}