NanoString dataset Giotto object example

R/data_to_zarr.R

@@ -218,9 +218,9 @@ spe_to_ome_zarr <- function(spe_obj, sample_id, image_id, out_path) {
 #' @export
 #' @examples
 #' obj <- get_giotto_obj()
-#' giotto_to_anndata_zarr(obj, "data/giotto.zarr")
+#' giotto_to_anndata_zarr(obj, "data/giotto.zarr", "raw_exprs")
 #' @importFrom methods slot
-giotto_to_anndata_zarr <- function(giotto_obj, out_path, X_slot = "raw_exprs") {
+giotto_to_anndata_zarr <- function(giotto_obj, out_path, X_slot) {
 
   # Use basilisk
   proc <- basilisk::basiliskStart(py_env)
@@ -229,22 +229,34 @@ giotto_to_anndata_zarr <- function(giotto_obj, out_path, X_slot = "raw_exprs") {
   success <- basilisk::basiliskRun(proc, function(giotto_obj, out_path, X_slot) {
     anndata <- reticulate::import("anndata")
     zarr <- reticulate::import("zarr")
+    np <- reticulate::import("numpy", convert=FALSE)
 
     # Reference: https://github.com/theislab/zellkonverter/blob/master/R/SCE2AnnData.R#L237
-    make_numpy_friendly <- function(x, transpose = TRUE) {
+    make_numpy_friendly <- function(x, transpose = TRUE, as_type = NA) {
       if (transpose) {
         x <- Matrix::t(x)
       }
       if (DelayedArray::is_sparse(x)) {
-        methods::as(x, "dgCMatrix")
+        x <- methods::as(x, "dgCMatrix")
       } else {
-        as.matrix(x)
+        x <- as.matrix(x)
       }
+      if(!is.na(as_type)) {
+        x <- np$array(x)
+        x <- x$astype(as_type)
+      }
+
+      return(x)
     }
 
-    X <- make_numpy_friendly(slot(giotto_obj, X_slot))
+    if(!is.na(X_slot)) {
+      X <- make_numpy_friendly(slot(giotto_obj, X_slot))
+      var <- slot(giotto_obj, "gene_metadata")
+    } else {
+      X <- NULL
+      var <- NULL
+    }
     obs <- slot(giotto_obj, "cell_metadata")
-    var <- slot(giotto_obj, "gene_metadata")
 
     adata <- anndata$AnnData(X = X, obs = obs, var = var)
 
@@ -264,8 +276,7 @@ giotto_to_anndata_zarr <- function(giotto_obj, out_path, X_slot = "raw_exprs") {
     }
 
     if(length(obsm) > 0) {
-      # TODO make_numpy_friendly is outside scope
-      obsm <- lapply(obsm, make_numpy_friendly)
+      obsm <- lapply(obsm, make_numpy_friendly, as_type = "<i4")
       adata$obsm <- obsm
     }
 

R/wrappers_giotto.R

@@ -19,7 +19,10 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
     #' @field obj The object to wrap.
     #' @keywords internal
     obj = NULL,
-    #' @field cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+    #' @field expr_matrix The key for the expression matrix.
+    #' @keywords internal
+    expr_matrix = NULL,
+    #' @field cell_embeddings The keys in the Giotto object's reductions/cell.embeddings
     #' to use for creating dimensionality reduction mappings.
     #' @keywords internal
     cell_embeddings = NULL,
@@ -31,25 +34,26 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
     #' to use for creating dimensionality reduction mappings.
     #' @keywords internal
     cell_embedding_dims = NULL,
-    #' @field cell_set_metas The keys in the Seurat object's meta.data
+    #' @field cell_set_metas The keys in the Giotto object's cell_metadata
     #' to use for creating cell sets.
     #' @keywords internal
     cell_set_metas = NULL,
-    #' @field cell_set_meta_names The keys in the Seurat object's meta.data
+    #' @field cell_set_meta_names The keys in the Giotto object's cell_metadata
     #' to use for cell set names mapped to new names.
     #' @keywords internal
     cell_set_meta_names = NULL,
-    #' @field cell_set_meta_scores The keys in the Seurat object's meta.data
+    #' @field cell_set_meta_scores The keys in the Giotto object's cell_metadata
     #' to use for cell set names mapped to keys for scores.
     #' @keywords internal
     cell_set_meta_scores = NULL,
     #' @field zarr_folder The name for the folder at the root of the zarr store.
     #' @keywords internal
     zarr_folder = NULL,
     #' @description
-    #' Create a wrapper around a Seurat object.
+    #' Create a wrapper around a Giotto object.
     #' @param obj The object to wrap.
-    #' @param cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+    #' @param expr_matrix The name of the slot in the Giotto object.
+    #' @param cell_embeddings The keys in the Giotto object's reductions/cell.embeddings
     #' to use for creating dimensionality reduction plots.
     #' @param cell_embedding_names Names
     #' to use for creating dimensionality reduction plots.
@@ -64,9 +68,10 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
     #' and keys for annotation scores.
     #' @param ... Parameters inherited from `AbstractWrapper`.
     #' @return A new `GiottoWrapper` object.
-    initialize = function(obj, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
+    initialize = function(obj, expr_matrix = NA, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
       super$initialize(...)
       self$obj <- obj
+      self$expr_matrix <- expr_matrix
       self$cell_embeddings <- cell_embeddings
       self$cell_embedding_names <- cell_embedding_names
       self$cell_embedding_dims <- cell_embedding_dims
@@ -88,8 +93,12 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
         warning("Object is not of type giotto.")
         success <- FALSE
       }
+      if(!is_na(self$expr_matrix) && !(self$expr_matrix %in% slotNames(self$obj))) {
+        warning("Specified expr_matrix not present in Giotto object slot names.")
+        success <- FALSE
+      }
       if(!is_na(self$cell_embeddings) && !all(self$cell_embeddings %in% names(self$obj@dimension_reduction$cells))) {
-        warning("Specified cell_embeddings not all present in Giotto object dimension_reduction")
+        warning("Specified cell_embeddings not all present in Giotto object dimension_reduction.")
         success <- FALSE
       }
       if(!is_na(self$cell_set_metas) && !all(self$cell_set_metas %in% colnames(self$obj@cell_metadata))) {
@@ -128,7 +137,7 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
 
       zarr_filepath <- self$get_zarr_path(dataset_uid, obj_i)
       if(!file.exists(zarr_filepath) || !self$use_cache) {
-        giotto_to_anndata_zarr(self$obj, out_path = zarr_filepath)
+        giotto_to_anndata_zarr(self$obj, out_path = zarr_filepath, X_slot = self$expr_matrix)
       }
 
       # Get the file definition creator functions.
@@ -139,7 +148,9 @@ GiottoWrapper <- R6::R6Class("GiottoWrapper",
       # Append the new file definition creators functions to the main list.
       self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
       self$file_def_creators <- append(self$file_def_creators, cell_sets_file_creator)
-      self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+      if(!is_na(self$expr_matrix)) {
+        self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+      }
 
       # Create a web server route object for the directory of JSON files.
       self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))

README.md

@@ -51,6 +51,7 @@ devtools::load_all()
 ```r
 devtools::check()
 devtools::test()
+devtools::run_examples()
 ```
 
 ## Documentation

pkgdown/_pkgdown.yml

@@ -38,6 +38,8 @@ navbar:
          href: articles/single_cell_experiment.html
        - text: "Usage with SpatialExperiment"
          href: articles/spatial_experiment.html
+       - text: "Usage with Giotto: Basic Example"
+         href: articles/giotto_basic.html
        - text: "Usage with OME-TIFF: Local Example"
          href: articles/ome_tiff_local.html
        - text: "Usage with JSON: Local Example"

vignettes/giotto.Rmd → vignettes/giotto_basic.Rmd

@@ -1,8 +1,8 @@
 ---
-title: "Usage with Giotto"
+title: "Usage with Giotto: Basic Example"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{Usage with Giotto}
+  %\VignetteIndexEntry{Usage with Giotto: Basic Example}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---
@@ -118,13 +118,30 @@ SS_seqfish <- runPCA(gobject = SS_seqfish, genes_to_use = featgenes, scale_unit
 SS_seqfish <- runtSNE(SS_seqfish, dimensions_to_use = 1:15)
 ```
 
+Rescale the coordinates to help with saving as a NumPy array:
+
+```r
+# Rescale dimensionality reduction coordinates
+for(dr in names(SS_seqfish@dimension_reduction$cells)) {
+  old_coord_2d <- SS_seqfish@dimension_reduction$cells[[dr]][[dr]]$coordinates[, c(1, 2)]
+  old_coord_2d[, 1] <- old_coord_2d[, 1] - min(old_coord_2d[, 1])
+  old_coord_2d[, 1] <- (old_coord_2d[, 1] / max(old_coord_2d[, 1])) * 10000
+  old_coord_2d[, 2] <- old_coord_2d[, 2] - min(old_coord_2d[, 2])
+  old_coord_2d[, 2] <- (old_coord_2d[, 2] / max(old_coord_2d[, 2])) * 10000
+
+  new_coord_2d <- old_coord_2d
+  SS_seqfish@dimension_reduction$cells[[dr]][[dr]]$coordinates[, c(1, 2)] <- new_coord_2d
+}
+```
+
 Set up the Vitessce widget:
 
 ```r
 library(vitessceR)
 
 w <- GiottoWrapper$new(
   SS_seqfish,
+  expr_matrix = "raw_exprs",
   cell_set_metas = c("cell_types"),
   cell_set_meta_names = c("Cell Types"),
   cell_embeddings = c("pca", "tsne"),

vignettes/giotto_nanostring.Rmd

@@ -0,0 +1,117 @@
+---
+title: "Usage with Giotto: NanoString dataset"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Usage with Giotto: NanoString dataset}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of usage of the widget with a [Giotto](https://github.com/RubD/Giotto) object from [NanoString](https://www.nanostring.com/products/cosmx-spatial-molecular-imager/ffpe-dataset/).
+
+First, install the R dependencies:
+
+```r
+install.packages("devtools")
+devtools::install_github("RubD/Giotto")
+```
+
+Download and un-tar the Giotto object: https://nanostring-public-share.s3.us-west-2.amazonaws.com/SMI-Compressed/All+SMI+Giotto+object.tar.gz
+
+
+Load the Giotto object in R:
+
+```r
+rdata_path <- file.path("data", "giotto", "SMI_Giotto_Object.RData")
+load(rdata_path)
+
+# Clean up
+gem@cell_metadata <- gem@cell_metadata$rna
+gem@spatial_locs <- gem@spatial_locs$raw
+gem@raw_exprs <- NULL
+gem@norm_expr <- NULL
+gem@norm_scaled_expr <- NULL
+gem@custom_expr <- NULL
+gem@gene_metadata <- NULL
+gem@gene_ID <- NULL
+```
+
+Filter to select only the data from the "Lung13" tissue sample:
+
+```r
+cell_metadata <- gem@cell_metadata
+cell_ids <- cell_metadata[cell_metadata$tissue %in% c("Lung13")]$cell_ID
+gem <- Giotto::subsetGiotto(gem, cell_ids = cell_ids)
+
+for(dr in names(gem@dimension_reduction$cells)) {
+  old_coord <- gem@dimension_reduction$cells[[dr]][[dr]]$coordinates
+  new_coord <- old_coord[rownames(old_coord) %in% cell_ids,]
+  gem@dimension_reduction$cells[[dr]][[dr]]$coordinates <- new_coord
+}
+```
+
+Rescale the coordinates to help with saving as a NumPy array:
+
+```r
+# Rescale spatial coordinates
+spatial_locs <- gem@spatial_locs
+spatial_locs$sdimx <- spatial_locs$sdimx*10000
+spatial_locs$sdimy <- spatial_locs$sdimy*10000
+gem@spatial_locs <- spatial_locs
+
+# Rescale dimensionality reduction coordinates
+for(dr in names(gem@dimension_reduction$cells)) {
+  old_coord_2d <- gem@dimension_reduction$cells[[dr]][[dr]]$coordinates[, c(1, 2)]
+  old_coord_2d[, 1] <- old_coord_2d[, 1] - min(old_coord_2d[, 1])
+  old_coord_2d[, 1] <- (old_coord_2d[, 1] / max(old_coord_2d[, 1])) * 10000
+  old_coord_2d[, 2] <- old_coord_2d[, 2] - min(old_coord_2d[, 2])
+  old_coord_2d[, 2] <- (old_coord_2d[, 2] / max(old_coord_2d[, 2])) * 10000
+
+  new_coord_2d <- old_coord_2d
+  gem@dimension_reduction$cells[[dr]][[dr]]$coordinates[, c(1, 2)] <- new_coord_2d
+}
+```
+
+Set up the Vitessce widget:
+
+```r
+library(vitessceR)
+
+w <- GiottoWrapper$new(
+  gem,
+  cell_set_metas = c("patient", "tissue", "cell_type", "niche"),
+  cell_set_meta_names = c("Patient", "Tissue", "Cell Type", "Niche"),
+  cell_embeddings = c("pca", "umapnew", "um.n200"),
+  cell_embedding_names = c("PCA", "Expression profile UMAP", "Neighborhood UMAP"),
+  out_dir = file.path("data", "giotto_nanostring")
+)
+
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(w)
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+scatterplot_expr <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "Expression profile UMAP")
+scatterplot_nbrh <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "Neighborhood UMAP")
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a Giotto object.")
+
+vc$layout(
+  hconcat(
+    vconcat(
+      spatial,
+      scatterplot_expr
+    ),
+    vconcat(
+      hconcat(cell_sets, vconcat(desc, status)),
+      scatterplot_nbrh
+    )
+  )
+)
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+