Pikainen ja likainen analyysi Jukolan tuloksista

Jukolan viesti juostiin viikko sitten Hollolassa ja voiton vei Koovee Tampereelta. Tein aikaisemmin keväällä pienen analyysin 10milaviestin etenemisestä ja tässä saman koodin päälle vastaava analyysi Jukolan viestin etenemisestä kymmenen parhaan joukkueen osalta. Koodi on R-kieltä löysästi ja huolimattomasti kirjoitettuna.

Jos et jaksa kahlata koodia läpi ja haluat nähdä vain parhaan kuvan klikkaa: paras kuva!

Data

Jukolan tulospalvelusta saa datan xml-muodossa tästä http://online.jukola.com/tulokset/results_j2018_ju.xml linkistä. Sen rakenteen ymmärtäminen ja prosessoiminen vaatii hetken ajattelua, mutta alla on koodi joka tekee sen puolestasi

library(tidyr)
library(ggplot2)
library(XML)
library(rvest)
library(stringr)
library(tidyverse)
library(xml2)
library(purrr)

urli <-"http://online.jukola.com/tulokset/results_j2018_ju.xml"
d <- read_xml(urli)
xml_find_all(d, ".//team") -> base

# base %>% xml_children(.) %>% length() -> juoksijoita
# 
# cont_tot <- data_frame(x = rep(NA,juoksijoita),y = rep(NA,juoksijoita), lista = list(juoksijoita))
# cont_tot <- vector("list", juoksijoita)
cont_tot <- data_frame()
# for (i in 1:2){
for (i in 1:length(base)){
  # Sarja
  cont_tot <- data_frame()
  map_df(base[i], function(x) {
    kids <- xml_children(x)
    setNames(as.list(xml_text(kids)), xml_name(kids)
    )
  }) -> sarja_tmp
  xml_find_all(base[i], ".//leg") -> base_1
  if (length(base_1) == 0) next()
  for (ii in 1:length(base_1)){
    # kilpailija
    map_df(base_1[ii], function(x) {
      kids1 <- xml_children(x)
      setNames(as.list(xml_text(kids1)), xml_name(kids1)
      )
    }) -> comp_tmp
    comp_tmp <- bind_cols(sarja_tmp,comp_tmp)
    xml_find_all(base_1[ii], ".//control") -> base_2
    
    for (iii in 1:length(base_2)){
      # kilpailija
      map_df(base_2[iii], function(x) {
        kids2 <- xml_children(x)
        setNames(as.list(xml_text(kids2)), xml_name(kids2)
        )
      }) -> cont_tmp
      cont_tmp <- bind_cols(comp_tmp,cont_tmp)
      cont_tot <- bind_rows(cont_tot,cont_tmp)
      # cont_tot[[i]] <- cont_tmp
    }
  }
  cont_tot <- cont_tot %>% select(-leg)
  assign(x = paste0("team_",i), value = cont_tot, envir = globalenv())
}

jukola <- do.call('bind_rows', mget(apropos(what = "team_")))
head(jukola)
teamid teamname teamnro result tsecs placement legnro nm crs emit control result1 tsecs1 cn cc ct cd year
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 1 113 14:24 14:24 2018
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 2 37 16:46 2:22 2018
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 3 129 19:50 3:04 2018
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 4 141 22:13 2:23 2018
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 5 142 24:17 2:04 2018
2 Koovee 1 7:27:18 26838 1 1 Joni Hirvikallio 109_CF 1504766 204441:04:3644 1:04:36 3876 6 128 26:42 2:25 2018

Sijoitukset vaihdossa

Maalileimasimen koodi datassa on 444. Seuraavalla koodilla datasta poimitaan maalissa 10 parasta joukkuetta ja piirretään kuva jossa heidän vaihtoaikansa ja sijoituksensa.

jukola_mod <- jukola %>%  
  mutate_at(., .vars = vars(tsecs,legnro,tsecs1,cn,cc), .funs = as.integer) %>% 
  mutate(name = paste(teamname,teamnro))  

jukola_mod %>%
  filter(cc == 444, legnro == 7) %>% 
  arrange(tsecs) %>% 
  select(teamid,name) %>% 
  slice(1:10) -> top10


jukola_mod %>% 
  filter(cc == 444) %>% 
  group_by(legnro) %>% 
  filter(tsecs1 == min(tsecs1, na.rm = TRUE)) %>% 
  ungroup() %>% 
  arrange(legnro)

