####
# 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!")
}
}
}
Datasets
Models
