Add support for ome.zarr in image viewer 2

R/explore_image2.R

@@ -25,42 +25,94 @@ explore_image_server2 <-function(input, output, session, rv){
     if(!is.null(rv$imgPath2) && length(unique(rv$imgPath2)) == 1 &&
        length(unique(rv$selectedFrame)) <= 1 &&
        !is.null(rv$fileCol2) && rv$fileCol2 != ""){
-      slice.def <- list()
-      if(class(rv$imgRoot)[1] == "s3_bucket"){ # Images are in a S3 bucket
-        filePath2 <- tempfile()
-        save_object(object = rv$imgPath2[1], bucket = rv$imgRoot, region = Sys.getenv("AWS_DEFAULT_REGION"),
-                    file = filePath2)
-      } else { # Images are on a filesystem
-        ## Deal with eventual Windows-style paths
-        ## Not sure if necessary, not fully tested
-        rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
-        filePath2 <- file.path(rootDir, strsplit(rv$imgPath2[1], '\\\\'))
-      }
-      validate(need(filePath2 != "" && file.exists(filePath2), "File not found. Check that you selected the correct image root directory."))
-      slice.def <- list()
-      rv$metadataImg2 <- read.metadata(filePath2)
-      series.idx <- 1
-      res.level <- 1
-      if(seriesCount(rv$metadataImg2) > 3) {
-        # Image is likely a multi-resolution pyramid
-        # Bioformats stores thumbnail, slide overview, and barcode image in the last 3 series
-        res.level <- max(1, (seriesCount(rv$metadataImg2) - 3)) # Select lowest resolution
-      }
-      metadata2 <- coreMetadata(rv$metadataImg2, series.idx)
-      if(!is.null(metadata2)) {
+      if(grepl("\\.ome\\.zarr$", rv$imgPath2[1])) { # NGFF, use Rarr
+        if(class(rv$imgRoot)[1] == "s3_bucket"){ # Images are in a S3 bucket
+          bucketName <- rv$imgRoot$Contents$Bucket
+          endPoint <- Sys.getenv("AWS_S3_ENDPOINT")
+          filePath2 <- file.path("https:/", endPoint, bucketName, rv$imgPath2[1], "s0")
+        } else if(!is.null(rv$imgRoot)) { # Images are on a filesystem
+          ## Deal with eventual Windows-style paths 
+          rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
+          filePath2 <- file.path(rootDir, strsplit(rv$imgPath2[1], '\\\\'), "s0")
+        }
         if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
           ## Figure out what the 3rd dimension is
-          if(metadata2$sizeZ == 1 && metadata2$sizeT > 1 && metadata2$sizeC == 1) {
-            slice.def = list(T = unique(rv$selectedFrame))
-          } else if(metadata2$sizeZ > 1 && metadata2$sizeT == 1 && metadata2$sizeC == 1) {
-            slice.def = list(Z = unique(rv$selectedFrame))
-          } else if(metadata2$sizeZ == 1 && metadata2$sizeT == 1 && metadata2$sizeC > 1) {
-            slice.def = list(C = unique(rv$selectedFrame))
+          metadata <- tryCatch( 
+            { zarr_overview(filePath2, as_data_frame = T) },
+            error = function(e) {
+              message("Error reading image metadata.\nRetrying in 0.5 s.\nIf this persists, check that you selected the correct image root directory.")
+              Sys.sleep(0.5)
+              return(zarr_overview(filePath2, as_data_frame = T))
+            }
+          )
+          ## NGFF dim order is t,c,z,y,x
+          size <- as.list(c(rev(metadata$dim[[1]]), rep(0, 5 - length(metadata$dim[[1]]))))
+          names(size) <- c("x", "y", "z", "t", "c")
+          slice <- rev(size)
+          if(size$z == 0 && size$t > 0 && size$c == 0) {
+            slice$t <- unique(rv$selectedFrame)
+            slice$z <- NULL
+            slice$c <- NULL
+          } else if(size$z > 0 && size$t == 0 && size$c == 0) {
+            slice$z <- unique(rv$selectedFrame)
+            slice$t <- NULL
+            slice$c <- NULL
+          } else if(size$z == 0 && size$t == 0 && size$c > 0) {
+            slice$c <- unique(rv$selectedFrame)
+            slice$z <- NULL
+            slice$t <- NULL
+          }
+        }
+        slice$x <- 1:slice$x
+        slice$y <- 1:slice$y
+        I <- tryCatch( 
+          { Rarr::read_zarr_array(filePath2, slice) },
+          error = function(e) {
+            message("Error reading image.\nRetrying in 0.5 s.\n")
+            Sys.sleep(0.5)
+            return(Rarr::read_zarr_array(filePath2, slice))
           }
+        )
+        # Need to reorder dimensions
+        I <- aperm(I, length(dim(I)):1) # re-order as (x, y, z, t, c)
+        I <- EBImage::as.Image(I)
+      } else { # Other formats, use RBioFormats
+        if(class(rv$imgRoot)[1] == "s3_bucket"){ # Images are in a S3 bucket
+          filePath2 <- tempfile()
+          save_object(object = rv$imgPath2[1], bucket = rv$imgRoot, region = Sys.getenv("AWS_DEFAULT_REGION"),
+                      file = filePath2)
+        } else { # Images are on a filesystem
+          ## Deal with eventual Windows-style paths
+          ## Not sure if necessary, not fully tested
+          rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
+          filePath2 <- file.path(rootDir, strsplit(rv$imgPath2[1], '\\\\'))
         }
+        validate(need(filePath2 != "" && file.exists(filePath2), "File not found. Check that you selected the correct image root directory."))
+        slice.def <- list()
+        rv$metadataImg2 <- read.metadata(filePath2)
+        series.idx <- 1
+        res.level <- 1
+        if(seriesCount(rv$metadataImg2) > 3) {
+          # Image is likely a multi-resolution pyramid
+          # Bioformats stores thumbnail, slide overview, and barcode image in the last 3 series
+          res.level <- max(1, (seriesCount(rv$metadataImg2) - 3)) # Select lowest resolution
+        }
+        metadata2 <- coreMetadata(rv$metadataImg2, series.idx)
+        if(!is.null(metadata2)) {
+          if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
+            ## Figure out what the 3rd dimension is
+            if(metadata2$sizeZ == 1 && metadata2$sizeT > 1 && metadata2$sizeC == 1) {
+              slice.def = list(T = unique(rv$selectedFrame))
+            } else if(metadata2$sizeZ > 1 && metadata2$sizeT == 1 && metadata2$sizeC == 1) {
+              slice.def = list(Z = unique(rv$selectedFrame))
+            } else if(metadata2$sizeZ == 1 && metadata2$sizeT == 1 && metadata2$sizeC > 1) {
+              slice.def = list(C = unique(rv$selectedFrame))
+            }
+          }
+        }
+        ## Use Bio-Formats to read one image
+        I <- read.image(filePath2, series = series.idx, resolution = res.level, subset = slice.def, normalize = TRUE)
       }
-      ## Use Bio-Formats to read one image
-      I <- read.image(filePath2, series = series.idx, resolution = res.level, subset = slice.def, normalize = TRUE)
       I <- normalize(I)
       I
     }
@@ -72,13 +124,17 @@ explore_image_server2 <-function(input, output, session, rv){
     image2 <- img2()
     if(!is.null(image2)) {
       if(!is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$roiX != "") { # input$roiX != "" => ROI selection enabled
-        res.level <- 1
-        if(seriesCount(rv$metadataImg2) > 3) {
-          # Image is likely a multi-resolution pyramid
-          # Bioformats stores thumbnail, slide overview, and barcode image in the last 3 series
-          res.level <- max(1, (seriesCount(rv$metadataImg2) - 3)) # Select lowest resolution
+        if(!grepl("\\.ome\\.zarr$", rv$imgPath1[1])) { # Not NGFF
+          res.level <- 1
+          if(seriesCount(rv$metadataImg2) > 3) {
+            # Image is likely a multi-resolution pyramid
+            # Bioformats stores thumbnail, slide overview, and barcode image in the last 3 series
+            res.level <- max(1, (seriesCount(rv$metadataImg2) - 3)) # Select lowest resolution
+          }
+          r <- ceiling(coreMetadata(rv$metadataImg2, res.level)$sizeX/100)
+        } else {
+          r <- floor(min(dim(image2)[1:2])/100)
         }
-        r <- ceiling(coreMetadata(rv$metadataImg2, res.level)$sizeX/100)
         if(colorMode(image2) == 0) { # Convert grayscale to color
           image2 <- rgbImage(image2, image2, image2)
           colorMode(image2) = Color