(Acest articol a fost publicat pentru prima dată pe Rstats – cuantificateși cu amabilitate a contribuit la R-bloggeri). (Puteți raporta problema legată de conținutul acestei pagini aici)
Doriți să vă distribuiți conținutul pe R-bloggeri? dați clic aici dacă aveți un blog, sau aici dacă nu aveți.
Iar începem! Am alergat la Maratonul Mainova Frankfurt 2025 și am vrut să mă uit la rezultatele cursei. Cum putem face asta folosind R?
Nu am putut vedea o modalitate ușoară de a descărca datele, așa că am folosit R pentru a le răzui. Rețineți că aceste timpuri sunt momentan provizorii, dar ne dau o idee bună despre ceea ce s-a întâmplat.
Rezultatele sunt disponibile cu o funcție de căutare pentru a găsi rezultatele unei persoane. Dacă lăsăm totul necompletat și setăm numărul de rezultate de afișat la maximum, obținem prima pagină din 16 care arată toate rezultatele. Regula este: dacă îl vedem, îl putem răzui!
Putem folosi {rvest} putem răzui aceste date. Pașii sunt: aflați formatul elementelor de extras (în acest caz, fiecare runner a fost un articol de listă, iar câmpurile de date erau div-uri în fiecare articol), scrieți o funcție pentru a extrage toți alergătorii de pe pagină, scrieți o funcție pentru a procesa o pagină, apelați această funcție pentru fiecare pagină! Poate este mai ușor să vezi codul:
library(rvest)
library(dplyr)
library(purrr)
library(stringr)
library(ggforce)
## Functions ----
# retrieves the data frame from the main function
scrape_results_page <- function(url) {
webpage <- read_html(url)
df <- scrape_startlist(webpage)
df <- df(-1, )
return(df)
}
# scrapes the data
scrape_startlist <- function(page) {
rows <- page %>% html_nodes("li.list-group-item.row")
map_df(rows, function(row) {
# helper to get text from a selector, remove small labels and trim
get_text <- function(sel) {
node <- row %>% html_node(sel)
if (is.na(node) || length(node) == 0) return(NA_character_)
# remove the mobile label nodes inside if present
node %>% html_nodes(".visible-xs-block, .visible-sm-block, .list-label") %>% xml2::xml_remove()
text <- node %>% html_text(trim = TRUE)
if (length(text) == 0) return(NA_character_) else return(text)
}
# place primary/secondary
place_primary <- get_text(".type-place.place-primary")
place_secondary <- get_text(".type-place.place-secondary")
# fullname and link
fullname_a <- row %>% html_node("h4.type-fullname a")
fullname <- if (length(fullname_a) == 0) NA_character_ else fullname_a %>% html_text(trim = TRUE)
link <- if (length(fullname_a) == 0) NA_character_ else fullname_a %>% html_attr("href")
# bib, club/city, age class (these are under second column)
bib <- get_text(".type-field")
club_city <- get_text(".type-priority")
age_class <- get_text(".type-age_class")
# finish and gun time: there are multiple .type-time entries; take them in order
times <- row %>% html_nodes(".type-time") %>% html_text(trim = TRUE)
times <- times(times != "") # drop blanks
finish <- if (length(times) >= 1) times(1) else NA_character_
gun_time <- if (length(times) >= 2) times(2) else NA_character_
# make data frame. We don't need gun time or link
data.frame(
place_primary = place_primary,
place_secondary = place_secondary,
fullname = fullname,
bib = bib,
club_city = club_city,
age_class = age_class,
finish = finish
)
})
}
# Specifying the base url for website to be scraped
url <- "https://live.frankfurt-marathon.com/2025/?page="
# the pages are like this:
# "https://live.frankfurt-marathon.com/2025/?page=2&event=L_HCH3BKLB3B8&num_results=1000&pid=startlist_list&pidp=startlist&search%5Bage_class%5D=%25&search%5Bsex%5D=%25&search%5Bnation%5D=%25&search_sort=name"
# we have 1000 results on a page and the first page shows there are 16 pages total
n_pages <- 16
# make a list of all urls to be scraped
urls <- paste0(url, seq(n_pages), "&event=L_HCH3BKLB3B8&num_results=1000&pid=startlist_list&pidp=startlist&search%5Bage_class%5D=%25&search%5Bsex%5D=%25&search%5Bnation%5D=%25&search_sort=name")
# scrape each page one by one and rbind into large df
result <- do.call(rbind, lapply(urls, scrape_results_page))
Într-adevăr, cea mai grea parte aici este să descoperi numele nodurilor html care conțin datele. Tocmai am aruncat o privire la sursa paginii din browser și am notat care sunt clasele div necesare.
Deci acum avem un cadru de date numit result care are toate datele. Mai întâi trebuie să facem un pic de ordine:
ages <- c("U18", "JU20", "U23", "H",
"30", "35", "40", "45", "50", "55", "60", "65", "70", "75", "80", "85", "–")
# order the age_class factor levels
result$age_class <- factor(result$age_class, levels = ages)
# if the bib number starts with F add "Female" to new "gender" column, otherwise assume "Male
result$gender <- ifelse(startsWith(result$bib, "F"), "Female", "Male")
# remove "Finish" text from finish times
result$finish <- str_replace(result$finish, "Finish", "")
# convert string times to hh:mm:ss POSIXct
result$finish_time <- as.POSIXct(result$finish, format = "%H:%M:%S", tz = "UTC")
Aici doar punem clasele de vârstă în ordinea corectă. Există două sexe pentru acest eveniment și le putem analiza din numerele de doste. În cele din urmă, timpul de terminare este ușor scăpat după răzuire, așa că a trebuit să corectăm asta. Am lăsat în urmă ora armei și linkul către detaliile fiecărui alergător în prima funcție pentru că nu avem nevoie de ele.
Să găsim câteva fapte și cifre!
## Some facts and figures ----
# total runners
total_runners <- nrow(result)
cat("Total runners:", total_runners, "n")
# total finishers (those without NA as finish_time)
total_finishers <- sum(!is.na(result$finish_time))
cat("Total finishers:", total_finishers, "n")
# average finish time
avg_finish_time <- mean(result$finish_time, na.rm = TRUE)
cat("Average finish time:", format(avg_finish_time, "%H:%M:%S"), "n")
# fastest finish time
fastest_finish_time <- min(result$finish_time, na.rm = TRUE)
cat("Fastest finish time:", format(fastest_finish_time, "%H:%M:%S"), "n")
# slowest finish time
slowest_finish_time <- max(result$finish_time, na.rm = TRUE)
cat("Slowest finish time:", format(slowest_finish_time, "%H:%M:%S"), "n")
# break down the same stats by gender
for (g in unique(result$gender)) {
cat("Gender:", g, "n")
res_g <- result(result$gender == g, )
total_runners_g <- nrow(res_g)
cat(" Total runners:", total_runners_g, "n")
total_finishers_g <- sum(!is.na(res_g$finish_time))
cat(" Total finishers:", total_finishers_g, "n")
avg_finish_time_g <- mean(res_g$finish_time, na.rm = TRUE)
cat(" Average finish time:", format(avg_finish_time_g, "%H:%M:%S"), "n")
fastest_finish_time_g <- min(res_g$finish_time, na.rm = TRUE)
cat(" Fastest finish time:", format(fastest_finish_time_g, "%H:%M:%S"), "n")
slowest_finish_time_g <- max(res_g$finish_time, na.rm = TRUE)
cat(" Slowest finish time:", format(slowest_finish_time_g, "%H:%M:%S"), "n")
}
Aceasta ne oferă:
Total runners: 15456 Total finishers: 12323 Average finish time: 03:53:51 Fastest finish time: 02:06:16 Slowest finish time: 07:13:07 Gender: Male Total runners: 11913 Total finishers: 9497 Average finish time: 03:48:09 Fastest finish time: 02:06:16 Slowest finish time: 07:13:07 Gender: Female Total runners: 3543 Total finishers: 2826 Average finish time: 04:12:59 Fastest finish time: 02:19:34 Slowest finish time: 06:47:55
Presupunând că fiecare alergător listat în rezultate a început evenimentul și că lipsa unui timp de sosire indică DNF. Aceasta înseamnă că rata de finalizare a fost de 80% și a fost aceeași pentru bărbați și femei. Sunt surprins că 20% dintre alergători nu au terminat. Traseul este foarte plat și, deși a fost destul de vânt, nu a fost o provocare pe măsură ce se desfășoară maratoanele. S-ar putea ca cei 20% să includă persoane care au DNS.
Să aruncăm o privire asupra timpilor de sfârșit și a modului în care se defectează.
## Plots ----
# filter out DNFs and "-" for age class
result <- result %>%
filter(!is.na(finish_time)) %>%
filter(age_class != "–")
mycolors <- c(rgb(218,63,65, maxColorValue = 255),
rgb(11,46,114, maxColorValue = 255))
ggplot(result, aes(x = finish_time)) +
geom_histogram(binwidth = 60, fill = mycolors(1)) +
labs(x = "Finish Time",
y = "Count") +
# 20 minute ticks on x axis
scale_x_datetime(date_breaks = "20 min", date_labels = "%H:%M") +
theme_minimal()
# save plot
ggsave("Output/Plots/frankfurt_marathon_2025_finish_time_histogram.png", width = 10, height = 6, bg = "white")
# plot finish times by age class facet by gender
ggplot(result, aes(x = age_class, y = finish_time, colour = gender)) +
geom_sina(alpha = 0.2, stroke = 0) +
scale_y_datetime(date_breaks = "20 min", date_labels = "%H:%M") +
stat_summary(fun = mean, geom = "point", size = 2, colour = "black", alpha = 0.8) +
scale_colour_manual(values = mycolors) +
facet_wrap(~ gender) +
labs(x = "",
y = "Finish Time") +
theme_minimal() +
theme(legend.position = "none")
# save plot
ggsave("Output/Plots/frankfurt_marathon_2025_finish_times_by_age_class.png", width = 10, height = 6)
Acest lucru ne oferă două comploturi. În primul rând, timpii de terminare în funcție de clasă de vârstă și de sex:
Timpul mediu (mediu) pe categorie este afișat ca un cerc negru, altfel fiecare alergător este un punct roșu sau albastru. Timpul mediu pentru bărbați pare să atingă vârful cu categoria de vârstă 35-40 de ani, deși cei mai rapidi timpi sunt în categoriile sub 35 de ani. Pentru femei, există o încetinire similară a timpilor medii de terminare la grupele de vârstă mai înaintate, dar există un efect de vârf mai puțin. Numărul de participanți de sex feminin este totuși mai mic, așa că am putea rata efectul din acest motiv.
Acest complot este destul de frumos, deoarece puteți vedea densitatea alergătorilor din fiecare categorie pentru a vă simți despre participare. Există, de asemenea, un efect de dungi care este cel mai clar în datele masculine.
Aceasta este o histogramă a timpilor de terminare a tuturor participanților. Sunt vârfuri la puțin sub 3 ore și 4 ore. Există, de asemenea, o acumulare de alergători care termină în jurul orei 3:30 și 5:00. Aceste numere runde sunt în mod evident timpi de gol pentru mulți alergători.
Felicitări tuturor celor care au participat și mai ales celor care și-au atins obiectivele pe care și le-au propus.
—
Titlul postării este preluat din „Pledging My Time”, o piesă din Blonde on Blonde de Bob Dylan.
