Suunnistuksen firmaliiga 2019 - kevätkausi

data analysis
R
election
suunnistus
orienteering
web scraping
dataviz
Tekijä

Markus Kainu

Julkaistu

21. toukokuuta 2019

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

[/kode] 
options(stringsAsFactors = FALSE)
require(rvest)
library(dplyr)
library(glue)

# KAUSI 2019

tulosdata <- tibble(
  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")
)
tulosdata$tulosurl_team <- sub("results", "teamresults", tulosdata$tulosurl)
tulosdata$tulosurl_team <- glue(tulosdata$tulosurl_team, "?totalpoints=true")


lst_tulos <- list()
for (i in 1:nrow(tulosdata)){
  if (tulosdata$kisanimi[i] == "") next()
  
  ## change Phantom.js scrape file
  url <- tulosdata$tulosurl[i]
  lines <- readLines("scrape_firmaliiga_2.js")
  lines[1] <- paste0("var url ='", url ,"';")
  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
  lst_tulos[[i]] <- tmp
}
df_tulos <- do.call(bind_rows, lst_tulos)

# joukkuetulokset
lst_tulos <- list()
for (i in 1:nrow(tulosdata)){
  if (tulosdata$kisanimi[i] == "") next()
  ## change Phantom.js scrape file
  url <- tulosdata$tulosurl_team[i]
  lines <- readLines("scrape_firmaliiga_2.js")
  lines[1] <- paste0("var url ='", url ,"';")
  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
  lst_tulos[[i]] <- tmp
}
df_tulos_team <- do.call(bind_rows, lst_tulos)


# ######################################################
# JOUKKUEET JA JUOKSIJAT

## KEVÄT
# Uniikit joukkueet
joukkueet <- unique(df_tulos_team$X3)
joukkueet_kevat <- sort(joukkueet)
# etsitään juoksija & joukkue -parit
df_tulos %>% 
  # filter(nro %in% c(3)) %>% 
  mutate(firmaliiga = ifelse(grepl(paste(joukkueet,collapse="|"), 
                                   Nimi), TRUE, FALSE)
  ) %>% 
  filter(firmaliiga) -> tmp

tmp$joukkue <- NA
for (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)){
  tmp$Nimi[i] <- sub(tmp$joukkue[i], "", tmp$Nimi[i])  
}

juoksija_ja_joukkue_kevat <- tmp %>% distinct(Nimi,joukkue) %>% mutate(kausi = "kevät")


# KEVÄTKAUDEN TULOKSET
df_tulos2 <- df_tulos

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
df_tulos2$joukkue <- juoksija_ja_joukkue_kevat$joukkue[match(df_tulos2$Nimi, juoksija_ja_joukkue_kevat$Nimi)]

# 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

tulos_ind <- tulokset %>%
  # 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
tulos_all <- left_join(tulos_ind,df_tulos_team %>% select(-nro,-pvm), by = c("kisa" = "kisa", "joukkue" = "X3")) %>% 
  mutate(facetti = glue::glue("{nro}. {kisa} {pvm}"))

tulos_all$kisa <- factor(tulos_all$kisa, levels = c("Nettaa - Sorvalampi","Solvalla - Ruuhijärvi","Rinnekoti - Halkolampi"))
df_tulos_team$kisa <- factor(df_tulos_team$kisa, levels = c("Nettaa - Sorvalampi","Solvalla - Ruuhijärvi","Rinnekoti - Halkolampi"))

levels(tulos_all$kisa) <- sub(" - ", " -\n", levels(tulos_all$kisa))
levels(df_tulos_team$kisa) <- sub(" - ", " -\n", levels(df_tulos_team$kisa))

# kumupisteet
df_kumu <- df_tulos_team %>% 
  group_by(X3) %>%
  arrange(X3,nro) %>% 
  mutate(kumu = cumsum(X4)) %>% 
  ungroup() %>% 
  mutate(kumu = ifelse(is.na(kumu), X4, kumu))

# joukkueet järjestyksessä

df_top <- df_kumu %>% filter(nro == max(nro)) %>% 
  arrange(desc(kumu)) %>% 
  mutate(rank = 1:n())

tulos_all$joukkue <- factor(tulos_all$joukkue, levels = df_top$X3)


library(ggplot2)
p1 <- ggplot(df_kumu, aes(x = kisa, y = kumu, group = X3, color = X3, fill = X3)) + 
  geom_point() + 
  geom_line() +
  ggrepel::geom_text_repel(
    data = 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)) +
  hrbrthemes::theme_ipsum_rc(grid = "XY", base_size = 8) +
  theme(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")


p2 <- ggplot(tulos_all, 
       aes(x = kisa, y = kisapisteet, group = Nimi, color = Nimi)) +
  hrbrthemes::theme_ipsum_rc(grid = "XY", base_size = 8) +
  geom_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")
  ) +
  ggrepel::geom_text_repel(data = tulos_all %>% distinct(Nimi, .keep_all = TRUE),
                            aes(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()}"))

cowplot::plot_grid(p1, p2, 
                               nrow = 2, 
                               align = "v",
                               rel_heights = c(1,1.3))

Uudelleenkäyttö

Viittaus

BibTeX-viittaus:
@online{kainu2019,
  author = {Kainu, Markus},
  title = {Suunnistuksen firmaliiga 2019 - kevätkausi},
  date = {2019-05-21},
  url = {https://markuskainu.fi/posts/2019-05-21-firmaliiga-kevat-2019/},
  langid = {fi}
}
Viitatkaa tähän teokseen seuraavasti:
Kainu, Markus. 2019. “Suunnistuksen firmaliiga 2019 - kevätkausi.” May 21, 2019. https://markuskainu.fi/posts/2019-05-21-firmaliiga-kevat-2019/.