R/mod_metrics_over_time_plots.R

In becky-work/MouseCageApp: INCA

#' metrics_over_time_plots UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_metrics_over_time_plots_ui <- function(id, mouse_selections = NA, metric_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)
      ),
      prettyCheckbox(inputId = ns("done_selecting_plot"),
                     label = "Plot these?",
                     value = FALSE, # default to not finished
                     icon = icon("check"),
                     status = "success",
                     animation = "rotate")
    
  )
  )
}
    
#' metrics_over_time_plots Server Functions
#'
#' @noRd 
mod_metrics_over_time_plots_server <- function(id, cage_data = NA, light_colors = c(light = "#FFF68F", dark = "#8DEEEE")){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    req(input$selected_mouse)
    req(input$selected_metric)
    
    filtered_cage_data <- eventReactive(input$done_selecting_plot,{
      if(input$done_selecting_plot == FALSE){
        cat('\nNot Finished with plot selections\n')
        return(NA)
      }

      
      req(cage_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) %>% 
        mutate(subject_id = as.factor(subject_id))
      
      print(head(plot_df))
      
      phase_changes <- plot_df %>% group_by(var) %>% 
        mutate(max_y = max(n)) %>% 
        group_by(var, phase_num, max_y) %>% 
        summarise(min_dt = min(dt))
      
      shaded_rect <- plot_df %>% group_by(var) %>% mutate(y_max = max(n)) %>% 
        group_by(mouse_id, subject_id, var, light_phase, phase_num, y_max) %>%
        summarise(start_time = min(dt), end_time = max(dt), y_min = min(n))
        
      
      p <- ggplot(plot_df) +
        theme_minimal()+
        labs(#title = plot_title,
             y = '',
             x = 'Date time') +
        # background colors for light phases
        geom_rect(data=shaded_rect, aes(xmin = start_time, xmax = end_time, ymin = y_min, ymax = y_max, fill = light_phase),
                  alpha = .75, stat = 'identity') +
        scale_fill_manual(name = 'Phase', values= light_colors)+
        # vertical lines indicating change in light phase
        geom_vline(data=phase_changes, aes(xintercept = min_dt), 
                   show.legend = FALSE, color = 'black', linetype = 'dashed', alpha = .5)+
        # label for the lines
        geom_text(data=phase_changes, aes(x = min_dt, y = max_y, label = phase_num), 
                  # move label forward 1 hour (in seconds), rotate text, set font size, set transparency
                  nudge_x = 3600, angle = 90, size = 4, alpha = .5
        ) +
        # do this last so points are on top
        geom_point(aes(dt, n, color = subject_id))  +
        facet_grid(rows = vars(var), scales = 'free_y', switch = 'y')
      
      return(p)
      # 
    })
    return(filtered_cage_data())
  })
}
    
## To be copied in the UI
# mod_metrics_over_time_plots_ui("metrics_over_time_plots_ui_1")
    
## To be copied in the server
# mod_metrics_over_time_plots_server("metrics_over_time_plots_ui_1")