R/mod_add_time_phases.R

In becky-work/MouseCageApp: INCA

#' add_time_phases UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_add_time_phases_ui <- function(id, time_selection = NA){
  ns <- NS(id)
  tagList(
    box(title = 'Choose light on and off times',
        pickerInput(inputId = ns('light_on_time'),
                    label = 'What time was the light turned on?\n(When did light start?)',
                    choices = time_selection,
                    selected = c('07:00'),
                    multiple = FALSE,
                    #options = list(style = 'background-color:#FFF68F;') # I cant get this to work will need to set css
                    #choicesOpt=list(rep_len('background:#FFF68F;',length(time_selection)))
        ),
        pickerInput(inputId = ns('light_off_time'),
                    label = 'What time was the light turned off?\n(When did dark start?)',
                    choices = time_selection,
                    selected = c('19:00'),
                    multiple = FALSE,
                    #choicesOpt = list(style = rep_len('background:#8DEEEE;',length(time_selection)))
        ),
        prettyCheckbox(inputId = ns("done_selecting_times"),
                       label = "Finished with setting light on/off?",
                       value = FALSE, # default to not finished
                       icon = icon("check"),
                       status = "success",
                       animation = "rotate"),
        
    ))
}
    
#' add_time_phases Server Functions
#'
#' @noRd 
mod_add_time_phases_server <- function(id, cage_data = NA){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    cat('\n\n')
    
    req(input$light_on_time)
    req(input$light_off_time)
    
    add_time_to_cage_df <- eventReactive(input$done_selecting_times,{
      if(input$done_selecting_times == FALSE){
        cat('\nNot Finished with time selections (checkbox not checked)\n')
        return(NA)
      }
      
      
      #req(input$done_selecting_times== TRUE)
      req(cage_data)
    
      cat('\nSetting user selected light on and off\n')
      start_light <- hms::as_hms(paste0(input$light_on_time,':00'))
      end_light <- hms::as_hms(paste0(input$light_off_time,':00'))


      p_df <- cage_data %>%
        # identify if cage is light or dark, calling it light phase so it's obvious that it's about the light
        mutate(light_phase = ifelse((hms::as_hms(dt) >= start_light) & (hms::as_hms(dt) < end_light), 'light','dark')) %>%
        # name the phases e.g. light phase 2
        # This is hokey but it works
        group_by(subject_id, var) %>% arrange(dt) %>%
        mutate(i = ifelse(light_phase == lag(light_phase), 0, 1),
               i = ifelse(is.na(i), 0, i)) %>%
        group_by(subject_id, var, light_phase) %>% arrange(light_phase, dt) %>%
        mutate(i1 = cumsum(i),
               add_one_to = ifelse(i1 == 0, light_phase, NA)) %>%
        ungroup()

      # pull out which light/dark that the cage started in i started with 0 so the cumsum is off by one
      #### NOTE: might want to leave it as light 0 dark 1 light 1 dark 2 etc so you know easily which phase the cage started in. Just remove the i1+1 part in the next step for this
      a <- p_df %>% select(subject_id, add_one_to) %>%
        na.omit() %>% unique() %>%
        mutate(p = paste(subject_id, add_one_to))

      cage_df <- p_df %>%
        mutate(i1 = ifelse(paste(subject_id, light_phase) %in% a$p , i1 + 1, i1),
               phase_num = paste(light_phase, i1)) %>% select(-c(i1, add_one_to)) %>%
        rename(phase_change = i) %>%
        ## THIS IS IMPORTANT for the plotting background to work
        arrange(subject_id, dt)

      return(cage_df)
    })
    return(add_time_to_cage_df())
    
  })
}
    
## To be copied in the UI
# mod_add_time_phases_ui("add_time_phases_ui_1")
    
## To be copied in the server
# mod_add_time_phases_server("add_time_phases_ui_1")