R/mod_metric_boxplots.R

In becky-work/MouseCageApp: INCA

#' metric_boxplots UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_metric_boxplots_ui <- function(id, mouse_selections = NA, metric_selections = NA, phase_selections=NA){
  ns <- NS(id)
  tagList(
    box(title = 'Choose which metric of which mouse/mice to view',
        pickerInput(inputId = ns('selected_mouse'),
                    label = 'Which mouse id',
                    choices = mouse_selections,
                    selected = NULL,
                    multiple = TRUE,
                    ## (de)select all options
                    options = list(`actions-box` = TRUE)
        ),
        pickerInput(inputId = ns('selected_metric'),
                    label = 'Which metric',
                    choices = metric_selections,
                    selected = NULL,
                    multiple = TRUE,
                    options = list(`actions-box` = TRUE)
        ), 
        # the phases won't be mouse/metric specific since I'm not filtering as those selections are made
        pickerInput(inputId = ns('selected_phase'),
                    label = 'Which phase',
                    choices = phase_selections,
                    selected = NULL,
                    multiple = TRUE,
                    options = list(`actions-box` = TRUE)
        ),
        prettyCheckbox(inputId = ns("done_selecting_plot"),
                       label = "Plot these?",
                       value = FALSE, # default to not finished
                       icon = icon("check"),
                       status = "success",
                       animation = "rotate")
        
    )
  )
}
    
#' metric_boxplots Server Functions
#'
#' @noRd 
mod_metric_boxplots_server <- function(id, cage_data = NA){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    req(input$selected_mouse)
    req(input$selected_metric)
    req(input$selected_phase)
    req(cage_data)
    
    filtered_cage_data <- eventReactive(input$done_selecting_plot,{
      if(input$done_selecting_plot == FALSE){
        cat('\nNot Finished with plot selections\n')
        return(NULL)
      }
      
      withProgress(message = 'Filtering data using selections', value = 0, {
        
        cat('\n building plot \n')
        
        incProgress(1/3, detail = "Filtering data")
      
      # cat('\n')
      # plot_title <- paste('Mouse:',  unlist(input$selected_mouse), 'with Metrics: ', unlist(input$selected_metric))
      # print(plot_title)
      # cat('\n')
      plot_df <- cage_data %>% 
        filter(mouse_id %in% input$selected_mouse, 
               var %in% input$selected_metric, 
               phase_num %in% input$selected_phase) %>% 
        mutate(subject_id = as.factor(subject_id))
      
      incProgress(2/3, detail = "Building plot")
      
     p <-  ggplot(plot_df, aes(y = n, x = subject_id)) + 
        geom_boxplot() +
        theme_minimal() +
        # theme(axis.text.x = element_blank(),
        #       axis.ticks.x = element_blank()) +
       facet_grid(rows = vars(var), scales = 'free_y', switch = 'y')
     
     p <- plotly::ggplotly(p) %>% plotly::layout(boxgap = .9)
     
     incProgress(3/3, detail = "Done with plot")
      })
     
     return(p)
    })
    return(filtered_cage_data())
  })
}
    
## To be copied in the UI
# mod_metric_boxplots_ui("metric_boxplots_ui_1")
    
## To be copied in the server
# mod_metric_boxplots_server("metric_boxplots_ui_1")