jukola_mod %>%
  filter(cc == 444, !teamid %in% c(35,14,482,919)) %>% 
  # luokittele osuuksisttain
  group_by(name) %>%
  arrange(legnro) %>% 
  mutate(vaihtoaika_kumu = cumsum(tsecs1)) %>% 
  ungroup() %>% 
  group_by(legnro) %>%
  arrange(vaihtoaika_kumu) %>% 
  mutate(place = 1:n(),
         min_vaihtoaika_kumu = min(vaihtoaika_kumu, na.rm = TRUE),
         diff_secs = vaihtoaika_kumu - min_vaihtoaika_kumu) %>% 
  select(teamid, name, nm, legnro, place, placement,diff_secs,tsecs,tsecs1,vaihtoaika_kumu,min_vaihtoaika_kumu) %>% 
  ungroup() %>% 
  arrange(legnro,place) %>% 
  rename(leg = legnro,
         club = name)-> dat
  # select(teamid,name) %>% 



leg_info <-   data_frame(leg = 1:7) %>% 
  mutate(length = case_when(
    leg == 1 ~ 11.0,
    leg == 2 ~ 11.9,
    leg == 3 ~ 12.7,
    leg == 4 ~ 8.75,
    leg == 5 ~ 8.65,
    leg == 6 ~ 10.75,
    leg == 7 ~ 15.05
  ), 
  length_cum = cumsum(length)) -> leg_info

dat2 <- left_join(dat,leg_info)

d_leg_0 <- dat2 %>% filter(leg == 1) %>% mutate(length_cum = 0, 
                                                diff_secs = 0,
                                                leg = 0)
d_leg_11 <- bind_rows(d_leg_0,dat2)

all_legs <- d_leg_11 # for excel

d_leg_111 <- d_leg_11 %>% filter(teamid %in% top10$teamid)

ipsum_palette <- c("#d18975", "#8fd175", "#3f2d54", "#75b8d1", "#2d543d", "#c9d175", "#d1ab75", "#d175b8", "#758bd1")

library(ggplot2)
library(hrbrthemes)
library(viridis)
ggplot(d_leg_111, aes(x = length_cum, y = diff_secs/60, color = club, fill = club)) + 
  geom_line(alpha = .8) + geom_point(shape = 21, color = "white", alpha = .8, size = 4) + 
  scale_x_continuous(breaks = leg_info$length_cum , labels = leg_info$leg) + 
  scale_y_reverse() +
  geom_text(aes(label = place), color = "white", family = "Roboto Condensed", size = 2.5, fontface= "bold") +
  theme_ipsum_rc() + 
  ggrepel::geom_text_repel(data = d_leg_111 %>% filter(leg == max(leg)), aes(label = club), nudge_y = -.2, size = 2.7, family = "Roboto Condensed") + 
  theme(legend.position = "none") + 
  # scale_fill_ipsum() + scale_color_ipsum() +
  scale_fill_manual(values = c(rev(ipsum_palette),"black")) + scale_color_manual(values = c(rev(ipsum_palette),"black")) +
  labs(title = "10 parasta joukkuetta Jukolan viestissä 2018",
       subtitle = "Ero kärkeen vaihdoissa",
       caption = paste0("Data: http://online.jukola.com/tulokset/results_j2018_ju.xml\n",Sys.time()),
       x = "osuus", y = "minuuttia kärjestä")

Tilanne rasteilla osuuksittain kymmenen parhaan joukkueen osalta

Datassa on siis rivi kunkin suunnistajan kultakin leimaukselta ja lopuksin tein kymmenen parhaan joukkuen osalta kuvan jossa sijoitus ja aikaero kärkeen kilpailun kullakin rastilla.

dat %>% 
  select(teamid,leg,tsecs1) %>% 
  # filter(teamid %in% top10$teamid) %>%
  group_by(teamid) %>% 
  arrange(leg) %>% 
  mutate(tsecs1_cum = cumsum(tsecs1)) %>% ungroup() %>% 
  mutate(legnro = leg + 1) %>% 
  select(-tsecs1,-leg) %>% 
  filter(legnro < 8) -> osuusajat

bind_rows(
  osuusajat %>% filter(legnro == 2) %>% mutate(legnro = 1, tsecs1_cum = 0),
  osuusajat
) -> osuusajat2

