# app.R
# --------------------------------------------
# F1 Shiny Dashboard — Interlagos 2023 (with Monza option)
# --------------------------------------------
# ---- Packages ----
pkgs <- c("shiny","shinyWidgets","plotly","dplyr","tidyr","ggplot2","tibble",
"purrr","httr","jsonlite","scales","zoo","DT")
need <- pkgs[!(pkgs %in% rownames(installed.packages()))]
if(length(need)) install.packages(need, dependencies = TRUE)
invisible(lapply(pkgs, library, character.only = TRUE))
## Loading required package: ggplot2
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
##
## Attaching package: 'httr'
## The following object is masked from 'package:plotly':
##
## config
##
## Attaching package: 'jsonlite'
## The following object is masked from 'package:purrr':
##
## flatten
## The following object is masked from 'package:shiny':
##
## validate
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
## Attaching package: 'DT'
## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTable
suppressWarnings(try(library(f1dataR), silent = TRUE)) # optional
## Loading required package: reticulate
# ---- Helpers: retry + time parsing ----
retry <- function(expr, attempts = 3, wait = 1){
for(i in seq_len(attempts)){
out <- try(eval.parent(substitute(expr)), silent = TRUE)
if(!inherits(out,"try-error") && !is.null(out)) return(out)
if(i < attempts) Sys.sleep(wait)
}
NULL
}
ms_from_time <- function(x){
if(is.null(x) || is.na(x)) return(NA_real_)
p <- strsplit(x, ":", fixed = TRUE)[[1]]
if(length(p)==2){
m <- suppressWarnings(as.numeric(p[1])); s <- suppressWarnings(as.numeric(p[2]))
return((m*60 + s)*1000)
}
suppressWarnings(as.numeric(x))*1000
}
# ---- Data loader (Interlagos, optionally Monza) ----
load_gp_laps <- function(season, round){
source_tag <- "unknown"
laps_raw <- NULL
results_raw <- NULL
# 1) f1dataR
if("f1dataR" %in% .packages()){
laps_raw <- retry(f1dataR::load_laps(season, round), 3, 1.5)
results_raw <- retry(f1dataR::load_results(season, round), 3, 1.5)
if(!is.null(laps_raw) && !is.null(results_raw)) source_tag <- "f1dataR"
}
# 2) Ergast HTTPS
if(is.null(laps_raw) || is.null(results_raw)){
laps_url <- sprintf("https://ergast.com/api/f1/%d/%d/laps.json?limit=5000", season, round)
res <- try(httr::GET(laps_url), silent = TRUE)
if(!inherits(res,"try-error") && httr::status_code(res)==200){
jl <- jsonlite::fromJSON(rawToChar(res$content))
L <- jl$MRData$RaceTable$Races
if(length(L)>=1 && !is.null(L[[1]]$Laps)){
laps_list <- L[[1]]$Laps
if(length(laps_list)>0){
laps_raw <- purrr::map_dfr(laps_list, function(le){
ln <- as.integer(le$number); tm <- le$Timings
if(is.null(tm)) return(NULL)
tibble(
lap = ln,
driverId = tm$driverId,
position = suppressWarnings(as.integer(tm$position)),
milliseconds = vapply(tm$time, ms_from_time, numeric(1))
)
})
}
}
}
res2_url <- sprintf("https://ergast.com/api/f1/%d/%d/results.json?limit=100", season, round)
res2 <- try(httr::GET(res2_url), silent = TRUE)
if(!inherits(res2,"try-error") && httr::status_code(res2)==200){
jr <- jsonlite::fromJSON(rawToChar(res2$content))
R <- jr$MRData$RaceTable$Races
if(length(R)>=1 && !is.null(R[[1]]$Results)){
rs <- R[[1]]$Results
if(nrow(rs)>0){
results_raw <- tibble(
position = suppressWarnings(as.integer(rs$position)),
driverId = rs$Driver$driverId
)
}
}
}
if(!is.null(laps_raw) && !is.null(results_raw)) source_tag <- "ergast_https"
}
# 3) Offline sample
offline_used <- FALSE
if(is.null(laps_raw) || is.null(results_raw)){
offline_used <- TRUE; source_tag <- "offline_sample"
set.seed(21)
drivers <- c("verstappen","perez","leclerc","hamilton","norris")
laps_raw <- expand.grid(lap = 1:25, driverId = drivers) |>
as_tibble() |>
mutate(
base = 72 + match(driverId, drivers)*1.2,
noise = rnorm(n(), sd = 0.35),
lap_time_s = pmax(70, base + noise + (lap/50)),
milliseconds = lap_time_s * 1000
)
results_raw <- tibble(position = 1:length(drivers), driverId = drivers)
}
# Harmonize
if(!"lap_time_s" %in% names(laps_raw) && "milliseconds" %in% names(laps_raw)){
laps_raw <- laps_raw |> mutate(lap_time_s = milliseconds/1000)
}
laps <- laps_raw |> filter(!is.na(lap_time_s))
if(!is.null(results_raw) && nrow(results_raw) > 0){
top10_ids <- results_raw |> arrange(position) |> slice_head(n=10) |> pull(driverId)
} else {
top10_ids <- laps |> distinct(driverId) |> pull(driverId) |> head(10)
}
list(laps = laps, results = results_raw, top10 = top10_ids, source = source_tag)
}
# Preload Interlagos (2023, round 21)
SEASON <- 2023
ROUND_ILG <- 21 # Interlagos
ROUND_MON <- 14 # Monza
data_ilg <- load_gp_laps(SEASON, ROUND_ILG)
## ! Failure at Jolpica with https:// connection. Retrying as http://.
## ✖ Error getting Jolpica data, http status code 404.
## Not Found
## ! Failure at Jolpica with https:// connection. Retrying as http://.
## ✖ Error getting Jolpica data, http status code 404.
## Not Found
# ---- UI ----
ui <- fluidPage(
titlePanel("F1 — Interlagos 2023 (with optional Monza)"),
sidebarLayout(
sidebarPanel(
tags$p(HTML("<b>Dataset:</b> Interlagos 2023 (top-10); optionally add Monza 2023 for comparison.")),
prettySwitch("include_monza", "Include Monza (Round 14, 2023)", value = FALSE, status = "info"),
uiOutput("driver_picker"),
sliderInput("ma_k", "Moving average window (laps):", min = 3, max = 15, value = 5, step = 1),
checkboxInput("show_roll_sd", "Show rolling 5-lap SD chart", value = TRUE),
hr(),
h5("Pairwise comparison"),
uiOutput("pair_a"),
uiOutput("pair_b"),
helpText("If empty, app will auto-pick Verstappen & Hamilton (or first two drivers available)."),
hr(),
strong("Data source:"),
verbatimTextOutput("source_tag", placeholder = TRUE)
),
mainPanel(
tabsetPanel(
tabPanel("Overview",
fluidRow(
column(6, DTOutput("summary_table")),
column(6, plotlyOutput("boxplot", height = "380px"))
),
fluidRow(
column(12, plotlyOutput("lap_evolution", height = "420px"))
)
),
tabPanel("Pace Trend",
plotlyOutput("moving_avg", height = "440px"),
conditionalPanel("input.show_roll_sd == true",
plotlyOutput("rolling_sd", height = "440px")
)
),
tabPanel("Pairwise Delta",
plotlyOutput("pair_delta", height = "520px"),
br(),
helpText("Delta to the faster of the selected pair on each lap (0 = faster on that lap).")
),
tabPanel("Interlagos vs Monza",
helpText("Average pace comparison for overlapping drivers."),
plotlyOutput("cmp_tracks", height = "520px")
)
)
)
)
)
# ---- Server ----
server <- function(input, output, session){
# Load Monza only if requested (reactive for responsiveness)
data_monza <- reactive({
req(input$include_monza)
load_gp_laps(SEASON, ROUND_MON)
})
# Combined driver set for selection
all_drivers <- reactive({
if(isTRUE(input$include_monza)){
unique(c(data_ilg$top10, data_monza()$top10)) |> unique()
} else {
data_ilg$top10
}
})
# UI pickers
output$driver_picker <- renderUI({
selectizeInput("drivers", "Drivers to display:",
choices = sort(all_drivers()), selected = data_ilg$top10,
multiple = TRUE, options = list(maxItems = 12, placeholder = "Choose drivers"))
})
output$pair_a <- renderUI({
selectizeInput("pairA", "Driver A:", choices = sort(all_drivers()), selected = NULL, multiple = FALSE)
})
output$pair_b <- renderUI({
selectizeInput("pairB", "Driver B:", choices = sort(all_drivers()), selected = NULL, multiple = FALSE)
})
output$source_tag <- renderText({
paste("Interlagos:", data_ilg$source,
if(isTRUE(input$include_monza)) paste("| Monza:", data_monza()$source) else "")
})
# Reactive datasets based on selections
laps_selected <- reactive({
laps <- data_ilg$laps
if(isTRUE(input$include_monza)){
laps_m <- data_monza()$laps |> mutate(track = "Monza")
laps_i <- laps |> mutate(track = "Interlagos")
bind_rows(laps_i, laps_m)
} else {
laps |> mutate(track = "Interlagos")
}
})
# Filter by selected drivers
lap_filtered <- reactive({
req(input$drivers)
laps_selected() |> filter(driverId %in% input$drivers)
})
# ---- Overview table ----
output$summary_table <- renderDT({
df <- lap_filtered() |>
group_by(track, driverId) |>
summarise(
laps = n(),
mean_s = mean(lap_time_s, na.rm = TRUE),
median_s = median(lap_time_s, na.rm = TRUE),
sd_s = sd(lap_time_s, na.rm = TRUE),
best_s = min(lap_time_s, na.rm = TRUE),
.groups = "drop"
) |>
arrange(track, mean_s)
datatable(df, rownames = FALSE, options = list(pageLength = 8))
})
# ---- Boxplot ----
output$boxplot <- renderPlotly({
df <- lap_filtered()
# order drivers by mean pace (per track if both present)
order_map <- df |>
group_by(track, driverId) |>
summarise(mean_s = mean(lap_time_s), .groups = "drop") |>
arrange(track, mean_s)
df$driverId <- factor(df$driverId, levels = unique(order_map$driverId))
p <- ggplot(df, aes(driverId, lap_time_s, fill = track)) +
geom_boxplot(outlier.alpha = 0.25) +
coord_flip() +
labs(title = "Lap-time distribution (lower = faster)",
x = "Driver", y = "Lap time (s)")
ggplotly(p)
})
# ---- Lap evolution ----
output$lap_evolution <- renderPlotly({
df <- lap_filtered()
p <- ggplot(df, aes(lap, lap_time_s, color = driverId, linetype = track)) +
geom_line(alpha = 0.95) +
labs(title = "Lap-time evolution",
x = "Lap", y = "Lap time (s)", color = "Driver", linetype = "Track") +
scale_y_continuous(labels = label_number(accuracy = 0.1))
ggplotly(p)
})
# ---- Moving average ----
output$moving_avg <- renderPlotly({
df <- lap_filtered() |>
arrange(driverId, track, lap) |>
group_by(driverId, track) |>
mutate(pace_ma = zoo::rollmean(lap_time_s, k = input$ma_k, align = "right", fill = NA)) |>
ungroup()
p <- ggplot(df, aes(lap, pace_ma, color = driverId, linetype = track)) +
geom_line(na.rm = TRUE, linewidth = 1) +
labs(title = paste0("Moving average (", input$ma_k, "-lap)"),
x = "Lap", y = "Avg lap time (s)", color = "Driver", linetype = "Track")
ggplotly(p)
})
# ---- Rolling SD ----
output$rolling_sd <- renderPlotly({
req(input$show_roll_sd)
df <- lap_filtered() |>
arrange(driverId, track, lap) |>
group_by(driverId, track) |>
mutate(roll_sd = zoo::rollapply(lap_time_s, width = 5, FUN = sd, align = "right", fill = NA)) |>
ungroup()
p <- ggplot(df, aes(lap, roll_sd, color = driverId, linetype = track)) +
geom_line(na.rm = TRUE, linewidth = 1) +
labs(title = "Rolling 5-lap SD (consistency)",
x = "Lap", y = "Rolling SD (s)", color = "Driver", linetype = "Track")
ggplotly(p)
})
# ---- Pairwise delta ----
auto_pair <- reactive({
v <- unique(lap_filtered()$driverId)
pri <- v[grepl("verstappen", v, ignore.case = TRUE)]
sec <- v[grepl("hamilton", v, ignore.case = TRUE)]
if(length(pri)==0 && length(v)>=1) pri <- v[1]
if(length(sec)==0 && length(v)>=2) sec <- v[2]
unique(c(pri[1], sec[1]))
})
output$pair_delta <- renderPlotly({
df <- lap_filtered()
a <- if(isTruthy(input$pairA)) input$pairA else auto_pair()[1]
b <- if(isTruthy(input$pairB)) input$pairB else auto_pair()[2]
req(a, b, a != b)
two <- df |> filter(driverId %in% c(a, b), track == "Interlagos") # focus Interlagos for cleaner deltas
req(nrow(two) > 0)
lap_min <- two |> group_by(lap) |> summarise(min_s = min(lap_time_s, na.rm=TRUE), .groups="drop")
lap_delta <- two |> left_join(lap_min, by = "lap") |> mutate(delta_s = lap_time_s - min_s)
p <- ggplot(lap_delta, aes(lap, delta_s, color = driverId)) +
geom_line(size = 0.9) +
labs(title = paste0("Per-lap delta (", a, " vs ", b, ") — Interlagos"),
x = "Lap", y = "Delta to per-lap best (s)", color = "Driver")
ggplotly(p)
})
# ---- Interlagos vs Monza comparison ----
output$cmp_tracks <- renderPlotly({
req(input$include_monza)
dfI <- data_ilg$laps |> mutate(track = "Interlagos")
dfM <- data_monza()$laps |> mutate(track = "Monza")
# overlap by selected drivers only
sel <- intersect(unique(dfI$driverId), unique(dfM$driverId))
sel <- intersect(sel, input$drivers)
req(length(sel) > 0)
cmp <- bind_rows(dfI, dfM) |>
filter(driverId %in% sel) |>
group_by(track, driverId) |>
summarise(mean_s = mean(lap_time_s), .groups = "drop")
p <- ggplot(cmp, aes(driverId, mean_s, fill = track)) +
geom_col(position = position_dodge()) +
coord_flip() +
labs(title = "Average Race Pace — Interlagos vs Monza",
x = "Driver", y = "Avg lap time (s)", fill = "Track")
ggplotly(p)
})
}
# ---- Launch app ----
shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents