-
Berinda van Dijk authored
Bugfix: filter the last-entry-table if you swam multiple times the same distance on the same day(for example prelim and final). So no 'weird' heatmaps anymore. Small bugfix: no Nan's in the city-column any more if the competition has no meet-id Small improvement: dates in heatmaps are one size bigger.
Berinda van Dijk authoredBugfix: filter the last-entry-table if you swam multiple times the same distance on the same day(for example prelim and final). So no 'weird' heatmaps anymore. Small bugfix: no Nan's in the city-column any more if the competition has no meet-id Small improvement: dates in heatmaps are one size bigger.
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
code.R 15.86 KiB
library(tidyr)
library(stringr)
library(dplyr)
library(ggplot2)
library(plotly)
library(htmlwidgets)
library(readr)
library(purrr)
library(RestRserve)
library(lubridate)
library(data.table)
dir.create("libdir")
foldername <- list.files("/tmp", pattern="Rtmp.*", full.names=TRUE)
doId <- function(input) {
id <- input$id
dates_to_drop <- input$dates_to_drop
if(is.null(dates_to_drop)) dates_to_drop <- ""
response <- list()
appendPlotly <- function(item) {
response <<- c(response, list(item))
}
appendPlot <- function(item) {
appendPlotly(ggplotly(item))
}
lettergrootte=18
regelhoogte=23
plot_tabel<-function(input_tabel){
kolombreedte=unname(sapply(input_tabel, function(x) max(nchar(as.character(x)))))
kolombreedte2=nchar(colnames(input_tabel))
kolombreedte_totaal=pmax(kolombreedte, kolombreedte2)
tabel_als_plot<-plot_ly(type = 'table', columnwidth=kolombreedte_totaal,
header = list(values=colnames(input_tabel),font=list(size=lettergrootte)),
cells = list(values =t(input_tabel),font=list(size=lettergrootte), height=regelhoogte))
return(tabel_als_plot)}
dates_to_drop=as.list(strsplit(dates_to_drop, ","))[[1]]
dates_to_drop=strptime(dates_to_drop, format="%Y-%m-%d")
dates_to_drop=ymd(dates_to_drop)
bron <- read.csv(paste0("https://swimrankings.rubend.nl/csv?requestedBy=zwemtijden&id=", id), encoding = "UTF-8")
if(length(bron)==1) {
return(bron[[1]])
}
bron$AfstandSlag <- gsub(" Lap", "", bron$stroke)
bron <- separate(bron, col = stroke, into = c("distance", "stroke", "Lap"), sep = " ", fill='right')
bron$stroke <- as.factor(bron$stroke)
bron$distance <- as.numeric(str_sub(bron$distance, end = -2))
bron$distance <- factor(bron$distance, ordered = TRUE, levels = sort(unique(bron$distance)))
bron$poolType <- as.factor(bron$poolType)
bron=bron[order(bron$stroke, bron$distance),]
bron$AfstandSlag<-factor(bron$AfstandSlag, ordered=TRUE, levels=unique(bron$AfstandSlag))
#Wat als iets niet in kleurenset_afstanden valt?
kleurenset_afstanden=c('25'='red', '50'='orange', '100'='yellow', '200'='green', '400'='blue', '800'='purple', '1500'='deeppink1','500'='black')
kleurenset_strokes=c('Backstroke'='red', "Breaststroke"='orange', "Butterfly"="purple", "Freestyle"="green", "Medley"="blue")
kleurenset_pooltypes=c('25m'='orchid', '50m'='cornflowerblue', 'OW'='limegreen')
kleurenset_Pbs=c('Pb'='maroon1', 'noPb'='black')
bron=separate(bron, col = heatType, into = c("hoofdafstand", "heatType"), sep = ", ", fill='left')
bron$heatType <- as.factor(bron$heatType)
bron$Lap=if_else(is.na(bron$Lap), FALSE, TRUE)
bron$date <- str_sub(bron$date, -11) #alleen laatste dag van wedstrijd van meerdere dagen weergeven
#bron$date<-dmy(bron$date, locale="English")
bron$date<-dmy(bron$date)
bron <- bron[bron$time != "NT",] #alle entrys met een TIJD
bron=bron[!(bron$date %in% dates_to_drop),]
bron$points <- as.integer(gsub('-', '0', bron$points))
#wedstrijdtijden converteren naar duration
bron$time <- sub("M", "", bron$time) #weet niet wat die M betekend.
bron$lengte_tijd <- str_length(bron$time)
toe_te_voegen <- "0:00:"
gewenste_lengte <- 10
bron$toe_te_voegen <- str_sub(toe_te_voegen, end = (gewenste_lengte - bron$lengte_tijd))
bron$time <- str_c(bron$toe_te_voegen, bron$time)
bron <- subset(bron, select = -c(lengte_tijd, toe_te_voegen))
bron$uren<-as.numeric(str_sub(bron$time, end=1))
bron$minuten <- as.numeric(str_sub(bron$time, start=3, end=4))
bron$seconden <- as.numeric(str_sub(bron$time, start =6))
bron$tijdsduur <- duration(second = bron$seconden, minute = bron$minuten, hour=bron$uren)
bron <- subset(bron, select = -c(minuten, seconden, uren))
bron<-separate(bron, col='city', into=c("MeetId", 'city'), sep=" - ", fill='left')#avoid empty place if theres no MeetId
bron <-bron[order(bron$date),]
bron$city=trimws(gsub('\\s+', ' ',gsub("-|'", ' ', str_replace_all(bron$city, "\\s", " "))))
bron$city<-paste(toupper(substr(bron$city, 1, 1)), substr(bron$city, 2, nchar(bron$city)), sep="")
zonder_split <- bron[bron$ranking != "Split",]#So even if your splittime is a Pb, it is not displayed by this application.
bovennul<-zonder_split[zonder_split$points !=0,]
DateAndPool<-bron %>%select('city', 'MeetId', 'date') %>%unique() %>% select('city', 'date')
DateAndPool<-DateAndPool[order(DateAndPool$date),]
plotfreq=DateAndPool %>% group_by(city) %>% mutate(count=row_number())
tussentabel=plotfreq %>% group_by(city) %>% filter(count==max(count))
tussentabel$date=max(plotfreq$date)
plotfreq=rbind(plotfreq, tussentabel)
CountsParPool_dates=ggplot(plotfreq, aes(x=date, y=count, color=city))+geom_step()+
labs(title='Cumulative number of meets par city')
CountsParPool_dates<-ggplotly(CountsParPool_dates, dynamicTicks=TRUE)
appendPlotly(CountsParPool_dates)
freqtabel=tussentabel%>%select(c('city', 'count'))
freqtabel=freqtabel[order(freqtabel$count, decreasing=TRUE),]
freqtabel_plot=plot_tabel(freqtabel)%>% layout(title = 'Number of meets par city')
appendPlotly(freqtabel_plot)
CountsParAfstandSlag_dates=bron %>% group_by(AfstandSlag) %>% mutate(count=row_number())
tussentabel=CountsParAfstandSlag_dates%>%group_by(AfstandSlag)%>%filter(count==max(count))
tussentabel$date=max(CountsParAfstandSlag_dates$date)
CountsParAfstandSlag_dates=rbind(CountsParAfstandSlag_dates, tussentabel)
Plot_CountsParAfstandSlag_dates=ggplot(CountsParAfstandSlag_dates, aes(x=date, y=count, text=AfstandSlag,
color=interaction(distance, stroke, sep="m ")))+
geom_step()+labs(color='Afstand & Slag', title='Cumulative count par distance/stroke')
Plot_CountsParAfstandSlag_dates<-ggplotly(Plot_CountsParAfstandSlag_dates, dynamicTicks=TRUE, tooltip=c('x', 'y', 'text'))
appendPlotly(Plot_CountsParAfstandSlag_dates)
tabel_Prs_metpooltype <- bovennul %>%
group_by(distance, stroke, poolType) %>%
filter(points == max(points, na.rm = TRUE)) %>%
filter(time == min(time, na.rm=TRUE))
tijdlijntabel=zonder_split %>% group_by(distance, stroke, poolType, Lap) %>%
mutate(Pb=ifelse(tijdsduur==min(tijdsduur),'Pb', 'noPb')) %>% arrange(distance, stroke, poolType, Lap)
tijdlijn_alles=ggplot(tijdlijntabel,
aes(x=date, y=interaction(distance, stroke, sep='m '), color=Pb, shape=interaction(poolType, Lap)))+
geom_point()+
labs(y='distance & stroke')+ggtitle(" ")+
scale_color_manual(values=kleurenset_Pbs)+theme(legend.position = "none")+
scale_x_date()+scale_y_discrete(limits=rev)
tijdlijn_alles<-ggplotly(tijdlijn_alles, tooltip=c('x', 'shape'), dynamicTicks=TRUE)%>%
layout(title = list(text = paste0('Datum van alle gezwommen slagen per afstand',
'<br>', '<sup>', 'rose: Pbs (inclusive timed disqualifications, exlusive split-times)','</sup>')))
appendPlotly(tijdlijn_alles)
tabel_Prs_zonderpooltype <- bovennul %>%
group_by(distance, stroke) %>%
filter(points == max(points, na.rm = TRUE)) %>% filter(time == min(time, na.rm=TRUE))
heatmap_prs <- ggplot(tabel_Prs_zonderpooltype, aes(distance, stroke, text=date)) +
geom_tile(aes(fill = points)) +
geom_text(aes(label = points), size=7) +
labs(title = "Heatmap punten per slag en afstand. Geen laptijden.") +
theme_bw()
heatmap_prs<-ggplotly(heatmap_prs, tooltip=c('text'))%>%layout(dragmode=FALSE)
appendPlotly(heatmap_prs)
tabel_LastEntrys<-zonder_split%>%
filter(Lap==FALSE)%>%
group_by(distance, stroke, poolType) %>%
filter(date == max(date, na.rm=TRUE))%>%
filter(tijdsduur==min(tijdsduur))#if you
#anders problemen als je meerdere keren hetzelfde zwemt op een dag. Misschien alleen als je verschillende heattypes hebt?
for (pooltype_loop in unique(tabel_LastEntrys$poolType)){
title_plot=paste("Last date swam - ", pooltype_loop, 'pool')
heatmap_lastswam=ggplot(tabel_LastEntrys[tabel_LastEntrys$poolType==pooltype_loop,],
aes(distance, stroke, text=date)) +
geom_tile(aes(fill = date)) + geom_text(aes(label = format(date, format="%e %b\n%Y")), size=5) +
labs(title = title_plot)+ theme_bw()
heatmap_lastswam=ggplotly(heatmap_lastswam, tooltip=FALSE)%>%
layout(dragmode=FALSE)
appendPlotly(heatmap_lastswam)
}
tabel_lastswam=tabel_LastEntrys%>%select(c('distance', 'stroke', 'poolType', 'date'))
kolombreedte=unname(sapply(tabel_lastswam, function(x) max(nchar(as.character(x)))))
kolombreedte2=nchar(colnames(tabel_lastswam))
kolombreedte_totaal=pmax(kolombreedte, kolombreedte2)
plottabel_LastSwam=plot_ly(type='table', columnwidth=kolombreedte_totaal,
header = list(values=colnames(tabel_lastswam),font=list(size=lettergrootte)),
cells=list(values=t(tabel_lastswam),
fill= list(color = list(kleurenset_pooltypes[tabel_lastswam$poolType])),
align=c('right', 'middle', 'middle', 'middle'),
height=regelhoogte,
font=list(size=lettergrootte)))
plottabel_LastSwam<-plottabel_LastSwam%>% layout(title='Last swam par distance and pooltype - no Laptimes')
appendPlotly(plottabel_LastSwam)
for (pooltype_loop in unique(tabel_LastEntrys$poolType)){
title_plot=paste("Last swam par distance and stroke - no Laptimes' - ", pooltype_loop, 'pool')
tabel_lastswam=tabel_LastEntrys[tabel_LastEntrys$poolType==pooltype_loop,]%>%ungroup()
tabel_lastswam=tabel_lastswam%>%select(c('distance', 'stroke', 'date'))
plottabel_LastSwam<-plot_tabel(tabel_lastswam)%>% layout(title=title_plot)
appendPlotly(plottabel_LastSwam)
}
breedte_perslag=unique(tabel_Prs_metpooltype[, c('distance', 'stroke')]) %>% group_by(stroke) %>%count()
breedte_perslag=breedte_perslag$n
breedte_perslag=breedte_perslag/(breedte_perslag%>%sum())
barplot_facets<-function(x){
ggplotly(
ggplot(data=x, aes(fill=distance, y=points, x=distance, label=poolType, text=date))+
geom_col(position=position_dodge2(preserve='single'))+
scale_fill_manual(values=kleurenset_afstanden, limits=force)+
scale_y_continuous(expand=c(0,0), limits=c(0, max(tabel_Prs_metpooltype$points)+15))+
theme(panel.grid.major = element_blank())+ggtitle(" ")+
facet_wrap(.~stroke, scales='free_x'),
tooltip=c('x', 'y', 'label', 'text'))}
facetwrap_prs=tabel_Prs_metpooltype[order(tabel_Prs_metpooltype$poolType),] %>%filter(Lap==FALSE) %>% split(.$stroke) %>%map(barplot_facets)
facetwrap_prs=facetwrap_prs %>% subplot(widths=breedte_perslag, margin=0.01, shareY=TRUE) %>%
layout(showlegend=FALSE, dragmode=FALSE, title='Prs')
appendPlotly(facetwrap_prs)
tabel_lasts=tabel_LastEntrys[order(tabel_LastEntrys$poolType),]%>%filter(points!=0)
facetwrap_lasts=tabel_lasts %>% split(.$stroke) %>%map(barplot_facets) facetwrap_lasts=facetwrap_lasts %>% subplot(widths=breedte_perslag, margin=0.01, shareY=TRUE) %>%
layout(showlegend=FALSE, dragmode=FALSE, title='Last entrys. Only points >0, and no laptimes.')
appendPlotly(facetwrap_lasts)
stippenplot_sizes<-ggplot(bovennul, aes(x=date, y=points, color=stroke, size=distance, group=AfstandSlag))+
geom_point() +
scale_color_manual(values=kleurenset_strokes)+
labs(title = "Punten >0 per datum per afstand")
stippenplot_sizes<-ggplotly(stippenplot_sizes, tooltip=c('x', 'y', 'size'))
appendPlotly(stippenplot_sizes)
lijnenplot_ineen=ggplot(bovennul, aes(x = date, y = points, text=AfstandSlag,
color=interaction(distance, stroke, sep='m '),
linetype=poolType, shape=poolType)) +
labs(title = "Points, grouped by pooltype", color='Distance & stroke') +guides(shape='none', linetype='none')+
geom_line()+geom_point()
lijnenplot_ineen=ggplotly(lijnenplot_ineen, tooltip=c('date', 'points', 'text', 'shape'), dynamicTicks=TRUE)
naam_laatstgezien=''
for (i in 1:length(lijnenplot_ineen$x$data)){
goede_naam=substring(unlist(strsplit(lijnenplot_ineen$x$data[[i]]$name, ','))[1], 2)
lijnenplot_ineen$x$data[[i]]$name <- goede_naam
lijnenplot_ineen$x$data[[i]]$legendgroup <- goede_naam
if (naam_laatstgezien==goede_naam){
lijnenplot_ineen$x$data[[i]]$showlegend=FALSE
}
naam_laatstgezien=goede_naam}
appendPlotly(lijnenplot_ineen)
for (pooltype_loop in unique(bovennul$poolType)){
title_plot=paste("Points - ", pooltype_loop, 'pool')
lijnenplot_pooltype=ggplot(bovennul[bovennul$poolType==pooltype_loop,],
aes(x = date, y = points, text=AfstandSlag,
color = interaction(distance, stroke, sep='m '))) +
labs(title = title_plot, color="Distance & stroke") + geom_line()+geom_point()
lijnenplot_pooltype=ggplotly(lijnenplot_pooltype, dynamicTicks=TRUE, tooltip=c('x','y', 'text'))
appendPlotly(lijnenplot_pooltype)
}
datumformat="'%y"
for (pooltype in unique(zonder_split$poolType)){
lijnenplot_gesplitst <- ggplot(zonder_split[zonder_split$poolType==pooltype,],
aes(x = date, y = tijdsduur, color = stroke)) +
labs(y = "Time", title = pooltype) +
geom_line() + geom_point(size=1)+
scale_y_time(labels = function(t) strftime(t, "%H:%M:%S"))+
scale_x_date(labels=function(t) strftime(t, datumformat))+
scale_colour_manual(values=kleurenset_strokes)+
facet_wrap(vars(distance), scales = 'free_y')
lijnenplot_gesplitst=ggplotly(lijnenplot_gesplitst, tooltip=c('x', 'y')) %>%
layout(dragmode=FALSE, legend=list(orientation='h'), yaxis = list(hoverformat = '%H:%M:%S'))
appendPlotly(lijnenplot_gesplitst)
}
#LAPS compared to other
tabel_LAPtovNormal=bron%>%filter(AfstandSlag %in% (bron%>%filter(Lap==TRUE))$AfstandSlag)
plot_LAPtovNormal<-ggplot(tabel_LAPtovNormal, aes(x=date, y=tijdsduur,
shape=poolType, color=Lap, linetype=poolType))+
labs(y='Time')+
geom_line()+geom_point()+
scale_y_time(labels = function(t) strftime(t, "%M:%S"), minor_breaks=NULL)+#Times >hour not expected
scale_x_date(labels=function(t) strftime(t, datumformat), minor_breaks=NULL)+
facet_grid(rows=vars(distance), cols=vars(stroke), scales='free_y')
plot_LAPtovNormal=ggplotly(plot_LAPtovNormal, tooltip=c('x', 'y'))%>%
layout(dragmode=FALSE, yaxis = list(hoverformat = '%M:%S'))
appendPlotly(plot_LAPtovNormal)
return(response)
}
app <- Application$new()
app$add_get( path = "/",
FUN = function(.req, .res) {
if(length(.req$parameters_query)==0) {
.res$set_content_type("text/html; charset=utf-8")
.res$set_body(read_file("index.html"))
return()
}
dir.create(foldername[[1]])
response <- doId(.req$parameters_query)
htmltools::save_html(response, file="test.html", libdir = "libdir")
response <- read_file("test.html")
style <- "<style>
body, html, .html-widget {
height: 100% !important;
width: 100% !important;
}
</style>"
.res$set_content_type("text/html; charset=utf-8")
.res$set_body(paste0(response, style))
})
app$add_get(
path = "/restart",
FUN = function(.req, .res) {
system("pkill R")
})
app$add_static("/libdir", "libdir")
backend <- BackendRserve$new()
swimmerData <- tryCatch(
{
df <- read.table(file= 'swimmerId.txt', header=FALSE, sep='=', col.names=c('Key', 'Value'))
output <- list()
for (row in seq_len(nrow(df))) {
output[[df$Key[row]]] <- df$Value[row]
}
output
},
warning = function(cond) {
print("WARNING:")
print(cond)
test <- 0
test
},
error = function(cond) {
print("ERROR:")
print(cond)
test <- 0
test
}
)
if (swimmerData != 0) {
doId(swimmerData)
} else {
args <- commandArgs(trailingOnly = TRUE)
if (length(args) == 1 && args[1] == "test") quit(status = 0)
backend$start(app, http_port = 8080)
}