Fix bugs in producing image galleries.

R/explore_gallery.R

@@ -47,24 +47,33 @@ explore_gallery_server <-function(input, output, session, rv, session_parent){
         slice.def <- list()
         img.metadata <- list()
         if(class(rv$imgRoot)[1] == "s3_bucket"){ # Images are in a S3 bucket
-          file.list <- c()
-          for(i in 1:length(imgPaths)) {
-            file.list[i] <- save_object(object = imgPaths[i], bucket = rv$imgRoot,
-                                        region = Sys.getenv("AWS_DEFAULT_REGION"),
-                                        file = tempfile())
+          if(any(grepl("\\.ome\\.zarr$", imgPaths))) { # NGFF, use omeRarr
+            showNotification("Galleries from ome-zarr files not supported yet", duration = 10, type="warning")
+            return(NULL)
+          } else {
+            file.list <- c()
+            for(i in 1:length(imgPaths)) {
+              file.list[i] <- save_object(object = imgPaths[i], bucket = rv$imgRoot,
+                                          region = Sys.getenv("AWS_DEFAULT_REGION"),
+                                          file = tempfile())
+            }
           }
         } else if(!is.null(rv$imgRoot)) { # Images are on a filesystem
           rootDir <- file.path(rv$imgRoot)
           file.list <- file.path(rootDir, imgPaths)
         }
         if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
-          ## Figure out what the 3rd dimension is using first image
-          img.metadata[[1]] <- read.metadata(file.list[[1]])
-          if(img.metadata[[1]]$coreMetadata$sizeZ == 1 && img.metadata[[1]]$coreMetadata$sizeT > 1) {
-            slice.def = list(T = unique(rv$selectedFrame))
-          }
-          else if(img.metadata[[1]]$coreMetadata$sizeZ > 1 && img.metadata[[1]]$coreMetadata$sizeT == 1) {
-            slice.def = list(Z = unique(rv$selectedFrame))
+          ## Figure out what the 3rd dimension is from first image
+          metadata <- read.metadata(file.list[[1]])$coreMetadata
+          if(metadata$sizeZ == 1 && metadata$sizeT > 1) {
+            frameName <- 'T'
+          } else if(metadata$sizeZ > 1 && metadata$sizeT == 1) {
+            frameName <- 'Z'
+          } 
+          ## Slice definition for each image
+          for(i in 1:nrow(dtmp)) {
+            slice.def[[i]] <- list()
+            slice.def[[i]][[frameName]] = rv$selectedFrame[i]
           }
         }
         # Do we have objects or images?
@@ -76,28 +85,23 @@ explore_gallery_server <-function(input, output, session, rv, session_parent){
           # Assume we have objects
           obj <- list()
           for(i in 1:nrow(dtmp)) {
+            metadata <- read.metadata(file.list[[i]])$coreMetadata
             x <- round(dtmp[i, get(rv$roiX)])
             dx <- c((x-floor(tile.w/2)) : (x+ceiling(tile.w/2)-1))
             y <- round(dtmp[i, get(rv$roiY)])
             dy <- c((y-floor(tile.h/2)) : (y+ceiling(tile.h/2)-1))
-            img <- read.image(file.list[[i]], subset = slice.def)
             # Crop image, taking care of object near image borders
-            dx <- dx[dx>0 & dx<dim(img)[1]]
-            dy <- dy[dy>0 & dy<dim(img)[2]]
-            a <- abind::asub(img, idx = list(dx,dy), dims = c(1,2))
-            a <- normalize(a)
-            # Make empty image of suitable size
-            obj[[i]] <- abind::asub(img, idx = list(1:tile.w,1:tile.h), dims = c(1,2))
-            obj[[i]][obj[[i]]!=0] <- 0
-            # Fill empty image with cropped image
-            dim.names <- list()
-            # Ensure both arrays have same dimension names (required to use afill())
-            for(j in 1:length(dim(a))) {
-              dimnames(obj[[i]])[[j]] <- 1:dim(obj[[i]])[j]
-              dimnames(a)[[j]] <- 1:dim(a)[j]
+            dx <- dx[dx>0 & dx<metadata$sizeX]
+            dy <- dy[dy>0 & dy<metadata$sizeY]
+            if(length(dx) == 0 || length(dy) == 0) {
+              showNotification("Object not in selected image. Check that anchor point coordinates come from the selected image.", duration = 10, type="error")
+              return(NULL)
             }
-            abind::afill(obj[[i]]) <- a
+            slice.def[[i]]$X <- dx
+            slice.def[[i]]$Y <- dy
+            obj[[i]] <- read.image(file.list[[i]], subset = slice.def[[i]])
           }
+          obj <- lapply(obj, EBImage::normalize, separate = TRUE)
           I <- combine(obj)
         } else { # We deal with whole images
           depth <- 1 # Images may have variable number of slices
@@ -149,6 +153,7 @@ explore_gallery_server <-function(input, output, session, rv, session_parent){
           }
           I <- abind(I, along = (length(dim(I[[1]]))+1))
         }
+        I <- EBImage::normalize(I, separate = FALSE)
         img.per.row <- 8
         if(nrow(dtmp) < img.per.row) {
           img.per.row <- nrow(dtmp)
@@ -159,7 +164,7 @@ explore_gallery_server <-function(input, output, session, rv, session_parent){
           # Assume we have 4D (since if 5D, one of t or z should have been fixed)
           img <- list()
           for(k in 1:dim(I)[3]) {
-            img[[k]] <- I[,,k,]
+            img[[k]] <- as.Image(I[,,k,])
             # if colorMode(I) > 0, prevent the third dimension
             # from being interpreted as channels 
             colorMode(img[[k]]) <- Grayscale

image_data_explorer.R

@@ -4,7 +4,7 @@
 ## Main application file ##
 ###########################
 
-VERSION <- "v1.5.1" # Update this when creating a new version
+VERSION <- "v1.5.2" # Update this when creating a new version
 
 # Increase max upload size to 1 GB
 options(shiny.maxRequestSize=1000*1024^2)