3 > 2Analyzing Sports Data with R
Max Marchi
20 seconds resume
2002-13: Public Health Statistician (infectious diseases)
2014-present: Data Scientist for the Cleveland Guardians (Major League Baseball)
2013: Author of Analyzing Baseball Data with R
Why I am giving this presentation
…previously on Conversations During UseR Breaks…
Caveat
- Expert in baseball
- Not as much in other sports
- “Light” examples
Basketball
“Advanced Analyics”
The most important piece of code in basketball is…
[1] TRUELoading data
Rows: 61,424
Columns: 57
$ game_id <int> 220612017, 220612017, 220609017, 220…
$ season <int> 2002, 2002, 2002, 2002, 2002, 2002, …
$ season_type <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, …
$ game_date <date> 2002-06-12, 2002-06-12, 2002-06-09,…
$ game_date_time <dttm> 2002-06-12 21:00:00, 2002-06-12 21:…
$ team_id <int> 13, 17, 13, 17, 17, 13, 17, 13, 13, …
$ team_uid <chr> "s:40~l:46~t:13", "s:40~l:46~t:17", …
$ team_slug <chr> "los-angeles-lakers", "new-jersey-ne…
$ team_location <chr> "Los Angeles", "New Jersey", "Los An…
$ team_name <chr> "Lakers", "Nets", "Lakers", "Nets", …
$ team_abbreviation <chr> "LAL", "NJ", "LAL", "NJ", "NJ", "LAL…
$ team_display_name <chr> "Los Angeles Lakers", "New Jersey Ne…
$ team_short_display_name <chr> "Lakers", "Nets", "Lakers", "Nets", …
$ team_color <chr> "542582", "06143F", "542582", "06143…
$ team_alternate_color <chr> "552582", "ffffff", "552582", "fffff…
$ team_logo <chr> "https://a.espncdn.com/i/teamlogos/n…
$ team_home_away <chr> "away", "home", "away", "home", "awa…
$ team_score <int> 113, 107, 106, 103, 83, 106, 94, 99,…
$ team_winner <lgl> TRUE, FALSE, TRUE, FALSE, FALSE, TRU…
$ assists <int> 28, 27, 17, 22, 18, 26, 19, 21, 24, …
$ blocks <int> 3, 4, 10, 5, 5, 7, 4, 8, 4, 4, 5, 4,…
$ defensive_rebounds <int> 32, 27, 33, 22, 23, 35, 24, 33, 37, …
$ fast_break_points <chr> "1", "3", "2", "4", "4", "6", "7", "…
$ field_goal_pct <dbl> 52.1, 48.9, 54.4, 51.8, 34.9, 50.0, …
$ field_goals_made <int> 37, 45, 37, 43, 30, 39, 37, 33, 39, …
$ field_goals_attempted <int> 71, 92, 68, 83, 86, 78, 94, 72, 94, …
$ flagrant_fouls <int> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ fouls <int> 15, 22, 22, 27, 27, 21, 29, 20, 25, …
$ free_throw_pct <dbl> 75.7, 81.3, 68.6, 73.7, 63.0, 79.2, …
$ free_throws_made <int> 28, 13, 24, 14, 17, 19, 15, 32, 27, …
$ free_throws_attempted <int> 37, 16, 35, 19, 27, 24, 26, 45, 33, …
$ offensive_rebounds <int> 7, 14, 7, 5, 20, 12, 21, 17, 15, 15,…
$ points_in_paint <chr> "-1", "-1", "-1", "-1", "-1", "-1", …
$ steals <int> 7, 5, 7, 13, 11, 6, 9, 8, 5, 5, 8, 7…
$ team_turnovers <int> 10, 8, 19, 13, 13, 16, 11, 16, 13, 1…
$ technical_fouls <int> 1, 2, 2, 0, 0, 1, 1, 1, 0, 1, 0, 0, …
$ three_point_field_goal_pct <dbl> 57.9, 44.4, 50.0, 25.0, 27.3, 56.3, …
$ three_point_field_goals_made <int> 11, 4, 8, 3, 6, 9, 5, 1, 7, 2, 3, 7,…
$ three_point_field_goals_attempted <int> 19, 9, 16, 12, 22, 16, 16, 10, 17, 2…
$ total_rebounds <int> 44, 49, 51, 36, 54, 56, 60, 60, 60, …
$ total_technical_fouls <int> 1, 2, 2, 0, 0, 1, 1, 1, 0, 1, 0, 0, …
$ total_turnovers <int> 20, 16, 38, 26, 26, 32, 22, 32, 26, …
$ turnover_points <chr> "11", "14", "15", "25", "20", "13", …
$ turnovers <int> 10, 8, 19, 13, 13, 16, 11, 16, 13, 1…
$ opponent_team_id <int> 17, 13, 17, 13, 13, 17, 13, 17, 23, …
$ opponent_team_uid <chr> "s:40~l:46~t:17", "s:40~l:46~t:13", …
$ opponent_team_slug <chr> "new-jersey-nets", "los-angeles-lake…
$ opponent_team_location <chr> "New Jersey", "Los Angeles", "New Je…
$ opponent_team_name <chr> "Nets", "Lakers", "Nets", "Lakers", …
$ opponent_team_abbreviation <chr> "NJ", "LAL", "NJ", "LAL", "LAL", "NJ…
$ opponent_team_display_name <chr> "New Jersey Nets", "Los Angeles Lake…
$ opponent_team_short_display_name <chr> "Nets", "Lakers", "Nets", "Lakers", …
$ opponent_team_color <chr> "06143F", "542582", "06143F", "54258…
$ opponent_team_alternate_color <chr> "ffffff", "552582", "ffffff", "55258…
$ opponent_team_logo <chr> NA, "https://a.espncdn.com/i/teamlog…
$ opponent_team_score <int> 107, 113, 103, 106, 106, 83, 99, 94,…
$ largest_lead <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, …Visualizing the trend
library(ggplot2)
nba_team_box %>%
group_by(season) %>%
# fraction of 3pt shots on total shots
summarise(threes_ratio = sum(three_point_field_goals_attempted) / sum(field_goals_attempted)) %>%
ggplot(aes(x = season, y = threes_ratio)) +
geom_line() +
scale_x_continuous(name = "Season", breaks = seq(2002, 2025, 2)) +
scale_y_continuous(name = "ratio of 3 point attempts", labels = scales::percent) +
theme_minimal(base_size = 16) +
ggtitle("Evolution of shooting selection in the NBA", subtitle = "percentage of field goal attempts that are 3-pointers")Visualizing the trend
From the boxscore to play-by-play data
Rows: 571,603
Columns: 62
$ game_play_number <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,…
$ id <dbl> 4017661284, 4017661287, 4017661288, 40…
$ sequence_number <int> 4, 7, 8, 10, 11, 13, 14, 15, 16, 18, 1…
$ type_id <int> 615, 131, 132, 155, 45, 92, 155, 132, …
$ type_text <chr> "Jumpball", "Pullup Jump Shot", "Step …
$ text <chr> "Myles Turner vs. Chet Holmgren (Tyres…
$ away_score <int> 0, 2, 2, 2, 2, 2, 2, 2, 5, 5, 5, 5, 5,…
$ home_score <int> 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, 2, 2, 2,…
$ period_number <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ period_display_value <chr> "1st Quarter", "1st Quarter", "1st Qua…
$ clock_display_value <chr> "12:00", "11:44", "11:29", "11:25", "1…
$ scoring_play <lgl> FALSE, TRUE, FALSE, FALSE, FALSE, FALS…
$ score_value <int> 0, 2, 0, 0, 0, 0, 0, 2, 3, 0, 0, 0, 0,…
$ team_id <int> 11, 11, 25, 11, 25, 11, 25, 25, 11, 25…
$ athlete_id_1 <int> 3133628, 4395712, 4593803, 4396909, 43…
$ athlete_id_2 <int> 4433255, NA, 4396909, NA, NA, NA, NA, …
$ athlete_id_3 <int> 4396993, NA, NA, NA, NA, NA, NA, NA, N…
$ wallclock <chr> "2025-06-23T00:08:47Z", "2025-06-23T00…
$ shooting_play <lgl> FALSE, TRUE, TRUE, FALSE, FALSE, TRUE,…
$ coordinate_x_raw <dbl> -214748340, 34, 15, 15, 15, 9, 9, 32, …
$ coordinate_y_raw <dbl> -214748365, 11, 2, 2, 22, 18, 18, 13, …
$ game_id <int> 401766128, 401766128, 401766128, 40176…
$ season <int> 2025, 2025, 2025, 2025, 2025, 2025, 20…
$ season_type <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
$ home_team_id <int> 25, 25, 25, 25, 25, 25, 25, 25, 25, 25…
$ home_team_name <chr> "Oklahoma City", "Oklahoma City", "Okl…
$ home_team_mascot <chr> "Thunder", "Thunder", "Thunder", "Thun…
$ home_team_abbrev <chr> "OKC", "OKC", "OKC", "OKC", "OKC", "OK…
$ home_team_name_alt <chr> "Oklahoma City", "Oklahoma City", "Okl…
$ away_team_id <int> 11, 11, 11, 11, 11, 11, 11, 11, 11, 11…
$ away_team_name <chr> "Indiana", "Indiana", "Indiana", "Indi…
$ away_team_mascot <chr> "Pacers", "Pacers", "Pacers", "Pacers"…
$ away_team_abbrev <chr> "IND", "IND", "IND", "IND", "IND", "IN…
$ away_team_name_alt <chr> "Indiana", "Indiana", "Indiana", "Indi…
$ game_spread <dbl> 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5…
$ home_favorite <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TR…
$ game_spread_available <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FAL…
$ home_team_spread <dbl> 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5, 2.5…
$ qtr <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ time <chr> "12:00", "11:44", "11:29", "11:25", "1…
$ clock_minutes <int> 12, 11, 11, 11, 11, 11, 11, 10, 10, 10…
$ clock_seconds <dbl> 0, 44, 29, 25, 17, 11, 8, 57, 45, 17, …
$ home_timeout_called <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FAL…
$ away_timeout_called <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FAL…
$ half <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ game_half <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ lead_qtr <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ lead_half <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ start_quarter_seconds_remaining <dbl> 720, 704, 689, 685, 677, 671, 668, 657…
$ start_half_seconds_remaining <dbl> 1440, 1424, 1409, 1405, 1397, 1391, 13…
$ start_game_seconds_remaining <dbl> 2880, 2864, 2849, 2845, 2837, 2831, 28…
$ end_quarter_seconds_remaining <dbl> 720, 689, 685, 677, 671, 668, 657, 645…
$ end_half_seconds_remaining <dbl> 1440, 1409, 1405, 1397, 1391, 1388, 13…
$ end_game_seconds_remaining <dbl> 2880, 2849, 2845, 2837, 2831, 2828, 28…
$ period <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
$ lag_qtr <int> NA, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ lag_half <int> NA, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ coordinate_x <dbl> -214748406.75, -30.75, 39.75, -39.75, …
$ coordinate_y <dbl> -214748365, 9, 10, -10, 10, -16, 16, -…
$ game_date <date> 2025-06-22, 2025-06-22, 2025-06-22, 2…
$ game_date_time <dttm> 2025-06-22 20:00:00, 2025-06-22 20:00…
$ type_abbreviation <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…(It’s never clean data)
library(stringr)
filter_field_goal_attempts <- . %>%
# detecting field goal attempts
filter(shooting_play) %>%
filter(!str_detect(type_text, "Free Throw"))
flip_coordinates <- . %>%
# flipping coordinates so that shots are
# on the same side of the court
mutate(
coordinate_x = coordinate_x * (ifelse(home_team_id == team_id, 1, -1))
, coordinate_y = coordinate_y * (ifelse(home_team_id == team_id, 1, -1))
)A lot of shots from 20 years apart
shot_location_evolution <- bind_rows(
nba_pbp_2002 %>% filter_field_goal_attempts() %>%
flip_coordinates() %>%
select(season, starts_with("coord"))
, nba_pbp_2025 %>%
filter_field_goal_attempts() %>%
flip_coordinates() %>%
select(season, starts_with("coord"))
) %>%
filter(abs(coordinate_y) < 30) %>%
filter(coordinate_x > 0) %>%
group_by(season) %>%
sample_n(30000) %>%
ungroup()Visualizing the evolution
sportyR to the rescue
sportyR to the rescue
geom_basketball("nba", display_range = "offense", rotation = 270
, color_updates = list(
plot_background = "#ffffff"
, defensive_half_court = "#ffffff"
, offensive_half_court = "#ffffff"
, court_apron = "#ffffff"
, center_circle_fill = "#ffffff"
, two_point_range = "#ffffff"
, painted_area = "#ffffff"
, free_throw_circle_fill = "#ffffff"
)
) +
geom_jitter(data = shot_location_evolution, aes(y = -coordinate_x, x = coordinate_y), alpha = .01) +
facet_wrap(~season) +
theme(strip.text = element_text(size = 20))sportyR to the rescue
Yes but… why?
nba_pbp_2025 %>%
filter_field_goal_attempts() %>%
flip_coordinates() %>%
mutate(three = str_detect(tolower(text), "three point")) %>% # flag 3s
mutate(distance = sqrt((45 - coordinate_x) ^ 2 + (coordinate_y) ^ 2)) %>%
mutate(shot_angle = -atan2(coordinate_y, 45 - coordinate_x) * 180 / pi) %>%
filter(abs(shot_angle) < 15) %>% # keep shots from the front
mutate(distance = plyr::round_any(distance, 3)) %>%
group_by(distance) %>%
summarise(
FGpct = mean(scoring_play) # field goal percentage
) %>%
filter(distance < 40) %>%
ggplot(aes(x = distance)) +
geom_line(aes(y = FGpct, col = "FGpct"), size = 1.5) +
scale_color_manual(name = "stat", labels = c("FGpct" = "FG%"), values = c("FGpct" = "black")) +
xlab("shot distance") +
scale_y_continuous(name = NULL, labels = scales::percent) +
theme_minimal(base_size = 16) +
ggtitle("Shot accuracy by distance", "(data from NBA 2025/26 season)")Yes but… why?
Effective Field Goal Percentage
nba_pbp_2025 %>%
filter_field_goal_attempts() %>%
flip_coordinates() %>%
mutate(three = str_detect(tolower(text), "three point")) %>%
mutate(distance = sqrt((45 - coordinate_x) ^ 2 + (coordinate_y) ^ 2)) %>%
mutate(shot_angle = -atan2(coordinate_y, 45 - coordinate_x) * 180 / pi) %>%
filter(abs(shot_angle) < 15) %>%
mutate(distance = plyr::round_any(distance, 3)) %>%
group_by(distance) %>%
summarise(
FGpct = mean(scoring_play) # field goal percentage
, eFGpct = mean(ifelse(three, 1.5, 1) * scoring_play) # effective FG%
) %>%
filter(distance < 40) %>%
ggplot(aes(x = distance)) +
geom_line(aes(y = FGpct, col = "FGpct"), size = 1.5) +
geom_line(aes(y = eFGpct + .005, col = "eFGpct"), size = 1.5) +
geom_vline(xintercept = 24, linetype = 2) + # 23.75
annotate("text", x = 24.7, y = .72, label = "3pt line", angle = 90) +
scale_color_manual(name = "stat", labels = c("FGpct" = "FG%", "eFGpct" = "eFG%"), values = c("FGpct" = "black", "eFGpct" = "blue")) +
xlab("shot distance") +
scale_y_continuous(name = NULL, labels = scales::percent) +
theme_minimal(base_size = 16) +
ggtitle("Shot efficiency by distance", "(data from NBA 2025/26 season)")Effective Field Goal Percentage
Shot chart evolution
(More sportyR)
library(patchwork)
basketball <- geom_basketball(league = "fiba", display_range = "offensive_half_court")
baseball <- geom_baseball(league = "mlb", display_range = "infield")
hockey <- geom_hockey(league = "nhl", display_range = "defensive zone", rotation = 90)
soccer <- geom_soccer(league = "fifa", display_range = "full")
tennis <- geom_tennis(league = "atp", display_range = "serving", rotation = 90)
volleyball <- geom_volleyball(league = "FIVB", display_range = "in bounds only", rotation = 90)
(baseball + hockey + basketball) / (soccer + tennis + volleyball)(More sportyR)
Formula 1
How you overtake a car
In R
# A tibble: 22 × 12
season round race_name circuit_id circuit_name lat long locality country
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 2022 1 Bahrain Gr… bahrain Bahrain Int… 26.0… 50.5… Sakhir Bahrain
2 2022 2 Saudi Arab… jeddah Jeddah Corn… 21.6… 39.1… Jeddah Saudi …
3 2022 3 Australian… albert_pa… Albert Park… -37.… 144.… Melbour… Austra…
4 2022 4 Emilia Rom… imola Autodromo E… 44.3… 11.7… Imola Italy
5 2022 5 Miami Gran… miami Miami Inter… 25.9… -80.… Miami USA
6 2022 6 Spanish Gr… catalunya Circuit de … 41.57 2.26… Barcelo… Spain
7 2022 7 Monaco Gra… monaco Circuit de … 43.7… 7.42… Monte C… Monaco
8 2022 8 Azerbaijan… baku Baku City C… 40.3… 49.8… Baku Azerba…
9 2022 9 Canadian G… villeneuve Circuit Gil… 45.5 -73.… Montreal Canada
10 2022 10 British Gr… silversto… Silverstone… 52.0… -1.0… Silvers… UK
11 2022 11 Austrian G… red_bull_… Red Bull Ri… 47.2… 14.7… Spielbe… Austria
12 2022 12 French Gra… ricard Circuit Pau… 43.2… 5.79… Le Cast… France
13 2022 13 Hungarian … hungarori… Hungaroring 47.5… 19.2… Budapest Hungary
14 2022 14 Belgian Gr… spa Circuit de … 50.4… 5.97… Spa Belgium
15 2022 15 Dutch Gran… zandvoort Circuit Par… 52.3… 4.54… Zandvoo… Nether…
16 2022 16 Italian Gr… monza Autodromo N… 45.6… 9.28… Monza Italy
17 2022 17 Singapore … marina_bay Marina Bay … 1.29… 103.… Marina … Singap…
18 2022 18 Japanese G… suzuka Suzuka Circ… 34.8… 136.… Suzuka Japan
19 2022 19 United Sta… americas Circuit of … 30.1… -97.… Austin USA
20 2022 20 Mexico Cit… rodriguez Autódromo H… 19.4… -99.… Mexico … Mexico
21 2022 21 São Paulo … interlagos Autódromo J… -23.… -46.… São Pau… Brazil
22 2022 22 Abu Dhabi … yas_marina Yas Marina … 24.4… 54.6… Abu Dha… UAE
# ℹ 3 more variables: date <chr>, time <chr>, sprint_date <chr>Visualizing lap times
Visualizing lap times
Visualizing lap times
Visualizing lap times
(Naively) Modeling tyre degradation
fastest_lap <- laps_extended %>%
group_by(driver) %>%
summarise(fastest_lap_time = min(lap_time, na.rm = T)) %>%
ungroup()
dat_for_model <- laps_extended %>%
inner_join(fastest_lap, by = "driver") %>%
mutate(time_off_fastest = lap_time - fastest_lap_time) %>%
filter(is.na(pit_in_time) & is.na(pit_out_time)) %>%
filter(track_status == 1) %>%
filter(lap_number > 1)(Naively) Modeling tyre degradation
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.863 0.154 18.584 0.000
lap_number -0.028 0.002 -13.018 0.000
tyre_life 0.006 0.007 0.821 0.412
compoundMEDIUM -0.764 0.175 -4.369 0.000
compoundSOFT -1.351 0.216 -6.241 0.000
tyre_life:compoundMEDIUM 0.047 0.009 5.062 0.000
tyre_life:compoundSOFT 0.137 0.015 9.105 0.000(Naively) comparing strategies
create_strategy_dataframe <- function(
pit_laps # laps for pit stop
, tyres # tyre compound for each stint
, race_laps # length of the race in laps
, fastest_lap_time
, pit_time_lost # expected time lost due to pitstop
, model
){
stint_start_end <- c(0, pit_laps, race_laps)
tyre_laps <- unlist(lapply(1:length(tyres), function(i) rep(tyres[i], diff(stint_start_end)[i])))
tyre_age <- unlist(lapply(1:length(tyres), function(i) 1:diff(stint_start_end)[i]))
strategy_df <- data.frame(
lap_number = 1:race_laps
, compound = tyre_laps
, tyre_life = tyre_age
)
strategy_df$is_pit_lap <- strategy_df$lap_number %in% pit_laps
strategy_df$expected_lap_time <- predict(model, strategy_df) + fastest_lap_time + strategy_df$is_pit_lap * pit_time_lost
strategy_df$expected_race_time <- cumsum(strategy_df$expected_lap_time)
strategy_df$expected_race_pace <- strategy_df$expected_race_time / strategy_df$lap_number * race_laps
strategy_df
}(Naively) comparing strategies
p1_hm <- create_strategy_dataframe(45, c("HARD", "MEDIUM"), 70, 82, 22, fit)
p2_mhm <- create_strategy_dataframe(c(20, 50), c("MEDIUM", "HARD", "MEDIUM"), 70, 82, 22, fit)
p2_smm <- create_strategy_dataframe(c(15, 42), c("SOFT", "MEDIUM", "MEDIUM"), 70, 82, 22, fit)
p2_mms <- create_strategy_dataframe(c(27, 55), c("SOFT", "MEDIUM", "MEDIUM"), 70, 82, 22, fit)
p2_smh <- create_strategy_dataframe(c(10, 35), c("SOFT", "MEDIUM", "HARD"), 70, 82, 22, fit)
p1_sh <- create_strategy_dataframe(15, c("SOFT", "HARD"), 70, 82, 22, fit)
p2_smh lap_number compound tyre_life is_pit_lap expected_lap_time
1 1 SOFT 1 FALSE 83.62691
2 2 SOFT 2 FALSE 83.74218
3 3 SOFT 3 FALSE 83.85745
4 4 SOFT 4 FALSE 83.97272
5 5 SOFT 5 FALSE 84.08799
6 6 SOFT 6 FALSE 84.20326
7 7 SOFT 7 FALSE 84.31853
8 8 SOFT 8 FALSE 84.43381
9 9 SOFT 9 FALSE 84.54908
10 10 SOFT 10 TRUE 106.66435
11 11 MEDIUM 1 FALSE 83.84597
12 12 MEDIUM 2 FALSE 83.87077
13 13 MEDIUM 3 FALSE 83.89558
14 14 MEDIUM 4 FALSE 83.92039
15 15 MEDIUM 5 FALSE 83.94519
16 16 MEDIUM 6 FALSE 83.97000
17 17 MEDIUM 7 FALSE 83.99481
18 18 MEDIUM 8 FALSE 84.01961
19 19 MEDIUM 9 FALSE 84.04442
20 20 MEDIUM 10 FALSE 84.06923
21 21 MEDIUM 11 FALSE 84.09403
22 22 MEDIUM 12 FALSE 84.11884
23 23 MEDIUM 13 FALSE 84.14364
24 24 MEDIUM 14 FALSE 84.16845
25 25 MEDIUM 15 FALSE 84.19326
26 26 MEDIUM 16 FALSE 84.21806
27 27 MEDIUM 17 FALSE 84.24287
28 28 MEDIUM 18 FALSE 84.26768
29 29 MEDIUM 19 FALSE 84.29248
30 30 MEDIUM 20 FALSE 84.31729
31 31 MEDIUM 21 FALSE 84.34210
32 32 MEDIUM 22 FALSE 84.36690
33 33 MEDIUM 23 FALSE 84.39171
34 34 MEDIUM 24 FALSE 84.41652
35 35 MEDIUM 25 TRUE 106.44132
36 36 HARD 1 FALSE 83.86806
37 37 HARD 2 FALSE 83.84594
38 38 HARD 3 FALSE 83.82382
39 39 HARD 4 FALSE 83.80170
40 40 HARD 5 FALSE 83.77958
41 41 HARD 6 FALSE 83.75746
42 42 HARD 7 FALSE 83.73534
43 43 HARD 8 FALSE 83.71323
44 44 HARD 9 FALSE 83.69111
45 45 HARD 10 FALSE 83.66899
46 46 HARD 11 FALSE 83.64687
47 47 HARD 12 FALSE 83.62475
48 48 HARD 13 FALSE 83.60263
49 49 HARD 14 FALSE 83.58051
50 50 HARD 15 FALSE 83.55839
51 51 HARD 16 FALSE 83.53628
52 52 HARD 17 FALSE 83.51416
53 53 HARD 18 FALSE 83.49204
54 54 HARD 19 FALSE 83.46992
55 55 HARD 20 FALSE 83.44780
56 56 HARD 21 FALSE 83.42568
57 57 HARD 22 FALSE 83.40356
58 58 HARD 23 FALSE 83.38145
59 59 HARD 24 FALSE 83.35933
60 60 HARD 25 FALSE 83.33721
61 61 HARD 26 FALSE 83.31509
62 62 HARD 27 FALSE 83.29297
63 63 HARD 28 FALSE 83.27085
64 64 HARD 29 FALSE 83.24873
65 65 HARD 30 FALSE 83.22661
66 66 HARD 31 FALSE 83.20450
67 67 HARD 32 FALSE 83.18238
68 68 HARD 33 FALSE 83.16026
69 69 HARD 34 FALSE 83.13814
70 70 HARD 35 FALSE 83.11602
expected_race_time expected_race_pace
1 83.62691 5853.884
2 167.36909 5857.918
3 251.22655 5861.953
4 335.19927 5865.987
5 419.28726 5870.022
6 503.49053 5874.056
7 587.80906 5878.091
8 672.24287 5882.125
9 756.79195 5886.160
10 863.45629 6044.194
11 947.30226 6028.287
12 1031.17303 6015.176
13 1115.06861 6004.216
14 1198.98900 5994.945
15 1282.93419 5987.026
16 1366.90419 5980.206
17 1450.89899 5974.290
18 1534.91861 5969.128
19 1618.96303 5964.601
20 1703.03225 5960.613
21 1787.12628 5957.088
22 1871.24512 5953.962
23 1955.38876 5951.183
24 2039.55722 5948.709
25 2123.75047 5946.501
26 2207.96854 5944.531
27 2292.21141 5942.770
28 2376.47908 5941.198
29 2460.77157 5939.793
30 2545.08886 5938.541
31 2629.43095 5937.425
32 2713.79786 5936.433
33 2798.18957 5935.554
34 2882.60608 5934.777
35 2989.04740 5978.095
36 3072.91546 5975.113
37 3156.76140 5972.251
38 3240.58522 5969.499
39 3324.38692 5966.848
40 3408.16650 5964.291
41 3491.92396 5961.821
42 3575.65931 5959.432
43 3659.37253 5957.118
44 3743.06364 5954.874
45 3826.73263 5952.695
46 3910.37950 5950.577
47 3994.00425 5948.517
48 4077.60688 5946.510
49 4161.18740 5944.553
50 4244.74579 5942.644
51 4328.28207 5940.779
52 4411.79622 5938.956
53 4495.28826 5937.173
54 4578.75818 5935.427
55 4662.20598 5933.717
56 4745.63167 5932.040
57 4829.03523 5930.394
58 4912.41668 5928.779
59 4995.77600 5927.192
60 5079.11321 5925.632
61 5162.42830 5924.098
62 5245.72127 5922.589
63 5328.99212 5921.102
64 5412.24086 5919.638
65 5495.46747 5918.196
66 5578.67197 5916.773
67 5661.85434 5915.370
68 5745.01460 5913.986
69 5828.15274 5912.619
70 5911.26876 5911.269(Naively) comparing strategies
bind_rows(
p1_hm %>% mutate(strategy = "1 stop - hard/medium")
, p1_sh %>% mutate(strategy = "1 stop - soft/hard")
) %>%
ggplot(aes(x = lap_number, y = expected_race_pace, col = strategy)) +
geom_line(linewidth = 1.2) +
xlab("lap number") +
ylab("estimated race pace") +
theme_minimal(base_size = 16)(Naively) comparing strategies
(Naively) comparing strategies
bind_rows(
p2_mhm %>% mutate(strategy = "2 stops - medium/hard/medium")
, p2_smm %>% mutate(strategy = "2 stops - soft/medium/medium")
, p2_mms %>% mutate(strategy = "2 stops - medium/medium/soft")
, p2_smh %>% mutate(strategy = "2 stops - soft/medium/hard")
) %>%
ggplot(aes(x = lap_number, y = expected_race_pace, col = strategy)) +
geom_line(linewidth = 1.2) +
xlab("lap number") +
ylab("estimated race pace") +
theme_minimal(base_size = 16)(Naively) comparing strategies
What teams actually need to do
- We looked at just three variables
- We cheated (after the fact)
- Life shell of the tyre
- Car parameters
- Race variables
What happened in that race
Source: formula1.com
“…Max Verstappen won the 2022 Hungarian Grand Prix from P10 with pitch perfect execution of Red Bull’s strategy…”
“…Leclerc blamed a decision to switch to the hard tyres for seeing him plummed down the order…”
Wrapping up
Books
Books (non R)
R Packages
⚽ worldfootballR, nwslR g, ggshakeR g
🏈 nflverse, cfbfastR
⚾ baseballr, Lahman, retrosheet
🏀 hoopR, wehoop, euroleaguer
🏏 yorkr, cricketr
🏒 nhlscraper, fastRhockey
🏎️ f1dataR, openf1r g
…check for more at SportsDataVerse and on CRAN Sports Analytics Task View!
Get in touch
📧
in
ʚɞ
☕
Bonus content
Basketball Player Tracking
library(NBAsportvu)
library(gganimate)
library(tidyr)
# download and unzip (https://github.com/sealneaward/nba-movement-data/blob/master/data/11.01.2015.SAS.at.BOS.7z)
all.movements <- sportvu_df(here::here("ASWR", "assets", "0021500040.json"))
p <- geom_basketball(
"nba",
color_updates = list(
plot_background = "#ffffff",
defensive_half_court = "#ffffff",
offensive_half_court = "#ffffff",
court_apron = "#ffffff",
center_circle_fill = "#ffffff",
two_point_range = "#ffffff",
painted_area = "#ffffff",
free_throw_circle_fill = "#ffffff"
)
) +
geom_label(
data = action,
aes(x = x - 94/2, y = y - 50/2, alpha = game_clock, fill = h_a, size = z, label = nr)
, inherit.aes = FALSE, label.r = unit(0.5, "lines")
) +
scale_fill_manual(values = c("h" = "blue", "a" = "yellow", "ball" = "orange")) +
transition_time(game_clock)
animate(p, fps = 5, width = 1200, height = 800)Basketball Player Tracking
Formula 1 Telemetry
lec1 <- load_driver_telemetry(season, race_nr, "Q", driver = "LEC", laps = 1)
ver1 <- load_driver_telemetry(season, race_nr, "Q", driver = "VER", laps = 1)
p <- ggplot(data = NULL, aes(x = x, y = y)) +
geom_path(data = bind_rows(lec1 %>% arrange(time), lec1[1,]) %>% select(-time), linewidth = 4, col = "grey") +
geom_label(data = lec1, aes(label = n_gear), fill = "red", col = "white") +
geom_label(data = ver1, aes(label = n_gear), fill = "blue", col = "white") +
annotate("text", x = -6000, y = 10000, label = "speed") +
geom_text(data = lec1 %>% mutate(speed = round(speed)), x = -6000, y = 9500, aes(label = speed), col = "red") +
geom_text(data = ver1 %>% mutate(speed = round(speed)), x = -6000, y = 9000, aes(label = speed), col = "blue") +
annotate("text", x = -5000, y = 10000, label = "rpm") +
geom_text(data = lec1 %>% mutate(rpm = round(rpm)), x = -5000, y = 9500, aes(label = rpm), col = "red") +
geom_text(data = ver1 %>% mutate(rpm = round(rpm)), x = -5000, y = 9000, aes(label = rpm), col = "blue") +
annotate("text", x = -4000, y = 10000, label = "throttle") +
geom_text(data = lec1 %>% mutate(throttle = round(throttle)), x = -4000, y = 9500, aes(label = throttle), col = "red") +
geom_text(data = ver1 %>% mutate(throttle = round(throttle)), x = -4000, y = 9000, aes(label = throttle), col = "blue") +
theme_void() +
transition_time(time) +
ease_aes("linear")
pFormula 1 Telemetry
Get in touch
📧
in
ʚɞ
☕