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ä.