Suunnistuksen firmaliigan kevätkausi on kisattu Sitowisen hallinnassa. Kelan joukkue säilytti asemansa A-lohkon keskikastissa ja tulosten valossa kesällä on lupa grillailla vapaasti ja nauttia päälle normaalit ruokajuomat.
Helsingin Suunnistajien järjestelyt olivat taas huippuluokkaa ja Navisportin tulospalvelu toimi moitteetta. Alla hieman data-analyysiä A-lohkon osalta kevään kilpailuista. Kuvan alla on analyysin R-kielinen lähdekoodi kiinnostuneille!
Lähdekoodi
options(stringsAsFactors = FALSE)
require(rvest)
library(dplyr)
library(glue)
# KAUSI 2019
<- tibble(
tulosdata kausi = rep(2019, 3),
kisanro = 1:3,
kisanimi = c("Nettaa - Sorvalampi",
"Solvalla - Ruuhijärvi",
"Rinnekoti - Halkolampi"),
kisapvm = c("7.5.2019",
"14.5.2019",
"21.5.2019"),
tulosurl = c("http://online.helsinginsuunnistajat.fi/results/9f700f0b-8b35-4e17-bfc6-a87850edacff",
"http://online.helsinginsuunnistajat.fi/results/38be839d-4129-4d15-abd5-14505b91879e",
"http://online.helsinginsuunnistajat.fi/results/cdb800b7-75ba-4774-9131-7d72c1fc330a")
)$tulosurl_team <- sub("results", "teamresults", tulosdata$tulosurl)
tulosdata$tulosurl_team <- glue(tulosdata$tulosurl_team, "?totalpoints=true")
tulosdata
<- list()
lst_tulos for (i in 1:nrow(tulosdata)){
if (tulosdata$kisanimi[i] == "") next()
## change Phantom.js scrape file
<- tulosdata$tulosurl[i]
url <- readLines("scrape_firmaliiga_2.js")
lines 1] <- paste0("var url ='", url ,"';")
lines[writeLines(lines, "scrape_firmaliiga_2.js")
## Download website
system("phantomjs scrape_firmaliiga_2.js")
### use Rvest to scrape the downloaded website.
read_html("1.html") %>%
html_table() %>%
1]] %>%
.[[as_tibble(.name_repair = "unique") %>%
mutate(kisa = tulosdata$kisanimi[i],
pvm = tulosdata$kisapvm[i],
nro = tulosdata$kisanro[i],
Sija = as.integer(sub("\\.", "", Sija))) -> tmp
<- tmp
lst_tulos[[i]]
}<- do.call(bind_rows, lst_tulos)
df_tulos
# joukkuetulokset
<- list()
lst_tulos for (i in 1:nrow(tulosdata)){
if (tulosdata$kisanimi[i] == "") next()
## change Phantom.js scrape file
<- tulosdata$tulosurl_team[i]
url <- readLines("scrape_firmaliiga_2.js")
lines 1] <- paste0("var url ='", url ,"';")
lines[writeLines(lines, "scrape_firmaliiga_2.js")
## Download website
system("phantomjs scrape_firmaliiga_2.js")
### use Rvest to scrape the downloaded website.
read_html("1.html") %>%
html_table() %>%
1]] %>%
.[[as_tibble(.name_repair = "unique") %>%
mutate(kisa = tulosdata$kisanimi[i],
pvm = tulosdata$kisapvm[i],
nro = tulosdata$kisanro[i]) -> tmp
<- tmp
lst_tulos[[i]]
}<- do.call(bind_rows, lst_tulos)
df_tulos_team
# ######################################################
# JOUKKUEET JA JUOKSIJAT
## KEVÄT
# Uniikit joukkueet
<- unique(df_tulos_team$X3)
joukkueet <- sort(joukkueet)
joukkueet_kevat # etsitään juoksija & joukkue -parit
%>%
df_tulos # filter(nro %in% c(3)) %>%
mutate(firmaliiga = ifelse(grepl(paste(joukkueet,collapse="|"),
TRUE, FALSE)
Nimi), %>%
) filter(firmaliiga) -> tmp
$joukkue <- NA
tmpfor (i in 1:nrow(tmp)){
for (j in joukkueet){
if (grepl(j, tmp$Nimi[i])) tmp$joukkue[i] <- j
}
}# putsataan nimi
for (i in 1:nrow(tmp)){
$Nimi[i] <- sub(tmp$joukkue[i], "", tmp$Nimi[i])
tmp
}
<- tmp %>% distinct(Nimi,joukkue) %>% mutate(kausi = "kevät")
juoksija_ja_joukkue_kevat
# KEVÄTKAUDEN TULOKSET
<- df_tulos
df_tulos2
for (i in 1:nrow(df_tulos2)){
for (j in joukkueet_kevat){
if (grepl(j, df_tulos2$Nimi[i])) df_tulos2$Nimi[i] <- sub(j, "", df_tulos2$Nimi[i])
}
}
# Annetaan kullekin juoksijalle joukkue
$joukkue <- juoksija_ja_joukkue_kevat$joukkue[match(df_tulos2$Nimi, juoksija_ja_joukkue_kevat$Nimi)]
df_tulos2
# Lasketaan tulokset
%>%
df_tulos2 mutate(Sija = as.integer(sub("\\.", "", Sija))) %>%
filter(!is.na(joukkue)) %>%
# valitaan vaan kolme juoksijaa per tiimi per kisa
group_by(nro,joukkue) %>%
arrange(Sija) %>%
mutate(juoksijanro = 1:n()) %>%
ungroup() -> tulokset
<- tulokset %>%
tulos_ind # filter(nro == 1) %>%
group_by(nro) %>%
mutate(kisapisteet = 101 - 1:n()) %>%
filter(juoksijanro <= 3) %>%
# as.data.frame()
ungroup() #%>%
# filter(joukkue == "Nokia") %>%
# group_by(nro) %>%
# summarise(joukkuepisteet = sum(kisapisteet, na.rm = TRUE))
# Yhdistetään kisapisteet
<- left_join(tulos_ind,df_tulos_team %>% select(-nro,-pvm), by = c("kisa" = "kisa", "joukkue" = "X3")) %>%
tulos_all mutate(facetti = glue::glue("{nro}. {kisa} {pvm}"))
$kisa <- factor(tulos_all$kisa, levels = c("Nettaa - Sorvalampi","Solvalla - Ruuhijärvi","Rinnekoti - Halkolampi"))
tulos_all$kisa <- factor(df_tulos_team$kisa, levels = c("Nettaa - Sorvalampi","Solvalla - Ruuhijärvi","Rinnekoti - Halkolampi"))
df_tulos_team
levels(tulos_all$kisa) <- sub(" - ", " -\n", levels(tulos_all$kisa))
levels(df_tulos_team$kisa) <- sub(" - ", " -\n", levels(df_tulos_team$kisa))
# kumupisteet
<- df_tulos_team %>%
df_kumu group_by(X3) %>%
arrange(X3,nro) %>%
mutate(kumu = cumsum(X4)) %>%
ungroup() %>%
mutate(kumu = ifelse(is.na(kumu), X4, kumu))
# joukkueet järjestyksessä
<- df_kumu %>% filter(nro == max(nro)) %>%
df_top arrange(desc(kumu)) %>%
mutate(rank = 1:n())
$joukkue <- factor(tulos_all$joukkue, levels = df_top$X3)
tulos_all
library(ggplot2)
<- ggplot(df_kumu, aes(x = kisa, y = kumu, group = X3, color = X3, fill = X3)) +
p1 geom_point() +
geom_line() +
::geom_text_repel(
ggrepeldata = df_top,
aes(label = glue::glue("{rank}. {X3}: {kumu}p")),
nudge_x = .2,
lineheight = .8,
family = "Roboto Condensed",
size = 2.8,
segment.colour = alpha("black", 1/5)) +
# xlim(c(1,3)) +
scale_x_discrete(expand = c(0,0.3)) +
::theme_ipsum_rc(grid = "XY", base_size = 8) +
hrbrthemestheme(legend.position = "none") +
# facet_wrap(~facetti, ncol = 1) +
labs(title = "Firmaliigan A-lohko 2019 kolmen kilpailun jälkeen",
subtitle = "Joukkuepisteiden kertymä",
x = NULL,
y = "pisteet pisteet")
<- ggplot(tulos_all,
p2 aes(x = kisa, y = kisapisteet, group = Nimi, color = Nimi)) +
::theme_ipsum_rc(grid = "XY", base_size = 8) +
hrbrthemesgeom_point() +
geom_line() +
facet_wrap(~joukkue, ncol = 3) +
theme(legend.position = "none",
panel.spacing.x=unit(0.1, "lines"),
panel.spacing.y=unit(.2, "lines")
+
) ::geom_text_repel(data = tulos_all %>% distinct(Nimi, .keep_all = TRUE),
ggrepelaes(label = glue::glue("{sub('^.+ ', '', Nimi)}")),
nudge_y = 5,
family = "Roboto Condensed",
lineheight = .8,
size = 2.5,
segment.colour = alpha("black", 1/5)) +
labs(title = NULL,
subtitle = "Juoksijat per osakilpailu per joukkue",
x = NULL,
y = "kilpailijan pisteet",
caption = glue("Data: online.helsinginsuunnistajat.fi \n {Sys.time()}"))
::plot_grid(p1, p2,
cowplotnrow = 2,
align = "v",
rel_heights = c(1,1.3))