Add the sample_order argument to the vis_grid*() functions. Should help

resolve LieberInstitute/spatialDLPFC#45. Also it'll make easier to create plots like https://github.com/LieberInstitute/Visium_IF_AD/blob/7acd70a3cc584a23bf6576b45ba7ca897e48383e/code/04_build_spe/initial_exploration.R#L48-L67 without having to re-order samples manually
LieberInstitute · Dec 1, 2021 · 848e207 · 848e207
1 parent 49f9935
commit 848e207
Show file tree

Hide file tree

Showing 6 changed files with 50 additions and 36 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,10 @@ BUG FIXES
 
 * `vis_gene()` and `vis_grid_gene()` now support `geneid`s that are found in
 the `rownames(spe)`. This makese these functions more flexible.
+* `vis_grid_gene()` and `vis_grid_clus()` now have the `sample_order` argument
+which gives you more control in case you want to plot a subset of samples. This
+should also reduced the memory required as discovered at
+https://github.com/LieberInstitute/spatialDLPFC/issues/45.
 
 # spatialLIBD 1.7.3
 

diff --git a/R/app_server.R b/R/app_server.R
@@ -135,17 +135,16 @@ app_server <- function(input, output, session) {
         if (isolate(input$cluster == "ManualAnnotation")) {
             spe$ManualAnnotation <- rv$ManualAnnotation
         }
-        spe_sub <-
-            spe[, spe$sample_id %in% isolate(input$grid_samples)]
         plots <-
             vis_grid_clus(
-                spe_sub,
+                spe,
                 isolate(input$cluster),
                 sort_clust = FALSE,
-                colors = cluster_colors(),
+                colors = isolate(cluster_colors()),
                 return_plots = TRUE,
-                image_id = input$imageid,
-                alpha = input$alphalevel,
+                image_id = isolate(input$imageid),
+                alpha = isolate(input$alphalevel),
+                sample_order = isolate(input$grid_samples),
                 ... = paste(" with", isolate(input$cluster))
             )
         cowplot::plot_grid(
@@ -186,18 +185,17 @@ app_server <- function(input, output, session) {
     static_gene_grid <- reactive({
         input$gene_grid_update
 
-        spe_sub <-
-            spe[, spe$sample_id %in% isolate(input$gene_grid_samples)]
         plots <-
             vis_grid_gene(
-                spe_sub,
+                spe,
                 geneid = isolate(input$geneid),
                 assayname = isolate(input$assayname),
                 minCount = isolate(input$minCount),
                 return_plots = TRUE,
                 cont_colors = isolate(cont_colors()),
-                image_id = input$imageid,
-                alpha = input$alphalevel
+                image_id = isolate(input$imageid),
+                alpha = isolate(input$alphalevel),
+                sample_order = isolate(input$gene_grid_samples)
             )
         cowplot::plot_grid(
             plotlist = plots,
@@ -494,19 +492,18 @@ app_server <- function(input, output, session) {
         img <- SpatialExperiment::imgRaster(spe, sample_id = sampleid, image_id = input$imageid)
 
         ## From vis_gene() in global.R
-        spe_sub <- spe[, spe$sample_id == sampleid]
-        d <- as.data.frame(colData(spe_sub, spatialData = TRUE, spatialCoords = TRUE), optional = TRUE)
-        if (geneid %in% colnames(colData(spe_sub))) {
-            d$COUNT <- colData(spe_sub)[[geneid]]
+        d <- as.data.frame(colData(spe, spatialData = TRUE, spatialCoords = TRUE)[spe$sample_id == sampleid, ], optional = TRUE)
+        if (geneid %in% colnames(d)) {
+            d$COUNT <- d[[geneid]]
         } else {
             d$COUNT <-
-                assays(spe_sub)[[assayname]][which(rowData(spe_sub)$gene_search == geneid), ]
+                assays(spe)[[assayname]][which(rowData(spe)$gene_search == geneid), spe$sample_id == sampleid]
         }
         d$COUNT[d$COUNT <= minCount] <- NA
 
         ## Add the reduced dims
         if (reduced_name != "") {
-            red_dims <- reducedDim(spe_sub, reduced_name)
+            red_dims <- reducedDim(spe, reduced_name)[spe$sample_id == sampleid, ]
             colnames(red_dims) <-
                 paste(reduced_name, "dim", seq_len(ncol(red_dims)))
             d <- cbind(d, red_dims)
@@ -520,7 +517,7 @@ app_server <- function(input, output, session) {
 
         ## Make the cluster plot
         p_clus <- vis_clus_p(
-            spe = spe_sub,
+            spe = spe,
             d = d_key,
             clustervar = clustervar,
             sampleid = sampleid,
@@ -530,7 +527,7 @@ app_server <- function(input, output, session) {
                 sampleid,
                 clustervar,
                 geneid,
-                if (!geneid %in% colnames(colData(spe_sub))) {
+                if (!geneid %in% colnames(colData(spe))) {
                     assayname
                 } else {
                     NULL
@@ -544,7 +541,7 @@ app_server <- function(input, output, session) {
 
         ## Next the gene plot
         p_gene <- vis_gene_p(
-            spe = spe_sub,
+            spe = spe,
             d = d_key,
             sampleid = sampleid,
             spatial = FALSE,
@@ -570,7 +567,7 @@ app_server <- function(input, output, session) {
                     size = 1.25,
                     stroke = 0.25
                 ) +
-                scale_fill_manual(values = get_colors(colors, colData(spe_sub)[[clustervar]])) +
+                scale_fill_manual(values = get_colors(colors, colData(spe)[[clustervar]][spe$sample_id == sampleid])) +
                 guides(fill = FALSE) +
                 ggtitle("") +
                 theme_set(theme_bw(base_size = 20)) +
@@ -855,13 +852,12 @@ app_server <- function(input, output, session) {
         }
         if (!is.null(event.data)) {
             ## Prepare the data
-            spe_sub <- spe[, spe$key %in% event.data$key]
-            d <- as.data.frame(colData(spe_sub, spatialData = TRUE, spatialCoords = TRUE), optional = TRUE)
-            if (input$geneid %in% colnames(colData(spe_sub))) {
-                d$COUNT <- colData(spe_sub)[[input$geneid]]
+            d <- as.data.frame(colData(spe, spatialData = TRUE, spatialCoords = TRUE)[spe$key %in% event.data$key, ], optional = TRUE)
+            if (input$geneid %in% colnames(d)) {
+                d$COUNT <- d[[input$geneid]]
             } else {
                 d$COUNT <-
-                    assays(spe_sub)[[input$assayname]][which(rowData(spe_sub)$gene_search == input$geneid), ]
+                    assays(spe)[[input$assayname]][which(rowData(spe)$gene_search == input$geneid), spe$key %in% event.data$key]
             }
             d$COUNT[d$COUNT <= input$minCount] <- NA
 
@@ -885,13 +881,12 @@ app_server <- function(input, output, session) {
             )
         } else {
             ## Prepare the data
-            spe_sub <- spe[, spe$key %in% event.data$key]
-            d <- as.data.frame(colData(spe_sub, spatialData = TRUE, spatialCoords = TRUE), optional = TRUE)
-            if (input$geneid %in% colnames(colData(spe_sub))) {
-                d$COUNT <- colData(spe_sub)[[input$geneid]]
+            d <- as.data.frame(colData(spe, spatialData = TRUE, spatialCoords = TRUE)[spe$key %in% event.data$key, ], optional = TRUE)
+            if (input$geneid %in% colnames(d)) {
+                d$COUNT <- d[[input$geneid]]
             } else {
                 d$COUNT <-
-                    assays(spe_sub)[[input$assayname]][which(rowData(spe_sub)$gene_search == input$geneid), ]
+                    assays(spe)[[input$assayname]][which(rowData(spe)$gene_search == input$geneid), spe$key %in% event.data$key]
             }
             d$COUNT[d$COUNT <= input$minCount] <- NA
 

diff --git a/R/vis_grid_clus.R b/R/vis_grid_clus.R
@@ -13,6 +13,8 @@
 #' [plot_grid][cowplot::plot_grid()].
 #' @param height A `numeric(1)` passed to [pdf][grDevices::pdf()].
 #' @param width A `numeric(1)` passed to [pdf][grDevices::pdf()].
+#' @param sample_order A `character()` with the names of the samples to use
+#' and their order.
 #'
 #' @return A list of [ggplot2][ggplot2::ggplot] objects.
 #' @export
@@ -56,13 +58,16 @@ vis_grid_clus <-
     width = 36,
     image_id = "lowres",
     alpha = 1,
+    sample_order = unique(spe$sample_id),
     ...) {
+        stopifnot(all(sample_order %in% unique(spe$sample_id)))
+
         if (sort_clust) {
             colData(spe)[[clustervar]] <-
                 sort_clusters(colData(spe)[[clustervar]])
         }
         plots <-
-            lapply(unique(spe$sample_id), function(sampleid) {
+            lapply(sample_order, function(sampleid) {
                 vis_clus(spe,
                     sampleid,
                     clustervar,
@@ -73,7 +78,7 @@ vis_grid_clus <-
                     ...
                 )
             })
-        names(plots) <- unique(spe$sample_id)
+        names(plots) <- sample_order
 
 
         if (!return_plots) {

diff --git a/R/vis_grid_gene.R b/R/vis_grid_gene.R
@@ -48,9 +48,11 @@ vis_grid_gene <-
     image_id = "lowres",
     alpha = 1,
     cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"),
+    sample_order = unique(spe$sample_id),
     ...) {
-        stopifnot("gene_search" %in% colnames(rowData(spe)))
-        plots <- lapply(unique(spe$sample_id), function(sampleid) {
+        stopifnot(all(sample_order %in% unique(spe$sample_id)))
+
+        plots <- lapply(sample_order, function(sampleid) {
             vis_gene(
                 spe,
                 sampleid,
@@ -65,7 +67,7 @@ vis_grid_gene <-
                 ...
             )
         })
-        names(plots) <- unique(spe$sample_id)
+        names(plots) <- sample_order
 
         if (!return_plots) {
             pdf(pdf_file, height = height, width = width)

diff --git a/man/vis_grid_clus.Rd b/man/vis_grid_clus.Rd
diff --git a/man/vis_grid_gene.Rd b/man/vis_grid_gene.Rd