R/mod_load_data.R

In becky-work/MouseCageApp: INCA

#' load_data UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @import whereami
#' @import dplyr
mod_load_data_ui <- function(id){
  ns <- NS(id)
  tagList(
    box(title = 'Select files.',
    fileInput(inputId = ns('meta_file_path'),
              label = 'Upload sample metadata file',
              multiple = FALSE,
              accept = c(".csv")),
      # prettyCheckbox(inputId = ns("done_selecting_meta"),
      #                label = "Finished with selections?",
      #                value = FALSE, # default to not finished
      #                icon = icon("check"),
      #                status = "success",
      #                animation = "rotate"),
    fileInput(inputId = ns('prom_file_path'),
              label = 'Upload promethion file(s)',
              multiple = TRUE,
              accept = '.csv'),
  prettyCheckbox(inputId = ns("done_selecting_files"),
                 label = "Finished with selections?",
                 value = FALSE, # default to not finished
                 icon = icon("check"),
                 status = "success",
                 animation = "rotate")
    ),
  
  box(title = 'testing',
      prettyCheckbox(inputId = ns("automate_file_upload"),
                     label = "Testing and lazy about selecting files?",
                     value = FALSE, # default to not finished
                     icon = icon("check"),
                     status = "success",
                     animation = "rotate")
  )
 
  )
}
    
#' load_data Server Functions
#'
#' @noRd 
mod_load_data_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    cat('\nsetting output of files ------\n')
    
    read_files <- eventReactive(input$done_selecting_files,{
      
      ## for testing manually set files; remove this if/else and test checkbox above when done
      if(input$automate_file_upload == TRUE){
        meta_path <- here::here('test_data/Male_5-6wk_metadata_test1.csv')
        n_files <- 2
        cage_path <- c(here::here('test_data/Run1_201909300914_m_Male.csv'),here::here('test_data/Run2_201910071102_m_Male.csv'))
      } else{
        req(input$meta_file_path)
        req(input$done_selecting_files == TRUE)
        meta_path <- input$meta_file_path$datapath
        
        req(input$prom_file_path)
        n_files <- length(input$prom_file_path[,1])
        cage_path <- input$prom_file_path$datapath
      }
      
      
      
      
      # this will change to user input but for now I'll leave it as it is
      meta_df <- read.csv(meta_path) %>% janitor::clean_names() %>% 
        rename(mouse_id = mouse, cage_id = cage, start_day = date) %>% 
        # force date format
        mutate(start_day = as.Date(start_day, format = '%m/%d/%Y'),
               # create a subject_id in case there are duplicate cage numbers (should be the same as mouse unless mouse is repeated later)
               subject_id = paste(cage_id, start_day, sep = '_'))
      
       # list(file = 'sample_meta_data', 
       #         file_info = data.frame(input$meta_file_path), 
       #         data = x)
      #return(x)
          cat('\n done reading meta file ', input$meta_file_path$name,'\n')

      
      prom_df <- data.frame()
      
      # include messages on page so you know what's up
      withProgress(message = 'Reading and cleaning promethion files', value = 0, {
        # need a loop in case there are multiple files
       for(i in 1:n_files){
         #input$prom_file_path$datapath[
        c <- read.csv(cage_path[i])
        
        incProgress(1/n_files, detail = paste("Working on file", i))
        
        c <- flip.cage.file.func(c)   # in fct_helpers.R (will probably move this eventually)
        prom_df <- rbind(prom_df,c)
        cat('\n done reading promethion file', input$prom_file_path$name[i],'\n')
       }
        
      })
      
      cat('\n done with all  promethion files \n')
      
      return(list(meta_file = meta_df, cage_file = prom_df))
    })

    
   return(read_files())
  })
}
    
## To be copied in the UI
# mod_load_data_ui("load_data_ui_1")
    
## To be copied in the server
# mod_load_data_server("load_data_ui_1")