R/app_server.R
In joseph-shaw/OpenTrack: OpenTrack
Defines functions
app_server
#' The application server-side
#'
#' @param input,output,session Internal parameters for {shiny}.
#' DO NOT REMOVE.
#' @import shiny
#' @import tidyr
#' @import DT
#' @noRd
# Module for splash screen
#splash_server <- function(input, output, session) {
# hide("splash_screen", anim = F, animType = "fade", time = 3)
#}
app_server <- function( input, output, session ) {
# List the first level callModules here
callModule(mod_splash_module_server, "splash_module_ui_1")
#tags$head(tags$style(HTML(".content { padding-top: 1000 !important;}")))
callModule(mod_upload_page_server, "upload_page_ui_1")
callModule(mod_analyse_page_server, "analyse_page_ui_1")
callModule(mod_dashboard_page_server, "dashboard_page_ui_1")
callModule(mod_database_page_server, "database_page_ui_1")
callModule(mod_longitudinal_page_server, "longitudinal_page_ui_1")
callModule(mod_squad_dashboard_server, "squad_dashboard_ui_1")
callModule(mod_session_dashboard_server, "session_dashboard_ui_1")
delay(200, show("dash"))
# Options -----------------------------------------------------------------
options(shiny.maxRequestSize = 70*1024^3,
browser = "C:/Program Files/Mozilla Firefox/firefox.exe",
shiny.usecairo=T)
# ~ Load SQL db -----------------------------------------------------------
sql <- read.csv("settings/sql.csv")
if(use.sql()){
conn <- DBI::dbConnect(odbc::odbc(),
Driver = sql$Driver,
Server = sql$Server,
Database = sql$Database,
#Trusted_Connection = "True",
UID = sql$UID,
PWD = rstudioapi::askForPassword("Database password") #sql$PWD
#Port = 1433
)
}
# ~ ~ Add session ------------------------------------------------------
# 1
observeEvent(input$addsession1, {
data$df <- data$df %>%
mutate(
session.type = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessiontype, session.type),
session.name = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionname, session.name),
session.num = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionnumber, session.num)
)
raw_data <- Window() %>%
mutate(
time = as.POSIXct(as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time)),
row_number = seq(1, nrow(Window()), 1)/100
)
n <- colnames(raw_data)
colnames(raw_data) <- gsub("\\.", "_", n)
#write.csv(sb_upload, "test1.csv")
user.id <- 28731 # define this
push_to_sb <- sql$smartabase == 1
if(push_to_sb){
athlete <- input$select_athlete
sb_id <- neon::pull_smartabase(
form = "Personal Details",
filter_user_key = "about",
filter_user_value = athlete,
start_date = "01/01/2000",
end_date = "01/01/2100"
)
sb_id <- sb_id$user_id[1]
sb_upload <- summary() %>%
rename(
Date = session_date,
About = athlete_name,
dummy = is_dummy,
ballet = session_name,
start_time = starttime,
end_time = endtime,
total.duration = total_dur,
Total.pl = total_pl,
Total.pl.active = active_pl,
Jumps = Jumps,
J.6_10 = Jumps_6_10 ,
J.10_15 = Jumps_10_15,
J.15_20 = Jumps_15_20,
J.20_25 = Jumps_20_25,
J.25_30 = Jumps_25_30,
J.30_35 = Jumps_30_35,
J.35_40 = Jumps_35_40,
J.40_45 = Jumps_40_45,
J.45_50 = Jumps_45_50,
J.50_55 = Jumps_50_55,
J.55_60 = Jumps_55_60,
J.60_65 = Jumps_60_65,
J.65_70 = Jumps_65_70,
J.70_75 = Jumps_70_75,
J.75_80 = Jumps_75_80,
s.jumps = s_jumps,
m.jumps = m_jumps,
l.jumps = l_jumps,
count_1.5 = C_count_1_5,
count_2.0 = C_count_2_0,
count_2.5 = C_count_2_5,
count_3.0 = C_count_3_0,
count_3.5 = C_count_3_5,
count_4.0 = C_count_4_0,
count_4.5 = C_count_4_5,
count_5.0 = C_count_5_0,
count_5.5 = C_count_5_5,
count_6.0 = C_count_6_0,
count_6.5 = C_count_6_5,
count_7.0 = C_count_7_0,
count_7.5 = C_count_7_5,
count_8.0 = C_count_8_0,
count_8.5 = C_count_8_5,
count_9.0 = C_count_9_0,
"c_9.0+" = C_count_10_0,
) %>%
mutate(
start_time = as.character(format(as_datetime(r_starttime), format = "%H:%M %p")),
start_time = ifelse(substr(start_time, 7,8) == "PM", paste0(as.numeric(substr(start_time, 1,2))-12, substr(start_time, 3,6), "PM"), start_time),
end_time = as.character(format(as_datetime(r_endtime), format = "%H:%M %p")),
end_time = ifelse(substr(end_time, 7,8) == "PM", paste0(as.numeric(substr(end_time, 1,2))-12, substr(end_time, 3,6), "PM"), end_time),
current_time_ampm = "00:00 AM",
current_end_time_ampm = "00:00 AM",
user_id = sb_id,
Date = NA,
Date = as.character(Date),
Date = paste(sep = "/", formatC(lubridate::day(r_starttime), width = 2, flag = 0, format = "d"), formatC(lubridate::month(r_starttime), width = 2, flag = 0, format = "d"), lubridate::year(r_starttime)),
#start_date = "09/09/2022",
#end_date = "09/09/2022",
)
neon::push_smartabase(
sb_upload,
form = "33 TL Database",
entered_by_user_id = user.id
)
}
if(use.sql()){
dbWriteTable(conn = conn, "training_load", summary() , append = TRUE)
db$db <- dbGetQuery(conn, "Select * from training_load;")
dbWriteTable(conn = conn, "raw_training_load", raw_data, append = TRUE)
}else{
#write.csv(summary(), "test2.csv")
new.row <- summary()
#new.row$session_id <- max(as.numeric(db$db$session_id), na.rm = T) +1
db$db <- plyr::rbind.fill(db$db, new.row) %>%
dplyr::filter(!is.na(session_id))
write.csv(db$db, "database.csv", row.names = F)
folder <- paste0("clipped-sessions/", input$select_athlete, "/", gsub(":", "-", substr(input$Graph1_date_window[1], 1, 10)))
filename <- paste0(folder, "/", stringr::str_replace_all(paste0(paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 1, 16)), ".csv")), " ", "-"))
dir.create(paste0("clipped-sessions/", input$select_athlete), showWarnings = FALSE)
dir.create(folder, showWarnings = FALSE)
write.csv(
raw_data,
filename, row.names = F)
}
})
# 2
observeEvent(input$addsession2, {
data$df <- data$df %>%
mutate(
session.type = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessiontype, session.type),
session.name = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionname, session.name),
session.num = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionnumber, session.num)
)
raw_data <- Window() %>%
mutate(
time = as.POSIXct(as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time)),
row_number = seq(1, nrow(Window()), 1)/100
)
n <- colnames(raw_data)
colnames(raw_data) <- gsub("\\.", "_", n)
if(use.sql()){
dbWriteTable(conn = conn, "training_load", summary() , append = TRUE)
db$db <- dbGetQuery(conn, "Select * from training_load;")
dbWriteTable(conn = conn, "raw_training_load", raw_data, append = TRUE)
}else{
new.row <- summary()
#new.row$session_id <- max(as.numeric(db$db$session_id), na.rm = T) +1
db$db <- plyr::rbind.fill(db$db, new.row) %>%
dplyr::filter(!is.na(session_id))
write.csv(db$db, "database.csv", row.names = F)
folder <- paste0("clipped-sessions/", input$select_athlete, "/", gsub(":", "-", substr(input$Graph1_date_window[1], 1, 10)))
filename <- paste0(folder, "/", stringr::str_replace_all(paste0(paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 1, 16)), ".csv")), " ", "-"))
dir.create(paste0("clipped-sessions/", input$select_athlete), showWarnings = FALSE)
dir.create(folder, showWarnings = FALSE)
write.csv(
raw_data,
filename, row.names = F)
}
})
# ~ ~ Delete row ------------------------------------------------------
observeEvent(input$droprowbutton, {
if(use.sql()){
dbSendStatement(conn, paste0("DELETE FROM training_load WHERE session_id = ", input$rowref))
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db <- db$db %>%
dplyr::filter(session_id != input$rowref)
write.csv(db$db, "database.csv", row.names = F)
}
})
# ~ ~ Edit cell -------------------------------------------------------
observeEvent(input$SQLinputbutton, {
if(use.sql()){
dbSendStatement(conn, paste0("UPDATE training_load SET ", input$columnref, " = '", input$newinput, "' WHERE session_id = ", input$rowref))
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db[input$rowref, input$columnref] <- input$newinput
write.csv(db$db, "database.csv", row.names = F)
}
})
# ~ ~ Download db csv --------------------------------------------------
observeEvent(input$db_csv, {
write.csv(
db$db,
paste("database_export", Sys.Date(), ".csv"),
row.names = F
)
})
# ~ Load TL data into reactive value -----------------------------------
db <- reactiveValues(
db = NULL
)
# # Load longitudinal analysis data
# long <- reactiveValues(
# data = NULL
# )
#
# long$data <-reactive(
# db$db %>%
# filter(
# athlete_name == input$select_athlete2,
# session_date >= input$date_range[1],
# session_date <= input$date_range[2]
# )
# )
# Create date slider
output$date_range <- renderUI({
sliderInput("date_range", "Select Date Range:",
min = min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max = max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), value = c(min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T)),
timeFormat = "%F", ticks = F
)
})
# Load data
if(use.sql()){
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db <- read.csv("database.csv")
}
# Create datatable
output$table <- renderDataTable({
db$db
},
options = list(
lengthMenu = list(
c(3, 4, 5, 6, 10, -1),
c('3', '4', '5', '6', '10', 'All')
),
pageLength = 3,
filter = 'top',
server = TRUE,
searchable = FALSE,
searching = F
)
)
# ~ Load athlete data into reactive value ------------------------------
athletes <- reactiveValues(
athletes = NULL
)
# Load data
if(use.sql()){
athletes$athletes <- as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
}else{
athletes$athletes <- read.csv("settings/athletes.csv")[,1]
}
# Create dropdown
output$select_athlete <- renderUI({
selectInput('select_athlete',
label ='Select Athlete',
choices=athletes$athletes,
selected = NULL, multiple = FALSE)
})
output$select_athlete2 <- renderUI({
selectInput('select_athlete2',
label ='Select Athlete',
choices=athletes$athletes,
selected = NULL, multiple = FALSE)
})
# Add new athlete
observeEvent(input$new_athlete, {
athlete_details <- data.frame(
athlete_name = input$new_name,
sex = input$new_sex,
dob = input$new_dob,
email_address = input$new_email
)
if(use.sql()){
dbWriteTable(conn = conn, "athletes", athlete_details, append = TRUE)
athletes$athletes <- as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
}else{
write.csv(plyr::rbind.fill(read.csv("settings/athletes.csv"), athlete_details), "settings/athletes.csv", row.names = F)
athletes$athletes <- plyr::rbind.fill(read.csv("settings/athletes.csv"), athlete_details)[,1]
}
})
filepaths <- read.csv("settings/filepaths.csv")
roots <- filepaths[,2]
names(roots) <- filepaths[,1]
# Filepaths --------------------------------------------------------------
# File select
shinyFiles::shinyFileChoose(input, 'Central', root=roots, filetypes='csv')
shinyFiles::shinyFileChoose(input, 'Left', root=roots, filetypes='csv')
shinyFiles::shinyFileChoose(input, 'Right', root=roots, filetypes='csv')
# ~ Output filepaths ------------------------------------------------------
output$filepath1 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Central)$datapath[1])){NULL
}else(
paste("Central:",
parseFilePaths(roots = roots,input$Central)$datapath[1])
)
})
output$filepath2 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Left)$datapath[1])){NULL
}else(
paste("Left:",
parseFilePaths(roots = roots,input$Left)$datapath[1])
)
})
output$filepath3 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Right)$datapath[1])){NULL
}else(
paste("Right:",
parseFilePaths(roots = roots,input$Right)$datapath[1])
)
})
# Value Boxes -------------------------------------------------------------
output$value_box.1 <- renderValueBox({
valueBox(sum(Window()$C.Jump, na.rm = TRUE), "Jumps", icon = icon("arrow-alt-circle-up"), width = 2, color = "yellow")
})
output$value_box.2 <- renderValueBox({
valueBox(length(which(Window()$C.jh <= 15 & Window()$C.jh > 0 & Window()$C.Jump == 1)), "Small Jumps", icon = icon("angle-up"), width = 2, color = "yellow")
})
output$value_box.3 <- renderValueBox({
valueBox(length(which(Window()$C.jh <= 30 & Window()$C.jh > 15 & Window()$C.Jump == 1)), "Medium Jumps", icon = icon("angle-double-up"), width = 2, color = "yellow")
})
output$value_box.4 <- renderValueBox({
valueBox(length(which(Window()$C.jh > 30 & Window()$C.jh < 100 & Window()$C.Jump == 1)), "Large Jumps", icon = icon("fighter-jet"), width = 2, color = "yellow")
})
output$value_box.5 <- renderValueBox({
valueBox(paste0(round(sum(Window()$C.jh[Window()$C.Jump == 1], na.rm = T)/100), " m"), "Height Jumped", icon = icon("sort-amount-up"), width = 2, color = "yellow")
})
output$value_box.6 <- renderValueBox({
valueBox(paste(round(Time()[3]/100/60), " min"), "Total Duration", icon = icon("clock"), width = 2, color = "yellow")
})
# Main Data Processing ----------------------------------------------------
data <- reactiveValues(df = NULL)
#Load raw file and add to create DF
observeEvent(input$processraw, {
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
# Filter settings
run.filter <- TRUE
data.freq <- 100
order <- 4
filt.freq <- 12
nyquist.freq <- data.freq / 2
bf <- signal::butter(order, filt.freq / nyquist.freq, type="low")
if(input$time_unit == "ms"){time_unit <- 1000}
if(input$time_unit == "s / 100"){time_unit <- 100}
if(input$time_unit == "s / 10"){time_unit <- 10}
if(input$time_unit == "s"){time_unit <- 1}
invert <- as.numeric(input$invertup) #Add a variable to flip up and down
up <- as.numeric(input$orientation)
ach <- 1 %in% input$tissue_forces
tib <- 2 %in% input$tissue_forces
pat <- 3 %in% input$tissue_forces
grf <- 4 %in% input$tissue_forces
# loop through central, left, and right files
if(is.na(file.list[1])){order <- c(2,3,1)}else{order <- 1:3}
for(i in order){
if(is.na(file.list[i])){DF <- data.table::fread("frame.csv") %>% mutate(time = ms/1000)}else{
DF <- process_imu_data(file = file.list[i], run.filter = run.filter, bf = bf, invert = invert, time_unit = time_unit, up = up)
}
#Rename cols
if(i == 1){names(DF)[2:ncol(DF)] <- paste0("C.", names(DF)[2:ncol(DF)])}
if(i == 2){names(DF)[2:ncol(DF)] <- paste0("L.", names(DF)[2:ncol(DF)])}
if(i == 3){names(DF)[2:ncol(DF)] <- paste0("R.", names(DF)[2:ncol(DF)])}
#bind dfs
if(i == order[1]){combined.DF <- DF}else{combined.DF <- cbind.fill(combined.DF, DF[,2:ncol(DF)], fill = 0)}
}
if(
!is.na(file.list[1]) & !is.na(file.list[2]) & !is.na(file.list[3]) &
(ach | tib | pat | grf)
){
tissue_force_data <- tissue_force(
waist = file.list[1],
l.shank = file.list[2],
r.shank = file.list[3],
ach = ach,
tib = tib,
pat = pat,
grf = grf,
invert = invert == 1
) %>%
replace_na(
list(
left_achilles = 0,
right_achilles = 0,
left_grf = 0,
right_grf = 0,
left_pat.tendon = 0,
right_pat.tendon = 0,
left_tibia = 0,
right_tibia = 0
)
)
write.csv(tissue_force_data, "tissueforce1.csv")
}
DF <- combined.DF %>%
mutate(
Time = seq(from = 1, to = nrow(combined.DF)/100, by = 0.01)[1:nrow(combined.DF)],
#time = seq(from = 1, to = nrow(combined.DF)/100, by = 0.01)[1:nrow(combined.DF)],
sec.group = ceiling(Time),
min.group = ceiling(Time/60),
session.type = NA,
session.name = NA,
session.num = NA,
athlete.name = "temp",
C.res.acc = as.numeric(C.res.acc),
R.res.acc = as.numeric(R.res.acc),
L.res.acc = as.numeric(L.res.acc),
row_number = as.numeric(row.names(combined.DF))
) %>%
# select cols to keep
select(
row_number, athlete.name, session.type, session.name, session.num, time,
C.res.acc, C.peak.mag, C.f.time, C.Jump, C.jh, C.PL, C.acc.zone, C.acc.zone.time, C.ma.Peak, C.raw.peak.mag, C.active.time,
L.res.acc, L.peak.mag, L.f.time, L.Jump, L.jh, L.PL, L.acc.zone, L.acc.zone.time, L.ma.Peak, L.raw.peak.mag, L.active.time,
R.res.acc, R.peak.mag, R.f.time, R.Jump, R.jh, R.PL, R.acc.zone, R.acc.zone.time, R.ma.Peak, R.raw.peak.mag, R.active.time#,
#C.x.acc, C.y.acc, C.z.acc, C.up.id
)
if(exists("tissue_force_data")){
DF <- DF %>%
left_join(tissue_force_data, by = "time")
}else{
DF <- DF %>%
mutate(
left_achilles = NA,
right_achilles = NA,
left_grf = NA,
right_grf = NA,
left_pat.tendon = NA,
right_pat.tendon = NA,
left_tibia = NA,
right_tibia = NA
)
}
data$df <- DF
#write.csv(tissue_force_data, "tissueforce1.csv")
#write.csv(DF, "tissueforce.csv")
})
# Clip data to window --------------------------------------------------
# ~ Start/finish times ---------------------------------------------
Time <- reactive({
Date <- substr(input$starttime, 1, 10)
Session.Start.ref <- substr(input$Graph1_date_window[1], 12, 19)
Session.End.ref <- substr(input$Graph1_date_window[2], 12, 19)
Unit.Start.ref <- strptime(input$starttime, "%Y-%m-%d %H:%M:%OS")
Unit.Start <- strptime(paste(Unit.Start.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Session.Start <- strptime(paste(Date, Session.Start.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Session.End <- strptime(paste(Date, Session.End.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Start <- sqrt(((as.numeric(difftime(Unit.Start, Session.Start, units ='secs')))*100) ^ 2)
Duration <- sqrt(((as.numeric(difftime(Session.Start, Session.End, units ='secs')))*100) ^ 2)
End <- Start + Duration
c(Start,End,Duration)
#c(Session.Start.ref, Session.End.ref, Unit.Start.ref)
})
# ~ Subset Data --------------------------------------------------
Window <- reactive({
start <- Time()[1]
end <- Time()[2]
subset(data$df, row_number >= start & row_number <= end) %>%
mutate(athlete.name = input$select_athlete)
})
# Create new row data ----
summary1 <- eventReactive(input$filename.go, {
head(file())
})
# Summary Data ------------------------------------------------------------
# ~ Create data ---------------------------------------------------------
summary <- reactive({
#sum_cols <- read.csv("settings/export.csv") %>%
# as.vector()
cols <- colnames(read.csv("settings/export.csv"))
data.frame(
session_id = ifelse(is.numeric(max(as.numeric(db$db$session_id), na.rm = T)), round(max(as.numeric(db$db$session_id), na.rm = T) + 1, digits = 0), 1),
athlete_name = input$select_athlete,
session_date = paste(substr(input$starttime, 1, 4), substr(input$starttime, 6, 7), substr(input$starttime, 9, 10), sep = '-'),
season = "2020/21",
is_dummy = NA,
session_num = input$sessionnumber,
session_type = input$sessiontype,
session_name = input$sessionname,
comments = input$comments,
position_name = input$position,
starttime = substr(input$Graph1_date_window[1], 12, 19),
endtime = substr(input$Graph1_date_window[2], 12, 19),
r_starttime = input$Graph1_date_window[1],
r_endtime = input$Graph1_date_window[2],
total_dur = round(Time()[3] / 60 / 100, 0),
#active_dur = length(which(Window()$C.active.time != 0))/100/60#,
rpe = input$rpe,
srpe = ifelse(input$durationoverride == "0", round(Time()[3] / 60 / 100, 0)* as.numeric(input$rpe), as.numeric(input$durationoverride) * as.numeric(input$rpe)),
total_pl = sum(Window()$C.PL, na.rm = TRUE),
active_pl = sum(Window()$C.PL.active, na.rm = TRUE),
DSL = sum(subset(Window(), C.peak.mag >2)$C.peak.mag, na.rm = TRUE),
Jumps = sum(Window()$C.Jump, na.rm = TRUE),
Jumps_6_10 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 5 & Window()$C.jh < 10)),
Jumps_10_15 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 10 & Window()$C.jh < 15)),
Jumps_15_20 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 15 & Window()$C.jh < 20)),
Jumps_20_25 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 20 & Window()$C.jh < 25)),
Jumps_25_30 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 25 & Window()$C.jh < 30)),
Jumps_30_35 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 30 & Window()$C.jh < 35)),
Jumps_35_40 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 35 & Window()$C.jh < 40)),
Jumps_40_45 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 40 & Window()$C.jh < 45)),
Jumps_45_50 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 45 & Window()$C.jh < 50)),
Jumps_50_55 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 50 & Window()$C.jh < 55)),
Jumps_55_60 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 55 & Window()$C.jh < 60)),
Jumps_60_65 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 60 & Window()$C.jh < 65)),
Jumps_65_70 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 65 & Window()$C.jh < 70)),
Jumps_70_75 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 70 & Window()$C.jh < 75)),
Jumps_75_80 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 75 & Window()$C.jh < 80)),
s_jumps = length(which(Window()$C.jh <= 15 & Window()$C.jh > 0 & Window()$C.Jump == 1)),
m_jumps = length(which(Window()$C.jh >= 15 & Window()$C.jh < 30 & Window()$C.Jump == 1)),
l_jumps = length(which(Window()$C.jh >= 30 & Window()$C.jh < 80 & Window()$C.Jump == 1)),
C_count_1_5 = length(which(Window()$C.acc.zone == 1.5)),
C_count_2_0 = length(which(Window()$C.acc.zone == 2.0)),
C_count_2_5 = length(which(Window()$C.acc.zone == 2.5)),
C_count_3_0 = length(which(Window()$C.acc.zone == 3.0)),
C_count_3_5 = length(which(Window()$C.acc.zone == 3.5)),
C_count_4_0 = length(which(Window()$C.acc.zone == 4.0)),
C_count_4_5 = length(which(Window()$C.acc.zone == 4.5)),
C_count_5_0 = length(which(Window()$C.acc.zone == 5.0)),
C_count_5_5 = length(which(Window()$C.acc.zone == 5.5)),
C_count_6_0 = length(which(Window()$C.acc.zone == 6.0)),
C_count_6_5 = length(which(Window()$C.acc.zone == 6.5)),
C_count_7_0 = length(which(Window()$C.acc.zone == 7.0)),
C_count_7_5 = length(which(Window()$C.acc.zone == 7.5)),
C_count_8_0 = length(which(Window()$C.acc.zone == 8.0)),
C_count_8_5 = length(which(Window()$C.acc.zone == 8.5)),
C_count_9_0 = length(which(Window()$C.acc.zone == 9.0)),
C_count_9_5 = length(which(Window()$C.acc.zone == 9.5)),
C_count_10_0 = length(which(Window()$C.acc.zone > 9.5)),
R_count_1_5 = length(which(Window()$R.acc.zone == 1.5)),
R_count_2_0 = length(which(Window()$R.acc.zone == 2.0)),
R_count_2_5 = length(which(Window()$R.acc.zone == 2.5)),
R_count_3_0 = length(which(Window()$R.acc.zone == 3.0)),
R_count_3_5 = length(which(Window()$R.acc.zone == 3.5)),
R_count_4_0 = length(which(Window()$R.acc.zone == 4.0)),
R_count_4_5 = length(which(Window()$R.acc.zone == 4.5)),
R_count_5_0 = length(which(Window()$R.acc.zone == 5.0)),
R_count_5_5 = length(which(Window()$R.acc.zone == 5.5)),
R_count_6_0 = length(which(Window()$R.acc.zone == 6.0)),
R_count_6_5 = length(which(Window()$R.acc.zone == 6.5)),
R_count_7_0 = length(which(Window()$R.acc.zone == 7.0)),
R_count_7_5 = length(which(Window()$R.acc.zone == 7.5)),
R_count_8_0 = length(which(Window()$R.acc.zone == 8.0)),
R_count_8_5 = length(which(Window()$R.acc.zone == 8.5)),
R_count_9_0 = length(which(Window()$R.acc.zone == 9.0)),
R_count_9_5 = length(which(Window()$R.acc.zone == 9.5)),
R_count_10_0 = length(which(Window()$R.acc.zone > 9.5)),
L_count_1_5 = length(which(Window()$L.acc.zone == 1.5)),
L_count_2_0 = length(which(Window()$L.acc.zone == 2.0)),
L_count_2_5 = length(which(Window()$L.acc.zone == 2.5)),
L_count_3_0 = length(which(Window()$L.acc.zone == 3.0)),
L_count_3_5 = length(which(Window()$L.acc.zone == 3.5)),
L_count_4_0 = length(which(Window()$L.acc.zone == 4.0)),
L_count_4_5 = length(which(Window()$L.acc.zone == 4.5)),
L_count_5_0 = length(which(Window()$L.acc.zone == 5.0)),
L_count_5_5 = length(which(Window()$L.acc.zone == 5.5)),
L_count_6_0 = length(which(Window()$L.acc.zone == 6.0)),
L_count_6_5 = length(which(Window()$L.acc.zone == 6.5)),
L_count_7_0 = length(which(Window()$L.acc.zone == 7.0)),
L_count_7_5 = length(which(Window()$L.acc.zone == 7.5)),
L_count_8_0 = length(which(Window()$L.acc.zone == 8.0)),
L_count_8_5 = length(which(Window()$L.acc.zone == 8.5)),
L_count_9_0 = length(which(Window()$L.acc.zone == 9.0)),
L_count_9_5 = length(which(Window()$L.acc.zone == 9.5)),
L_count_10_0 = length(which(Window()$L.acc.zone > 9.5)),
L_DSL = sum(subset(Window(), L.peak.mag >2)$L.peak.mag, na.rm = TRUE),
R_DSL = sum(subset(Window(), R.peak.mag >2)$R.peak.mag, na.rm = TRUE)
) #%>%
#select(
# cols
#)
})
# ~ Output Data ----------------------------------------------------------
output$summarydata1 <- renderDataTable({
summary()
# DT::datatable(summary(),
# extensions = 'Buttons',
# options = list(
# searching = F,
# paging = F,
# dom = 'Bfrtip',
# buttons = c('copy', 'csv', 'excel')
# )
#
# )
},
options = list(searching = F,
paging = F
)
)
# Analysis Page Plots --------------------------------------------------
# ~ Wrangle time series ------------------------------------
# Central Plot
time.series <- reactive({
df1 <- data$df
df1 <- df1[seq(from = 1, to = nrow(df1), by = 50),] %>%
select(C.res.acc, L.res.acc, R.res.acc)
x <- nrow(df1)
TimeSeries <- seq(from = 0.00, to = x, by = 0.5) # 2 Hz (x*0.5)
#TimeSeries <- seq(from = 0.00, to = (x*0.01), by = 0.01) # 100 Hz
TimeSeries <- as.POSIXct(TimeSeries, tz = "GMT", strptime(input$starttime, "%Y-%m-%d %H:%M:%OS"))
xts(df1, order.by = TimeSeries[1:x])
})
# L and R plot
time.series2 <- reactive({
df1 <- Window()
df1 <- df1[seq(from = 1, to = nrow(df1), by = 50),] %>%
select(C.res.acc, C.PL, C.DSL, C.Jump)
x <- nrow(df1)
TimeSeries <- seq(from = 0.00, to = x, by = 0.5) # 2 Hz
#TimeSeries <- seq(from = 0.00, to = (x*0.01), by = 0.01) # 100 Hz
TimeSeries <- as.POSIXct(TimeSeries, tz = "GMT", strptime(input$starttime, "%Y-%m-%d %H:%M:%OS"))
xts(df1, order.by = TimeSeries[1:x])
})
# ~ Create plots --------------------------------------------------
output$Graph1 <- renderDygraph(
dygraph(time.series(), group = 'Group1') %>%
dySeries('C.res.acc', axis = 'y', color = 'rgb(90, 182, 155)', strokeWidth = 1.5) %>%
dySeries('L.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dySeries('R.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dyOptions(useDataTimezone = TRUE, gridLineWidth = 0.09) %>%
dyAxis("y", label = "Acceleration (g)", drawGrid = FALSE) %>%
dyLegend(show = "never", hideOnMouseOut = TRUE)
)
output$Graph2 <- renderDygraph(
dygraph(time.series(), group = 'Group1') %>% # changed this group
dySeries('L.res.acc', axis = 'y', color = '#4157c1', strokeWidth = 1.5) %>%
dySeries('R.res.acc', axis = 'y', color = 'red', strokeWidth = 1.5) %>%
dySeries('C.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dyOptions(useDataTimezone = TRUE, gridLineWidth = 0.09) %>%
dyAxis("y", label = "Acceleration (g)", drawGrid = FALSE) %>%
dyLegend(show = "never", hideOnMouseOut = TRUE)
)
# Dashboard Plots ---------------------------------------------------------
# ~ Plot 1 -----------------------------------------------------------
output$dashboardplot1 <- renderPlotly({
test <- Window()
#write.csv(test, "test.csv")
df <- data.frame(
acc.zone = c(test$C.acc.zone, test$R.acc.zone, test$L.acc.zone),
raw.peak.mag = c(test$C.raw.peak.mag, test$R.raw.peak.mag, test$L.raw.peak.mag),
ma.peak = c(test$C.ma.Peak, test$R.ma.Peak, test$L.ma.Peak),
location = c(rep("c", nrow(test)), rep("r", nrow(test)), rep("l", nrow(test)))
) %>%
mutate_at(1:3, as.numeric) %>%
dplyr::filter(ma.peak == 1 & acc.zone > 1.8) %>%
group_by(location, acc.zone) %>%
summarise(sum = length(raw.peak.mag)) %>%
# sum = sum(raw.peak.mag)) %>%
tidyr::pivot_wider(id_cols = acc.zone, names_from = "location", values_from = sum )
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
if(!is.na(file.list[2])){
plotly::plot_ly(df, x = ~acc.zone, y = ~r, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_trace(y = ~-l, name = 'Left', marker = list(color = 'rgb(79, 151, 213)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plotly::plot_ly(df, x = ~acc.zone, y = ~c, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# ~ Plot 2 -----------------------------------------------------------
output$dashboardplot2 <- renderPlotly({
df <- Window()
now_lt <- as.POSIXlt(Sys.time(), tz = "GMT")
tm <- df$time
x <- now_lt + tm
ay1 <- list(
side = "left",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ay <- list(
tickfont = list(color = "blue"),
overlaying = "y",
side = "right",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
if(length(x) < 50000){
plot_ly(x = ~x) %>%
plotly::add_trace(y = ~cumsum(df$C.PL), mode = 'lines', type = "scatter", yaxis = "y2", name = "PlayerLoad", line = list(color = '#7C8B9D')) %>%
plotly::add_trace(x = ~x, y = ~df$C.res.acc[1:length(tm)], type = "scatter", mode = "lines", name = "Acceleration (100 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(y = ~df$C.Jump[1:length(tm)]*5, name = "Jumps", marker = list(color = "lightgrey")) %>%
#plotly::add_trace(x = ~x, y = ~cumsum(df[df$C.raw.peak.mag > 1.5,]$C.raw.peak.mag[1:length(tm)])/100, mode = "lines", type = "scatter", yaxis = "y2", name = "Impact Load / 100") %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plot_ly(df[df$C.Jump == 1,], x = ~time) %>%
plotly::add_trace(data = df[seq(1, nrow(df), 20),], y = ~C.res.acc, type = "scatter", mode = "lines", name = "Acceleration (20 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(data = df[df$C.Jump == 1,], y = ~C.Jump*4, name = "Jumps", marker = list(color = 'lightgrey')) %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# Longitudinal Plots ---------------------------------------------------
# ~ Plot 1 -------------------------------------------------------------
output$longplot1 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
)
if(use.sql()){cols <- 14:93}else{cols <- 15:94}
if(input$time_grouping == 1){
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[cols], sum
)
}
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[cols], sum
)
}
x <- list(
title = "",
tickformat = "%d/%m"
)
p <- plot_ly(data, x = ~as.Date(session_date, format = "%d/%m/%Y")) %>%
#plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent', barmode = "stack", title = "External Load")
if(1 %in% input$variables){
y <- list(
title = "Jump Count"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_6_10 + Jumps_10_15 + Jumps_15_20, name = "< 20 cm", marker = list(color = '#FFBABA')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_20_25 + Jumps_25_30, name = "20-30 cm", marker = list(color = '#FF7B7B')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_30_35 + Jumps_35_40, name = "30-40 cm", marker = list(color = '#FF5252')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_40_45 + Jumps_45_50, name = "40-50 cm", marker = list(color = '#FF0000')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_50_55 + Jumps_55_60 + Jumps_60_65 + Jumps_65_70 + Jumps_70_75 + Jumps_75_80, name = "> 50 cm", marker = list(color = '#A70000')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(2 %in% input$variables){
y <- list(
title = "Impact Count"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_2_0 + C_count_2_5 + C_count_3_0, name = "1.5-3 g", marker = list(color = '#FFBABA')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_3_5 + C_count_4_0 + C_count_4_5 + C_count_5_0, name = "3-5 g", marker = list(color = '#FF7B7B')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_5_5 + C_count_6_0 + C_count_6_5 + C_count_7_0, name = "5-7 g", marker = list(color = '#FF5252')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_7_5 + C_count_8_0 + C_count_8_5 + C_count_9_0, name = "7-9 g", marker = list(color = '#FF0000')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_9_5 + C_count_10_0, name = "> 9 g", marker = list(color = '#A70000')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(3 %in% input$variables){
y <- list(
title = "PlayerLoad"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~total_pl, name = "PlayerLoad", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(4 %in% input$variables){
y <- list(
title = "Impact Load"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~DSL, name = "Impact Load", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
p
})
# ~ Plot 2 -------------------------------------------------------------
output$longplot2 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[14:93], sum
)
}
x <- list(
title = ""
)
p <- plot_ly(data, x = ~as.Date(session_date, format = "%d/%m/%Y")) %>%
#plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent', barmode = "stack", title = "Internal Load")
y <- list(
title = "s-RPE"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~srpe, name = "s-RPE", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
p
})
# ~ Plot 3- R/L balance --------------------------------------------------------
output$longplot3 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
c(session_date, R_DSL, L_DSL)
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}else{
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}
data <- data %>%
mutate(
asym = R_DSL - L_DSL,
L_DSL = 0 - L_DSL
)
data2 <- data %>%
select(-asym) %>%
pivot_longer(
!session_date,
names_to = "variable",
values_to = "value"
)
y <- ceiling(max(sqrt(data2$value^2))/1000)*1000
y <- c(-y, y)
p <- ggplot(data2)+
geom_col(
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
y = value,
fill = variable
)
)+
scale_fill_manual(
values = c("#FFBABA", "#5AB69B")
)+
scale_x_date(date_breaks = "7 days", date_labels = "%d/%m")+
geom_segment(
data = data,
y = 0,
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
xend = as.Date(session_date, format = "%d/%m/%Y"),
yend = asym
)
)+
geom_point(
data = data,
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
y = asym,
shape = asym > 0
),
show.legend = F
)+
scale_shape_manual(values = c(6, 2), guide = "none")+
theme_minimal()+
labs(
x = NULL,
y = "Left Right"
)+
theme(
legend.title = element_blank(),
legend.position = "none"
)+
ylim(y)
ggplotly(p)
})
# ~ Table 0 - R/L balance --------------------------------------------------------
output$longtable0 <- formattable::renderFormattable({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
c(session_date, R_DSL, L_DSL)
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}else{
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}
data <- as.data.frame(t(data))
names(data) <- substr(data[1,], 1, 10)
data <- data[-1,]
rownames(data) <- c("Right", "Left")
formattable::formattable(
data ,
align = rep("c", ncol(data)),
lapply(1:nrow(data), function(row) {
formattable::area(row) ~ formattable::color_tile("transparent", "#FF7B7B")
})
#align =c("l",rep("c", 12), "r"),
# list(
# "s-RPE" = formattable::color_tile("transparent", '#5AB69B'),
# # "Impact Load" = formattable::color_tile("transparent", '#FF7B7B'),
# # "PlayerLoad" = formattable::color_tile("transparent", '#FF7B7B')
# #
# )
)
})
# ~ Table 1 --------------------------------------------------------
output$longtable1 <- formattable::renderFormattable({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
session_date, session_type, session_name, starttime,
total_dur, active_dur, srpe, total_pl, DSL, s_jumps, m_jumps,
l_jumps, R_DSL, L_DSL
) %>%
mutate(
active_dur = round(active_dur),
total_pl = round(total_pl),
DSL = round(DSL)
) %>%
rename(
Date = 1, Type = 2, Name = 3, Time = 4, Duration = 5,
"Active Dur." = 6, "s-RPE" = 7, PlayerLoad = 8, "Impact Load" = 9,
"Small Jumps" = 10, "Med. Jumps" = 11, "Large Jumps" = 12,
"R Imp. Ld." = 13, "L Imp. Ld." = 14
)
formattable::formattable(data,
align =c("l",rep("c", 12), "r"),
list(
"Date" = formattable::formatter("span", style = ~ formattable::style(color = "grey",font.weight = "bold")),
"s-RPE" = formattable::color_tile("transparent", '#5AB69B'),
"Impact Load" = formattable::color_tile("transparent", '#FF7B7B'),
"PlayerLoad" = formattable::color_tile("transparent", '#FF7B7B')
))
})
# Squad Dashboard ---------------------------------------------------------
# ~ Date slider ----
output$date_range2 <- renderUI({
sliderInput("date_range2", "Select Date Range:",
min = min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max = max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), value = c(min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T)),
timeFormat = "%F", ticks = F
)
})
# ~ Athlete selector ----
output$select_athlete3 <- renderUI({
selectInput('select_athlete3',
label ='Select Athletes:',
choices=athletes$athletes,
selected = NULL, multiple = T)
})
# ~ Create squad data ----
# # observe event for updating the reactiveValues
# observeEvent(input$submit,
# {
# squaddata$data <- db$db
# })
#
# # reactiveValues
# squaddata <- reactiveValues(
# data = NA
# )
squaddata <- eventReactive(input$updatesquad, {
data <- db$db %>%
dplyr::filter(
athlete_name %in% input$select_athlete3,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range2[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range2[2]
)
for(i in input$select_athlete3){
for(j in input$date_range2[1]:input$date_range2[2]){
data <- data %>%
ungroup() %>%
mutate(session_date = as.Date(session_date, format = "%d/%m/%Y")) %>%
add_row(session_date = as.Date(j), athlete_name = i)
}
}
data
})
# ~ Table 1 ----
output$squadtable <- formattable::renderFormattable({
data <- as.data.frame(squaddata()) %>%
select(
session_date, session_type, athlete_name, starttime,
total_dur, active_dur, srpe, total_pl, DSL, s_jumps, m_jumps,
l_jumps, R_DSL, L_DSL
) %>%
mutate(
active_dur = round(active_dur),
total_pl = round(total_pl),
DSL = round(DSL)
) %>%
rename(
Date = 1, Type = 2, Name = 3, Time = 4, Duration = 5,
"Active Dur." = 6, "sRPE" = 7, PlayerLoad = 8, "ImpactLoad" = 9,
"Small Jumps" = 10, "Med. Jumps" = 11, "Large Jumps" = 12,
"R Imp. Ld." = 13, "L Imp. Ld." = 14
)
if(input$time_grouping2 == 1){
data <- data %>%
group_by(Name, Date) %>%
summarise(
PlayerLoad = sum(PlayerLoad, na.rm = T),
sRPE = sum(sRPE, na.rm = T),
impactload = sum(ImpactLoad, na.rm = T)
)
}
if(input$select_squad_variable == 1){data$values <- data$PlayerLoad}
if(input$select_squad_variable == 2){data$values <- data$sRPE}
if(input$select_squad_variable == 3){data$values <- data$impactload}
data <- data %>%
pivot_wider(
id_cols = Name,
names_from = Date,
values_from = values
)
formattable::formattable(data,
align =c("l",rep("c", ncol(data)-1)),
lapply(1:nrow(data), function(row) {
formattable::area(row) ~ formattable::color_tile("transparent", "#FF7B7B")
})
)
})
# Session Dashboard -------------------------------------------------------
# ~ Athlete selector ----
output$select_athlete4 <- renderUI({
selectInput('select_athlete4',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
# ~ Date selector ----
output$select_date <- renderUI({
dateInput('select_date',
label ='Select Date:')
})
# ~ Session selector ----
sessionlist <- reactive ({
if(use.sql()){
as.vector( dbGetQuery(conn, paste0("Select DISTINCT session_name from raw_training_load WHERE session_date = '", input$select_date, "';") ))
}else{
list.files(
paste0("./clipped-sessions/", input$select_athlete4, "/", as.Date(input$select_date, format = "%Y-%m-%d"), "/")
)
}
})
output$select_session <- renderUI({
selectInput('select_session',
label ='Select Session:',
choices = sessionlist()
)
})
output$test <- renderText(
input$select_session
)
sessiondata <- eventReactive(input$updatesession, {
if(use.sql()){
#as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
dbGetQuery(conn, paste0("SELECT * FROM raw_training_load WHERE session_name = '", input$select_session, "' AND session_date = '", input$select_date, "';"))
}else{
read.csv(
paste0("./clipped-sessions/", input$select_athlete4, "/", as.Date(input$select_date, format = "%Y-%m-%d"), "/", input$select_session)
)
}
})
# ~ Value Boxes ----
output$value_box.7 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 0)), "Jumps", icon = icon("arrow-alt-circle-up"), width = 2, color = "yellow")
})
output$value_box.8 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 0 & sessiondata()$C_jh < 20)), "Small Jumps", icon = icon("angle-up"), width = 2, color = "yellow")
})
output$value_box.9 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh >= 20 & sessiondata()$C_jh < 40)), "Medium Jumps", icon = icon("angle-double-up"), width = 2, color = "yellow")
})
output$value_box.10 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 40)), "Large Jumps", icon = icon("fighter-jet"), width = 2, color = "yellow")
})
output$value_box.11 <- renderValueBox({
valueBox(paste0(round(length(which(sessiondata()$C_active_time > 0))/100/60), " min"), "Active Duration", icon = icon("clock"), width = 2, color = "yellow")
})
output$value_box.12 <- renderValueBox({
valueBox(paste(round(nrow(sessiondata())/100/60), " min"), "Total Duration", icon = icon("clock"), width = 2, color = "yellow")
})
# ~ Plot 1 -----------------------------------------------------------
output$sessionplot1 <- renderPlotly({
test <- sessiondata()
df <- data.frame(
acc.zone = c(test$C_acc_zone, test$R_acc_zone, test$L_acc_zone),
raw.peak.mag = c(test$C_raw_peak_mag, test$R_raw_peak_mag, test$L_raw_peak_mag),
ma.peak = c(test$C_ma_Peak, test$R_ma_Peak, test$L_ma_Peak),
location = c(rep("c", nrow(test)), rep("r", nrow(test)), rep("l", nrow(test)))
) %>%
mutate_at(1:3, as.numeric) %>%
dplyr::filter(ma.peak == 1 & acc.zone > 1.8) %>%
group_by(location, acc.zone) %>%
summarise(sum = length(raw.peak.mag)) %>%
# sum = sum(raw.peak.mag)) %>%
tidyr::pivot_wider(id_cols = acc.zone, names_from = "location", values_from = sum )
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
if(!is.na(file.list[2])){
plotly::plot_ly(df, x = ~acc.zone, y = ~r, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_trace(y = ~-l, name = 'Left', marker = list(color = 'rgb(79, 151, 213)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plotly::plot_ly(df, x = ~acc.zone, y = ~c, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# ~ Plot 2 -----------------------------------------------------------
output$texttest <- renderText({
df <- sessiondata()
df$row_number[1]
#now_lt <- as.POSIXlt(df$time[1], tz = "GMT")
#unlist(now_lt[1])
})
output$sessionplot2 <- renderPlotly({
df <- sessiondata()
if(use.sql()){
now_lt <- lubridate::as_datetime(df$time[1])
}else{
now_lt <- as.POSIXlt(df$time[1], tz = "GMT")
}
tm <- as.numeric(df$row_number)
x <- now_lt + tm
ay1 <- list(
side = "left",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ay <- list(
tickfont = list(color = "blue"),
overlaying = "y",
side = "right",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
if(length(x) < 50000){
plot_ly(x = ~x) %>%
plotly::add_trace(y = ~cumsum(df$C_PL), mode = 'lines', type = "scatter", yaxis = "y2", name = "PlayerLoad", line = list(color = '#7C8B9D')) %>%
plotly::add_trace(x = ~x, y = ~df$C_res_acc[1:length(tm)], type = "scatter", mode = "lines", name = "Acceleration (100 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(y = ~df$C_Jump[1:length(tm)]*5, name = "Jumps", marker = list(color = "lightgrey")) %>%
#plotly::add_trace(x = ~x, y = ~cumsum(df[df$C.raw.peak.mag > 1.5,]$C.raw.peak.mag[1:length(tm)])/100, mode = "lines", type = "scatter", yaxis = "y2", name = "Impact Load / 100") %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plot_ly(df[df$C_Jump == 1,], x = ~time) %>%
plotly::add_trace(data = df[seq(1, nrow(df), 20),], y = ~C_res_acc, type = "scatter", mode = "lines", name = "Acceleration (20 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(data = df[df$C_Jump == 1,], y = ~C_Jump*4, name = "Jumps", marker = list(color = 'lightgrey')) %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# Upload Page -------------------------------------------------------------
#shinyjs::onclick(input$athlete_count, if(input$athlete_count < 2){toggle(id = "athlete_upload_2")})
## observe the button being pressed
observeEvent(input$athlete_count, {
if(input$athlete_count < 2){shinyjs::hide(id = "athlete_upload_2")}else{
shinyjs::show(id = "athlete_upload_2")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 3){shinyjs::hide(id = "athlete_upload_3")}else{
shinyjs::show(id = "athlete_upload_3")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 4){shinyjs::hide(id = "athlete_upload_4")}else{
shinyjs::show(id = "athlete_upload_4")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 5){shinyjs::hide(id = "athlete_upload_5")}else{
shinyjs::show(id = "athlete_upload_5")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 6){shinyjs::hide(id = "athlete_upload_6")}else{
shinyjs::show(id = "athlete_upload_6")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 7){shinyjs::hide(id = "athlete_upload_7")}else{
shinyjs::show(id = "athlete_upload_7")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 8){shinyjs::hide(id = "athlete_upload_8")}else{
shinyjs::show(id = "athlete_upload_8")}
})
# Add athlete selection boxes
output$athlete1 <- renderUI({
selectInput('athlete1',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete2 <- renderUI({
selectInput('athlete2',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete3 <- renderUI({
selectInput('athlete3',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete4 <- renderUI({
selectInput('athlete5',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete5 <- renderUI({
selectInput('athlet5',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete6 <- renderUI({
selectInput('athlete6',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete7 <- renderUI({
selectInput('athlete7',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete8 <- renderUI({
selectInput('athlete7',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
}
joseph-shaw/OpenTrack documentation built on Dec. 1, 2022, 9:54 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions app_server
#' The application server-side
#'
#' @param input,output,session Internal parameters for {shiny}.
#' DO NOT REMOVE.
#' @import shiny
#' @import tidyr
#' @import DT
#' @noRd
# Module for splash screen
#splash_server <- function(input, output, session) {
# hide("splash_screen", anim = F, animType = "fade", time = 3)
#}
app_server <- function( input, output, session ) {
# List the first level callModules here
callModule(mod_splash_module_server, "splash_module_ui_1")
#tags$head(tags$style(HTML(".content { padding-top: 1000 !important;}")))
callModule(mod_upload_page_server, "upload_page_ui_1")
callModule(mod_analyse_page_server, "analyse_page_ui_1")
callModule(mod_dashboard_page_server, "dashboard_page_ui_1")
callModule(mod_database_page_server, "database_page_ui_1")
callModule(mod_longitudinal_page_server, "longitudinal_page_ui_1")
callModule(mod_squad_dashboard_server, "squad_dashboard_ui_1")
callModule(mod_session_dashboard_server, "session_dashboard_ui_1")
delay(200, show("dash"))
# Options -----------------------------------------------------------------
options(shiny.maxRequestSize = 70*1024^3,
browser = "C:/Program Files/Mozilla Firefox/firefox.exe",
shiny.usecairo=T)
# ~ Load SQL db -----------------------------------------------------------
sql <- read.csv("settings/sql.csv")
if(use.sql()){
conn <- DBI::dbConnect(odbc::odbc(),
Driver = sql$Driver,
Server = sql$Server,
Database = sql$Database,
#Trusted_Connection = "True",
UID = sql$UID,
PWD = rstudioapi::askForPassword("Database password") #sql$PWD
#Port = 1433
)
}
# ~ ~ Add session ------------------------------------------------------
# 1
observeEvent(input$addsession1, {
data$df <- data$df %>%
mutate(
session.type = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessiontype, session.type),
session.name = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionname, session.name),
session.num = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionnumber, session.num)
)
raw_data <- Window() %>%
mutate(
time = as.POSIXct(as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time)),
row_number = seq(1, nrow(Window()), 1)/100
)
n <- colnames(raw_data)
colnames(raw_data) <- gsub("\\.", "_", n)
#write.csv(sb_upload, "test1.csv")
user.id <- 28731 # define this
push_to_sb <- sql$smartabase == 1
if(push_to_sb){
athlete <- input$select_athlete
sb_id <- neon::pull_smartabase(
form = "Personal Details",
filter_user_key = "about",
filter_user_value = athlete,
start_date = "01/01/2000",
end_date = "01/01/2100"
)
sb_id <- sb_id$user_id[1]
sb_upload <- summary() %>%
rename(
Date = session_date,
About = athlete_name,
dummy = is_dummy,
ballet = session_name,
start_time = starttime,
end_time = endtime,
total.duration = total_dur,
Total.pl = total_pl,
Total.pl.active = active_pl,
Jumps = Jumps,
J.6_10 = Jumps_6_10 ,
J.10_15 = Jumps_10_15,
J.15_20 = Jumps_15_20,
J.20_25 = Jumps_20_25,
J.25_30 = Jumps_25_30,
J.30_35 = Jumps_30_35,
J.35_40 = Jumps_35_40,
J.40_45 = Jumps_40_45,
J.45_50 = Jumps_45_50,
J.50_55 = Jumps_50_55,
J.55_60 = Jumps_55_60,
J.60_65 = Jumps_60_65,
J.65_70 = Jumps_65_70,
J.70_75 = Jumps_70_75,
J.75_80 = Jumps_75_80,
s.jumps = s_jumps,
m.jumps = m_jumps,
l.jumps = l_jumps,
count_1.5 = C_count_1_5,
count_2.0 = C_count_2_0,
count_2.5 = C_count_2_5,
count_3.0 = C_count_3_0,
count_3.5 = C_count_3_5,
count_4.0 = C_count_4_0,
count_4.5 = C_count_4_5,
count_5.0 = C_count_5_0,
count_5.5 = C_count_5_5,
count_6.0 = C_count_6_0,
count_6.5 = C_count_6_5,
count_7.0 = C_count_7_0,
count_7.5 = C_count_7_5,
count_8.0 = C_count_8_0,
count_8.5 = C_count_8_5,
count_9.0 = C_count_9_0,
"c_9.0+" = C_count_10_0,
) %>%
mutate(
start_time = as.character(format(as_datetime(r_starttime), format = "%H:%M %p")),
start_time = ifelse(substr(start_time, 7,8) == "PM", paste0(as.numeric(substr(start_time, 1,2))-12, substr(start_time, 3,6), "PM"), start_time),
end_time = as.character(format(as_datetime(r_endtime), format = "%H:%M %p")),
end_time = ifelse(substr(end_time, 7,8) == "PM", paste0(as.numeric(substr(end_time, 1,2))-12, substr(end_time, 3,6), "PM"), end_time),
current_time_ampm = "00:00 AM",
current_end_time_ampm = "00:00 AM",
user_id = sb_id,
Date = NA,
Date = as.character(Date),
Date = paste(sep = "/", formatC(lubridate::day(r_starttime), width = 2, flag = 0, format = "d"), formatC(lubridate::month(r_starttime), width = 2, flag = 0, format = "d"), lubridate::year(r_starttime)),
#start_date = "09/09/2022",
#end_date = "09/09/2022",
)
neon::push_smartabase(
sb_upload,
form = "33 TL Database",
entered_by_user_id = user.id
)
}
if(use.sql()){
dbWriteTable(conn = conn, "training_load", summary() , append = TRUE)
db$db <- dbGetQuery(conn, "Select * from training_load;")
dbWriteTable(conn = conn, "raw_training_load", raw_data, append = TRUE)
}else{
#write.csv(summary(), "test2.csv")
new.row <- summary()
#new.row$session_id <- max(as.numeric(db$db$session_id), na.rm = T) +1
db$db <- plyr::rbind.fill(db$db, new.row) %>%
dplyr::filter(!is.na(session_id))
write.csv(db$db, "database.csv", row.names = F)
folder <- paste0("clipped-sessions/", input$select_athlete, "/", gsub(":", "-", substr(input$Graph1_date_window[1], 1, 10)))
filename <- paste0(folder, "/", stringr::str_replace_all(paste0(paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 1, 16)), ".csv")), " ", "-"))
dir.create(paste0("clipped-sessions/", input$select_athlete), showWarnings = FALSE)
dir.create(folder, showWarnings = FALSE)
write.csv(
raw_data,
filename, row.names = F)
}
})
# 2
observeEvent(input$addsession2, {
data$df <- data$df %>%
mutate(
session.type = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessiontype, session.type),
session.name = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionname, session.name),
session.num = ifelse(row_number > Time()[1] & row_number < Time()[2], input$sessionnumber, session.num)
)
raw_data <- Window() %>%
mutate(
time = as.POSIXct(as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time)),
row_number = seq(1, nrow(Window()), 1)/100
)
n <- colnames(raw_data)
colnames(raw_data) <- gsub("\\.", "_", n)
if(use.sql()){
dbWriteTable(conn = conn, "training_load", summary() , append = TRUE)
db$db <- dbGetQuery(conn, "Select * from training_load;")
dbWriteTable(conn = conn, "raw_training_load", raw_data, append = TRUE)
}else{
new.row <- summary()
#new.row$session_id <- max(as.numeric(db$db$session_id), na.rm = T) +1
db$db <- plyr::rbind.fill(db$db, new.row) %>%
dplyr::filter(!is.na(session_id))
write.csv(db$db, "database.csv", row.names = F)
folder <- paste0("clipped-sessions/", input$select_athlete, "/", gsub(":", "-", substr(input$Graph1_date_window[1], 1, 10)))
filename <- paste0(folder, "/", stringr::str_replace_all(paste0(paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 1, 16)), ".csv")), " ", "-"))
dir.create(paste0("clipped-sessions/", input$select_athlete), showWarnings = FALSE)
dir.create(folder, showWarnings = FALSE)
write.csv(
raw_data,
filename, row.names = F)
}
})
# ~ ~ Delete row ------------------------------------------------------
observeEvent(input$droprowbutton, {
if(use.sql()){
dbSendStatement(conn, paste0("DELETE FROM training_load WHERE session_id = ", input$rowref))
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db <- db$db %>%
dplyr::filter(session_id != input$rowref)
write.csv(db$db, "database.csv", row.names = F)
}
})
# ~ ~ Edit cell -------------------------------------------------------
observeEvent(input$SQLinputbutton, {
if(use.sql()){
dbSendStatement(conn, paste0("UPDATE training_load SET ", input$columnref, " = '", input$newinput, "' WHERE session_id = ", input$rowref))
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db[input$rowref, input$columnref] <- input$newinput
write.csv(db$db, "database.csv", row.names = F)
}
})
# ~ ~ Download db csv --------------------------------------------------
observeEvent(input$db_csv, {
write.csv(
db$db,
paste("database_export", Sys.Date(), ".csv"),
row.names = F
)
})
# ~ Load TL data into reactive value -----------------------------------
db <- reactiveValues(
db = NULL
)
# # Load longitudinal analysis data
# long <- reactiveValues(
# data = NULL
# )
#
# long$data <-reactive(
# db$db %>%
# filter(
# athlete_name == input$select_athlete2,
# session_date >= input$date_range[1],
# session_date <= input$date_range[2]
# )
# )
# Create date slider
output$date_range <- renderUI({
sliderInput("date_range", "Select Date Range:",
min = min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max = max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), value = c(min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T)),
timeFormat = "%F", ticks = F
)
})
# Load data
if(use.sql()){
db$db <- dbGetQuery(conn, "Select * from training_load;")
}else{
db$db <- read.csv("database.csv")
}
# Create datatable
output$table <- renderDataTable({
db$db
},
options = list(
lengthMenu = list(
c(3, 4, 5, 6, 10, -1),
c('3', '4', '5', '6', '10', 'All')
),
pageLength = 3,
filter = 'top',
server = TRUE,
searchable = FALSE,
searching = F
)
)
# ~ Load athlete data into reactive value ------------------------------
athletes <- reactiveValues(
athletes = NULL
)
# Load data
if(use.sql()){
athletes$athletes <- as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
}else{
athletes$athletes <- read.csv("settings/athletes.csv")[,1]
}
# Create dropdown
output$select_athlete <- renderUI({
selectInput('select_athlete',
label ='Select Athlete',
choices=athletes$athletes,
selected = NULL, multiple = FALSE)
})
output$select_athlete2 <- renderUI({
selectInput('select_athlete2',
label ='Select Athlete',
choices=athletes$athletes,
selected = NULL, multiple = FALSE)
})
# Add new athlete
observeEvent(input$new_athlete, {
athlete_details <- data.frame(
athlete_name = input$new_name,
sex = input$new_sex,
dob = input$new_dob,
email_address = input$new_email
)
if(use.sql()){
dbWriteTable(conn = conn, "athletes", athlete_details, append = TRUE)
athletes$athletes <- as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
}else{
write.csv(plyr::rbind.fill(read.csv("settings/athletes.csv"), athlete_details), "settings/athletes.csv", row.names = F)
athletes$athletes <- plyr::rbind.fill(read.csv("settings/athletes.csv"), athlete_details)[,1]
}
})
filepaths <- read.csv("settings/filepaths.csv")
roots <- filepaths[,2]
names(roots) <- filepaths[,1]
# Filepaths --------------------------------------------------------------
# File select
shinyFiles::shinyFileChoose(input, 'Central', root=roots, filetypes='csv')
shinyFiles::shinyFileChoose(input, 'Left', root=roots, filetypes='csv')
shinyFiles::shinyFileChoose(input, 'Right', root=roots, filetypes='csv')
# ~ Output filepaths ------------------------------------------------------
output$filepath1 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Central)$datapath[1])){NULL
}else(
paste("Central:",
parseFilePaths(roots = roots,input$Central)$datapath[1])
)
})
output$filepath2 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Left)$datapath[1])){NULL
}else(
paste("Left:",
parseFilePaths(roots = roots,input$Left)$datapath[1])
)
})
output$filepath3 <- renderText({
if(is.na(parseFilePaths(roots = roots,input$Right)$datapath[1])){NULL
}else(
paste("Right:",
parseFilePaths(roots = roots,input$Right)$datapath[1])
)
})
# Value Boxes -------------------------------------------------------------
output$value_box.1 <- renderValueBox({
valueBox(sum(Window()$C.Jump, na.rm = TRUE), "Jumps", icon = icon("arrow-alt-circle-up"), width = 2, color = "yellow")
})
output$value_box.2 <- renderValueBox({
valueBox(length(which(Window()$C.jh <= 15 & Window()$C.jh > 0 & Window()$C.Jump == 1)), "Small Jumps", icon = icon("angle-up"), width = 2, color = "yellow")
})
output$value_box.3 <- renderValueBox({
valueBox(length(which(Window()$C.jh <= 30 & Window()$C.jh > 15 & Window()$C.Jump == 1)), "Medium Jumps", icon = icon("angle-double-up"), width = 2, color = "yellow")
})
output$value_box.4 <- renderValueBox({
valueBox(length(which(Window()$C.jh > 30 & Window()$C.jh < 100 & Window()$C.Jump == 1)), "Large Jumps", icon = icon("fighter-jet"), width = 2, color = "yellow")
})
output$value_box.5 <- renderValueBox({
valueBox(paste0(round(sum(Window()$C.jh[Window()$C.Jump == 1], na.rm = T)/100), " m"), "Height Jumped", icon = icon("sort-amount-up"), width = 2, color = "yellow")
})
output$value_box.6 <- renderValueBox({
valueBox(paste(round(Time()[3]/100/60), " min"), "Total Duration", icon = icon("clock"), width = 2, color = "yellow")
})
# Main Data Processing ----------------------------------------------------
data <- reactiveValues(df = NULL)
#Load raw file and add to create DF
observeEvent(input$processraw, {
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
# Filter settings
run.filter <- TRUE
data.freq <- 100
order <- 4
filt.freq <- 12
nyquist.freq <- data.freq / 2
bf <- signal::butter(order, filt.freq / nyquist.freq, type="low")
if(input$time_unit == "ms"){time_unit <- 1000}
if(input$time_unit == "s / 100"){time_unit <- 100}
if(input$time_unit == "s / 10"){time_unit <- 10}
if(input$time_unit == "s"){time_unit <- 1}
invert <- as.numeric(input$invertup) #Add a variable to flip up and down
up <- as.numeric(input$orientation)
ach <- 1 %in% input$tissue_forces
tib <- 2 %in% input$tissue_forces
pat <- 3 %in% input$tissue_forces
grf <- 4 %in% input$tissue_forces
# loop through central, left, and right files
if(is.na(file.list[1])){order <- c(2,3,1)}else{order <- 1:3}
for(i in order){
if(is.na(file.list[i])){DF <- data.table::fread("frame.csv") %>% mutate(time = ms/1000)}else{
DF <- process_imu_data(file = file.list[i], run.filter = run.filter, bf = bf, invert = invert, time_unit = time_unit, up = up)
}
#Rename cols
if(i == 1){names(DF)[2:ncol(DF)] <- paste0("C.", names(DF)[2:ncol(DF)])}
if(i == 2){names(DF)[2:ncol(DF)] <- paste0("L.", names(DF)[2:ncol(DF)])}
if(i == 3){names(DF)[2:ncol(DF)] <- paste0("R.", names(DF)[2:ncol(DF)])}
#bind dfs
if(i == order[1]){combined.DF <- DF}else{combined.DF <- cbind.fill(combined.DF, DF[,2:ncol(DF)], fill = 0)}
}
if(
!is.na(file.list[1]) & !is.na(file.list[2]) & !is.na(file.list[3]) &
(ach | tib | pat | grf)
){
tissue_force_data <- tissue_force(
waist = file.list[1],
l.shank = file.list[2],
r.shank = file.list[3],
ach = ach,
tib = tib,
pat = pat,
grf = grf,
invert = invert == 1
) %>%
replace_na(
list(
left_achilles = 0,
right_achilles = 0,
left_grf = 0,
right_grf = 0,
left_pat.tendon = 0,
right_pat.tendon = 0,
left_tibia = 0,
right_tibia = 0
)
)
write.csv(tissue_force_data, "tissueforce1.csv")
}
DF <- combined.DF %>%
mutate(
Time = seq(from = 1, to = nrow(combined.DF)/100, by = 0.01)[1:nrow(combined.DF)],
#time = seq(from = 1, to = nrow(combined.DF)/100, by = 0.01)[1:nrow(combined.DF)],
sec.group = ceiling(Time),
min.group = ceiling(Time/60),
session.type = NA,
session.name = NA,
session.num = NA,
athlete.name = "temp",
C.res.acc = as.numeric(C.res.acc),
R.res.acc = as.numeric(R.res.acc),
L.res.acc = as.numeric(L.res.acc),
row_number = as.numeric(row.names(combined.DF))
) %>%
# select cols to keep
select(
row_number, athlete.name, session.type, session.name, session.num, time,
C.res.acc, C.peak.mag, C.f.time, C.Jump, C.jh, C.PL, C.acc.zone, C.acc.zone.time, C.ma.Peak, C.raw.peak.mag, C.active.time,
L.res.acc, L.peak.mag, L.f.time, L.Jump, L.jh, L.PL, L.acc.zone, L.acc.zone.time, L.ma.Peak, L.raw.peak.mag, L.active.time,
R.res.acc, R.peak.mag, R.f.time, R.Jump, R.jh, R.PL, R.acc.zone, R.acc.zone.time, R.ma.Peak, R.raw.peak.mag, R.active.time#,
#C.x.acc, C.y.acc, C.z.acc, C.up.id
)
if(exists("tissue_force_data")){
DF <- DF %>%
left_join(tissue_force_data, by = "time")
}else{
DF <- DF %>%
mutate(
left_achilles = NA,
right_achilles = NA,
left_grf = NA,
right_grf = NA,
left_pat.tendon = NA,
right_pat.tendon = NA,
left_tibia = NA,
right_tibia = NA
)
}
data$df <- DF
#write.csv(tissue_force_data, "tissueforce1.csv")
#write.csv(DF, "tissueforce.csv")
})
# Clip data to window --------------------------------------------------
# ~ Start/finish times ---------------------------------------------
Time <- reactive({
Date <- substr(input$starttime, 1, 10)
Session.Start.ref <- substr(input$Graph1_date_window[1], 12, 19)
Session.End.ref <- substr(input$Graph1_date_window[2], 12, 19)
Unit.Start.ref <- strptime(input$starttime, "%Y-%m-%d %H:%M:%OS")
Unit.Start <- strptime(paste(Unit.Start.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Session.Start <- strptime(paste(Date, Session.Start.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Session.End <- strptime(paste(Date, Session.End.ref, sep = ''), "%Y-%m-%d %H:%M:%OS")
Start <- sqrt(((as.numeric(difftime(Unit.Start, Session.Start, units ='secs')))*100) ^ 2)
Duration <- sqrt(((as.numeric(difftime(Session.Start, Session.End, units ='secs')))*100) ^ 2)
End <- Start + Duration
c(Start,End,Duration)
#c(Session.Start.ref, Session.End.ref, Unit.Start.ref)
})
# ~ Subset Data --------------------------------------------------
Window <- reactive({
start <- Time()[1]
end <- Time()[2]
subset(data$df, row_number >= start & row_number <= end) %>%
mutate(athlete.name = input$select_athlete)
})
# Create new row data ----
summary1 <- eventReactive(input$filename.go, {
head(file())
})
# Summary Data ------------------------------------------------------------
# ~ Create data ---------------------------------------------------------
summary <- reactive({
#sum_cols <- read.csv("settings/export.csv") %>%
# as.vector()
cols <- colnames(read.csv("settings/export.csv"))
data.frame(
session_id = ifelse(is.numeric(max(as.numeric(db$db$session_id), na.rm = T)), round(max(as.numeric(db$db$session_id), na.rm = T) + 1, digits = 0), 1),
athlete_name = input$select_athlete,
session_date = paste(substr(input$starttime, 1, 4), substr(input$starttime, 6, 7), substr(input$starttime, 9, 10), sep = '-'),
season = "2020/21",
is_dummy = NA,
session_num = input$sessionnumber,
session_type = input$sessiontype,
session_name = input$sessionname,
comments = input$comments,
position_name = input$position,
starttime = substr(input$Graph1_date_window[1], 12, 19),
endtime = substr(input$Graph1_date_window[2], 12, 19),
r_starttime = input$Graph1_date_window[1],
r_endtime = input$Graph1_date_window[2],
total_dur = round(Time()[3] / 60 / 100, 0),
#active_dur = length(which(Window()$C.active.time != 0))/100/60#,
rpe = input$rpe,
srpe = ifelse(input$durationoverride == "0", round(Time()[3] / 60 / 100, 0)* as.numeric(input$rpe), as.numeric(input$durationoverride) * as.numeric(input$rpe)),
total_pl = sum(Window()$C.PL, na.rm = TRUE),
active_pl = sum(Window()$C.PL.active, na.rm = TRUE),
DSL = sum(subset(Window(), C.peak.mag >2)$C.peak.mag, na.rm = TRUE),
Jumps = sum(Window()$C.Jump, na.rm = TRUE),
Jumps_6_10 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 5 & Window()$C.jh < 10)),
Jumps_10_15 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 10 & Window()$C.jh < 15)),
Jumps_15_20 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 15 & Window()$C.jh < 20)),
Jumps_20_25 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 20 & Window()$C.jh < 25)),
Jumps_25_30 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 25 & Window()$C.jh < 30)),
Jumps_30_35 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 30 & Window()$C.jh < 35)),
Jumps_35_40 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 35 & Window()$C.jh < 40)),
Jumps_40_45 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 40 & Window()$C.jh < 45)),
Jumps_45_50 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 45 & Window()$C.jh < 50)),
Jumps_50_55 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 50 & Window()$C.jh < 55)),
Jumps_55_60 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 55 & Window()$C.jh < 60)),
Jumps_60_65 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 60 & Window()$C.jh < 65)),
Jumps_65_70 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 65 & Window()$C.jh < 70)),
Jumps_70_75 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 70 & Window()$C.jh < 75)),
Jumps_75_80 = length(which(Window()$C.Jump == 1 & Window()$C.jh >= 75 & Window()$C.jh < 80)),
s_jumps = length(which(Window()$C.jh <= 15 & Window()$C.jh > 0 & Window()$C.Jump == 1)),
m_jumps = length(which(Window()$C.jh >= 15 & Window()$C.jh < 30 & Window()$C.Jump == 1)),
l_jumps = length(which(Window()$C.jh >= 30 & Window()$C.jh < 80 & Window()$C.Jump == 1)),
C_count_1_5 = length(which(Window()$C.acc.zone == 1.5)),
C_count_2_0 = length(which(Window()$C.acc.zone == 2.0)),
C_count_2_5 = length(which(Window()$C.acc.zone == 2.5)),
C_count_3_0 = length(which(Window()$C.acc.zone == 3.0)),
C_count_3_5 = length(which(Window()$C.acc.zone == 3.5)),
C_count_4_0 = length(which(Window()$C.acc.zone == 4.0)),
C_count_4_5 = length(which(Window()$C.acc.zone == 4.5)),
C_count_5_0 = length(which(Window()$C.acc.zone == 5.0)),
C_count_5_5 = length(which(Window()$C.acc.zone == 5.5)),
C_count_6_0 = length(which(Window()$C.acc.zone == 6.0)),
C_count_6_5 = length(which(Window()$C.acc.zone == 6.5)),
C_count_7_0 = length(which(Window()$C.acc.zone == 7.0)),
C_count_7_5 = length(which(Window()$C.acc.zone == 7.5)),
C_count_8_0 = length(which(Window()$C.acc.zone == 8.0)),
C_count_8_5 = length(which(Window()$C.acc.zone == 8.5)),
C_count_9_0 = length(which(Window()$C.acc.zone == 9.0)),
C_count_9_5 = length(which(Window()$C.acc.zone == 9.5)),
C_count_10_0 = length(which(Window()$C.acc.zone > 9.5)),
R_count_1_5 = length(which(Window()$R.acc.zone == 1.5)),
R_count_2_0 = length(which(Window()$R.acc.zone == 2.0)),
R_count_2_5 = length(which(Window()$R.acc.zone == 2.5)),
R_count_3_0 = length(which(Window()$R.acc.zone == 3.0)),
R_count_3_5 = length(which(Window()$R.acc.zone == 3.5)),
R_count_4_0 = length(which(Window()$R.acc.zone == 4.0)),
R_count_4_5 = length(which(Window()$R.acc.zone == 4.5)),
R_count_5_0 = length(which(Window()$R.acc.zone == 5.0)),
R_count_5_5 = length(which(Window()$R.acc.zone == 5.5)),
R_count_6_0 = length(which(Window()$R.acc.zone == 6.0)),
R_count_6_5 = length(which(Window()$R.acc.zone == 6.5)),
R_count_7_0 = length(which(Window()$R.acc.zone == 7.0)),
R_count_7_5 = length(which(Window()$R.acc.zone == 7.5)),
R_count_8_0 = length(which(Window()$R.acc.zone == 8.0)),
R_count_8_5 = length(which(Window()$R.acc.zone == 8.5)),
R_count_9_0 = length(which(Window()$R.acc.zone == 9.0)),
R_count_9_5 = length(which(Window()$R.acc.zone == 9.5)),
R_count_10_0 = length(which(Window()$R.acc.zone > 9.5)),
L_count_1_5 = length(which(Window()$L.acc.zone == 1.5)),
L_count_2_0 = length(which(Window()$L.acc.zone == 2.0)),
L_count_2_5 = length(which(Window()$L.acc.zone == 2.5)),
L_count_3_0 = length(which(Window()$L.acc.zone == 3.0)),
L_count_3_5 = length(which(Window()$L.acc.zone == 3.5)),
L_count_4_0 = length(which(Window()$L.acc.zone == 4.0)),
L_count_4_5 = length(which(Window()$L.acc.zone == 4.5)),
L_count_5_0 = length(which(Window()$L.acc.zone == 5.0)),
L_count_5_5 = length(which(Window()$L.acc.zone == 5.5)),
L_count_6_0 = length(which(Window()$L.acc.zone == 6.0)),
L_count_6_5 = length(which(Window()$L.acc.zone == 6.5)),
L_count_7_0 = length(which(Window()$L.acc.zone == 7.0)),
L_count_7_5 = length(which(Window()$L.acc.zone == 7.5)),
L_count_8_0 = length(which(Window()$L.acc.zone == 8.0)),
L_count_8_5 = length(which(Window()$L.acc.zone == 8.5)),
L_count_9_0 = length(which(Window()$L.acc.zone == 9.0)),
L_count_9_5 = length(which(Window()$L.acc.zone == 9.5)),
L_count_10_0 = length(which(Window()$L.acc.zone > 9.5)),
L_DSL = sum(subset(Window(), L.peak.mag >2)$L.peak.mag, na.rm = TRUE),
R_DSL = sum(subset(Window(), R.peak.mag >2)$R.peak.mag, na.rm = TRUE)
) #%>%
#select(
# cols
#)
})
# ~ Output Data ----------------------------------------------------------
output$summarydata1 <- renderDataTable({
summary()
# DT::datatable(summary(),
# extensions = 'Buttons',
# options = list(
# searching = F,
# paging = F,
# dom = 'Bfrtip',
# buttons = c('copy', 'csv', 'excel')
# )
#
# )
},
options = list(searching = F,
paging = F
)
)
# Analysis Page Plots --------------------------------------------------
# ~ Wrangle time series ------------------------------------
# Central Plot
time.series <- reactive({
df1 <- data$df
df1 <- df1[seq(from = 1, to = nrow(df1), by = 50),] %>%
select(C.res.acc, L.res.acc, R.res.acc)
x <- nrow(df1)
TimeSeries <- seq(from = 0.00, to = x, by = 0.5) # 2 Hz (x*0.5)
#TimeSeries <- seq(from = 0.00, to = (x*0.01), by = 0.01) # 100 Hz
TimeSeries <- as.POSIXct(TimeSeries, tz = "GMT", strptime(input$starttime, "%Y-%m-%d %H:%M:%OS"))
xts(df1, order.by = TimeSeries[1:x])
})
# L and R plot
time.series2 <- reactive({
df1 <- Window()
df1 <- df1[seq(from = 1, to = nrow(df1), by = 50),] %>%
select(C.res.acc, C.PL, C.DSL, C.Jump)
x <- nrow(df1)
TimeSeries <- seq(from = 0.00, to = x, by = 0.5) # 2 Hz
#TimeSeries <- seq(from = 0.00, to = (x*0.01), by = 0.01) # 100 Hz
TimeSeries <- as.POSIXct(TimeSeries, tz = "GMT", strptime(input$starttime, "%Y-%m-%d %H:%M:%OS"))
xts(df1, order.by = TimeSeries[1:x])
})
# ~ Create plots --------------------------------------------------
output$Graph1 <- renderDygraph(
dygraph(time.series(), group = 'Group1') %>%
dySeries('C.res.acc', axis = 'y', color = 'rgb(90, 182, 155)', strokeWidth = 1.5) %>%
dySeries('L.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dySeries('R.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dyOptions(useDataTimezone = TRUE, gridLineWidth = 0.09) %>%
dyAxis("y", label = "Acceleration (g)", drawGrid = FALSE) %>%
dyLegend(show = "never", hideOnMouseOut = TRUE)
)
output$Graph2 <- renderDygraph(
dygraph(time.series(), group = 'Group1') %>% # changed this group
dySeries('L.res.acc', axis = 'y', color = '#4157c1', strokeWidth = 1.5) %>%
dySeries('R.res.acc', axis = 'y', color = 'red', strokeWidth = 1.5) %>%
dySeries('C.res.acc', axis = 'y', color = 'transparent', strokeWidth = 0) %>%
dyOptions(useDataTimezone = TRUE, gridLineWidth = 0.09) %>%
dyAxis("y", label = "Acceleration (g)", drawGrid = FALSE) %>%
dyLegend(show = "never", hideOnMouseOut = TRUE)
)
# Dashboard Plots ---------------------------------------------------------
# ~ Plot 1 -----------------------------------------------------------
output$dashboardplot1 <- renderPlotly({
test <- Window()
#write.csv(test, "test.csv")
df <- data.frame(
acc.zone = c(test$C.acc.zone, test$R.acc.zone, test$L.acc.zone),
raw.peak.mag = c(test$C.raw.peak.mag, test$R.raw.peak.mag, test$L.raw.peak.mag),
ma.peak = c(test$C.ma.Peak, test$R.ma.Peak, test$L.ma.Peak),
location = c(rep("c", nrow(test)), rep("r", nrow(test)), rep("l", nrow(test)))
) %>%
mutate_at(1:3, as.numeric) %>%
dplyr::filter(ma.peak == 1 & acc.zone > 1.8) %>%
group_by(location, acc.zone) %>%
summarise(sum = length(raw.peak.mag)) %>%
# sum = sum(raw.peak.mag)) %>%
tidyr::pivot_wider(id_cols = acc.zone, names_from = "location", values_from = sum )
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
if(!is.na(file.list[2])){
plotly::plot_ly(df, x = ~acc.zone, y = ~r, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_trace(y = ~-l, name = 'Left', marker = list(color = 'rgb(79, 151, 213)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plotly::plot_ly(df, x = ~acc.zone, y = ~c, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# ~ Plot 2 -----------------------------------------------------------
output$dashboardplot2 <- renderPlotly({
df <- Window()
now_lt <- as.POSIXlt(Sys.time(), tz = "GMT")
tm <- df$time
x <- now_lt + tm
ay1 <- list(
side = "left",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ay <- list(
tickfont = list(color = "blue"),
overlaying = "y",
side = "right",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
if(length(x) < 50000){
plot_ly(x = ~x) %>%
plotly::add_trace(y = ~cumsum(df$C.PL), mode = 'lines', type = "scatter", yaxis = "y2", name = "PlayerLoad", line = list(color = '#7C8B9D')) %>%
plotly::add_trace(x = ~x, y = ~df$C.res.acc[1:length(tm)], type = "scatter", mode = "lines", name = "Acceleration (100 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(y = ~df$C.Jump[1:length(tm)]*5, name = "Jumps", marker = list(color = "lightgrey")) %>%
#plotly::add_trace(x = ~x, y = ~cumsum(df[df$C.raw.peak.mag > 1.5,]$C.raw.peak.mag[1:length(tm)])/100, mode = "lines", type = "scatter", yaxis = "y2", name = "Impact Load / 100") %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plot_ly(df[df$C.Jump == 1,], x = ~time) %>%
plotly::add_trace(data = df[seq(1, nrow(df), 20),], y = ~C.res.acc, type = "scatter", mode = "lines", name = "Acceleration (20 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(data = df[df$C.Jump == 1,], y = ~C.Jump*4, name = "Jumps", marker = list(color = 'lightgrey')) %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# Longitudinal Plots ---------------------------------------------------
# ~ Plot 1 -------------------------------------------------------------
output$longplot1 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
)
if(use.sql()){cols <- 14:93}else{cols <- 15:94}
if(input$time_grouping == 1){
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[cols], sum
)
}
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[cols], sum
)
}
x <- list(
title = "",
tickformat = "%d/%m"
)
p <- plot_ly(data, x = ~as.Date(session_date, format = "%d/%m/%Y")) %>%
#plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent', barmode = "stack", title = "External Load")
if(1 %in% input$variables){
y <- list(
title = "Jump Count"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_6_10 + Jumps_10_15 + Jumps_15_20, name = "< 20 cm", marker = list(color = '#FFBABA')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_20_25 + Jumps_25_30, name = "20-30 cm", marker = list(color = '#FF7B7B')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_30_35 + Jumps_35_40, name = "30-40 cm", marker = list(color = '#FF5252')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_40_45 + Jumps_45_50, name = "40-50 cm", marker = list(color = '#FF0000')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~Jumps_50_55 + Jumps_55_60 + Jumps_60_65 + Jumps_65_70 + Jumps_70_75 + Jumps_75_80, name = "> 50 cm", marker = list(color = '#A70000')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(2 %in% input$variables){
y <- list(
title = "Impact Count"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_2_0 + C_count_2_5 + C_count_3_0, name = "1.5-3 g", marker = list(color = '#FFBABA')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_3_5 + C_count_4_0 + C_count_4_5 + C_count_5_0, name = "3-5 g", marker = list(color = '#FF7B7B')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_5_5 + C_count_6_0 + C_count_6_5 + C_count_7_0, name = "5-7 g", marker = list(color = '#FF5252')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_7_5 + C_count_8_0 + C_count_8_5 + C_count_9_0, name = "7-9 g", marker = list(color = '#FF0000')) %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~C_count_9_5 + C_count_10_0, name = "> 9 g", marker = list(color = '#A70000')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(3 %in% input$variables){
y <- list(
title = "PlayerLoad"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~total_pl, name = "PlayerLoad", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
if(4 %in% input$variables){
y <- list(
title = "Impact Load"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~DSL, name = "Impact Load", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
}
p
})
# ~ Plot 2 -------------------------------------------------------------
output$longplot2 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[14:93], sum
)
}
x <- list(
title = ""
)
p <- plot_ly(data, x = ~as.Date(session_date, format = "%d/%m/%Y")) %>%
#plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent', barmode = "stack", title = "Internal Load")
y <- list(
title = "s-RPE"
)
p <- p %>%
plotly::add_bars(data = data, x = ~as.Date(session_date, format = "%d/%m/%Y"),
y = ~srpe, name = "s-RPE", marker = list(color = '#FFBABA')) %>%
plotly::layout(yaxis = y, xaxis = x)
p
})
# ~ Plot 3- R/L balance --------------------------------------------------------
output$longplot3 <- renderPlotly({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
c(session_date, R_DSL, L_DSL)
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}else{
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}
data <- data %>%
mutate(
asym = R_DSL - L_DSL,
L_DSL = 0 - L_DSL
)
data2 <- data %>%
select(-asym) %>%
pivot_longer(
!session_date,
names_to = "variable",
values_to = "value"
)
y <- ceiling(max(sqrt(data2$value^2))/1000)*1000
y <- c(-y, y)
p <- ggplot(data2)+
geom_col(
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
y = value,
fill = variable
)
)+
scale_fill_manual(
values = c("#FFBABA", "#5AB69B")
)+
scale_x_date(date_breaks = "7 days", date_labels = "%d/%m")+
geom_segment(
data = data,
y = 0,
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
xend = as.Date(session_date, format = "%d/%m/%Y"),
yend = asym
)
)+
geom_point(
data = data,
aes(
x = as.Date(session_date, format = "%d/%m/%Y"),
y = asym,
shape = asym > 0
),
show.legend = F
)+
scale_shape_manual(values = c(6, 2), guide = "none")+
theme_minimal()+
labs(
x = NULL,
y = "Left Right"
)+
theme(
legend.title = element_blank(),
legend.position = "none"
)+
ylim(y)
ggplotly(p)
})
# ~ Table 0 - R/L balance --------------------------------------------------------
output$longtable0 <- formattable::renderFormattable({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
c(session_date, R_DSL, L_DSL)
)
lastmon <- function(x) 7 * floor(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
if(input$time_grouping == 2){
data <- data %>%
mutate(session_date = lastmon(as.Date(session_date, format = "%d/%m/%Y"))) %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}else{
data <- data %>%
group_by(session_date) %>%
summarise_at(.vars = colnames(.)[2:3], sum
)
}
data <- as.data.frame(t(data))
names(data) <- substr(data[1,], 1, 10)
data <- data[-1,]
rownames(data) <- c("Right", "Left")
formattable::formattable(
data ,
align = rep("c", ncol(data)),
lapply(1:nrow(data), function(row) {
formattable::area(row) ~ formattable::color_tile("transparent", "#FF7B7B")
})
#align =c("l",rep("c", 12), "r"),
# list(
# "s-RPE" = formattable::color_tile("transparent", '#5AB69B'),
# # "Impact Load" = formattable::color_tile("transparent", '#FF7B7B'),
# # "PlayerLoad" = formattable::color_tile("transparent", '#FF7B7B')
# #
# )
)
})
# ~ Table 1 --------------------------------------------------------
output$longtable1 <- formattable::renderFormattable({
data <- as.data.frame(db$db) %>%
dplyr::filter(
athlete_name == input$select_athlete2,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range[2]
) %>%
select(
session_date, session_type, session_name, starttime,
total_dur, active_dur, srpe, total_pl, DSL, s_jumps, m_jumps,
l_jumps, R_DSL, L_DSL
) %>%
mutate(
active_dur = round(active_dur),
total_pl = round(total_pl),
DSL = round(DSL)
) %>%
rename(
Date = 1, Type = 2, Name = 3, Time = 4, Duration = 5,
"Active Dur." = 6, "s-RPE" = 7, PlayerLoad = 8, "Impact Load" = 9,
"Small Jumps" = 10, "Med. Jumps" = 11, "Large Jumps" = 12,
"R Imp. Ld." = 13, "L Imp. Ld." = 14
)
formattable::formattable(data,
align =c("l",rep("c", 12), "r"),
list(
"Date" = formattable::formatter("span", style = ~ formattable::style(color = "grey",font.weight = "bold")),
"s-RPE" = formattable::color_tile("transparent", '#5AB69B'),
"Impact Load" = formattable::color_tile("transparent", '#FF7B7B'),
"PlayerLoad" = formattable::color_tile("transparent", '#FF7B7B')
))
})
# Squad Dashboard ---------------------------------------------------------
# ~ Date slider ----
output$date_range2 <- renderUI({
sliderInput("date_range2", "Select Date Range:",
min = min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max = max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), value = c(min(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T), max(as.Date(db$db$session_date, format = "%d/%m/%Y"), na.rm = T)),
timeFormat = "%F", ticks = F
)
})
# ~ Athlete selector ----
output$select_athlete3 <- renderUI({
selectInput('select_athlete3',
label ='Select Athletes:',
choices=athletes$athletes,
selected = NULL, multiple = T)
})
# ~ Create squad data ----
# # observe event for updating the reactiveValues
# observeEvent(input$submit,
# {
# squaddata$data <- db$db
# })
#
# # reactiveValues
# squaddata <- reactiveValues(
# data = NA
# )
squaddata <- eventReactive(input$updatesquad, {
data <- db$db %>%
dplyr::filter(
athlete_name %in% input$select_athlete3,
as.Date(session_date, format = "%d/%m/%Y") >= input$date_range2[1],
as.Date(session_date, format = "%d/%m/%Y") <= input$date_range2[2]
)
for(i in input$select_athlete3){
for(j in input$date_range2[1]:input$date_range2[2]){
data <- data %>%
ungroup() %>%
mutate(session_date = as.Date(session_date, format = "%d/%m/%Y")) %>%
add_row(session_date = as.Date(j), athlete_name = i)
}
}
data
})
# ~ Table 1 ----
output$squadtable <- formattable::renderFormattable({
data <- as.data.frame(squaddata()) %>%
select(
session_date, session_type, athlete_name, starttime,
total_dur, active_dur, srpe, total_pl, DSL, s_jumps, m_jumps,
l_jumps, R_DSL, L_DSL
) %>%
mutate(
active_dur = round(active_dur),
total_pl = round(total_pl),
DSL = round(DSL)
) %>%
rename(
Date = 1, Type = 2, Name = 3, Time = 4, Duration = 5,
"Active Dur." = 6, "sRPE" = 7, PlayerLoad = 8, "ImpactLoad" = 9,
"Small Jumps" = 10, "Med. Jumps" = 11, "Large Jumps" = 12,
"R Imp. Ld." = 13, "L Imp. Ld." = 14
)
if(input$time_grouping2 == 1){
data <- data %>%
group_by(Name, Date) %>%
summarise(
PlayerLoad = sum(PlayerLoad, na.rm = T),
sRPE = sum(sRPE, na.rm = T),
impactload = sum(ImpactLoad, na.rm = T)
)
}
if(input$select_squad_variable == 1){data$values <- data$PlayerLoad}
if(input$select_squad_variable == 2){data$values <- data$sRPE}
if(input$select_squad_variable == 3){data$values <- data$impactload}
data <- data %>%
pivot_wider(
id_cols = Name,
names_from = Date,
values_from = values
)
formattable::formattable(data,
align =c("l",rep("c", ncol(data)-1)),
lapply(1:nrow(data), function(row) {
formattable::area(row) ~ formattable::color_tile("transparent", "#FF7B7B")
})
)
})
# Session Dashboard -------------------------------------------------------
# ~ Athlete selector ----
output$select_athlete4 <- renderUI({
selectInput('select_athlete4',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
# ~ Date selector ----
output$select_date <- renderUI({
dateInput('select_date',
label ='Select Date:')
})
# ~ Session selector ----
sessionlist <- reactive ({
if(use.sql()){
as.vector( dbGetQuery(conn, paste0("Select DISTINCT session_name from raw_training_load WHERE session_date = '", input$select_date, "';") ))
}else{
list.files(
paste0("./clipped-sessions/", input$select_athlete4, "/", as.Date(input$select_date, format = "%Y-%m-%d"), "/")
)
}
})
output$select_session <- renderUI({
selectInput('select_session',
label ='Select Session:',
choices = sessionlist()
)
})
output$test <- renderText(
input$select_session
)
sessiondata <- eventReactive(input$updatesession, {
if(use.sql()){
#as.vector( dbGetQuery(conn, "Select athlete_name from athletes;") )
dbGetQuery(conn, paste0("SELECT * FROM raw_training_load WHERE session_name = '", input$select_session, "' AND session_date = '", input$select_date, "';"))
}else{
read.csv(
paste0("./clipped-sessions/", input$select_athlete4, "/", as.Date(input$select_date, format = "%Y-%m-%d"), "/", input$select_session)
)
}
})
# ~ Value Boxes ----
output$value_box.7 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 0)), "Jumps", icon = icon("arrow-alt-circle-up"), width = 2, color = "yellow")
})
output$value_box.8 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 0 & sessiondata()$C_jh < 20)), "Small Jumps", icon = icon("angle-up"), width = 2, color = "yellow")
})
output$value_box.9 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh >= 20 & sessiondata()$C_jh < 40)), "Medium Jumps", icon = icon("angle-double-up"), width = 2, color = "yellow")
})
output$value_box.10 <- renderValueBox({
valueBox(length(which(sessiondata()$C_jh > 40)), "Large Jumps", icon = icon("fighter-jet"), width = 2, color = "yellow")
})
output$value_box.11 <- renderValueBox({
valueBox(paste0(round(length(which(sessiondata()$C_active_time > 0))/100/60), " min"), "Active Duration", icon = icon("clock"), width = 2, color = "yellow")
})
output$value_box.12 <- renderValueBox({
valueBox(paste(round(nrow(sessiondata())/100/60), " min"), "Total Duration", icon = icon("clock"), width = 2, color = "yellow")
})
# ~ Plot 1 -----------------------------------------------------------
output$sessionplot1 <- renderPlotly({
test <- sessiondata()
df <- data.frame(
acc.zone = c(test$C_acc_zone, test$R_acc_zone, test$L_acc_zone),
raw.peak.mag = c(test$C_raw_peak_mag, test$R_raw_peak_mag, test$L_raw_peak_mag),
ma.peak = c(test$C_ma_Peak, test$R_ma_Peak, test$L_ma_Peak),
location = c(rep("c", nrow(test)), rep("r", nrow(test)), rep("l", nrow(test)))
) %>%
mutate_at(1:3, as.numeric) %>%
dplyr::filter(ma.peak == 1 & acc.zone > 1.8) %>%
group_by(location, acc.zone) %>%
summarise(sum = length(raw.peak.mag)) %>%
# sum = sum(raw.peak.mag)) %>%
tidyr::pivot_wider(id_cols = acc.zone, names_from = "location", values_from = sum )
file.list <- c(parseFilePaths(roots = roots,input$Central)$datapath[1],
parseFilePaths(roots = roots,input$Left)$datapath[1],
parseFilePaths(roots = roots,input$Right)$datapath[1]
)
if(!is.na(file.list[2])){
plotly::plot_ly(df, x = ~acc.zone, y = ~r, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_trace(y = ~-l, name = 'Left', marker = list(color = 'rgb(79, 151, 213)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plotly::plot_ly(df, x = ~acc.zone, y = ~c, type = 'bar', name = 'Right', marker = list(color = 'rgb(90, 182, 155)')) %>%
plotly::layout(yaxis = list(title = 'Impact Count'), xaxis = list(title = 'Acceleration Zone (g)'), barmode = 'relative') %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# ~ Plot 2 -----------------------------------------------------------
output$texttest <- renderText({
df <- sessiondata()
df$row_number[1]
#now_lt <- as.POSIXlt(df$time[1], tz = "GMT")
#unlist(now_lt[1])
})
output$sessionplot2 <- renderPlotly({
df <- sessiondata()
if(use.sql()){
now_lt <- lubridate::as_datetime(df$time[1])
}else{
now_lt <- as.POSIXlt(df$time[1], tz = "GMT")
}
tm <- as.numeric(df$row_number)
x <- now_lt + tm
ay1 <- list(
side = "left",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ay <- list(
tickfont = list(color = "blue"),
overlaying = "y",
side = "right",
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
ax <- list(
title = "",
zeroline = FALSE,
showline = FALSE,
showticklabels = FALSE,
showgrid = FALSE
)
if(length(x) < 50000){
plot_ly(x = ~x) %>%
plotly::add_trace(y = ~cumsum(df$C_PL), mode = 'lines', type = "scatter", yaxis = "y2", name = "PlayerLoad", line = list(color = '#7C8B9D')) %>%
plotly::add_trace(x = ~x, y = ~df$C_res_acc[1:length(tm)], type = "scatter", mode = "lines", name = "Acceleration (100 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(y = ~df$C_Jump[1:length(tm)]*5, name = "Jumps", marker = list(color = "lightgrey")) %>%
#plotly::add_trace(x = ~x, y = ~cumsum(df[df$C.raw.peak.mag > 1.5,]$C.raw.peak.mag[1:length(tm)])/100, mode = "lines", type = "scatter", yaxis = "y2", name = "Impact Load / 100") %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}else{
plot_ly(df[df$C_Jump == 1,], x = ~time) %>%
plotly::add_trace(data = df[seq(1, nrow(df), 20),], y = ~C_res_acc, type = "scatter", mode = "lines", name = "Acceleration (20 Hz)", line = list(color = 'rgb(90, 182, 155)')) %>%
plotly::add_bars(data = df[df$C_Jump == 1,], y = ~C_Jump*4, name = "Jumps", marker = list(color = 'lightgrey')) %>%
plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>%
plotly::layout(legend = list(orientation = 'h')) %>%
plotly::layout(plot_bgcolor='transparent') %>%
plotly::layout(paper_bgcolor='transparent')
}
})
# Upload Page -------------------------------------------------------------
#shinyjs::onclick(input$athlete_count, if(input$athlete_count < 2){toggle(id = "athlete_upload_2")})
## observe the button being pressed
observeEvent(input$athlete_count, {
if(input$athlete_count < 2){shinyjs::hide(id = "athlete_upload_2")}else{
shinyjs::show(id = "athlete_upload_2")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 3){shinyjs::hide(id = "athlete_upload_3")}else{
shinyjs::show(id = "athlete_upload_3")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 4){shinyjs::hide(id = "athlete_upload_4")}else{
shinyjs::show(id = "athlete_upload_4")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 5){shinyjs::hide(id = "athlete_upload_5")}else{
shinyjs::show(id = "athlete_upload_5")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 6){shinyjs::hide(id = "athlete_upload_6")}else{
shinyjs::show(id = "athlete_upload_6")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 7){shinyjs::hide(id = "athlete_upload_7")}else{
shinyjs::show(id = "athlete_upload_7")}
})
observeEvent(input$athlete_count, {
if(input$athlete_count < 8){shinyjs::hide(id = "athlete_upload_8")}else{
shinyjs::show(id = "athlete_upload_8")}
})
# Add athlete selection boxes
output$athlete1 <- renderUI({
selectInput('athlete1',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete2 <- renderUI({
selectInput('athlete2',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete3 <- renderUI({
selectInput('athlete3',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete4 <- renderUI({
selectInput('athlete5',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete5 <- renderUI({
selectInput('athlet5',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete6 <- renderUI({
selectInput('athlete6',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete7 <- renderUI({
selectInput('athlete7',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
output$athlete8 <- renderUI({
selectInput('athlete7',
label ='Select Athlete:',
choices=athletes$athletes,
selected = NULL, multiple = F)
})
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.