data_analysisServer <- function(id) { moduleServer(id, function(input, output, session) { # Update UI: plate metadata template ---------------------------------------- # toggle download_metadata button after data upload observe({ shinyjs::toggleState(id = "download_metadata", condition = input$Image_Analyst_output) }) # Handler download_metadata ----------------------------------------------- # download plate metadata template template_names <- reactive({ input$Image_Analyst_output$name %>% stringr::str_replace_all(pattern = ".xlsx", replacement = "_metadata.csv") }) template_url <- "https://raw.githubusercontent.com/f-neri/FAST.R/main/inst/extdata/plate-metadata.csv" # TO CHANGE: RELATIVE INST PATH output$download_metadata <- downloadHandler( filename = function() if (length(input$Image_Analyst_output$name) == 1) { # single IAoutput and metadata files template_names() } else { # multiple IAoutput and metadata files paste0("plate_metadata_templates_", Sys.Date(), ".zip") }, content = function(file) if (length(input$Image_Analyst_output$name) == 1) { # single IAoutput and metadata files utils::download.file(template_url, destfile = file, method = "auto") } else { # multiple IAoutput and metadata files temp_directory <- file.path(tempdir(), as.integer(Sys.time())) dir.create(temp_directory) file_paths <- vector("character", length = length(input$Image_Analyst_output$name)) for (i in seq_along(input$Image_Analyst_output$name)) { file_paths[i] <- file.path(temp_directory, template_names()[i]) suppressMessages( utils::download.file(template_url, destfile = file_paths[i], method = "auto") ) } zip::zip( zipfile = file, files = dir(temp_directory), root = temp_directory ) }, contentType = "application/zip" ) # DATA ANALYSIS ----------------------------------------------------------- # Load files -------------------------------------------------------------- Input_files <- reactive({ req(input$Image_Analyst_output, input$plate_metadata, input$background_threshold) # Update UI --------------------------------------------------------------- # disable button_analysis while computing shinyjs::disable("button_analysis") # disable table outputs w/ shinyjs shinyjs::hide("sc_and_analysis_report_panel") # Load and check input files ------------------------------------------------------- Input_files <- load_input_files(input$Image_Analyst_output, input$plate_metadata) # return loaded files Input_files }) %>% bindCache(input$Image_Analyst_output$datapath, input$plate_metadata$datapath, input$background_threshold) %>% bindEvent(input$button_analysis) # Generate single_cell_data table ----------------------------------------------------------- # tidy IAouput and merge with metadata single_cell_data <- reactive({ # disable button_analysis while computing shinyjs::disable("button_analysis") Input_files <- Input_files() single_cell_df <- generate_single_cell_df(Input_files) # return single cell df single_cell_df }) %>% bindCache(input$Image_Analyst_output$datapath, input$plate_metadata$datapath, input$background_threshold) %>% bindEvent(input$button_analysis) # Generate analysis_report table ------------------------------------------ analysis_report <- reactive({ # disable button_analysis while computing shinyjs::disable("button_analysis") # enable button_analysis on exit on.exit({ enable_button_analysis() }) # generate analysis report analysis_report <- analyze_single_cell_data(single_cell_data(), input$background_threshold) # return analysis report df analysis_report }) %>% bindCache(input$Image_Analyst_output$datapath, input$plate_metadata$datapath, input$background_threshold) %>% bindEvent(input$button_analysis) # OUTPUT ------------------------------------------------------------------ # error message ----------------------------------------------------------- # Print data analysis message output$analysis_report_message <- renderText({ analysis_report() # creates dependency on analysis_report() output # turn output tables visible w/ shinyjs shinyjs::show("sc_and_analysis_report_panel") # return empty text if all good "" }) %>% bindEvent(input$button_analysis) # Hide output panel on load shinyjs::hide("sc_and_analysis_report_panel") # Show output panel upon calculation of single_cell_data() and analysis_report() observe({ shinyjs::show("sc_and_analysis_report_panel") }) %>% bindEvent(single_cell_data(), analysis_report()) # single cell data ------------------------------------------ output$df_single_cell_title <- renderText({ single_cell_data() "Single Cell Data" }) output$df_single_cell <- DT::renderDataTable({ DT::datatable( single_cell_data(), filter = 'top', extensions = c('Buttons', 'Scroller'), options = list(scroller = TRUE, scrollY = 200, scrollX = 500, deferRender = TRUE, dom = 'lBfrtip', fixedColumns = TRUE, buttons = list( list(extend = 'colvis', targets = 0, visible = FALSE) ) ), rownames = FALSE) }) # download button for single-cell data output$download_sc_data <- downloadHandler( filename = function() { paste0("Single_Cell_Data_", Sys.Date(), ".csv") }, content = function(file) { utils::write.csv(single_cell_data(), file, row.names = FALSE) } ) # analysis report -------------------------------------------------- ## table title output$analysis_report_title <- renderText({ analysis_report() "Analysis Report" }) ## set columns to be visible initially cols_to_hide_indices <- reactive({ # create vector containing additional variables additional_variables <- names(analysis_report())[-c(1:3)] # remove plate, well, Condition pos_cell_counts <- which(additional_variables == "cell_counts") # find index for cell_counts additional_variables <- additional_variables[-c(pos_cell_counts:length(additional_variables))] # remove all vars after cell_counts, leaving only possible additional vars # create vector with cols to visualize cols_to_vis <- c("plate", "well", "Condition", additional_variables, "cell_counts", "Nuclear_Area_median", "EdU_median", "SABGal_median", "percentage_EdU_positive", "percentage_SABGal_positive" ) # get indices of cols to NOT visualize indices <- which(!(names(analysis_report()) %in% cols_to_vis)) %>% -1 # indices in columnDefs calls start from 0, not 1 indices }) ## render table output$df_analysis_report <- DT::renderDataTable({ DT::datatable( analysis_report(), filter = 'top', extensions = c('Buttons', 'Scroller'), options = list(scroller = TRUE, scrollY = 200, scrollX = 500, deferRender = TRUE, dom = 'lBfrtip', fixedColumns = TRUE, buttons = list('colvis'), columnDefs = list( list(visible = FALSE, targets = cols_to_hide_indices()) # Use the vector to hide columns ) ), rownames = FALSE) }) ## download button for analysis report data output$download_analysis_report <- downloadHandler( filename = function() { paste0("Analysis_Report_", Sys.Date(), ".csv") }, content = function(file) { utils::write.csv(analysis_report(), file, row.names = FALSE) } ) }) # close moduleServer } # close data_analysisServer