Merge pull request #1030 from josschavezf/suite_dev

add function giottoToAnndataZarr

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Giotto
 Title: Spatial Single-Cell Transcriptomics Toolbox
-Version: 4.1.2
+Version: 4.1.3
 Authors@R: c(
 	person("Ruben", "Dries", email = "[email protected]",
 		 role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7650-7754")),

NAMESPACE

@@ -126,6 +126,7 @@ export(createGiottoPolygon)
 export(createGiottoPolygonsFromDfr)
 export(createGiottoPolygonsFromGeoJSON)
 export(createGiottoPolygonsFromMask)
+export(createGiottoVisiumHDObject)
 export(createGiottoVisiumObject)
 export(createGiottoXeniumObject)
 export(createMerscopeLargeImage)
@@ -255,6 +256,7 @@ export(giottoPoints)
 export(giottoPolygon)
 export(giottoSankeyPlan)
 export(giottoToAnnData)
+export(giottoToAnndataZarr)
 export(giottoToSeurat)
 export(giottoToSeuratV4)
 export(giottoToSeuratV5)

NEWS.md

@@ -1,3 +1,7 @@
+# Giotto 4.1.3
+
+## New
+* Add `giottoToAnndataZarr()` to create a local anndata zarr folder and interact with the vitessceR package.
 
 # Giotto 4.1.2
 

R/interactivity.R

@@ -754,3 +754,126 @@ plotInteractive3D <- function(
 
     shiny::runGadget(ui, server)
 }
+
+#' Create a local anndata zarr folder
+#'
+#' @param gobject giotto object
+#' @param spat_unit spatial unit (e.g. "cell")
+#' @param feat_type feature type (e.g. "rna", "dna", "protein")
+#' @param expression expression values to extract (e.g. "raw", "normalized", "scaled")
+#' @param output_path path to create and save the anndata zarr folder
+#'
+#' @return local anndata zarr folder
+#' @export
+#'
+#' @examples
+#' # using the mini visium object
+#' giotto_object <- GiottoData::loadGiottoMini("visium")
+#' 
+#' giottoToAnndataZarr(giotto_object,
+#'                     expression = "raw"
+#'                     output_path = tempdir())
+#' 
+#' # using the mini vizgen object
+#' giotto_object <- GiottoData::loadGiottoMini("vizgen")
+#' 
+#' giottoToAnndataZarr(giotto_object,
+#'                     spat_unit = "aggregate",
+#'                     expression = "scaled",
+#'                     output_path = tempdir())
+giottoToAnndataZarr <- function(gobject, spat_unit = NULL, 
+                                feat_type = NULL, expression = "raw",
+                                output_path) {
+
+    proc <- basilisk::basiliskStart(GiottoClass::instructions(gobject = gobject, 
+                                                              param = "python_path"))
+    on.exit(basilisk::basiliskStop(proc))
+
+    success <- basilisk::basiliskRun(
+        proc, 
+        function(gobject, 
+                 output_path, 
+                 expression) {
+
+            anndata <- reticulate::import("anndata")
+            zarr <- reticulate::import("zarr")
+
+            # extract expression matrix
+            X <- t(as.matrix(GiottoClass::getExpression(gobject = gobject, 
+                                                        spat_unit = spat_unit,
+                                                        feat_type = feat_type,
+                                                        values = expression,
+                                                        output = "matrix")))
+
+            # extract cell metadata
+            obs <- as.data.frame(GiottoClass::getCellMetadata(gobject = gobject,
+                                                              spat_unit = spat_unit,
+                                                              feat_type = feat_type,
+                                                              output = "data.table"))
+
+            rownames(obs) <- obs$cell_ID
+
+            # extract feature metadata
+            var <- as.data.frame(GiottoClass::getFeatureMetadata(gobject = gobject,
+                                                                 spat_unit = spat_unit,
+                                                                 feat_type = feat_type,
+                                                                 output = "data.table"))
+
+            obsm <- list()
+
+            # extract spatial locations
+            spatial_locs <- as.data.frame(GiottoClass::getSpatialLocations(gobject = gobject,
+                                                                           spat_unit = spat_unit,
+                                                                           output = "data.table"))
+
+            if (!is.null(spatial_locs)) {
+                rownames(spatial_locs) <- spatial_locs$cell_ID
+                spatial_locs <- spatial_locs[obs$cell_ID,]
+                spatial_locs_matrix <- as.matrix(spatial_locs[,1:2])
+
+                obsm[["spatial"]] <- spatial_locs_matrix
+            }
+
+            # extract pca
+            dim_reducs_pca <- GiottoClass::getDimReduction(gobject = gobject,
+                                                           spat_unit = spat_unit,
+                                                           feat_type = feat_type,
+                                                           reduction_method = "pca",
+                                                           output = "matrix")
+
+            if(!is.null(dim_reducs_pca)) {
+                obsm[["pca"]] <- dim_reducs_pca[obs$cell_ID,]
+            }
+
+            # extract umap
+            dim_reducs_umap <- GiottoClass::getDimReduction(gobject = gobject,
+                                                            spat_unit = spat_unit,
+                                                            feat_type = feat_type,
+                                                            reduction_method = "umap",
+                                                            name = "umap",
+                                                            output = "matrix")
+
+            if(!is.null(dim_reducs_umap)) {
+                obsm[["umap"]] <- dim_reducs_umap[obs$cell_ID,]
+            }
+
+            # extract tSNE
+            dim_reducs_tsne <- GiottoClass::getDimReduction(gobject = gobject,
+                                                            spat_unit = spat_unit,
+                                                            feat_type = feat_type,
+                                                            reduction_method = "tsne",
+                                                            name = "tsne",
+                                                            output = "matrix")
+
+            if(!is.null(dim_reducs_tsne)) {
+                obsm[["tsne"]] <- dim_reducs_tsne[obs$cell_ID,]
+            }
+
+            adata <- anndata$AnnData(X = X, obs = obs, var = var, obsm = obsm)
+
+            adata$write_zarr(output_path)
+            return(TRUE)
+        }, gobject = gobject, output_path = output_path, expression = expression)
+
+    return(success)
+}