Kaksi kuvaa Kangasalan Jukolasta

Jukolan viesti juostiin viikko sitten Kangasalla ja voiton vei ruotsalainen Stora Tuna. Päivitin viime vuotisia R-koodeja

Jos et jaksa kahlata koodia läpi ja haluat nähdä vain parhaan kuvan klikkaa alta

Data

Jukolan tulospalvelusta saa datan xml-muodossa tästä http://online.jukola.com/tulokset/results_j2019_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)

##################################################################################
# DATA


urli <-"http://online.jukola.com/tulokset/results_j2019_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())
}

df <- do.call('bind_rows', mget(apropos(what = "team_")))

assign(x = "jukola", value = df, envir = globalenv())
rm(list=apropos(what = "team_"))

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, 
         !teamid %in% c(601,1409,1654,172,26)
         # teamid %in% c(1)
         ) -> tmp


# korjataan Kratov
bind_rows(tmp,
          jukola_mod %>% filter(grepl("Kratov", nm)) %>% .[1,]
          ) %>% 
# 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

leg_info <-   tibble(leg = 1:7) %>% 
  mutate(length = case_when(
    leg == 1 ~ 10.7,
    leg == 2 ~ 10.4,
    leg == 3 ~ 13.1,
    leg == 4 ~ 7.2,
    leg == 5 ~ 7.7,
    leg == 6 ~ 11.0,
    leg == 7 ~ 12.8
  ), 
  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ä 2019",
       subtitle = "Ero kärkeen vaihdoissa",
       caption = paste0("Data: http://online.jukola.com/tulokset/results_j2019_ju.xml\n",Sys.time()),
       x = "osuus", y = "minuuttia kärjestä")

Uudelleenkäyttö

CC BY 4.0

Viittaus

BibTeX-viittaus:

@online{kainu,
  author = {Markus Kainu and Markus Kainu},
  title = {Kaksi kuvaa Kangasalan Jukolasta},
  date = {},
  url = {https://markuskainu.fi/posts/2019-06-22-jukola-kangasala},
  langid = {fi}
}

Viitatkaa tähän teokseen seuraavasti:

Markus Kainu, and Markus Kainu. n.d. “Kaksi kuvaa Kangasalan Jukolasta.” https://markuskainu.fi/posts/2019-06-22-jukola-kangasala.