Merge pull request #68 from Artur-man/main

improve annotation and subsetting interfaces
BIMSBbioinfo · Dec 14, 2023 · 8f367d5 · 8f367d5
2 parents df7286a + f26711b
commit 8f367d5
Show file tree

Hide file tree

Showing 24 changed files with 143 additions and 54 deletions.
diff --git a/.gitignore b/.gitignore
@@ -12,3 +12,4 @@ configure.log
 autobrew
 .deps
 Makevars
+data/
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -5,7 +5,7 @@ Version: 1.0.0
 Depends: R (>= 4.3.0)
 Author: Artür Manukyan, Ella Bahry, Deborah Schmidt, Markus Landthaler, Altuna Akalin
 Maintainer: Artur Manukyan <artur-man@hotmail.com>
-Description: VoltRon is a novel spatial omic analysis toolbox for multi-omics integration using spatial image registration. VoltRon is capable of analyzing multiple types and modalities of spatially-aware datasets. VoltRon visualizes and analyzes regions of interests (ROIs), spots, cells and even molecules (under development).
+Description: VoltRon is a novel spatial omic analysis toolbox for multi-omics integration using spatial image registration. VoltRon is capable of analyzing multiple types and modalities of spatially-aware datasets. VoltRon visualizes and analyzes regions of interests (ROIs), spots, cells and even molecules.
 License: MIT + file LICENSE
 SystemRequirements: OpenCV 4.7 (or higher): libopencv-dev (Debian, Ubuntu) or opencv-devel (Fedora)
 Encoding: UTF-8
@@ -49,4 +49,5 @@ Suggests:
     ComplexHeatmap, 
     xlsx, 
     tiledb,
-    tiledbsc
+    tiledbsc, 
+    vitessceR
diff --git a/R/annotation.R b/R/annotation.R
@@ -138,8 +138,13 @@ annotateSpatialData <- function(object, label, assay = NULL, ...) {
         n <- counter$n
         if (n > 0) {
           lapply(seq_len(n), function(i) {
+            if(is.null(input[[paste0("region",i)]])){
               column(12,textInput(inputId = paste0("region", i),
                                   label = paste0("Region ", i), value = paste0("Region ", i)))
+            } else {
+              column(12,textInput(inputId = paste0("region", i),
+                                  label = paste0("Region ", i), value = input[[paste0("region",i)]]))
+            }
           })
         }
       })
