Initial support for ome.zarr in image viewer 1.

Dockerfile

@@ -35,7 +35,7 @@ install.packages(c('data.table', 'shiny', 'DT', 'shinyFiles', 'shinycssloaders',
 install.packages(c('ggplot2', 'plotly', 'RANN', 'MASS', 'dbscan', 'uwot', 'xgboost', 'Ckmeans.1d.dp', 'e1071', 'caret', 'RColorBrewer', 'aws.s3', 'configr'), repos=c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/')); \
 install.packages('BiocManager', repos=c('https://cloud.r-project.org/', 'https://ftp.gwdg.de/pub/misc/cran/')); \
 install.packages(c('rJava', 'RCurl')); BiocManager::install('EBImage'); BiocManager::install('aoles/RBioFormats'); \
-library(devtools); setwd('/home/ide/app/image-data-explorer/imageViewer'); install();"
+BiocManager::install('Rarr'); library(devtools); setwd('/home/ide/app/image-data-explorer/imageViewer'); install();"
 
 # Use older version of RBioFormats if/when installation of latest version is broken
 # RUN R -e "devtools::install_github('aoles/RBioFormats@Bio-Formats_6.10.1')"

R/explore_image.R

@@ -29,43 +29,95 @@ explore_image_server <-function(input, output, session, rv, parent_input){
     if(!is.null(rv$imgPath1) && length(unique(rv$imgPath1)) == 1 &&
        length(unique(rv$selectedFrame)) <= 1 &&
        !is.null(rv$fileCol1) && rv$fileCol1 != ""){
-      slice.def <- list()
-      if(class(rv$imgRoot)[1] == "s3_bucket"){ # Images are in a S3 bucket
-        filePath1 <- tempfile()
-        save_object(object = rv$imgPath1[1], bucket = rv$imgRoot, region = Sys.getenv("AWS_DEFAULT_REGION"),
-                    file = filePath1)
-      } else if(!is.null(rv$imgRoot)) { # Images are on a filesystem
-        ## Deal with eventual Windows-style paths 
-        ## Not sure if this is necessary, R may be able to recognize Windows paths
-        ## Not fully tested
-        rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
-        filePath1 <- file.path(rootDir, strsplit(rv$imgPath1[1], '\\\\'))
-      }
-      validate(need(filePath1 != "" && file.exists(filePath1), "File not found. Check that you selected the correct image root directory."))
-      rv$metadataImg1 <- read.metadata(filePath1)
-      series.idx <- 1
-      res.level <- 1
-      slice.def <- list()
-      if(seriesCount(rv$metadataImg1) > 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$metadataImg1) - 3)) # Select lowest resolution
-      }
-      metadata <- coreMetadata(rv$metadataImg1, series.idx)
-      if(!is.null(metadata)) {
+      if(grepl("\\.ome\\.zarr$", rv$imgPath1[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")
+          filePath1 <- file.path("https:/", endPoint, bucketName, rv$imgPath1[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,'\\\\'))
+          filePath1 <- file.path(rootDir, strsplit(rv$imgPath1[1], '\\\\'), "s0")
+        }
         if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
           ## Figure out what the 3rd dimension is
-          if(metadata$sizeZ == 1 && metadata$sizeT > 1 && metadata$sizeC == 1) {
-            slice.def = list(T = unique(rv$selectedFrame))
-          } else if(metadata$sizeZ > 1 && metadata$sizeT == 1 && metadata$sizeC == 1) {
-            slice.def = list(Z = unique(rv$selectedFrame))
-          } else if(metadata$sizeZ == 1 && metadata$sizeT == 1 && metadata$sizeC > 1) {
-            slice.def = list(C = unique(rv$selectedFrame))
+          metadata <- tryCatch( 
+            { zarr_overview(filePath1, 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(filePath1, 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(filePath1, slice) },
+          error = function(e) {
+            message("Error reading image.\nRetrying in 0.5 s.\n")
+            Sys.sleep(0.5)
+            return(Rarr::read_zarr_array(filePath1, 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
+          filePath1 <- tempfile()
+          save_object(object = rv$imgPath1[1], bucket = rv$imgRoot, region = Sys.getenv("AWS_DEFAULT_REGION"),
+                      file = filePath1)
+        } else if(!is.null(rv$imgRoot)) { # Images are on a filesystem
+          ## Deal with eventual Windows-style paths 
+          ## Not sure if this is necessary, R may be able to recognize Windows paths
+          ## Not fully tested
+          rootDir <- file.path(strsplit(rv$imgRoot,'\\\\'))
+          filePath1 <- file.path(rootDir, strsplit(rv$imgPath1[1], '\\\\'))
+        }
+        validate(need(filePath1 != "" && file.exists(filePath1), "File not found. Check that you selected the correct image root directory."))
+        rv$metadataImg1 <- read.metadata(filePath1)
+        series.idx <- 1
+        res.level <- 1
+        slice.def <- list()
+        if(seriesCount(rv$metadataImg1) > 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$metadataImg1) - 3)) # Select lowest resolution
+        }
+        metadata <- coreMetadata(rv$metadataImg1, series.idx)
+        if(!is.null(metadata)) {
+          if(!is.null(rv$roiFrame) && rv$roiFrame != "") {
+            ## Figure out what the 3rd dimension is
+            if(metadata$sizeZ == 1 && metadata$sizeT > 1 && metadata$sizeC == 1) {
+              slice.def = list(T = unique(rv$selectedFrame))
+            } else if(metadata$sizeZ > 1 && metadata$sizeT == 1 && metadata$sizeC == 1) {
+              slice.def = list(Z = unique(rv$selectedFrame))
+            } else if(metadata$sizeZ == 1 && metadata$sizeT == 1 && metadata$sizeC > 1) {
+              slice.def = list(C = unique(rv$selectedFrame))
+            }
+          }
+        }
+        ## Use Bio-Formats to read one image
+        I <- read.image(filePath1, series = series.idx, resolution = res.level, subset = slice.def, normalize = TRUE)
       }
-      ## Use Bio-Formats to read one image
-      I <- read.image(filePath1, series = series.idx, resolution = res.level, subset = slice.def, normalize = TRUE)
       I <- normalize(I)
       I
     }
@@ -76,13 +128,17 @@ explore_image_server <-function(input, output, session, rv, parent_input){
     image1 <- img1()
     if(!is.null(image1)) {
       if(!is.null(rv$pixelPosition) && !is.null(rv$roiX) && rv$roiX!="") { # input$roiX!="" => ROI selection enabled
-        res.level <- 1
-        if(seriesCount(rv$metadataImg1) > 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$metadataImg1) - 3)) # Select lowest resolution
+        if(!grepl("\\.ome\\.zarr$", rv$imgPath1[1])) { # Not NGFF
+          res.level <- 1
+          if(seriesCount(rv$metadataImg1) > 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$metadataImg1) - 3)) # Select lowest resolution
+          }
+          r <- ceiling(coreMetadata(rv$metadataImg1, res.level)$sizeX/100)
+        } else {
+          r <- floor(min(dim(image1)[1:2])/100)
         }
-        r <- ceiling(coreMetadata(rv$metadataImg1, res.level)$sizeX/100)
         if(colorMode(image1) == 0) { # Convert grayscale to color
           image1 <- rgbImage(image1, image1, image1)
           colorMode(image1) = Color
@@ -100,7 +156,7 @@ explore_image_server <-function(input, output, session, rv, parent_input){
   ## Get table row(s) associated with clicked pixel(s)
   ## Use nearest neighbour(s)
   observeEvent(input$pixelPosition, {
-    # Only in imageViewer (i.e. not in gallery)
+    ## Only in imageViewer (i.e. not in gallery)
     if(!is.null(parent_input$viewer_tabs) && parent_input$viewer_tabs == 'imageViewer') {
       clickPosition <- NULL
       roiData <- NULL
@@ -127,7 +183,7 @@ explore_image_server <-function(input, output, session, rv, parent_input){
               roiData <- as.data.frame(rv$data[row.idx, c(rv$roiX, rv$roiY), with = FALSE])
               rownames(roiData) <- row.idx
             }
-            # Discard ROIS with undefined coordinates (i.e. x, y or z/t is NA)
+            ## Discard ROIS with undefined coordinates (i.e. x, y or z/t is NA)
             roiData <- roiData[complete.cases(roiData),]
             nn <- nn2(roiData,
                       clickPosition,

image_data_explorer.R

@@ -4,7 +4,7 @@
 ## Main application file ##
 ###########################
 
-VERSION <- "v1.4.7" # Update this when creating a new version
+VERSION <- "v1.5.0" # Update this when creating a new version
 
 # Increase max upload size to 1 GB
 options(shiny.maxRequestSize=1000*1024^2)
@@ -34,6 +34,9 @@ if(!"RBioFormats" %in% installed.packages()) {
 if(!"EBImage" %in% installed.packages()) {
   BiocManager::install("EBImage")
 }
+if(!"Rarr" %in% installed.packages()) {
+  BiocManager::install("Rarr")
+}
 if(!"imageViewer" %in% installed.packages()) {
   devtools::install('imageViewer')
 }
@@ -42,6 +45,7 @@ suppressMessages({
   library(DT) # R interface to the js DataTables library
   library(RBioFormats)
   library(EBImage)
+  library(Rarr)
   library(imageViewer)
   library(data.table)
   library(shiny)