Add possibility to automatically switch to explore workspace after loading...

Add possibility to automatically switch to explore workspace after loading toml file. Remove constant columns for dimensionality reduciton.

R/cluster.R

@@ -121,7 +121,7 @@ cluster_server <- function(input, output, session, rv, session_parent) {
       }
       remove_modal_spinner()
       
-      updateTabsetPanel(session_parent , "tabs_menu", selected = "explore")
+      updateTabsetPanel(session_parent, "tabs_menu", selected = "explore")
       
       shinyjs::enable("clusteringButton")
       

R/datafile.R

@@ -138,18 +138,22 @@ input_data_server <- function(input, output, session) {
   ## Vector of user input names (i.e. inputId) that we may want to restore from file
   ## Values are stored in rv$inputChoices
   inputChoices.params <- c("selectedVar", "colsOnHover", "colsToHide", "groupLabels", "roiX", "roiY",
-                           "roiFrame", "imgRoot", "fileCol1", "fileCol2", "plateSize", "plateCol", "wellCol", "fieldCol",
-                           "treatCol", "awsEndPoint", "awsAccess", "awsSecret", "awsRegion", "awsBucketName")
+                           "roiFrame", "imgRoot", "fileCol1", "fileCol2", "plateSize", "plateCol", "wellCol",
+                           "fieldCol", "treatCol", "awsEndPoint", "awsAccess", "awsSecret", "awsRegion",
+                           "awsBucketName")
   
   ## Store all reactive values we need to share between modules in one object
   rv <- reactiveValues(inputChoices = setNames(vector("list", length(inputChoices.params)), inputChoices.params),
                        data = NULL, currentRows = NULL, selectedRows = NULL, clusters = NULL, 
-                       imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL, selectedFrame = 1, metadataImg1 = NULL,
-                       metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL, groupCol = NULL, selectedVar = NULL, roiX = NULL,
-                       roiY = NULL, roiFrame = NULL, fileCol1 = NULL, fileCol2 = NULL, plateSize = NULL, plateCol = NULL, wellCol = NULL,
-                       fieldCol = NULL, treatCol = NULL, plateSummary = NULL, wellInfo = NULL, proxy = NULL, key = NULL, colsOnHover = NULL, 
-                       dataTable_rows_all = NULL, annotationCol = NULL, annotationLabels = NULL, imgRoot = NULL,
-                       datapath = NULL, select_variable_DR = NULL, bucketName = NULL)
+                       imgPath1 = NULL, imgPath2 = NULL, pixelPosition = NULL, selectedFrame = 1, 
+                       metadataImg1 = NULL, metadataImg2 = NULL, colsToHide = NULL, colsToEdit = NULL,
+                       groupCol = NULL, selectedVar = NULL, roiX = NULL, roiY = NULL, roiFrame = NULL,
+                       fileCol1 = NULL, fileCol2 = NULL, plateSize = NULL, plateCol = NULL, 
+                       wellCol = NULL, fieldCol = NULL, treatCol = NULL, plateSummary = NULL, 
+                       wellInfo = NULL, proxy = NULL, key = NULL, colsOnHover = NULL, 
+                       dataTable_rows_all = NULL, annotationCol = NULL, annotationLabels = NULL,
+                       imgRoot = NULL, datapath = NULL, select_variable_DR = NULL, bucketName = NULL,
+                       workspace = NULL)
   
   ## Dynamically generate UI input to select variables once data is uploaded and read
   Output_variable <- function(type, idx, label, binary, opt) {
@@ -281,7 +285,7 @@ input_data_server <- function(input, output, session) {
                      choices = c("", colNames),
                      options = list(maxItems = 1))
     }) # End renderUI
-  } # End  Select_colums_image_file_names()
+  } # End  Select_columns_image_file_names()
   
   Select_colums_image_file_names("fileColumn1", "image|intensit", "fileCol1", "Column with file names for image 1")
   Select_colums_image_file_names("fileColumn2", "label|mask", "fileCol2", "Column with file names for image 2")
@@ -313,7 +317,7 @@ input_data_server <- function(input, output, session) {
                        options = list(maxItems = 1))
       }
     }) # End renderUI
-  } # End Select_colums_coordinates()
+  } # End Select_plate_info()
   
   Select_plate_info("PlateSize", "", "plateSize", "Select plate size (number of wells)")
   Select_plate_info("Plate", "plate", "plateCol", "Column for plates")
