R/app_server.R

In becky-work/MouseCageApp: INCA

#' The application server-side
#' 
#' @param input,output,session Internal parameters for {shiny}. 
#'     DO NOT REMOVE.
#' @import shiny
#' @importFrom plotly renderPlotly plotlyOutput
#' @noRd
app_server <- function( input, output, session ) {
  # Your application server logic 
  
  whereami::cat_where( whereami::whereami())
  # Build sidebar UI ----
  output$sidebar <- renderMenu({
    sidebarMenu(
      id = 'tabs',
      ## start_tab----
      menuItem(tabName = 'start_tab',
               text = 'Howdy'),
      ## data_tab----
      #tabName = data_tab: load_data, rsd_data
      menuItem(tabName = 'data_tab',
               text = 'Data',
               ### tabName = load_data ----
               menuSubItem(tabName = "load_data",
                           text = "Load",
                           icon = icon("angle-double-right"))
               ),
      
      ## plot_tab ----
      # tabName = plot_tab: pca_plots, mean_ci_plots
      menuItem(tabName = 'plot_tab',
               text = 'Plots',
               ### tabName = pca_plots ----
               menuSubItem(tabName = "ts_plots",
                           text = "Time Series Plots",
                           icon = icon("angle-double-right")),
               ### tabName = mean_ci_plots ----
               menuSubItem(tabName = "metric_boxplots",
                           text = "Measurement Boxplots",
                           icon = icon("angle-double-right")))
    )
  })
  
  # global variables ----
  cage_df <- NULL
  
  # when switching tabs in the sidebar, change what is going to show
  observeEvent(input$tabs,{
    
    print(input$tabs) # show in console; mostly for debugging
    
    #############################################-
    # start_tab ----
    # default opening tab; renders text notes
    if(input$tabs == 'start_tab'){
      ## UI notes ----
      output$hi_note <- renderText({"Let's analyse cage data."})
      output$variable_for_notes <- renderText({
        "You will need a meta data file and the promethion file(s)."})
      ## UI ----
      output$to_render <- renderUI({
        fluidRow(
          verbatimTextOutput(outputId = "hi_note"),
          verbatimTextOutput(outputId = "variable_for_notes")
        )
      })
      ### change to 
      # output$start_tab_ui <- renderUI({start_tab_body_ui})
      #to app_ui tabItem( 'start_tab', uiOutput('start_tab_ui'))
      #############################################-
      } else if (input$tabs == 'load_data'){
        
        #############################################-
        # load data tab ----
        ## read and clean files; needs both meta and promethion
        ## TO DO: add in checks for column names
        
        ## vars needed ----
        ## create time seq choices - can adjust by argument as needed
        times <- format( seq.POSIXt(as.POSIXct('2021-01-01 00:00'), 
                                    as.POSIXct('2021-01-01 23:59'), by = "30 min"),"%H:%M")
        
        
        ## UI ----
        output$to_render <- renderUI({
          fluidPage(
            fluidRow(
              # show these every time at start
              box(title = 'Step 1:',
                  mod_load_data_ui('paths'))),
            fluidRow(
              box(title = 'Step 2:',
                  mod_working_data_table_ui("working_data_table_ui_1", time_selection = times)),
              conditionalPanel(condition = "output.fileUploaded", 
                               box(title = 'Switched tabs and want to reload table?',
                                   prettyCheckbox(inputId = "reload_table",
                                                  label = "Reload",
                                                  value = FALSE, # default to not finished
                                                  icon = icon("check"),
                                                  status = "success",
                                                  animation = "rotate")))
            ),
           
            # only show table after selections are made
            fluidRow(conditionalPanel(condition = "output.fileUploaded", 
                                      DT::DTOutput(outputId = 'cage_df_table')
            ))
          )
        })
        
        ## user selection of files ----
        ## read.csv
        file_df <- reactive(mod_load_data_server('paths'))
        
        observe({
          
          if(!is.null(file_df()[1]) & !(is.null(file_df()[2]))){
            cage_df_mod  <- mod_working_data_table_server("working_data_table_ui_1", file_data = file_df())
            # output as global variable
            cage_df <<- cage_df_mod
          } else {
            cage_df_mod  <- mod_working_data_table_server("working_data_table_ui_1", file_data = NA)
          }
          
          output$fileUploaded <- reactive({
            return(!is.null(cage_df_mod))
          })
          ## hide if it's null
          outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
          
          output$cage_df_table <- DT::renderDT(head(cage_df_mod))
          
          
        })
        
        
        
      #############################################-
      } else if (input$tabs == 'ts_plots'){ 
        #############################################-
        # ts plot tab ----
        
        #output$test_text <- renderText('testing some text \n wooooo')
        #verbatimTextOutput(outputId= 'no_file_text')
        #output$test_table <- DT::renderDT({shinipsum::random_DT(nrow = 5, ncol = 3)})
        #DT::DTOutput(outputId = 'test_table')
        #output$test_plot <- renderPlot(shinipsum::random_ggplot(type = 'random'))
        #plotOutput(outputId = 'test_plot')
        
        ## vars needed ----
        ## set colors for plot; not making this an option; note: these won't be set when using renderPlotly
        light_colors <- c(light = "#FFF68F", dark = "#8DEEEE")
        output$no_load_data <- renderText('Please upload files and select times for light on/off (Load Data section).')
        
        ts_plot_ui <- reactive({
          if(!is.null(cage_df)){
            
            mod_metrics_over_time_plots_ui("metrics_over_time_plots_ui_1", 
                                           mouse_selections = unique(cage_df$mouse_id),
                                           metric_selections = unique(cage_df$var),
                                           phase_selections=unique(cage_df$phase_num))
          } else{
            verbatimTextOutput(outputId= 'no_load_data')
          }
        })
        
        
        ## UI ----
        output$to_render <- renderUI({
          fluidPage(
            fluidRow(ts_plot_ui()),
            fluidRow(#plotOutput(outputId= 'ts_plot'))
              conditionalPanel(condition = "output.createdPlot",
                                    plotOutput(outputId= 'ts_plot')))
            )
        })
        
        observe({
          
          # p1 <- mod_metrics_over_time_plots_server("metrics_over_time_plots_ui_1", cage_data = cage_df)
          
          output$createdPlot <- reactive({
            return(!is.null(ts_ggplot))
          })
          ## hide if it's null
          outputOptions(output, 'createdPlot', suspendWhenHidden=FALSE)
          
          if(!is.null(cage_df)){
            ts_ggplot <- mod_metrics_over_time_plots_server("metrics_over_time_plots_ui_1", cage_data = cage_df)
          } else{
            ts_ggplot <- NULL
          }
          
          
          
          observe({
            output$ts_plot <- if(!is.null(ts_ggplot)){
                cat('\n render plot\n')
                renderPlot(ts_ggplot)
              } else {
                #this shouldn't show
                return(renderPlot(shinipsum::random_ggplot(type = 'violin')))
              }
            })
        
        })
        
        
        #############################################-
      } else if (input$tabs == 'metric_boxplots'){
        
        
        output$no_load_data <- renderText('Please upload files and select times for light on/off (Load Data section).')
        bx_ggplot <- NULL
        
        
        bx_plot_ui <- reactive({
          if(!is.null(cage_df)){
            
            mod_metric_boxplots_ui("metric_boxplots_ui_1", 
                                           mouse_selections = unique(cage_df$mouse_id),
                                           metric_selections = unique(cage_df$var),
                                           phase_selections=unique(cage_df$phase_num))
          } else{
            verbatimTextOutput(outputId= 'no_load_data')
          }
        })
        
        
        ## UI ----
        output$to_render <- renderUI({
          fluidPage(
            fluidRow(bx_plot_ui()),
            fluidRow(#plotOutput(outputId= 'ts_plot'))
              conditionalPanel(condition = "output.createdBxPlot",
                               plotlyOutput(outputId= 'bx_plot')))
          )
        })
        
        observe({
          
          
          
          output$createdBxPlot <- reactive({
            return(!is.null(bx_ggplot))
          })
          ## hide if it's null
          outputOptions(output, 'createdBxPlot', suspendWhenHidden=FALSE)
          
          if(!is.null(cage_df)){
            bx_ggplot <-mod_metric_boxplots_server("metric_boxplots_ui_1", 
                                                   cage_data = cage_df)
          } else{
            bx_ggplot <- NULL
          }
          
          
          
          observe({
            output$bx_plot <- if(!is.null(bx_ggplot)){
              cat('\n render boxplot\n')
              renderPlotly(bx_ggplot)
            } else {
              #this shouldn't show
              return(renderPlotly(shinipsum::random_ggplot(type = 'violin')))
            }
          })
          
        })
        
      }
  })
  
}