Merge pull request #146 from Artur-man/main

allowing shiny options passed to shinyApp and runApp git #144
BIMSBbioinfo · Sep 4, 2024 · 1a59baa · 1a59baa
2 parents a803071 + 849ad3b
commit 1a59baa
Show file tree

Hide file tree

Showing 13 changed files with 772 additions and 701 deletions.
diff --git a/R/annotation.R b/R/annotation.R
diff --git a/R/image.R b/R/image.R
diff --git a/R/interactive.R b/R/interactive.R
@@ -10,11 +10,15 @@
 #'
 #' @inheritParams shiny::runApp
 #' @param plot_g the ggplot plot
+#' @param shiny.options a list of shiny options (launch.browser, host, port etc.) passed \code{options} arguement of \link{shinyApp}. For more information, see \link{runApp}
+#' 
 #' @importFrom rstudioapi viewer
 #'
 #' @noRd
-vrSpatialPlotInteractive <- function(host = getOption("shiny.host", "127.0.0.1"),
-                                     port = getOption("shiny.port"), plot_g = NULL){
+vrSpatialPlotInteractive <- function(plot_g = NULL, 
+                                     shiny.options = list()){
+
+  # js for Shiny
   shinyjs::useShinyjs()
 
   # UI
@@ -28,8 +32,11 @@ vrSpatialPlotInteractive <- function(host = getOption("shiny.host", "127.0.0.1")
     })
   }
 
+  # get shiny options
+  shiny.options = configure_shiny_options(shiny.options)
+
   # Start Shiny Application
