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
<-"http://online.jukola.com/tulokset/results_j2019_ju.xml"
urli <- read_xml(urli)
d 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)
<- data_frame()
cont_tot # for (i in 1:2){
for (i in 1:length(base)){
# Sarja
<- data_frame()
cont_tot map_df(base[i], function(x) {
<- xml_children(x)
kids 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) {
<- xml_children(x)
kids1 setNames(as.list(xml_text(kids1)), xml_name(kids1)
)-> comp_tmp
}) <- bind_cols(sarja_tmp,comp_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) {
<- xml_children(x)
kids2 setNames(as.list(xml_text(kids2)), xml_name(kids2)
)-> cont_tmp
}) <- bind_cols(comp_tmp,cont_tmp)
cont_tmp <- bind_rows(cont_tot,cont_tmp)
cont_tot # cont_tot[[i]] <- cont_tmp
}
}<- cont_tot %>% select(-leg)
cont_tot assign(x = paste0("team_",i), value = cont_tot, envir = globalenv())
}
<- do.call('bind_rows', mget(apropos(what = "team_")))
df
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 %>%
jukola_mod 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,
%>% filter(grepl("Kratov", nm)) %>% .[1,]
jukola_mod %>%
) # 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
<- tibble(leg = 1:7) %>%
leg_info mutate(length = case_when(
== 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
leg
), length_cum = cumsum(length)) -> leg_info
<- left_join(dat,leg_info)
dat2
<- dat2 %>% filter(leg == 1) %>% mutate(length_cum = 0,
d_leg_0 diff_secs = 0,
leg = 0)
<- bind_rows(d_leg_0,dat2)
d_leg_11
<- d_leg_11 # for excel
all_legs
<- d_leg_11 %>% filter(teamid %in% top10$teamid)
d_leg_111
<- c("#d18975", "#8fd175", "#3f2d54", "#75b8d1", "#2d543d", "#c9d175", "#d1ab75", "#d175b8", "#758bd1")
ipsum_palette
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() +
::geom_text_repel(data = d_leg_111 %>% filter(leg == max(leg)), aes(label = club), nudge_y = -.2, size = 2.7, family = "Roboto Condensed") +
ggrepeltheme(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ä")