Diff of /R/conversion.R [000000] .. [413088]

Switch to side-by-side view

--- a
+++ b/R/conversion.R
@@ -0,0 +1,996 @@
+####
+# Seurat ####
+####
+
+#' @param type the spatial data type of Seurat object: "image" or "spatial"
+#' @param assay_name the assay name
+#' @param verbose verbose
+#' @param ... Additional parameter passed to \link{formVoltRon}
+#'
+#' @rdname as.VoltRon
+#' @method as.VoltRon Seurat
+#'
+#' @importFrom stringr str_replace str_extract
+#' @export
+#'
+as.VoltRon.Seurat <- function(object, type = c("image", "spatial"), assay_name = NULL, verbose = TRUE, ...){
+
+  # check Seurat package
+  if(!requireNamespace('Seurat'))
+    stop("Please install Seurat package for using Seurat objects!: install.packages('Seurat')")
+
+  # raw counts
+  rawdata <- SeuratObject::LayerData(object, assay = Seurat::DefaultAssay(object), layer = "counts")
+
+  # metadata
+  metadata <- object@meta.data
+
+  # embeddings
+  if(length(object@reductions) > 0){
+    embeddings_flag <- TRUE
+    embedding_list <- sapply(object@reductions, Seurat::Embeddings, USE.NAMES = TRUE)
+  } else {
+    embeddings_flag <- FALSE
+  }
+
+  # image
+  voltron_list <- list()
+  spatialobjectlist <- object@images
+  fov_names <- names(spatialobjectlist)
+  if(length(spatialobjectlist) > 0){
+    for(fn in fov_names){
+
+      # message
+      if(verbose)
+        message("Converting FOV: ", fn, " ...")
+
+      # image object
+      spatialobject <- spatialobjectlist[[fn]]
+
+      # cells
+      cells <- Seurat::Cells(spatialobject)
+      cells_nopostfix <- gsub("_Assay[0-9]+$", "", cells)
+
+      # count
+      cur_rawdata <- as.matrix(rawdata[,cells])
+      colnames(cur_rawdata) <- cells_nopostfix
+
+      # metadata
+      cur_metadata <- metadata[cells,]
+      rownames(cur_metadata) <- cells_nopostfix
+
+      # coords
+      coords <- as.matrix(Seurat::GetTissueCoordinates(spatialobject))[,seq_len(2)]
+      coords <- apply(coords, 2, as.numeric)
+      colnames(coords) <- c("x", "y")
+      rownames(coords) <- cells_nopostfix
+
+      # form voltron
+      params <- list()
+      assay.type <- "cell"
+      assay_name <- "FOV"
+      voltron_list[[fn]] <- formVoltRon(data = cur_rawdata, metadata = cur_metadata, coords = coords, main.assay = assay_name, params = params, assay.type = assay.type, sample_name = fn, ...)
+
+      # embeddings
+      spatialpoints <- vrSpatialPoints(voltron_list[[fn]])
+      spatialpoints_nopostfix <- stringr::str_replace(spatialpoints, "_Assay[0-9]+$", "")
+      spatialpoints_assay <- stringr::str_extract(spatialpoints, "Assay[0-9]+$")
+      if(embeddings_flag){
+        for(embed_name in names(embedding_list)){
+          cur_embedding <- embedding_list[[embed_name]][cells,]
+          rownames(cur_embedding) <- spatialpoints
+          vrEmbeddings(voltron_list[[fn]], type = embed_name) <- cur_embedding
+        }
+      }
+    }
+
+    # merge object
+    if(length(voltron_list) > 1){
+      if(verbose)
+        message("Merging object ...")
+      vrobject <- merge(voltron_list[[1]], voltron_list[-1]) 
+    } else {
+      vrobject <- voltron_list[[1]]
+    }
+  } else{
+    image <- NULL
+    stop("There are no spatial objects available in this Seurat object")
+  }
+
+  return(vrobject)
+}
+
+#' as.Seurat
+#'
+#' Converting a VoltRon object into a Seurat object
+#'
+#' @param object a VoltRon object
+#' @param cell.assay the name(type) of the cell assay to be converted
+#' @param molecule.assay the name(type) of the molecule assay to be added to the cell assay in Seurat object
+#' @param image_key the name (or prefix) of the image(s)
+#' @param type the spatial data type of Seurat object: "image" or "spatial"
+#' @param reg if TRUE, registered coordinates will be used
+#'
+#' @rdname as.Seurat
+#'
+#' @importFrom dplyr bind_cols
+#' @importFrom stringr str_replace
+#'
+#' @export
+as.Seurat <- function(object, cell.assay = NULL, molecule.assay = NULL, image_key = "fov", type = c("image", "spatial"), reg = FALSE){
+  
+  # sample metadata
+  sample_metadata <- SampleMetadata(object)
+  
+  # check Seurat package
+  if(!requireNamespace('Seurat'))
+    stop("Please install Seurat package for using Seurat objects")
+  
+  # check the number of assays
+  if(is.null(cell.assay)){
+    if(length(unique(sample_metadata[["Assay"]])) > 1){
+      stop("You can only convert a single VoltRon assay into a Seurat object!")
+    } else {
+      cell.assay <- sample_metadata[["Assay"]]
+    }
+  } else {
+    vrMainAssay(object) <- cell.assay
+  }
+  
+  # check the number of assays
+  if(unique(vrAssayTypes(object, assay = cell.assay)) %in% c("spot","ROI")) {
+    stop("Conversion of Spot or ROI assays into Seurat is not yet permitted!")
+  }
+  
+  # data
+  data <- vrData(object, assay = cell.assay, norm = FALSE)
+  
+  # metadata
+  metadata <- Metadata(object, assay = cell.assay)
+  
+  # Seurat object
+  seu <- Seurat::CreateSeuratObject(counts = data, meta.data = metadata, assay = cell.assay)
+  
+  # add embeddings
+  if(length(vrEmbeddingNames(object)) > 0){
+    for(embd in vrEmbeddingNames(object)){
+      embd_data <- vrEmbeddings(object, type = embd)
+      colnames(embd_data) <- paste0(embd, seq_len(ncol(embd_data)))
+      seu[[embd]] <- Seurat::CreateDimReducObject(embd_data, key = paste0(embd, "_"), assay = Seurat::DefaultAssay(seu))
+    }
+  }
+  
+  # get image objects for each assay
+  for(assy in vrAssayNames(object)){
+    assay_object <- object[[assy]]
+    if(type == "image"){
+      coords <- vrCoordinates(assay_object, reg = reg)
+      image.data <- list(centroids = SeuratObject::CreateCentroids(coords[,c("x", "y")]))
+      if(!is.null(molecule.assay)){
+        assay_metadata <- sample_metadata[assy,]
+        molecule.assay.id <- rownames(sample_metadata)[sample_metadata$Assay == molecule.assay & (assay_metadata$Layer == sample_metadata$Layer & assay_metadata$Sample == sample_metadata$Sample)]
+        if(length(molecule.assay.id) > 0){
+          molecules_metadata <- Metadata(object, assay = molecule.assay.id)
+          molecules_coords <- vrCoordinates(object, assay = molecule.assay.id, reg = reg)
+          molecules <- dplyr::bind_cols(molecules_metadata, molecules_coords)
+          rownames(molecules) <- stringr::str_replace(rownames(molecules), pattern = molecule.assay.id, replacement = assy)
+          colnames(molecules)[colnames(molecules) %in% "feature_name"] <- "gene"
+        }
+      } else {
+        molecules <- NULL
+      }
+      image.data <- SeuratObject::CreateFOV(coords = image.data, type = c("centroids"), molecules = molecules, assay = cell.assay)
+      image <- paste0(image_key, assy)
+      seu[[image]] <- image.data
+    } else if(type == "spatial"){
+      stop("Currently VoltRon does not support converting into Spatial-type (e.g. VisiumV1) Spatial objects!")
+    }
+  }
+  
+  
+  # return
+  seu
+}
+
+####
+# AnnData ####
+####
+
+#' convertAnnDataToVoltRon
+#'
+#' converting AnnData h5ad files to VoltRon objects
+#'
+#' @param file h5ad file
+#' @param AssayID the ID assays in the h5ad file
+#' @param ... additional parameters passed to \link{formVoltRon}
+#'
+#' @export
+#'
+convertAnnDataToVoltRon <- function(file, AssayID = NULL, ...){
+  
+  # check anndata package
+  if(!requireNamespace('anndata'))
+    stop("Please install anndata package!: install.packages('anndata')")
+  
+  # read anndata
+  adata <- anndata::read_h5ad(file)
+  
+  # raw counts
+  rawdata <- as.matrix(t(adata$X))
+  
+  # metadata
+  metadata <- adata$obs
+  
+  # coordinates and subcellular
+  if(is.null(AssayID)){
+    coords <- data.frame(adata$obsm, row.names = colnames(rawdata))
+    coords <- apply(coords, 2, as.numeric)
+    colnames(coords) <- c("x", "y")
+    
+    # scale coordinates and assay.type
+    params <- list()
+    assay.type <- "cell"
+    assay_name <- "Xenium"
+    
+    # create VoltRon
+    object <- formVoltRon(rawdata, metadata, image = NULL, coords, main.assay = assay_name, params = params, assay.type = assay.type, ...)
+    
+    # return
+    return(object)
+  } else {
+  }
+}
+
+#' as.AnnData
+#'
+#' Converting a VoltRon object into a AnnData (.h5ad) object
+#'
+#' @param object a VoltRon object
+#' @param assay assay name (exp: Assay1) or assay class (exp: Visium, Xenium), see \link{SampleMetadata}. 
+#' if NULL, the default assay will be used, see \link{vrMainAssay}.
+#' @param file the name of the h5ad file.
+#' @param flip_coordinates if TRUE, the spatial coordinates (including segments) will be flipped.
+#' @param method the package to use for conversion: "anndataR" or "anndata".
+#' @param create.ometiff should an ometiff file be generated of default image of the object
+#' @param python.path the path to the python binary, otherwise either \code{basilisk} package is used or \code{getOption("voltron.python.path")} should be not NULL.
+#' @param ... additional parameters passed to \link{vrImages}.
+#' 
+#' @details
+#' This function converts a VoltRon object into an AnnData object (.h5ad file). It extracts assay data,
+#' spatial coordinates, and optionally flips coordinates. Images associated with the assay can be included in the 
+#' resulting AnnData file, with additional customization parameters like channel, scale.perc. 
+#' 
+#' @rdname as.AnnData
+#'
+#' @importFrom stringr str_extract
+#' @importFrom magick image_data
+#' 
+#' @export
+as.AnnData <- function(object, 
+                       file, 
+                       assay = NULL, 
+                       flip_coordinates = FALSE, 
+                       method = "anndata", 
+                       create.ometiff = FALSE, 
+                       python.path = NULL,
+                       ...) {
+  
+  # Check the number of assays
+  if (is.null(assay)) {
+    if (length(unique(SampleMetadata(object)[["Assay"]])) > 1) {
+      stop("You can only convert a single VoltRon assay into a Anndata object!")
+    } else {
+      assay <- SampleMetadata(object)[["Assay"]]
+    }
+  }
+  assay <- vrAssayNames(object, assay = assay)
+  
+  # Check the number of assays
+  if (unique(vrAssayTypes(object, assay = assay)) %in% c("ROI", "tile")) {
+    stop("Conversion of tile or ROI assays into Anndata is not permitted!")
+  }
+  
+  # Data
+  data <- vrData(object, assay = assay, norm = FALSE)
+  
+  # Metadata
+  metadata <- Metadata(object, assay = assay)
+  metadata[["library_id"]] <- stringr::str_extract(rownames(metadata), "_Assay[0-9]+$")
+  metadata[["library_id"]] <- gsub("^_", "", metadata[["library_id"]])
+  
+  # Embeddings
+  obsm <- list()
+  if (length(vrEmbeddingNames(object, assay = assay)) > 0) {
+    for (embed_name in vrEmbeddingNames(object, assay = assay)) {
+      obsm[[embed_name]] <- vrEmbeddings(object, assay = assay, type = embed_name)
+    }
+  }
+  
+  # Flip coordinates
+  if (flip_coordinates) {
+    object <- flipCoordinates(object, assay = assay)
+  }
+  
+  # Coordinates
+  coords <- vrCoordinates(object, assay = assay)
+  
+  # Segments
+  segments <- vrSegments(object, assay = assay)
+  if(length(segments) > 0){
+    max_vertices <- max(vapply(segments, nrow, numeric(1)))
+    num_cells <- length(segments)
+    segmentations_array <- array(NA, dim = c(num_cells, max_vertices, 2))
+    cell_ids <- names(segments)
+    for (i in seq_along(cell_ids)) {
+      seg <- segments[[i]]
+      seg_matrix <- as.matrix(seg[, c("x", "y")])
+      nrow_diff <- max_vertices - nrow(seg_matrix)
+      if (nrow_diff > 0) {
+        seg_matrix <- rbind(seg_matrix, matrix(NA, nrow = nrow_diff, ncol = 2))
+      }
+      segmentations_array[i, , ] <- seg_matrix
+    }
+    for (k in seq_len(2)) {
+      segmentations_array[,,k] <- t(apply(segmentations_array[,,k], 1, fill_na_with_preceding))
+    } 
+  } else {
+    segmentations_array <- array(dim = nrow(coords))
+  }
+
+  # Images
+  images_mgk <- vrImages(object, assay = assay, ...)
+  if(!is.list(images_mgk)){
+    images_mgk <- list(images_mgk)
+    names(images_mgk) <- vrAssayNames(object, assay = assay)  
+  }
+  image_list <- lapply(images_mgk, function(img) {
+    list(images = list(hires = as.numeric(magick::image_data(img, channels = "rgb"))),
+         scalefactors = list(tissue_hires_scalef = 1, spot_diameter_fullres = 0.5))
+  })
+  
+  # obsm
+  # TODO: currently embedding and spatial dimensions should of the same size, but its not 
+  # always the case in VoltRon objects
+  obsm <- c(obsm, list(spatial = coords, 
+                       spatial_AssayID = coords, 
+                       segmentation = segmentations_array))
+  
+  # save as zarr
+  if(grepl(".zarr[/]?$", file)){
+    
+    # check packages
+    if(!requireNamespace('reticulate'))
+      stop("Please install reticulate package!: install.packages('reticulate')")
+    if(!requireNamespace('DelayedArray'))
+      stop("Please install DelayedArray package for using DelayedArray functions")
+    
+    # run basilisk to call zarr methods
+    python.path <- getPythonPath(python.path)
+    if(!is.null(python.path)){
+      reticulate::use_python(python = python.path)
+      
+      zarr <- reticulate::import("zarr")
+      anndata <- reticulate::import("anndata")
+      make_numpy_friendly <- function(x) {
+        if (DelayedArray::is_sparse(x)) {
+          methods::as(x, "dgCMatrix")
+        }
+        else {
+          as.matrix(x)
+        }
+      }
+      X <- make_numpy_friendly(t(data))
+      obsm <- list(spatial = coords, 
+                   spatial_AssayID = coords, 
+                   segmentation = segmentations_array)
+      adata <- anndata$AnnData(X = X, 
+                               obs = metadata, 
+                               obsm = obsm, 
+                               uns = list(spatial = image_list))
+      adata <- reticulate::r_to_py(adata)
+      adata$write_zarr(file)   
+      success <- TRUE
+    } else if(requireNamespace('basilisk')){
+      py_env <- getBasilisk()
+      proc <- basilisk::basiliskStart(py_env)
+      on.exit(basilisk::basiliskStop(proc))
+      success <- basilisk::basiliskRun(proc, function(data, metadata, obsm, coords, segments, image_list, file) {
+        zarr <- reticulate::import("zarr")
+        anndata <- reticulate::import("anndata")
+        make_numpy_friendly <- function(x) {
+          if (DelayedArray::is_sparse(x)) {
+            methods::as(x, "dgCMatrix")
+          }
+          else {
+            as.matrix(x)
+          }
+        }
+        X <- make_numpy_friendly(t(data))
+        obsm <- list(spatial = coords, 
+                     spatial_AssayID = coords, 
+                     segmentation = segmentations_array)
+        adata <- anndata$AnnData(X = X, 
+                                 obs = metadata, 
+                                 obsm = obsm, 
+                                 uns = list(spatial = image_list))
+        adata <- reticulate::r_to_py(adata)
+        adata$write_zarr(file)       
+        return(TRUE)
+      }, data = data, metadata = metadata, obsm = obsm, coords = coords, segments = segmentations_array, image_list = image_list, file = file)
+    } else {
+      stop("Please define the 'python.path' or install the basilisk package!: BiocManager::install('basilisk')")
+    }
+    
+    if(create.ometiff){
+      success2 <- as.OmeTiff(images_mgk[[1]], out_path = gsub("zarr[/]?$", "ome.tiff", file), python.path = python.path) 
+      success <- success & success2
+    } 
+    
+    return(success)
+    
+  # save as h5ad
+  } else if(grepl(".h5ad$", file)) {
+    
+    # Check and use a package for saving h5ad
+    if (method == "anndataR") {
+      if (!requireNamespace('anndataR', quietly = TRUE)) {
+        stop("The anndataR package is not installed. Please install it or choose the 'anndata' method.")
+      }
+      
+      # Create anndata using anndataR
+      adata <- anndataR::AnnData(obs_names = rownames(metadata), 
+                                 var_names = rownames(data), 
+                                 X = t(data), 
+                                 obs = metadata, 
+                                 obsm = list(spatial = coords, 
+                                             spatial_AssayID = coords, 
+                                             segmentation = segmentations_array),
+                                 uns = list(spatial = image_list))
+      
+      # Write to h5ad file using anndataR
+      anndataR::write_h5ad(adata, path = file)
+      
+    } else if (method == "anndata") {
+      if (!requireNamespace('anndata', quietly = TRUE)) {
+        stop("The anndata package is not installed. Please install it or choose the 'anndataR' method.")
+      }
+      
+      # check reticulate
+      python.path <- getPythonPath(python.path)
+      if(!is.null(python.path)){
+        reticulate::use_python(python.path)
+      }
+      
+      # Create anndata using anndata
+      adata <- anndata::AnnData(X = t(data), 
+                                obs = metadata, 
+                                obsm = list(spatial = coords,
+                                            spatial_AssayID = coords,
+                                            segmentation = segmentations_array),
+                                uns = list(spatial = image_list))
+      
+      
+      # Write to h5ad file using anndata
+      anndata::write_h5ad(adata, filename = file)
+      
+    } else {
+      stop("Invalid method selected. Please choose either 'anndataR' or 'anndata'.")
+    }
+    
+  } else {
+    stop("the 'file' should have an .h5ad, .zarr or .zarr/ extension")
+  }
+}  
+
+####
+# Zarr ####
+####
+
+#' @rdname as.Zarr
+#'
+#' @importFrom magick image_raster
+#' @importFrom grDevices col2rgb
+#'
+#' @export
+"as.Zarr.magick-image" <- function (object, out_path, image_id = "image_1")
+{
+  # check packages
+  if(!requireNamespace('basilisk'))
+    stop("Please install basilisk package!: BiocManager::install('basilisk')")
+  if(!requireNamespace('reticulate'))
+    stop("Please install reticulate package!: install.packages('reticulate')")
+  
+  img_arr <- apply(as.matrix(magick::image_raster(object, tidy = FALSE)), c(1, 2), col2rgb)
+  py_env <- getBasilisk()
+  proc <- basilisk::basiliskStart(py_env)
+  on.exit(basilisk::basiliskStop(proc))
+  success <- basilisk::basiliskRun(proc, function(img_arr, image_id, out_path) {
+    zarr <- reticulate::import("zarr")
+    ome_zarr <- reticulate::import("ome_zarr")
+    z_root <- zarr$open_group(out_path, mode = "w")
+    obj_list <- function(...) {
+      retval <- stats::setNames(list(), character(0))
+      param_list <- list(...)
+      for (key in names(param_list)) {
+        retval[[key]] = param_list[[key]]
+      }
+      retval
+    }
+    default_window <- obj_list(start = 0, min = 0, max = 255, end = 255)
+    ome_zarr$writer$write_image(image = img_arr,
+                                group = z_root,
+                                axes = "cyx",
+                                omero = obj_list(name = image_id, version = "0.3",
+                                                 rdefs = obj_list(),
+                                                 channels = list(obj_list(label = "r", color = "FF0000", window = default_window),
+                                                                 obj_list(label = "g", color = "00FF00", window = default_window),
+                                                                 obj_list(label = "b", color = "0000FF", window = default_window))))
+    return(TRUE)
+  }, img_arr = img_arr, image_id = image_id, out_path = out_path)
+  return(success)
+}
+
+####
+# OME ####
+####
+
+#' as.OmeTiff
+#'
+#' Converting VoltRon (magick) images to ome.tiff
+#'
+#' @param object a magick-image object
+#' @param out_path output path to ome.tiff file
+#' @param image_id image name
+#' @param python.path the path to the python binary, otherwise either \code{basilisk} package is used or \code{getOption("voltron.python.path")} should be not NULL.
+#' 
+#' @importFrom magick image_raster
+#' @importFrom grDevices col2rgb
+#'
+#' @export
+as.OmeTiff <- function (object, out_path, image_id = "image_1", python.path = NULL){
+  
+  # check packages
+  if(!requireNamespace('reticulate'))
+    stop("Please install reticulate package!: install.packages('reticulate')")
+  
+  # get image and transpose the array
+  img_arr <- apply(as.matrix(magick::image_raster(object, tidy = FALSE)), c(1, 2), col2rgb)
+  img_arr <- aperm(img_arr, c(2,3,1))
+  
+  # run basilisk
+  python.path <- getPythonPath(python.path)
+  if(!is.null(python.path)){
+    reticulate::use_python(python = python.path)
+    e <- new.env()
+    options("reticulate.engine.environment" = e)
+    img_arr <- reticulate::r_to_py(img_arr)
+    assign("img_arr_py", img_arr, envir = e)
+    reticulate::py_run_string(
+      paste0("import numpy as np
+import tifffile
+tifimage = r.img_arr_py.astype('uint8')
+# tifimage = np.random.randint(0, 255, (32, 32, 3), 'uint8')
+with tifffile.TiffWriter('", out_path, "') as tif: tif.write(tifimage, photometric='rgb')"
+      ))
+    success <- TRUE
+  } else if(requireNamespace('basilisk')) {
+    py_env <- getBasilisk()
+    proc <- basilisk::basiliskStart(py_env)
+    on.exit(basilisk::basiliskStop(proc))
+    success <- basilisk::basiliskRun(proc, function(img_arr, image_id, out_path, e) {
+      
+      # set up environment
+      e <- new.env()
+      options("reticulate.engine.environment" = e)
+      
+      # get image data to python environment
+      img_arr <- reticulate::r_to_py(img_arr)
+      assign("img_arr_py", img_arr, envir = e)
+      
+      # save ome.tiff
+      reticulate::py_run_string(
+        paste0("import numpy as np
+import tifffile
+tifimage = r.img_arr_py.astype('uint8')
+# tifimage = np.random.randint(0, 255, (32, 32, 3), 'uint8')
+with tifffile.TiffWriter('", out_path, "') as tif: tif.write(tifimage, photometric='rgb')"
+        ))
+      
+      return(TRUE)
+    }, img_arr = img_arr, image_id = image_id, out_path = out_path)
+  } else {
+    stop("Please define the 'python.path' or install the basilisk package!: BiocManager::install('basilisk')")
+  }
+  
+  return(success)
+}
+
+#' as.OmeZarr
+#'
+#' Converting VoltRon (magick) images to ome.tiff
+#'
+#' @param object a magick-image object
+#' @param out_path output path to ome.tiff file
+#' @param image_id image name
+#' 
+#' @importFrom magick image_raster
+#' @importFrom grDevices col2rgb
+#'
+#' @export
+as.OmeZarr <- function (object, out_path, image_id = "image_1"){
+  
+  # check packages
+  if(!requireNamespace('basilisk'))
+    stop("Please install basilisk package!: BiocManager::install('basilisk')")
+  if(!requireNamespace('reticulate'))
+    stop("Please install reticulate package!: install.packages('reticulate')")
+  
+  # get image and transpose the array
+  img_arr <- apply(as.matrix(magick::image_raster(object, tidy = FALSE)), c(1, 2), col2rgb)
+
+  # run basilisk
+  py_env <- getBasilisk()
+  proc <- basilisk::basiliskStart(py_env)
+  on.exit(basilisk::basiliskStop(proc))
+  success <- basilisk::basiliskRun(proc, function(img_arr, image_id, out_path) {
+    zarr <- reticulate::import("zarr")
+    ome_zarr <- reticulate::import("ome_zarr")
+    z_root <- zarr$open_group(out_path, mode = "w")
+    obj_list <- function(...) {
+      retval <- stats::setNames(list(), character(0))
+      param_list <- list(...)
+      for (key in names(param_list)) {
+        retval[[key]] = param_list[[key]]
+      }
+      retval
+    }
+    default_window <- obj_list(start = 0, min = 0, max = 255, end = 255)
+    ome_zarr$writer$write_image(image = img_arr,
+                                group = z_root,
+                                axes = "cyx",
+                                omero = obj_list(name = image_id, version = "0.3",
+                                                 rdefs = obj_list(),
+                                                 channels = list(obj_list(label = "r", color = "FF0000", window = default_window),
+                                                                 obj_list(label = "g", color = "00FF00", window = default_window),
+                                                                 obj_list(label = "b", color = "0000FF", window = default_window))))
+    return(TRUE)
+  }, img_arr = img_arr, image_id = image_id, out_path = out_path)
+  return(success)
+}
+
+####
+# Giotto ####
+####
+
+#' as.Giotto
+#'
+#' Converting a VoltRon object into a Giotto object
+#'
+#' @param object a VoltRon object
+#' @param assay the name of the assay to be converted
+#' @param reg if TRUE, registered coordinates will be used
+#'
+#' @rdname as.Giotto
+#'
+#' @importFrom dplyr bind_cols
+#' @importFrom stringr str_replace str_extract
+#' @importFrom magick image_write
+#'
+#' @export
+as.Giotto <- function(object, assay = NULL, reg = FALSE){
+  
+  # sample metadata
+  sample_metadata <- SampleMetadata(object)
+  
+  # check Seurat package
+  if(!requireNamespace('Giotto'))
+    stop("Please install Giotto package!devtools::install_github('drieslab/Giotto')")
+  
+  # check the number of assays
+  if(is.null(assay)){
+    if(length(unique(sample_metadata[["Assay"]])) > 1){
+      stop("You can only convert a single VoltRon assay into a Seurat object!")
+    } else {
+      assay <- sample_metadata[["Assay"]]
+    }
+  } else {
+    vrMainAssay(object) <- assay
+  }
+  
+  # check the number of assays
+  if(!unique(vrAssayTypes(object, assay = assay)) %in% c("cell")) {
+    stop("Conversion of assay types other than cells into Giotto is not yet permitted!")
+  }
+  
+  # data
+  rowdata <- vrData(object, assay = assay, norm = FALSE)
+  
+  # metadata
+  metadata <- Metadata(object, assay = assay)
+  metadata$cell_ID <- rownames(metadata)
+  assays <- stringr::str_extract(rownames(metadata), pattern = "_Assay[0-9]+$")
+  assays <- gsub("^_", "", assays)
+  
+  # coordinates
+  coords <- vrCoordinates(object, assay = assay, reg = reg)
+  
+  # Seurat object
+  gio <- Giotto::createGiottoObject(expression = rowdata, 
+                                    spatial_locs = coords, 
+                                    cell_metadata = metadata)
+  
+  # get image objects for each assay
+  for(assy in vrAssayNames(object)){
+    assay_object <- object[[assy]]
+    if(vrAssayTypes(assay_object) == "cell"){
+      img <- vrImages(assay_object)
+      gio_img <- Giotto::createGiottoImage(gio, 
+                                   spat_unit = "cell", 
+                                   mg_object = img)
+      gio <- Giotto::addGiottoImage(gio, images = list(gio_img), spat_loc_name = "cell")
+    } else {
+      stop("Currently VoltRon does only support converting cell type spatial data sets into SpatialExperiment objects!")
+    }
+  }
+  
+  # return
+  gio
+}
+
+####
+# SpatialExperiment ####
+####
+
+#' @param type the spatial data type of Seurat object: "image" or "spatial"
+#' @param assay_type one of two types, 'cell' or 'spot' etc.
+#' @param assay_name the assay name of the voltron assays (e.g. Visium, Xenium etc.)
+#' @param image_id select image_id names if needed.
+#' @param verbose verbose
+#' @param ... Additional parameter passed to \link{formVoltRon}
+#'
+#' @rdname as.VoltRon
+#' @method as.VoltRon SpatialExperiment
+#' 
+#' @importFrom magick image_read
+#'
+#' @export
+as.VoltRon.SpatialExperiment <- function(object, assay_type = "cell", assay_name = NULL, image_id = NULL, verbose = TRUE, ...){
+  
+  # check SpatialExperiment package
+  if(!requireNamespace('SpatialExperiment'))
+    stop("Please install SpatialExperiment package for using SpatialExperiment objects!: BiocManager::install('SpatialExperiment')")
+  
+  # raw counts
+  data <- SummarizedExperiment::assay(object, i = "counts")
+
+  # metadata
+  metadata <- as.data.frame(SummarizedExperiment::colData(object))
+  
+  # embeddings
+  dim_names <- SingleCellExperiment::reducedDimNames(object)
+  if(length(dim_names) > 0){
+    embeddings_flag <- TRUE
+    embedding_list <- sapply(dim_names, function(x) {
+      SingleCellExperiment::reducedDim(object, type = x)
+    }, USE.NAMES = TRUE)
+  } else {
+    embeddings_flag <- FALSE
+  }
+  
+  # coords
+  coords <- SpatialExperiment::spatialCoords(object)
+  colnames(coords) <- c("x", "y")
+  
+  # img data
+  imgdata <- SpatialExperiment::imgData(object)
+  
+  # image
+  voltron_list <- list()
+  sample_names <- unique(metadata$sample_id)
+  for(samp in sample_names){
+    
+    # spatial points
+    sppoints <- rownames(metadata)[metadata$sample_id == samp]
+
+    # metadata 
+    cur_metadata <- metadata[sppoints,]
+    
+    # data
+    cur_data <- data[,sppoints]
+    
+    # coords
+    cur_coords <- coords[sppoints,]
+    
+    # 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 <- vapply(image_names, function(img){ 
+        SpatialExperiment::scaleFactors(object, 
+                                        sample_id = samp, 
+                                        image_id = img)
+      }, numeric(1))
+      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
+    }
+    
+    # get params
+    if(assay_type == "spot"){
+      vis.spot.radius <- 1 
+      spot.radius <- 1
+    } else {
+      params <- list()
+    }
+    
+    # form voltron
+    assay_name <- assay_name
+    assay_type <- assay_type
+    voltron_list[[samp]] <- formVoltRon(data = cur_data, metadata = cur_metadata, coords = cur_coords, 
+                                      main.assay = assay_name, image = img_list, params = params, 
+                                      assay.type = assay_type, sample_name = samp, ...)
+    
+    # add embeddings
+    spatialpoints <- vrSpatialPoints(voltron_list[[samp]])
+    spatialpoints_nopostfix <- stringr::str_replace(spatialpoints, "_Assay[0-9]+$", "")
+    spatialpoints_assay <- stringr::str_extract(spatialpoints, "Assay[0-9]+$")
+    if(embeddings_flag){
+      for(embed_name in names(embedding_list)){
+        cur_embedding <- embedding_list[[embed_name]][sppoints,]
+        rownames(cur_embedding) <- spatialpoints
+        vrEmbeddings(voltron_list[[samp]], type = embed_name) <- cur_embedding
+      }
+    }
+  }
+  
+  # merge object
+  if(verbose)
+    message("Merging object ...")
+  if(length(voltron_list) > 1){
+    vrobject <- merge(voltron_list[[1]], voltron_list[-1])
+  } else {
+    vrobject <- voltron_list[[1]]
+  }
+
+  return(vrobject)
+}
+
+#' as.SpatialExperiment
+#'
+#' Converting a VoltRon object into a SpatialExperiment object
+#'
+#' @param object a VoltRon object
+#' @param assay the name of the assay to be converted
+#' @param reg if TRUE, registered coordinates will be used
+#'
+#' @rdname as.SpatialExperiment
+#'
+#' @importFrom dplyr bind_cols
+#' @importFrom stringr str_replace str_extract
+#' @importFrom magick image_write
+#'
+#' @export
+as.SpatialExperiment <- function(object, assay = NULL, reg = FALSE){
+  
+  # sample metadata
+  sample_metadata <- SampleMetadata(object)
+  
+  # check Seurat package
+  if(!requireNamespace('SpatialExperiment'))
+    stop("Please install SpatialExperiment package!: BiocManager::install('SpatialExperiment'')")
+  
+  # check the number of assays
+  if(is.null(assay)){
+    if(length(unique(sample_metadata[["Assay"]])) > 1){
+      stop("You can only convert a single VoltRon assay into a Seurat object!")
+    } else {
+      assay <- sample_metadata[["Assay"]]
+    }
+  } else {
+    vrMainAssay(object) <- assay
+  }
+  
+  # check the number of assays
+  if(unique(vrAssayTypes(object, assay = assay)) %in% c("ROI", "molecule", "tile")) {
+    stop("Conversion of ROI, molecule and tile assays into SpatialExperiment is not yet permitted!")
+  }
+  
+  # data
+  rawdata <- as.matrix(vrData(object, assay = assay, norm = FALSE))
+  
+  # metadata
+  metadata <- Metadata(object, assay = assay)
+  if(is.null(rownames(metadata)))
+    rownames(metadata) <- metadata$id
+  metadata <- metadata[colnames(rawdata),]
+  assays <- stringr::str_extract(rownames(metadata), pattern = "_Assay[0-9]+$")
+  assays <- gsub("^_", "", assays)
+  
+  # Embeddings
+  reduceddims <- list()
+  if (length(vrEmbeddingNames(object, assay = assay)) > 0) {
+    for (embed_name in vrEmbeddingNames(object, assay = assay)) {
+      reduceddims[[embed_name]] <- vrEmbeddings(object, assay = assay, type = embed_name)
+    }
+  }
+  
+  # coordinates
+  coords <- as.matrix(vrCoordinates(flipCoordinates(object, assay = assay), assay = assay, reg = reg))
+  coords <- coords[colnames(rawdata),]
+  coords <- coords[,c("x", "y")]
+  colnames(coords) <- c("x_centroid", "y_centroid")
+  
+  # Seurat object
+  spe <- SpatialExperiment::SpatialExperiment(assay=list(counts = rawdata),
+                                              colData=metadata, 
+                                              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]]
+    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
+  spe
+}
+
+####
+# Auxiliary ####
+####
+
+getPythonPath <- function(python.path){
+  voltron.python.path <- getOption("voltron.python.path")
+  python.path <- python.path %||% voltron.python.path
+  if(is.null(python.path)){
+    return(NULL)
+  } else {
+    if(file.exists(python.path)){
+      return(python.path)
+    } else if(file.exists(voltron.python.path)){
+      return(voltron.python.path)
+    } else {
+      stop("The python path '", python.path, "' doesn't exist!")
+    }
+  }
+}