-  shiny::shinyApp(ui, server, options = list(host = host, port = port, launch.browser = rstudioapi::viewer),
+  shiny::shinyApp(ui, server, options = list(host = shiny.options[["host"]], port = shiny.options[["port"]], launch.browser = shiny.options[["launch.browser"]]),
                   onStart = function() {
                     cat("Doing application setup\n")
                     onStop(function() {
@@ -88,6 +95,41 @@ mod_app_server <- function(id, plot_g = NULL) {
   })
 }
 
+#' configure_shiny_options
+#'
+#' @param shiny.options a list of shiny options (launch.browser, host, port etc.) passed \code{options} arguement of \link{shinyApp}. For more information, see \link{runApp}
+#'
+#' @noRd
+configure_shiny_options <- function(shiny.options){
+
+  # launch.browser
+  if("launch.browser" %in% names(shiny.options)){
+    launch.browser <- shiny.options[["launch.browser"]]
+  } else {
+    launch.browser <- "RStudio"
+  }
+  if(!is.function(launch.browser)){
+    if(launch.browser == "RStudio"){
+      launch.browser <- rstudioapi::viewer
+    } 
+  }
+
+  # host and port
+  # if "port" is entered, parse "host" (or use default) but ignore "launch.browser"
+  if("host" %in% names(shiny.options)){
+    host <- shiny.options[["host"]]
+  } else {
+    host <- getOption("shiny.host", "0.0.0.0")
+  }
+  if("port" %in% names(shiny.options)){
+    port <- shiny.options[["port"]]
+    launch.browser <- TRUE
+  } else {
+    port <- getOption("shiny.port")
+  }
+  return(list(host = host, port = port, launch.browser = launch.browser))
+}
+
 ####
 # Spatial Interactive Plot (Vitessce) ####
 ####

diff --git a/R/objects.R b/R/objects.R
@@ -770,7 +770,8 @@ addConnectivity <- function(object, connectivity, sample, layer){
 #' @param image the subseting string passed to \link{image_crop}
 #' @param interactive TRUE if interactive subsetting on the image is demanded
 #' @param use_points if \code{interactive} is \code{TRUE}, use spatial points instead of the reference image
-#'
+#' @param shiny.options a list of shiny options (launch.browser, host, port etc.) passed \code{options} arguement of \link{shinyApp}. For more information, see \link{runApp}
+#' 
 #' @rdname subset
 #' @aliases subset
 #' @method subset VoltRon
@@ -801,7 +802,8 @@ addConnectivity <- function(object, connectivity, sample, layer){
 #' # interactive subsetting
 #' visium_subset_data <- subset(visium_data, interactive = TRUE)
 #' visium_subset <- visium_subset_data$subsets[[1]]
-subset.VoltRon <- function(object, subset, samples = NULL, assays = NULL, spatialpoints = NULL, features = NULL, image = NULL, interactive = FALSE, use_points = FALSE) {
+subset.VoltRon <- function(object, subset, samples = NULL, assays = NULL, spatialpoints = NULL, features = NULL, image = NULL, interactive = FALSE, use_points = FALSE, 
+                           shiny.options = list(launch.browser = getOption("shiny.launch.browser", interactive()))) {
 
   # subseting based on subset argument
   if (!missing(x = subset)) {
@@ -905,7 +907,7 @@ subset.VoltRon <- function(object, subset, samples = NULL, assays = NULL, spatia
       stop("Please provide a character based subsetting notation, see magick::image_crop documentation")
     }
   } else if(interactive){
-    results <- demuxVoltRon(object, use_points = use_points)
+    results <- demuxVoltRon(object, use_points = use_points, shiny.options = shiny.options)
     return(results)
   }
 

diff --git a/R/registration.R b/R/registration.R
@@ -10,14 +10,16 @@
 #' @param reference_spatdata a reference spatial data set, used only if \code{object_list} is \code{NULL}
 #' @param query_spatdata a query spatial data set, used only if \code{object_list} is \code{NULL}
 #' @param keypoints a list of tables, each points to matching keypoints from registered images.
+#' @param shiny.options a list of shiny options (launch.browser, host, port etc.) passed \code{options} arguement of \link{shinyApp}. For more information, see \link{runApp}
 #'
 #' @import shiny
 #' @importFrom shinyjs useShinyjs show hide
 #' @importFrom stats median
 #' @importFrom waiter useWaiter
 #'
 #' @export
-registerSpatialData <- function(object_list = NULL, reference_spatdata = NULL, query_spatdata = NULL, keypoints = NULL) {
+registerSpatialData <- function(object_list = NULL, reference_spatdata = NULL, query_spatdata = NULL, keypoints = NULL, 
+                                shiny.options = list(launch.browser = getOption("shiny.launch.browser", interactive()))) {
 
   ## Importing images ####
 
@@ -58,22 +60,20 @@ registerSpatialData <- function(object_list = NULL, reference_spatdata = NULL, q
   ## UI and Server ####
 
   # get the ui and server
-  if(interactive()){
-    # ui <- tagList(
-    ui <- fluidPage(
-      # use javascript extensions for Shiny
-      waiter::useWaiter(),
-      shinyjs::useShinyjs(),
-
-      sidebarLayout(position = "left",
-
-                    # Side bar
-                    sidebarPanel(
-                      tags$style(make_css(list('.well', 'margin', '7%'))),
-
-                      # # specific settings for dealing with simultaneous click and brush events
-                      # # https://jokergoo.github.io/2021/02/20/differentiate-brush-and-click-event-in-shiny/
-                      tags$script(HTML("
+  ui <- fluidPage(
+    # use javascript extensions for Shiny
+    waiter::useWaiter(),
+    shinyjs::useShinyjs(),
+
+    sidebarLayout(position = "left",
+
+                  # Side bar
+                  sidebarPanel(
+                    tags$style(make_css(list('.well', 'margin', '7%'))),
+
+                    # # specific settings for dealing with simultaneous click and brush events
+                    # # https://jokergoo.github.io/2021/02/20/differentiate-brush-and-click-event-in-shiny/
+                    tags$script(HTML("
                         $('#plot').mousedown(function(e) {
                             var parentOffset = $(this).offset();
                             var relX = e.pageX - parentOffset.left;
@@ -89,125 +89,113 @@ registerSpatialData <- function(object_list = NULL, reference_spatdata = NULL, q
                             Shiny.setInputValue('action', Math.random());
                         });
                       ")),
-
-                      getSideBar(),
-
-                      # h4("Spatial Data Alignment"),
-                      # fluidRow(
-                      #   column(12,shiny::checkboxInput("automatictag", "Automated", value = FALSE)),
-                      #   br(),
-                      #   column(12,selectInput("AutoMethod", "Method", choices = c("FLANN", "BRUTE-FORCE"), selected = "FLANN")),
-                      #   br(),
-                      #   column(12,textInput("GOOD_MATCH_PERCENT", "Match %", value = "0.20", width = "80%", placeholder = NULL)),
-                      #   column(12,textInput("MAX_FEATURES", "# of Features", value = "1000", width = "80%", placeholder = NULL)),
-                      #   br(),
-                      #   column(12,shiny::actionButton("register", "Register!")),
-                      #   br(),
-                      # ),
-                      # br(),
-                      # fluidRow(
-                      #   column(12,shiny::htmlOutput("summary"))
-                      # ),
-                      # br(),
-                      # fluidRow(
-                      #   column(12,shiny::actionButton("done", "Done")),
-                      #   br()
-                      # ),
-
-                      # panel options
-                      width = 3,
+
+                    getSideBar(),
+
+                    # panel options
+                    width = 3,
+                  ),
+
+                  mainPanel(
+
+                    # Interface for the reference image
+                    br(),
+                    column(6,
+
+                           # Reference Images
+                           getImageTabPanels(length(orig_image_query_list), orig_image_channelname_list, type = "ref"),
+
+                           br(),
+
+                           # Matching Alignment
+                           getAlignmentTabPanel(length(orig_image_query_list), centre, register_ind),
                     ),
-
-                    mainPanel(
-
-                      # Interface for the reference image
-                      br(),
-                      column(6,
-
-                             # Reference Images
-                             getImageTabPanels(length(orig_image_query_list), orig_image_channelname_list, type = "ref"),
-
-                             br(),
-
-                             # Matching Alignment
-                             getAlignmentTabPanel(length(orig_image_query_list), centre, register_ind),
-                      ),
-
-                      # Interface for the query images
-                      column(6,
-
-                             # Query Images
-                             getImageTabPanels(length(orig_image_query_list), orig_image_channelname_list, type = "query"),
-
-                             br(),
-
-                             # Registered Query Images
-                             getRegisteredImageTabPanels(length(orig_image_query_list), centre, register_ind)
-                      ),
-
-                      # panel options
-                      width = 9
-                    )
-      )
+
+                    # Interface for the query images
+                    column(6,
+
+                           # Query Images
+                           getImageTabPanels(length(orig_image_query_list), orig_image_channelname_list, type = "query"),
+
+                           br(),
+
+                           # Registered Query Images
+                           getRegisteredImageTabPanels(length(orig_image_query_list), centre, register_ind)
+                    ),
+
+                    # panel options
+                    width = 9
+                  )
     )
-
-    server <- function(input, output, session) {
-
-      ## Manage interface ####
-      updateParameterPanels(length(orig_image_query_list), input, output, session)
-      updateSequentialTabPanels(input, output, session, centre, register_ind)
-
-      ## Transform images ####
-      trans_image_query_list <- transformImageQueryList(orig_image_query_list, input)
+  )
+
+  server <- function(input, output, session) {
+
+    ## Manage interface ####
+    updateParameterPanels(length(orig_image_query_list), input, output, session)
+    updateSequentialTabPanels(input, output, session, centre, register_ind)
+
+    ## Transform images ####
+    trans_image_query_list <- transformImageQueryList(orig_image_query_list, input)
+
+    ## get image and zoom info ####
+    orig_image_query_info_list <- getImageInfo(orig_image_query_list)
+    zoom_list <- initiateZoomOptions(orig_image_query_info_list)
+    # manageImageZoomOptions(centre, register_ind, zoom_list, trans_image_query_list, orig_image_query_list, orig_image_query_info_list, input, output, session)
+    manageImageZoomOptions(centre, register_ind, zoom_list, orig_image_query_list, orig_image_query_info_list, input, output, session)
+
+    ## Manage reference and query keypoints ####
+    xyTable_list <- initateKeypoints(length(orig_image_query_list), keypoints)
+    # manageKeypoints(centre, register_ind, xyTable_list, trans_image_query_list, orig_image_query_info_list, zoom_list, input, output, session)
+    manageKeypoints(centre, register_ind, xyTable_list, orig_image_query_list, orig_image_query_info_list, zoom_list, input, output, session)
+
+    ## Image registration ####
+    registration_mapping_list <- initiateMappings(length(spatdata_list))
+    getManualRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list, xyTable_list,
+                           centre, register_ind, input, output, session)
+    getAutomatedRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list_full, orig_image_channelname_list,
+                              centre, register_ind, input, output, session)
+
+    ## Main observable ####
+    observe({
 
-      ## get image and zoom info ####
-      orig_image_query_info_list <- getImageInfo(orig_image_query_list)
-      zoom_list <- initiateZoomOptions(orig_image_query_info_list)
-      # manageImageZoomOptions(centre, register_ind, zoom_list, trans_image_query_list, orig_image_query_list, orig_image_query_info_list, input, output, session)
-      manageImageZoomOptions(centre, register_ind, zoom_list, orig_image_query_list, orig_image_query_info_list, input, output, session)
+      # output the list of query images
+      getImageOutput(orig_image_query_list_full, orig_image_query_info_list, xyTable_list, zoom_list, centre, input, output, session)
 
-      ## Manage reference and query keypoints ####
-      xyTable_list <- initateKeypoints(length(orig_image_query_list), keypoints)
-      # manageKeypoints(centre, register_ind, xyTable_list, trans_image_query_list, orig_image_query_info_list, zoom_list, input, output, session)
-      manageKeypoints(centre, register_ind, xyTable_list, orig_image_query_list, orig_image_query_info_list, zoom_list, input, output, session)
+    })
+
+    ## Return values for the shiny app ####
+    observeEvent(input$done, {
 
-      ## Image registration ####
-      registration_mapping_list <- initiateMappings(length(spatdata_list))
-      getManualRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list, xyTable_list,
-                             centre, register_ind, input, output, session)
-      getAutomatedRegisteration(registration_mapping_list, spatdata_list, orig_image_query_list_full, orig_image_channelname_list,
-                                centre, register_ind, input, output, session)
-
-      ## Main observable ####
-      observe({
-
-        # output the list of query images
-        getImageOutput(orig_image_query_list_full, orig_image_query_info_list, xyTable_list, zoom_list, centre, input, output, session)
-
-      })
-
-      ## Return values for the shiny app ####
-      observeEvent(input$done, {
-
-        # keypoints
-        keypoints <- reactiveValuesToList(xyTable_list)
-
-        # get keypoints and registered spatial datasets
-        stopApp(
-          list(keypoints = keypoints,
-               registered_spat = getRegisteredObject(spatdata_list,
-                                                     registration_mapping_list,
-                                                     register_ind,
-                                                     centre,
-                                                     input,
-                                                     reg_mode = ifelse(input$automatictag, "auto", "manual"),
-                                                     image_list = orig_image_query_list))
-          )
-      })
-    }
-
-    shiny::runApp(shiny::shinyApp(ui, server))
+      # keypoints
+      keypoints <- reactiveValuesToList(xyTable_list)
+
+      # get keypoints and registered spatial datasets
+      stopApp(
+        list(keypoints = keypoints,
+             registered_spat = getRegisteredObject(spatdata_list,
+                                                   registration_mapping_list,
+                                                   register_ind,
+                                                   centre,
+                                                   input,
+                                                   reg_mode = ifelse(input$automatictag, "auto", "manual"),
+                                                   image_list = orig_image_query_list))
+      )
+    })
   }
+
+  # configure options
+  shiny.options <- configure_shiny_options(shiny.options)
+
+  # run app
+  # shiny::runApp(shiny::shinyApp(ui, server), port = shiny.options[["port"]], host = shiny.options[["host"]], launch.browser = shiny.options[["launch.browser"]])
+  shiny::shinyApp(ui, server, options = list(host = shiny.options[["host"]], port = shiny.options[["port"]], launch.browser = shiny.options[["launch.browser"]]),
+                  onStart = function() {
+                    cat("Doing application setup\n")
+                    onStop(function() {
+                      cat("Doing application cleanup\n")
+                    })
+                  })
 }
 
 ####

diff --git a/R/spatial.R b/R/spatial.R
@@ -189,8 +189,7 @@ vrNeighbourhoodEnrichmentSingle <- function(object, group.by = NULL, graph.type
 
   # get adjacency for observed and simulated pairs
   # grp_sim_data <- 
-  # neighbors_graph_data <- dplyr::bind_rows(neighbors_graph_data)
-
+  # neighbors_graph_data <- dplyr::bind_rows(neighbors_graph_data
 
   neigh_results <- neighbors_graph_data %>%
     dplyr::group_by(from_value, to_value, type) %>%