@@ -168,7 +173,11 @@ annotateSpatialData <- function(object, label, assay = NULL, ...) {
         if(length(selected_corners_list()) > 0){
           for (i in 1:length(selected_corners_list())){
             cur_corners <- selected_corners_list()[[i]]
-            cur_corners <- data.frame(x = mean(cur_corners[,1]), y = max(cur_corners[,2]), region = paste("Region ", i))
+            if(is.null(input[[paste0("sample",i)]])){
+              cur_corners <- data.frame(x = mean(cur_corners[,1]), y = max(cur_corners[,2]), region = paste("Region ", i))
+            } else {
+              cur_corners <- data.frame(x = mean(cur_corners[,1]), y = max(cur_corners[,2]), region = input[[paste0("region",i)]])
+            }
             g <- g +
               ggrepel::geom_label_repel(mapping = aes(x = x, y = y, label = region), data = cur_corners,
                                         size = 5, direction = "y", nudge_y = 6, box.padding = 0, label.padding = 1, seed = 1, color = "red")

diff --git a/R/clustering.R b/R/clustering.R
@@ -11,6 +11,7 @@ NULL
 #' @param dims the set of dimensions of the embedding data
 #' @param k number of neighbors for kNN
 #' @param method the method used for graph construction, SNN or kNN
+#' @param graph.key the name of the graph
 #' @param ... additional parameters passed to \code{FNN:get.knn}
 #'
 #' @rdname getProfileNeighbors
@@ -82,6 +83,7 @@ getProfileNeighbors.VoltRon <- function(object, assay = NULL, data.type = "pca",
 #' @param assay assay
 #' @param label the name for the newly created clustering column in the metadata
 #' @param graph the graph type to be used
+#' @param seed seed
 #'
 #' @importFrom igraph cluster_leiden
 #' @export

diff --git a/R/conversion.R b/R/conversion.R
@@ -4,6 +4,7 @@
 
 #' @param object A Seurat object
 #' @param type the spatial data type of Seurat object: "image" or "spatial"
+#' @param assay_name the assay name
 #' @param ... Additional parameter passed to \code{formVoltRon}
 #'
 #' @rdname as.VoltRon
@@ -80,7 +81,7 @@ as.VoltRon.Seurat <- function(object, type = c("image", "spatial"), assay_name =
 #'
 #' @export
 #'
-convertAnnDataToVoltRon <- function(file, AssayID = NULL, Sample = NULL, ...){
+convertAnnDataToVoltRon <- function(file, AssayID = NULL, ...){
 
   # read anndata
   adata <- anndata::read_h5ad(file)
@@ -250,7 +251,7 @@ as.AnnData.VoltRon <- function(object, file, assay = NULL, image_key = "fov", ty
   NULL
 }
 
-#' @param vrimage VoltRon image
+#' @param object VoltRon image
 #' @param out_path output path to ome.zarr
 #' @param image_id image name
 #'
@@ -310,7 +311,7 @@ as.Zarr.VoltRon <- function (object, out_path, image_id = "main_image")
   return(success)
 }
 
-#' @param vrimage VoltRon image
+#' @param object a VoltRon image
 #' @param out_path output path to ome.zarr
 #' @param image_id image name
 #'

diff --git a/R/image.R b/R/image.R
@@ -42,6 +42,7 @@ vrImages.vrLayer <- function(object, ...){
 
 #' @param object A vrAssay object
 #' @param main_image the name of the main image
+#' @param as.raster if TRUE, return as raster matrix
 #'
 #' @rdname vrImages
 #' @method vrImages vrAssay
@@ -122,7 +123,6 @@ vrImageNames.vrAssay <- function(object){
   return(names(object@image))
 }
 
-#'
 #' @rdname vrMainImage
 #' @method vrMainImage vrAssay
 #'
@@ -132,6 +132,7 @@ vrMainImage.vrAssay <- function(object){
   return(object@main_image)
 }
 
+#' @param value the name of main image
 #'
 #' @rdname vrMainImage
 #' @method vrMainImage<- vrAssay
@@ -245,9 +246,10 @@ modulateImage.vrAssay <- function(object, brightness = 100, saturation = 100, hu
 #' @param dir.path Xenium output folder
 #' @param increase.contrast increase the contrast of the image before writing
 #' @param resolution_level the level of resolution within Xenium OME-TIFF image. Default: 7 (553x402)
+#' @param overwrite_resolution if TRUE, the image "file.name" will be generated again although it exists at "dir.path"
 #' @param output.path The path to the new morphology image created if the image should be saved to a location other than Xenium output folder.
 #' @param file.name the name of the lowred morphology image. Default: morphology_lowres.tif
-#' @param ... additional parameters passed to the EBImage::writeImage function
+#' @param ... additional parameters passed to the \code{EBImage::writeImage} function
 #'
 #' @importFrom EBImage writeImage
 #'
@@ -259,14 +261,14 @@ modulateImage.vrAssay <- function(object, brightness = 100, saturation = 100, hu
 #'
 #' @export
 #'
-generateXeniumImage <- function(dir.path, increase.contrast = TRUE, resolution_level = 7, output.path = NULL, file.name = "morphology_lowres.tif", ...) {
+generateXeniumImage <- function(dir.path, increase.contrast = TRUE, resolution_level = 7, overwrite_resolution = FALSE, output.path = NULL, file.name = "morphology_lowres.tif", ...) {
 
   # file path to either Xenium output folder or specified folder
   file.path <- paste0(dir.path, "/", file.name)
   output.file <- paste0(output.path, "/", file.name)
 
   # check if the file exists in either Xenium output folder, or the specified location
-  if(file.exists(file.path) | file.exists(paste0(output.file))){
+  if((file.exists(file.path) | file.exists(paste0(output.file))) & !overwrite_resolution){
     message(paste0(file.name, " already exists!"))
   } else {
     message("Loading morphology_mip.ome.tif \n")
@@ -395,6 +397,7 @@ generateCosMxImage <- function(dir.path, increase.contrast = TRUE, output.path =
 #' @importFrom ggplot2 geom_rect
 #' @importFrom htmltools HTML
 #' @importFrom dplyr filter add_row tibble
+#' @importFrom ggrepel geom_label_repel
 #'
 demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
 {
@@ -414,9 +417,11 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
   # get the ui and server
   if (interactive()){
     ui <- fluidPage(
+
       # use javascript extensions for Shiny
       shinyjs::useShinyjs(),
 
+      # sidebar
       sidebarLayout(position = "left",
 
                     # Side bar
@@ -439,7 +444,7 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
                       # Subsets
                       fluidRow(
                         column(12,h4("Selected Sections")),
-                        column(12,htmlOutput("summary")),
+                        column(12, uiOutput("textbox_ui")),
                         br()
                       ),
 
@@ -474,14 +479,14 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
       selected_corners <- reactiveVal(dplyr::tibble(x = numeric(), y = numeric()))
 
       # selected corner list
-      selected_corners_list <- reactiveVal(dplyr::tibble(box = character()))
+      selected_corners_list_image <- reactiveVal(dplyr::tibble(box = character()))
+      selected_corners_list <- reactiveVal(list())
 
       # the image
       if(use_points){
         object_small <- resizeImage(object, size = scale_width)
         image_info_small <- magick::image_info(vrImages(object_small))
         coords <- as.data.frame(vrCoordinates(object_small, reg = FALSE))
-        # coords[,2] <- max(coords[,2]) - coords[,2] + min(coords[,2])
         pl <- ggplot() + geom_point(aes_string(x = "x", y = "y"), coords, size = 1.5, color = "black") +
           theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank(),
                 axis.line=element_blank(), axis.title.x=element_blank(), axis.title.y=element_blank(),
@@ -491,26 +496,69 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
         pl <- magick::image_ggplot(images)
       }
 
+      # counter for boxes
+      counter <- reactiveValues(n = 0)
+      output$textbox_ui <- renderUI({ textboxes() })
+      textboxes <- reactive({
+        n <- counter$n
+        if (n > 0) {
+          lapply(seq_len(n), function(i) {
+            if(is.null(input[[paste0("sample",i)]])){
+              column(12,textInput(inputId = paste0("sample", i),
+                                  label = paste0("Sample ", i), value = paste0("Sample ", i)))
+            } else {
+              column(12,textInput(inputId = paste0("sample", i),
+                                  label = paste0("Sample ", i), value = input[[paste0("sample",i)]]))
+            }
+          })
+        }
+      })
+
       ### Main observable ####
       observe({
 
-        # update summary
-        output[["summary"]] <- renderUI({
-          if(nrow(selected_corners_list()) > 0){
-            corners <- selected_corners_list()$box
-            print_selected <- paste0("Subset ", 1:length(corners), ": ", corners)
-            htmltools::HTML(paste(print_selected, collapse = '<br/>'))
-          }
-        })
-
         # output image
         output[["cropped_image"]] <- renderPlot({
-          corners <- apply(as.matrix(selected_corners()),2,as.numeric)
+
+          # visualize already selected boxes
+          if(length(selected_corners_list()) > 0){
+            for (i in 1:length(selected_corners_list())){
+              corners <- apply(as.matrix(selected_corners_list()[[i]]),2,as.numeric)
+              if(nrow(corners) > 1){
+                corners <- as.data.frame(rbind(cbind(corners[1,1], corners[1:2,2]), cbind(corners[2,1], corners[2:1,2])))
+                colnames(corners) <- c("x", "y")
+                pl <- pl + ggplot2::geom_polygon(aes(x = x, y = y), data = corners, alpha = 0.3, fill = "green", color = "black")
+
+              }
+            }
+          }
+
+          # add currently selected points
           if(nrow(selected_corners()) > 1){
-            pl <- pl +
-              ggplot2::geom_rect(aes(xmin = corners[1,1], xmax = corners[2,1], ymin = corners[1,2], ymax = corners[2,2]),
-                                 fill = "green", alpha = 0.3, color = "black")
+            corners <- apply(as.matrix(selected_corners()),2,as.numeric)
+            corners <- as.data.frame(rbind(cbind(corners[1,1], corners[1:2,2]), cbind(corners[2,1], corners[2:1,2])))
+            colnames(corners) <- c("x", "y")
+            pl <- pl + ggplot2::geom_polygon(aes(x = x, y = y), data = corners, alpha = 0.3, fill = "green", color = "black")
+          }
+
+          # put labels of the already selected polygons
+          if(length(selected_corners_list()) > 0){
+            for (i in 1:length(selected_corners_list())){
+              corners <- selected_corners_list()[[i]]
+              corners <- as.data.frame(rbind(cbind(corners[1,1], corners[1:2,2]), cbind(corners[2,1], corners[2:1,2])))
+              if(is.null(input[[paste0("sample",i)]])){
+                corners <- data.frame(x = mean(corners[,1]), y = max(corners[,2]), sample = paste0("Sample ",i))
+              } else {
+                corners <- data.frame(x = mean(corners[,1]), y = max(corners[,2]), sample = input[[paste0("sample",i)]])
+              }
+              pl <- pl +
+                ggrepel::geom_label_repel(mapping = aes(x = x, y = y, label = sample), data = corners,
+                                          size = 5, direction = "y", nudge_y = 6, box.padding = 0, label.padding = 1, seed = 1, color = "red")
+
+            }
           }
+
+          # return graph
           pl
         })
       })
@@ -524,13 +572,21 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
       ## add box ####
       observeEvent(input$addbox, {
         if(nrow(selected_corners()) == 2){
+
+          # get corners
           next_ind <- length(selected_corners_list()) + 1
           corners <- selected_corners()
 
+          # record corners
+          selected_corners_list(c(selected_corners_list(), list(corners)))
+
           # adjust corners
           corners <- corners*scale_factor
           corners <- apply(corners,2,ceiling)
 
+          # Track the number of input boxes to render
+          counter$n <- counter$n + 1
+
           # fix for limits
           corners[1,1] <- ifelse(corners[1,1] < 0, 0, corners[1,1])
           corners[1,1] <- ifelse(corners[1,1] > imageinfo$width, imageinfo$width, corners[1,1])
@@ -547,9 +603,9 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
                             min(corners[,1]), "+", imageinfo$height - max(corners[,2]))
 
           # add to box list
-          selected_corners_list() %>%
+          selected_corners_list_image() %>%
             dplyr::add_row(box = corners) %>%
-            selected_corners_list()
+            selected_corners_list_image()
           selected_corners() %>%
             dplyr::filter(FALSE) %>% selected_corners()
         }
@@ -569,13 +625,16 @@ demuxVoltRon <- function(object, scale_width = 800, use_points = FALSE)
         }
       })
 
-      ## select points on the image ####
+      ## done ####
       observeEvent(input$done, {
-        if(nrow(selected_corners_list()) > 0){
+        if(nrow(selected_corners_list_image()) > 0){
           subsets <- list()
-          box_list <- selected_corners_list()
-          sample_names <- paste0("Sample", 1:length(box_list$box))
+          box_list <- selected_corners_list_image()
+
+          # collect labels
+          sample_names <- sapply(1:length(box_list$box), function(i) input[[paste0("sample",i)]])
           print(sample_names)
+
           for(i in 1:length(box_list$box)){
             temp <- subset(object, image = box_list$box[i])
             temp$Sample <- sample_names[i]

diff --git a/R/import.R b/R/import.R
@@ -16,6 +16,7 @@
 #' @param use_image if TRUE, the DAPI image will be used.
 #' @param morphology_image the name of the lowred morphology image. Default: morphology_lowres.tif
 #' @param resolution_level the level of resolution within Xenium OME-TIFF image, see \code{generateXeniumImage}. Default: 7 (553x402)
+#' @param overwrite_resolution if TRUE, the image "file.name" will be generated again although it exists at "dir.path"
 #' @param import_molecules if TRUE, molecule assay will be created along with cell assay.
 #' @param ... additional parameters passed to \code{formVoltRon}
 #'
@@ -25,7 +26,7 @@
 #'
 #' @export
 #'
-importXenium <- function (dir.path, selected_assay = "Gene Expression", assay_name = "Xenium", use_image = TRUE, morphology_image = "morphology_lowres.tif", resolution_level = 7, import_molecules = FALSE, ...)
+importXenium <- function (dir.path, selected_assay = "Gene Expression", assay_name = "Xenium", use_image = TRUE, morphology_image = "morphology_lowres.tif", resolution_level = 7, overwrite_resolution = FALSE, import_molecules = FALSE, ...)
 {
   # cell assay
   message("Creating cell level assay ...")
@@ -45,7 +46,7 @@ importXenium <- function (dir.path, selected_assay = "Gene Expression", assay_na
 
   # image
   if(use_image){
-    suppressMessages(generateXeniumImage(dir.path, file.name = morphology_image, resolution_level = resolution_level))
+    suppressMessages(generateXeniumImage(dir.path, file.name = morphology_image, resolution_level = resolution_level, overwrite_resolution = overwrite_resolution))
     image_file <- paste0(dir.path, "/", morphology_image)
     if(file.exists(image_file)){
       image <-  image_read(image_file)

diff --git a/R/objects.R b/R/objects.R
@@ -1045,7 +1045,11 @@ Metadata.VoltRon <- function(object, assay = NULL, type = NULL) {
       if(length(new_columns) > 0){
         value <- value[,c(colnames(metadata), new_columns)]
         for(cur_col in new_columns){
-          metadata[[cur_col]] <- ""
+          if(is.numeric(value[[cur_col]])){
+            metadata[[cur_col]] <- NA
+          } else {
+            metadata[[cur_col]] <- ""
+          }
         }
       }