R/mod_app.R

Defines functions mod_app_server mod_app_ui

#' app UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @import shinydashboardPlus
#' @import shiny
#' @import shinydashboard
#' @import dashboardthemes
#' @import shinyWidgets
#' @import shinycssloaders
#' @import dygraphs
#' @import DescTools
#' @import zoo
#' @import caTools
#' @import png
#' @import xts
#' @import dplyr
#' @import gridExtra
#' @import extrafont
#' @import ggplot2
#' @import ggiraph
#' @import data.table
#' @import fmsb
#' @import shinyFiles
#' @import pool
#' @import dplyr
#' @import odbc
#' @import DBI
#' @import DT
#' @import lubridate
#' @import chron
#' @import shinyjs
#' @import rowr
#' @import plotly
#' @import signal

mod_app_ui <- function(id){
  ns <- NS(id)
  
  # Settings ----------------------------------------------------------------
  settings <- read.csv("settings/sql.csv")
  use.sql <- settings$csv[1] == 0
  
  # Create a database backup
  if(!use.sql){
    write.csv(read.csv("database.csv"), paste("backups/db_backup ", format(Sys.time(), "%Y-%m-%d %H%M"), ".csv", sep = ""), row.names = F)
  }
  
  # Create lists for drop down menus----
  Session_type_list <- read.csv("settings/lists.csv")[,1]
  Ballet_List <- read.csv("settings/lists.csv")[,2]
  
  # Load filepaths ----------------------------------------------------------
  filepaths <- read.csv("settings/filepaths.csv")
  roots <- filepaths[,2]
  names(roots) <- filepaths[,1]
  
  
  
  # Create dashboard theme ----
  theme_light <- shinyDashboardThemeDIY(
    ### general
    appFontFamily = "Arial"
    ,appFontColor = "#616161"
    ,primaryFontColor = "rgb(0,0,0)"
    ,infoFontColor = "rgb(0,0,0)"
    ,successFontColor = "rgb(0,0,0)"
    ,warningFontColor = "rgb(0,0,0)"
    ,dangerFontColor = "rgb(0,0,0)"
    ,bodyBackColor = "#F9FAFB"
    
    ### header
    ,logoBackColor =  "#252E3E"
    
    ,headerButtonBackColor = "#252E3E"
    ,headerButtonIconColor = "white"
    ,headerButtonBackColorHover = "#538CC6"
    ,headerButtonIconColorHover = "white"
    
    ,headerBackColor = "#252E3E"
    ,headerBoxShadowColor = "#CB2030"
    ,headerBoxShadowSize = "0px 0px 0px"
    
    ### sidebar
    ,sidebarBackColor = "#F9FAFB"
    ,sidebarPadding = 0
    
    ,sidebarMenuBackColor = "#F9FAFB"
    ,sidebarMenuPadding = 0
    ,sidebarMenuBorderRadius = 0
    
    ,sidebarShadowRadius = "0px 0px 0px"
    ,sidebarShadowColor = "#aaaaaa"
    
    ,sidebarUserTextColor = "#343D46"
    
    ,sidebarSearchBackColor = "rgb(55,72,80)"
    ,sidebarSearchIconColor = "rgb(153,153,153)"
    ,sidebarSearchBorderColor = "#D8DEE9"
    
    ,sidebarTabTextColor = "#343D46"
    ,sidebarTabTextSize = 15
    ,sidebarTabBorderStyle = "none none none none"
    ,sidebarTabBorderColor = "#D8DEE9"
    ,sidebarTabBorderWidth = 100
    
    ,sidebarTabBackColorSelected = "#D8DEE9"
    ,sidebarTabTextColorSelected = "rgb(0,0,0)"
    ,sidebarTabRadiusSelected = "0px 0px 0px 0px"
    
    ,sidebarTabBackColorHover = "#D8DEE9"
    ,sidebarTabTextColorHover = "rgb(50,50,50)"
    ,sidebarTabBorderStyleHover = "none solid solid solid"
    ,sidebarTabBorderColorHover = "transparent"
    ,sidebarTabBorderWidthHover = 1
    ,sidebarTabRadiusHover = "0px 0px 0px 0px"
    
    ### boxes
    ,boxBackColor = "rgb(255,255,255)"
    ,boxBorderRadius = 1
    ,boxShadowSize = "0px 0px 0px"
    ,boxShadowColor = "transparent"
    ,boxTitleSize = 16
    ,boxDefaultColor =  "white" #  "rgb(210,214,220)"
    ,boxPrimaryColor = "rgba(44,222,235,1)"
    ,boxInfoColor = "rgb(210,214,220)"
    ,boxSuccessColor = "#6699CC"
    ,boxWarningColor = "rgb(244,156,104)"
    ,boxDangerColor = "rgb(255,88,55)"
    
    ,tabBoxTabColor = "rgb(255,255,255)"
    ,tabBoxTabTextSize = 14
    ,tabBoxTabTextColor = "lightgrey"   #"rgb(0,0,0)"
    ,tabBoxTabTextColorSelected = "#6699CC"
    ,tabBoxBackColor = "rgb(255,255,255)"
    ,tabBoxHighlightColor = "rgb(248,248,248)"   #"#6699CC"
    ,tabBoxBorderRadius = 0
    
    ### inputs
    ,buttonBackColor = "rgb(245,245,245)"
    ,buttonTextColor = "rgb(0,0,0)"
    ,buttonBorderColor = "rgb(200,200,200)"
    ,buttonBorderRadius = 5
    
    ,buttonBackColorHover = "rgb(235,235,235)"
    ,buttonTextColorHover = "rgb(100,100,100)"
    ,buttonBorderColorHover = "rgb(200,200,200)"
    
    ,textboxBackColor = "rgb(255,255,255)"
    ,textboxBorderColor = "rgb(200,200,200)"
    ,textboxBorderRadius = 5
    ,textboxBackColorSelect = "rgb(245,245,245)"
    ,textboxBorderColorSelect = "rgb(200,200,200)"
    
    ### tables
    ,tableBackColor = "rgb(255,255,255)"
    ,tableBorderColor = "rgb(240,240,240)"
    ,tableBorderTopSize = 1
    ,tableBorderRowSize = 1
    
  )
  
  #Create the header logo
  logo_blue <- shinyDashboardLogoDIY(
    mainText = "Dashboard"
    ,boldText = "Training Load"
    ,textSize = 16
    ,badgeText = ""
    ,badgeTextColor = "white"
    ,badgeTextSize = 0
    ,badgeBackColor = "white"
    ,badgeBorderRadius = 0
  )
  
  
  
  
  tagList(
    ui <-  dashboardPagePlus(
      useShinyjs(),
      
      #   Header -----------------------------------------------------------------
      
      header = dashboardHeaderPlus(
        #Add logos
        title = tagList(
          img(class = "logo-mini", src = "logo_short_wt.png", height = "50px", width = "52.5px", align = "centre"), 
          img(class = "logo-lg", src = "logo_long_wt.png", height = "50px", width = "230px", align = "left")),
        enable_rightsidebar = TRUE,
        rightSidebarIcon = "cog"
      ),
      
      
      #   Left Sidebar -----------------------------------------------------------
      
      sidebar = dashboardSidebar(
        width = 300,
        uiOutput('style_tag'),
        
        # Sidebar menu
        sidebarMenu(
          id = "sidebar",
          menuItem("Upload Data", tabName = "UploadData2", icon = icon("file-upload")),
          menuItem("Analyse Data", tabName = "Dashboard", icon = icon("chart-area")),
          menuItem("Dashboard", tabName = "Dashboard2", icon = icon("chart-bar")),              
          menuItem("Database", tabName = "Database", icon = icon("database")),
          
          div( id = 'sidebar_cr',
               conditionalPanel(condition = "input.sidebar === 'Database'",
                                actionButton("db_csv", "Download Database as csv", width = 200)
                                #downloadButton("db_csv", "Download Database as csv")
               ))
          #menuItem("Database", tabName = "Database", icon = icon("th")),
          #menuItem("Daily Report", tabName = "DailyReport", icon = icon("chart-line"))
        )
      ),
      
      #   - Right Sidebar -----------------------------------------------------------
      
      rightsidebar =  rightSidebar(
        width = 250,
        rightSidebarTabContent(
          id = 1,
          icon = "desktop",
          active = TRUE,
          title = 
            "Welcome to OpenTrack. If you're just getting started, check out the user guide which can be found at https://github.com/joseph-shaw/OpenTrack"
        ),
        rightSidebarTabContent(
          id = 2,
          title = "Filter Settings",
          radioButtons("filtertype", "Select filter type:", choices = c("Butterworth", "Moving Average"), selected = "Butterworth"),
          numericInput("cutofffreq", "Cutoff frequency/window size", min = 1, max = 100, step = 1, value = 12)
        ),
        rightSidebarTabContent(
          id = 3,
          icon = "paint-brush",
          title = "About",
          numericInput("obs", "Observations:", 10, min = 1, max = 100)
        )
      ),
      
      
      
      
      
      #   - Dashboard Body ----------------------------------------------------------
      
      body = dashboardBody(
        theme_light,
        #       ~ Tab 1 ---- "Upload Data"-------------
        tabItems(
          tabItem(
            tabName = "UploadData2",
            # Upload buttons
            tags$h5("Upload the raw data:", style = "font-weight: bold;"),
            shinyFilesButton('Central', label='Select Central File...', title='Please select a file', multiple=FALSE, style='font-size:100%'),
            tags$span(style="display:inline-block; width: 10px;"),
            shinyFilesButton('Left', label='Select Left File...', title='Please select a file', multiple=FALSE, style='padding-right:23px; padding-left:23px; font-size:100%'),
            tags$span(style="display:inline-block; width: 10px;"),
            shinyFilesButton('Right', label='Select Right File...', title='Please select a file', multiple=FALSE, style='padding-right:18px; padding-left:18px; font-size:100%'),
            tags$br(),
            textOutput("filepath1"), 
            textOutput(outputId = "res_defaultValue"),
            textOutput("filepath2"), 
            textOutput("filepath3"), 
            tags$br(), 
            # Time input
            airDatepickerInput("starttime",
                               timepicker = TRUE,
                               label = "What time were the units turned on?:",
                               placeholder = NULL,
                               multiple = FALSE,
                               clearButton = TRUE,
                               
                               value = as.POSIXct(paste(Sys.Date(),'10:00', sep = " ")),
                               width = 300
            ),
            # Otheroptions
            selectInput("timeunit", "What are the input units of time?:", choices = c("s", "1 / 10", "1 / 100", "ms"), selected = "ms"),
            radioButtons("invertup", "Swap up/down:", choiceNames = c("No", "Yes"), choiceValues = c(1, -1), selected = 1),
            tags$hr(), 
            actionButton("processraw", "Process Data", width = 200, style='padding-top:0px; padding-bottom:0px; padding-left:10px; font-size:100%'),
            #actionButton("saveraw", "Save Raw Data", width = 200) 
          ),
          #       ~ Tab 2 ---- "Analyse Data"------------------------------------------   
          tabItem(
            tabName = "Dashboard",
            # Acceleration plots
            fluidRow(
              tabBox(
                width = 12,
                tabPanel(
                  status = "primary",
                  title = "Accelerometry Graph - Central",
                  withSpinner(dygraphOutput("Graph1", height = 190), type = 3, color.background = "white")
                ),
                tabPanel(
                  status = "secondary",
                  title = "Accelerometry Graph - L/R",
                  withSpinner(dygraphOutput("Graph2", height = 190), type = 3, color.background = "white")
                )
              )
            ), 
            # Data entry boxes 
            fluidRow(
              tabBox(
                width = 12, height = 350,
                # Session info
                tabPanel(
                  status = "primary",
                  title = "Session/Drill Data",
                  column(3,
                         h4("Enter Session Information"),
                         selectInput('sessiontype',
                                     'Session Type:',
                                     selected = 'Rehearsal',
                                     choices = Session_type_list
                         ),
                         uiOutput("select_athlete"),
                         textInput("durationoverride",
                                   "Duration Override:",
                                   value = "0"
                         )
                  ),
                  column(4, offset = 1,
                         br(),
                         br(),
                         textInput('sessionname',
                                   'Session Name:'
                         ),
                         splitLayout(
                           textInput('rpe',
                                     'RPE:',
                                     value = 0
                           ),
                           br(),
                           textInput('position',
                                     'Position:'
                           ), cellWidths = c(100,10, 185)
                         ),
                         
                         textInput('comments',
                                   'Comments:'
                         )
                  ),
                  column(4, offset = 0,
                         br(),
                         br(),
                         numericInput(
                           inputId = "sessionnumber",
                           label = "Session Number:",
                           value = 1,
                           step = 1
                         ),
                         
                         # Create action buttons
                         br(),
                         actionButton("addsession1",
                                      "Add Session to Database",
                                      width = 300
                         ),
                         br(),
                         uiOutput("clip"),
                         br(),
                         br(),
                         # actionButton("saveproc",
                         #              "Save Processed Data",
                         #              width = 300
                         # )
                  )
                ),
                # Add athlete
                tabPanel(
                  title = "Add New Athlete",
                  column(3,
                         textInput('new_name',
                                   'Name:'
                         ),
                         dateInput("new_dob",
                                   "Date of Birth:"
                         ),
                         textInput('new_sex',
                                   'Sex (single letter):'
                         ),
                         textInput('new_email',
                                   'Email Address:'
                         )
                         
                  ),
                  column(
                    width = 1,
                    br(),
                    actionButton("new_athlete",
                                 "Add Athlete",
                                 width = 100
                    )
                  )
                  
                )
              )
            )          
          ),
          #       ~ Tab 3 ---- "Dashboard"-----------------------------------------------------------------------
          tabItem(
            tabName = "Dashboard2",
            fluidRow(
              valueBoxOutput("value_box.1", width = 2),
              valueBoxOutput("value_box.2", width = 2),
              valueBoxOutput("value_box.3", width = 2),
              valueBoxOutput("value_box.4", width = 2),
              valueBoxOutput("value_box.5", width = 2),
              valueBoxOutput("value_box.6", width = 2)
            ),
            fluidRow(
              column(6,plotlyOutput("dashboardplot1", width="600px",height="300px")),  
              column(6,plotlyOutput("dashboardplot2", width="600px",height="300px"))
              
            )
          ),
          #       ~ Tab 4 ---- "Database"-----------------------------------------------------------------------
          tabItem(
            tabName = "Database",
            #     Database DataTable 
            fluidRow(
              box(height = "auto", width = "auto",
                  h5("Database"),
                  div(style="display: inline-block;padding:0; width: 1200px;overflow-x: scroll",
                      #tableOutput("summarydata12" #, height = 300
                      dataTableOutput("table" #, height = "auto"
                      )
                  )
              )
            ),
            #     New Row 
            fluidRow(
              box(height = "auto", width = "auto",
                  h5("New Row"),
                  #width = 12,
                  div(style="display: inline-block;padding:0; width: 1200px;overflow-x: scroll",
                      dataTableOutput("summarydata1") #
                  )
              )
            ),
            #     SQL Buttons 
            fluidRow(
              box(
                h5("Add Session:"),
                width = 2,
                actionButton("addsession2", "Add Session", width = 150)
              ),
              box(
                h5("Session ID:"),
                width = 2,
                textInput("rowref", label = NULL, width = 150)
              ),
              box(
                h5("Column reference:"),
                width = 2,
                textInput("columnref", label = NULL, width = 150)
              ),
              box(
                h5("New data to input:"),
                width = 2,
                textInput("newinput", label = NULL, width = 150)
              ),
              box(
                h5("Delete whole row:"),
                width = 2,
                actionButton("droprowbutton",
                             "Delete row",
                             width = 150
                )
              ),
              box(
                h5("Insert new data:"),
                width = 2,
                actionButton("SQLinputbutton",
                             "Insert data",
                             width = 150
                )
              )
            )
          )
        )
      )
    )
  )
}
    
