update SpatialExperiment conversion

Artur-man · Jan 15, 2025 · f72203a · f72203a
1 parent cb9c064
commit f72203a
Show file tree

Hide file tree

Showing 5 changed files with 58 additions and 29 deletions.
diff --git a/R/conversion.R b/R/conversion.R
@@ -806,17 +806,39 @@ as.VoltRon.SpatialExperiment <- function(object, assay_type = "cell", assay_name
 
     # image
     if(nrow(imgdata) > 0){
+
+      # get image names 
       if(is.null(image_id)){
         image_names <- imgdata$image_id[imgdata$sample_id == samp]
       } else {
         image_names <- image_id
       }
+
+      # get image scales
+      scale.factors_list <- sapply(image_names, function(img){ 
+        SpatialExperiment::scaleFactors(object, 
+                                        sample_id = samp, 
+                                        image_id = img)
+      })
+      if(length(unique(scale.factors_list)) > 1){
+        stop("All images of a single sample should have the same scale for VoltRon object conversion!: please select an 'image_id'")
+      }
+
+      # get image list
       img_list <- sapply(image_names, function(img){ 
         imgraster <- SpatialExperiment::imgRaster(object, 
                                                   sample_id = samp, 
                                                   image_id = img)
         magick::image_read(imgraster)
       }, USE.NAMES = TRUE)
+
+      # scale coordinates
+      scale.factors <- unique(unlist(scale.factors_list))
+      cur_coords <- cur_coords*scale.factors
+
+      # reverse y coordinates
+      imginfo <- getImageInfo(img_list[[1]])
+      cur_coords[,2] <- imginfo$height - cur_coords[,2]
     } else {
       img_list <- NULL
     }
@@ -930,20 +952,24 @@ as.SpatialExperiment <- function(object, assay = NULL, reg = FALSE){
                                               reducedDims = reduceddims,
                                               sample_id=assays,
                                               spatialCoords=coords)
+  spe$sample_id <- assays
 
   # get image objects for each assay
   for(assy in vrAssayNames(object)){
     assay_object <- object[[assy]]
-    img <- vrImages(assay_object)
-    imgfile <- tempfile(fileext='.png')
-    magick::image_write(image = img, path = imgfile, format = 'png')
-    spe <- SpatialExperiment::addImg(spe,
-                                     sample_id = vrAssayNames(assay_object),
-                                     image_id = "main",
-                                     imageSource = imgfile,
-                                     scaleFactor = 1,
-                                     load = TRUE)
-    file.remove(imgfile)
+    channels <- vrImageChannelNames(assay_object)
+    for(ch in channels){
+      img <- vrImages(assay_object, channel = ch)
+      imgfile <- tempfile(fileext='.png')
+      magick::image_write(image = img, path = imgfile, format = 'png')
+      spe <- SpatialExperiment::addImg(spe,
+                                       sample_id = vrAssayNames(assay_object),
+                                       image_id = ch,
+                                       imageSource = imgfile,
+                                       scaleFactor = 1,
+                                       load = TRUE)
+      file.remove(imgfile) 
+    }
   }
 
   # return

diff --git a/R/io.R b/R/io.R
@@ -266,7 +266,7 @@ write_h5_samples <- function(object, assay = NULL, h5_path, chunkdim, level,
 
   # open h5 file
   if(verbose)
-    message("HDF5 file: ", h5_path, "\n")
+    message("HDF5 file: ", h5_path)
   if(!file.exists("h5_path"))
     rhdf5::h5createFile(h5_path)
 
@@ -349,7 +349,7 @@ writeHDF5ArrayInMetadata <- function(object,
         meta.data_list <- list()
         rhdf5::h5createGroup(h5_path, group = paste0(name, "/", sn))
         if(verbose)
-          message("Writing ", sn, " Metadata \n")
+          message("Writing ", sn, " Metadata")
 
         # write rownames first if they exist, and there is no id column
         if(!is.null(rownames(meta.data)) && !("id" %in% colnames(meta.data))){
@@ -424,7 +424,7 @@ writeHDF5ArrayInVrData <- function(object,
         if(!inherits(a, "dgCMatrix"))
           a <- as(a, "dgCMatrix")
         if(verbose)
-          message("Writing '", vrAssayNames(object), "' ", feat, " data \n")
+          message("Writing '", vrAssayNames(object), "' ", feat, " data")
         a <- BPCells::write_matrix_hdf5(a, 
                                         path = h5_path, 
                                         group = paste0(name, "/", feat), 
@@ -440,7 +440,7 @@ writeHDF5ArrayInVrData <- function(object,
         if(!inherits(a, "dgCMatrix"))
           a <- as(a, "dgCMatrix")
         if(verbose)
-          message("Writing '", vrAssayNames(object), "' normalized ", feat, " data \n")
+          message("Writing '", vrAssayNames(object), "' normalized ", feat, " data")
         a <- BPCells::write_matrix_hdf5(a, 
                                         path = h5_path, 
                                         group = paste0(name, "/", feat, "_norm"), 
@@ -459,7 +459,7 @@ writeHDF5ArrayInVrData <- function(object,
       if(!inherits(a, "dgCMatrix"))
         a <- as(a, "dgCMatrix")
       if(verbose)
-        message("Writing '", vrAssayNames(object), "' data \n")
+        message("Writing '", vrAssayNames(object), "' data")
       a <- BPCells::write_matrix_hdf5(a, 
                                       path = h5_path, 
                                       group = paste0(name, "/rawdata"), 
@@ -473,7 +473,7 @@ writeHDF5ArrayInVrData <- function(object,
       if(!inherits(a, "dgCMatrix"))
         a <- as(a, "dgCMatrix")
       if(verbose)
-        message("Writing '", vrAssayNames(object), "' normalized data \n")
+        message("Writing '", vrAssayNames(object), "' normalized data")
       a <- BPCells::write_matrix_hdf5(a, 
                                       path = h5_path, 
                                       group = paste0(name, "/normdata"), 
@@ -516,7 +516,7 @@ writeHDF5ArrayInImage <- function(object,
       if(!inherits(coords, "dgCMatrix"))
         coords <- as(coords, "dgCMatrix")
       if(verbose)
-        message("Writing '", name, "' coordinates \n")
+        message("Writing '", name, "' coordinates")
       coords <- BPCells::write_matrix_hdf5(coords, 
                                            path = h5_path, 
                                            group = paste0(name, "/", spat, "/coords"), 
@@ -536,7 +536,7 @@ writeHDF5ArrayInImage <- function(object,
         # write image
         if(!inherits(img, "Image_Array") || replace){
           if(verbose)
-            message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"' \n")
+            message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"'")
           img <- ImageArray::writeImageArray(img,
                                              output = gsub(".h5$", "", h5_path),
                                              name = paste0(name, "/", spat, "/", ch), 
@@ -575,7 +575,7 @@ write_zarr_samples <- function(object, assay = NULL, zarr_path, chunkdim, level,
 
   # create zarr
   if(verbose)
-    message("Zarr store: ", zarr_path, "\n")
+    message("Zarr store: ", zarr_path)
   zarr.array <- pizzarr::zarr_open(store = zarr_path)
 
   # create metadata
@@ -657,7 +657,7 @@ writeZarrArrayInMetadata <- function(object,
         meta.data_list <- list()
         zarr.array <- pizzarr::zarr_open(store = zarr_path)
         if(verbose)
-          message("Writing ", sn, " Metadata \n")
+          message("Writing ", sn, " Metadata")
         zarr.array$create_group(paste0(name, "/", sn))
 
         # write rownames first if they exist, and there is no id column
@@ -731,7 +731,7 @@ writeZarrArrayInVrData <- function(object,
       a <- vrData(object, feat_type = feat, norm = FALSE)
       if(!inherits(a, "DelayedArray") || replace){
         if(verbose)
-          message("Writing '", vrAssayNames(object), "' data \n")
+          message("Writing '", vrAssayNames(object), "' data")
         a <- ZarrArray::writeZarrArray(a, 
                                        zarr_path, 
                                        name = paste0(name, "/", feat),
@@ -747,7 +747,7 @@ writeZarrArrayInVrData <- function(object,
       a <- vrData(object, feat_type = feat, norm = TRUE)
       if(!inherits(a, "DelayedArray") || replace){
         if(verbose)
-          message("Writing '", vrAssayNames(object), "' normalized data \n")
+          message("Writing '", vrAssayNames(object), "' normalized data")
         a <- ZarrArray::writeZarrArray(a, 
                                        zarr_path, 
                                        name = paste0(name, "/", feat, "_norm"),
@@ -766,7 +766,7 @@ writeZarrArrayInVrData <- function(object,
     a <- vrData(object, norm = FALSE)
     if(!inherits(a, "DelayedArray") || replace){
       if(verbose)
-        message("Writing '", vrAssayNames(object), "' data \n")
+        message("Writing '", vrAssayNames(object), "' data")
       a <- ZarrArray::writeZarrArray(a, 
                                      zarr_path, 
                                      name = paste0(name, "/rawdata"),
@@ -782,7 +782,7 @@ writeZarrArrayInVrData <- function(object,
     a <- vrData(object, norm = TRUE)
     if(!inherits(a, "DelayedArray") || replace){
       if(verbose)
-        message("Writing '", vrAssayNames(object), "' normalized data \n")
+        message("Writing '", vrAssayNames(object), "' normalized data")
       a <- ZarrArray::writeZarrArray(a, 
                                      zarr_path, 
                                      name = paste0(name, "/normdata"),
@@ -828,7 +828,7 @@ writeZarrArrayInImage <- function(object,
     coords <- vrCoordinates(object, spatial_name = spat)
     if(!inherits(coords, c("DelayedArray", "IterableMatrix")) || replace){
       if(verbose)
-        message("Writing '", name, "' coordinates \n")
+        message("Writing '", name, "' coordinates")
       coords <- ZarrArray::writeZarrArray(coords,
                                           zarr_path,
                                           name = paste0(name, "/", spat, "/coords"),
@@ -851,7 +851,7 @@ writeZarrArrayInImage <- function(object,
         # write image
         if(!inherits(img, "Image_Array") || replace){
           if(verbose)
-            message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"' \n")
+            message("Writing '", name, "' image channel '", ch, "' for spatial system '", spat,"'")
           img <- ImageArray::writeImageArray(img,
                                              output = gsub(".zarr$", "", zarr_path),
                                              name = paste0(name, "/", spat, "/", ch), 

diff --git a/R/objects.R b/R/objects.R
@@ -1205,6 +1205,9 @@ vrData.VoltRon <- function(object, assay = NULL, features = NULL, feat_type = NU
   data <- NULL
   for(i in 1:length(assay_names)){
     cur_data <- vrData(object[[assay_names[i]]], features = features, feat_type = feat_type, norm = norm, ...)
+    if(inherits(cur_data, c("dgCMatrix", "CsparseMatrix", "dsparseMatrix"))){
+      cur_data <- as.matrix(cur_data)
+    }
     if(inherits(cur_data, c("data.frame", "Matrix", "matrix"))){
       cur_data <- data.frame(cur_data, feature.ID = rownames(cur_data), check.names = FALSE) 
     } 

diff --git a/R/spatial.R b/R/spatial.R
@@ -59,7 +59,7 @@ getSpatialNeighbors <- function(object,
 
       # metadata
       if(verbose)
-        message("Calculating Spatial Neighbors with group.by='", group.by, "' and group.ids='", paste(group.ids, collapse = ","), "'\n")
+        message("Calculating Spatial Neighbors with group.by='", group.by, "' and group.ids='", paste(group.ids, collapse = ","), "'")
       metadata = Metadata(object, assay = assy)
       if(!group.by %in% colnames(metadata))
         stop("The column '", group.by, "' was not found in the metadata!")

diff --git a/tests/testthat/test_conversion.R b/tests/testthat/test_conversion.R
@@ -35,7 +35,7 @@ test_that("as.AnnData", {
   # as.AnnData(visium_data, file = zarr_file, flip_coordinates = TRUE)
 
   # clean file
-  file.remove(h5ad_file)
-  unlink(zarr_file, recursive = TRUE)
+  # file.remove(h5ad_file)
+  # unlink(zarr_file, recursive = TRUE)
   expect_equal(1,1L)
 })