@@ -360,9 +364,10 @@ input_data_server <- function(input, output, session) {
     content = function(file){
       ## Collect current choices
       settings <- list("selectedVar" = input$selectedVar, "colsOnHover" = input$colsOnHover,
-                       "colsToHide" = input$colsToHide, "groupLabels" = input$groupLabels, "roiX" = input$roiX, 
-                       "roiY" = input$roiY, "roiFrame" = input$roiFrame, "imgRoot" = rv$inputChoices[["imgRoot"]], 
-                       "fileCol1" = input$fileCol1, "fileCol2" = input$fileCol2, "plateSize" = input$plateSize, "plateCol" = input$plateCol, 
+                       "colsToHide" = input$colsToHide, "groupLabels" = input$groupLabels, 
+                       "roiX" = input$roiX, "roiY" = input$roiY, "roiFrame" = input$roiFrame,
+                       "imgRoot" = rv$inputChoices[["imgRoot"]], "fileCol1" = input$fileCol1,
+                       "fileCol2" = input$fileCol2, "plateSize" = input$plateSize, "plateCol" = input$plateCol, 
                        "wellCol" = input$wellCol, "fieldCol" = input$fieldCol, "treatCol" = input$treatCol,
                        "awsEndPoint" = input$awsEndPoint, "awsAccess" = input$awsAccess, "awsSecret" = input$awsSecret,
                        "awsRegion" = input$awsRegion, "awsBucketName" = input$awsBucketName)
@@ -432,6 +437,11 @@ input_data_server <- function(input, output, session) {
             rv$inputChoices[["treatCol"]] <- cfg$columns$hcs$treatments
           }
         }
+        if(!is.null(cfg$ui)) {
+          if(!is.null(cfg$ui$workspace)) {
+            rv$workspace <- cfg$ui$workspace
+          }
+        }
       }
       for(field in inputChoices.params) {
         updateInput(field)
@@ -578,6 +588,6 @@ input_data_server <- function(input, output, session) {
   } # End Columns_event_Group_label()
   
   Columns_event_Group_label("groupLabels")
-  
+ 
   return(rv) # To make reactive values available to other modules
 }

R/dim_reduction.R

@@ -105,6 +105,8 @@ dimensionality_reduction_server <- function(input, output, session, rv, session_
       # Remove rows with NAs and infinite values
       idx.valid.rows <- which(is.finite(rowSums(tmp)))
       tmp <- tmp[idx.valid.rows,]
+      # Remove constant columns
+      tmp <- tmp[,!apply(tmp, 2, function(x) {all(x==x[1])})]
       if(input$dimReductionMethod == 'PCA') {
         pca <- prcomp(tmp[,input$featuresToReduce], rank = 2, retx = TRUE, scale = TRUE)
         tmp <- predict(pca, newdata = rv$data[, input$featuresToReduce, with = FALSE])

image_data_explorer.R

@@ -4,7 +4,7 @@
 ## Main application file ##
 ###########################
 
-VERSION <- "v1.5.4" # Update this when creating a new version
+VERSION <- "v1.5.5" # Update this when creating a new version
 
 # Increase max upload size to 1 GB
 options(shiny.maxRequestSize=1000*1024^2)
@@ -91,6 +91,14 @@ source("R/cluster.R")
 source("R/feature_selection.R")
 source("R/stats.R")
 
+## Delay execution of expr until after all session inputs have been set
+execute_after_input <- function(expr, session = getDefaultReactiveDomain()) {
+  observeEvent(once = TRUE, reactiveValuesToList(session$input), {
+    print("HERE")
+    force(expr)
+  }, ignoreInit = TRUE)
+}
+
 ui <- function(request) {
   
   dashboardPage(
@@ -160,16 +168,9 @@ ui <- function(request) {
   ) # End Dashboard Page
 } # ui() function
 
-
-
 server <- function(input, output, session){
   ns <- session$ns  # Allow to use ns() in the server
   
-  ## To update menu areas
-  react <- reactiveValues(update_key = NULL)
-  ## Detect switching menu areas
-  observeEvent(input$tabs_menu,{ react$update_key <- 1 })
-  
   ## Sidebar panel for inputs
   output$menu <- renderMenu({
   sidebarMenu(id = "tabs_menu",
@@ -192,49 +193,57 @@ server <- function(input, output, session){
   ## datafile
   ### global_data used to pass reactive values between modules
   global_data <- callModule(input_data_server, "data_module")
-
+  
   ## explore
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="explore"){
-     explore_data <- callModule(explore_server, "explore_module", global_data)
+    if(input$tabs_menu == "explore"){
+      callModule(explore_server, "explore_module", global_data)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
-
+  
   ## annotate
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="annotate"){
+    if(input$tabs_menu == "annotate"){
       callModule(annotate_server, "annotate_module", global_data, session)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
   
   ## dimensionality reduction
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="dimensionality_reduction"){
+    if(input$tabs_menu == "dimensionality_reduction"){
       callModule(dimensionality_reduction_server, "dimensionality_reduction_module", global_data, session)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
   
   ## feature selection
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="feature_selection"){
+    if(input$tabs_menu == "feature_selection"){
       callModule(feature_selection_server, "feature_selection_module", global_data, session)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
   
   ## cluster
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="cluster"){
+    if(input$tabs_menu == "cluster"){
       callModule(cluster_server, "cluster_module", global_data, session)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
   
   ## statistics
   observeEvent(input$tabs_menu,{
-    if(input$tabs_menu=="statistics"){
+    if(input$tabs_menu == "statistics"){
       callModule(stats_server, "statistics_module", global_data, session)
     }
   }, ignoreNULL = TRUE, ignoreInit = TRUE)
 
+  ## Switch to explore workspace after input fields have been populated 
+  ## from config file
+  execute_after_input({
+    if(!is.null(global_data$workspace) && global_data$workspace == "explore") {
+      updateTabsetPanel(session, "tabs_menu", selected = "explore")
+    }
+  })
+  
 }
 
 ## Run the application
@@ -243,6 +252,3 @@ IDE <- shinyApp(ui = ui,
                 enableBookmarking = "url",
                 options = list(port = 5476))
 
-## Supply desired port to runApp() because it ignores options in shinyApp()
-## Need to supply host for use in Docker container
-##runApp(IDE, port = 5476, host = "0.0.0.0")