#' app Server Function
#'
#' @noRd 
mod_app_server <- function(input, output, session){
  ns <- session$ns
  
  # Settings ----------------------------------------------------------------
  settings <- read.csv("settings/sql.csv")
  use.sql <- settings$csv[1] == 0
  
  # Create lists for drop down menus----
  Session_type_list <- read.csv("settings/lists.csv")[,1]
  Ballet_List <- read.csv("settings/lists.csv")[,2]
  
  # Load filepaths ----------------------------------------------------------
  filepaths <- read.csv("settings/filepaths.csv")
  roots <- filepaths[,2]
  names(roots) <- filepaths[,1]
  
  
  # Options -----
  options(shiny.maxRequestSize = 70*1024^3,
          browser = "C:/Program Files/Mozilla Firefox/firefox.exe",
          shiny.usecairo=T)
  
  #memory.limit(size = 8095)
  
  
  # Database ----------------------------------------------------------------
  # ~ 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      = "FatHippo123!", # rstudioapi::askForPassword("Database password")
                           #Port     = 1433
    )
  }
  
  #FSU@ DIC FH123! DM13 2HD? 321T%
  
  
  # ~ Load TL data into reactive value  -----------------------------------
  db <- reactiveValues(
    db = NULL
  )
  
  # 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
  }, #width = "auto", 
  options = list(lengthMenu = list(c(3, 4, 5, 6, 10, -1), c('3', '4', '5', '6', '10', 'All')))
  )
  
  # ~ 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)
  })
  
  # 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]
      
    }
    
  })
  
  
  # ~ Buttons  ------------------------------------------------------------
  
  # ~ ~ 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)
      )
    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",
                   Window() %>% 
                     mutate(
                       time = as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time),
                       row_number = seq(1, nrow(Window()), 1)/100
                     ),
                   append = TRUE) 
      
    }else{
      new.row <- summary()
      new.row$session_id <- max(db$db$session_id, na.rm = T) +1
      db$db <- plyr::rbind.fill(db$db, new.row) %>% 
        filter(!is.na(session_id))
      write.csv(db$db, "database.csv", row.names = F)
      folder <- paste0("clipped-sessions/", input$select_athlete)
      filename <- paste0(folder, "/", paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 12, 16)), ".csv"))
      dir.create(folder, showWarnings = FALSE)
      write.csv(
        Window() %>% 
          mutate(
            time = as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time),
            row_number = seq(1, nrow(Window()), 1)/100
          ),
        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)
      )
    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",
                   Window() %>% 
                     mutate(
                       time = as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time),
                       row_number = seq(1, nrow(Window()), 1)/100
                     ),
                   append = TRUE) 
      
    }else{
      new.row <- summary()
      new.row$session_id <- max(db$db$session_id, na.rm = T) +1
      db$db <- plyr::rbind.fill(db$db, new.row) %>% 
        filter(!is.na(session_id))
      write.csv(db$db, "database.csv", row.names = F)
      folder <- paste0("clipped-sessions/", input$select_athlete)
      filename <- paste0(folder, "/", paste(input$select_athlete, input$sessiontype, input$sessionname, input$sessionnumber, gsub(":", "-", substr(input$Graph1_date_window[1], 12, 16)), ".csv"))
      dir.create(folder, showWarnings = FALSE)      
      write.csv(
        Window() %>% 
          mutate(
            time = as.POSIXct(input$Graph1_date_window[1]) + as.numeric(time),
            row_number = seq(1, nrow(Window()), 1)/100
          ),
        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 %>% 
        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
    )
  })
  
  
  
  
  # Filepaths --------------------------------------------------------------
  
  # File select 
  shinyFileChoose(input, 'Central', root=roots, filetypes='csv')
  shinyFileChoose(input, 'Left', root=roots, filetypes='csv')
  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 = c(documents = "C:/Users/shaw_/Documents/", SD_Card = 'e:/',  data = "d:/"),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 = "fuchsia")
  })
  output$value_box.2 <- renderValueBox({
    valueBox(summary()$s_jumps, "Small Jumps", icon = icon("angle-up"), width = 2, color = "olive")
  })
  output$value_box.3 <- renderValueBox({
    valueBox(summary()$m_jumps, "Medium Jumps", icon = icon("angle-double-up"), width = 2, color = "orange")
  })
  output$value_box.4 <- renderValueBox({
    valueBox(summary()$l_jumps, "Large Jumps", icon = icon("fighter-jet"), width = 2, color = "red")
  })
  output$value_box.5 <- renderValueBox({
    valueBox(paste0(round(summary()$active_dur), " min"), "Active Time", icon = icon("clock"), width = 2, color = "purple")
  })
  output$value_box.6 <- renderValueBox({
    valueBox(paste(round(Time()[3]/100/60), " min"), "Duration", icon = icon("clock"), width = 2, color = "teal")
  })
  
  # 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$timeunit == "ms"){time_unit <- 1000}  
    if(input$timeunit == "s / 100"){time_unit <- 100}  
    if(input$timeunit == "s / 10"){time_unit <- 10}  
    if(input$timeunit == "s"){time_unit <- 1}  
    
    invert <- as.numeric(input$invertup) #Add a variable to flip up and down
    
    # 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)  
      }
      
      #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)}
      
    }
    
    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
      )
    
    data$df <- DF
    
  })
  
  # 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(
      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 >  6   & 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.f.time < 40.3 & Window()$C.f.time > 22 & Window()$C.Jump == 1)),
      m_jumps = length(which(Window()$C.f.time > 40.3 & Window()$C.f.time < 57.1 & Window()$C.Jump == 1)),
      l_jumps = length(which(Window()$C.f.time > 57.1 & Window()$C.f.time < 80.7 & 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))
    ) %>% 
      select(
        cols
      )
    # Here it can be filtered based on contents of the 'export.csv' file
  })
  
  # ~ Output Data ----------------------------------------------------------
  output$summarydata1 <- renderDataTable({ #Data added
    #summary()
    DT::datatable(summary(),
                  extensions = 'Buttons', 
                  options = list(
                    searching = F,
                    paging = F,
                    dom = 'Bfrtip',
                    buttons = c('copy', 'csv', 'excel')
                  )
                  
    )
  })
  
  # 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*0.5), 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])
  })
  
  # 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*0.5), 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 = '#4157c1', 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()
    
    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) %>% 
      filter(ma.peak == 1 & acc.zone > 1.8) %>% 
      group_by(location, acc.zone) %>% 
      summarise(sum = length(raw.peak.mag)) %>% 
      # sum = sum(raw.peak.mag)) %>% 
      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(99, 203, 228)')) %>%
        plotly::add_trace(y = ~-l, name = 'Left', marker = list(color = 'rgb(234, 104, 109)')) %>% 
        plotly::layout(yaxis = list(title = 'Count'), xaxis = list(title = 'Acceleration Zone'), 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(234, 104, 109)')) %>%
        plotly::layout(yaxis = list(title = 'Count'), xaxis = list(title = 'Acceleration Zone'), 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 = '#4BC076')) %>% 
        plotly::add_trace(x = ~x, y = ~df$C.res.acc[1:length(tm)], type = "scatter", mode = "lines", name = "Acceleration (100 Hz)", line = list(color = '#4157c1')) %>% 
        plotly::add_bars(y = ~df$C.Jump[1:length(tm)]*5, name = "Jumps", marker = list(color = 'rgb(234, 104, 109)')) %>% 
        #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 = '#4157c1')) %>% 
        plotly::add_bars(data = df[df$C.Jump == 1,], y = ~C.Jump*4, name = "Jumps", marker = list(color = '#ea686d')) %>% 
        plotly::layout(yaxis2 = ay, xaxis = ax, yaxis = ay1) %>% 
        plotly::layout(legend = list(orientation = 'h')) %>% 
        plotly::layout(plot_bgcolor='transparent') %>% 
        plotly::layout(paper_bgcolor='transparent')  
      
    }
  })
  
  
  
}
    
## To be copied in the UI
# mod_app_ui("app_ui_1")
    
## To be copied in the server
# callModule(mod_app_server, "app_ui_1")
 
joseph-shaw/OpenTrack documentation built on Dec. 1, 2022, 9:54 a.m.