jukola_mod %>%
  left_join(.,osuusajat2) %>% 
  filter(!teamid %in% c(35,14,482,919,
                        387,1322,1282)) %>% 
  # koko joukkueen kumulatiivinen rastiväliaika sekunteina
  mutate(ct_secs = as.integer(gsub(".+:", "", ct)),
         ct_mins_h_tmp = gsub(":[0-9]+$", "", ct),
         ct_mins = as.integer(gsub("^.+:", "", ct_mins_h_tmp)),
         ct_mins_h_tmp2 = ifelse(!grepl(":", ct_mins_h_tmp), NA, ct_mins_h_tmp),
         ct_mins_h_tmp2 = str_trim(ct_mins_h_tmp2),
         ct_hs = as.integer(gsub(":.+$", "", ct_mins_h_tmp2)),
         ct_hs = ifelse(is.na(ct_hs), 0, ct_hs),
         ct_sec = ct_hs * 3600 + ct_mins * 60 + ct_secs) %>% 
  # select(ct,ct_sec,ct_secs,ct_mins,ct_hs,ct_mins_h_tmp,ct_mins_h_tmp2) %>% slice(1:100) %>% View()
  # luokittele osuuksisttain
  group_by(name,legnro) %>%
  arrange(legnro,cn) %>% 
  mutate(rastiaika_kumu = tsecs1_cum + ct_sec) %>%
  ungroup() %>% 
  group_by(legnro,cn) %>%
  arrange(rastiaika_kumu) %>% 
  mutate(place = 1:n(),
         min_rastiaika_kumu = min(rastiaika_kumu, na.rm = TRUE),
         diff_secs = rastiaika_kumu - min_rastiaika_kumu) %>% 
  select(teamid, name, nm, legnro, place, placement,diff_secs,tsecs,tsecs1,rastiaika_kumu,ct_sec,min_rastiaika_kumu) %>% 
  ungroup() %>% 
  arrange(legnro,place) %>% 
  filter(teamid %in% top10$teamid) %>%
  rename(leg = legnro,
         club = name) -> dat


dat %>% 
  filter(leg %in% 1, cn == 13) %>%
  arrange(cn,diff_secs) %>% View()

dat$leg2 <- paste0("Osuus ", dat$leg)
dat$leg2 <- factor(dat$leg2, levels = c("Osuus 1","Osuus 2","Osuus 3","Osuus 4","Osuus 5","Osuus 6","Osuus 7"))

library(ggplot2)
library(hrbrthemes)
library(viridis)

bind_rows(
dat %>% filter(leg2 == "Osuus 1", cn == 1) %>% 
  mutate(cn = 0, diff_secs = 0),
dat) -> dat2



ggplot(dat2, aes(x = cn, y = diff_secs/60, color = club, fill = club)) + 
  geom_line(alpha = .8) + 
  geom_point(shape = 21, color = "white", alpha = .7, size = 4) + 
  geom_text(aes(label = place), color = "white", family = "Roboto Condensed", size = 2.2, fontface= "bold") +
  ggrepel::geom_text_repel(data = dat2 %>%
                             group_by(leg2) %>%
                             filter(cn == max(cn)),
                           aes(label = paste0(nm,"\n",club)), nudge_y = -.2, nudge_x = 1, size = 2.0, lineheight = .8, family = "Roboto Condensed") +
  facet_wrap(~leg2, ncol = 1, scales = "free") +
  # scale_x_continuous(breaks = 0:18, labels = 0:18, limits = c(0,18)) +
  scale_y_reverse() + 
  theme_ipsum_rc() + 
  theme(legend.position = "none") + 
  scale_fill_manual(values = c(rev(ipsum_palette),"black")) + scale_color_manual(values = c(rev(ipsum_palette),"black")) +
  # theme(plot.margin = unit(0,0,0,0)) +
  # theme(margin(t = 0, r = 0, b = 0, l = 0, unit = "pt")) +
  labs(title = "Top 10 joukkuetta Jukolassa 2018 osuuksittain",
       subtitle = "Ero kärkeen kullakin rastilla",
       caption = paste0("Data: http://online.jukola.com/tulokset/results_j2018_ju.xml\n",Sys.time()),
       x = "Rastin järjestysnumero", y = "minuuttia kärjestä")

Kuvista käy ilmi sama kuin tuloksista että viestin kulku oli vaihtelevaa, Kratovin suoritus oli hieno ja että kärkijoukkueet eivät tehneet pahoja virheitä.