Add guide options to vis_grid_clus()

NAMESPACE

@@ -90,6 +90,7 @@ importFrom(SummarizedExperiment,assays)
 importFrom(SummarizedExperiment,colData)
 importFrom(benchmarkme,get_ram)
 importFrom(circlize,colorRamp2)
+importFrom(cowplot,get_legend)
 importFrom(cowplot,plot_grid)
 importFrom(dplyr,group_by)
 importFrom(dplyr,left_join)
@@ -105,6 +106,8 @@ importFrom(grDevices,pdf)
 importFrom(graphics,boxplot)
 importFrom(graphics,par)
 importFrom(graphics,points)
+importFrom(grid,grid.draw)
+importFrom(grid,grid.newpage)
 importFrom(grid,rasterGrob)
 importFrom(grid,unit)
 importFrom(jsonlite,read_json)

R/add_qc_metrics.R

@@ -71,7 +71,7 @@
 #' ## Visualize scran QC flags
 #'
 #' ## Check the spots with low library size as detected by scran::isOutlier()
-#' vis_clus(spe_qc, sample_id = "Br6432_ant", clustervar = "scran_low_lib_size")
+#' vis_clus(spe_qc, sampleid = "Br6432_ant", clustervar = "scran_low_lib_size")
 #'
 #' ## Violin plot of library size with low library size highlighted in a
 #' ## different color.

R/app_server.R

@@ -176,9 +176,9 @@ app_server <- function(input, output, session) {
             alpha = input$alphalevel,
             point_size = input$pointsize,
             auto_crop = input$auto_crop,
-            is_stitched = is_stitched,
+            is_stitched = is_stitched,         
             guide_point_size = input$guidepointsize,
-            ... = paste(" with", input$cluster)
+            title_suffix = paste("with", input$cluster)
         )
         if (!input$side_by_side_histology) {
             return(p)
@@ -220,8 +220,9 @@ app_server <- function(input, output, session) {
                 auto_crop = isolate(input$auto_crop),
                 is_stitched = is_stitched,
                 guide_point_size = isolate(input$guidepointsize),
-                ... = paste(" with", isolate(input$cluster))
-            )
+                guides = isolate(input$guides),
+                title_suffix = paste("with", isolate(input$cluster))
+                )
         cowplot::plot_grid(
             plotlist = plots,
             nrow = isolate(input$grid_nrow),

R/app_ui.R

@@ -419,6 +419,12 @@ app_ui <- function() {
                                         value = 3,
                                         min = 1
                                     ),
+                                    selectInput(
+                                        "guides",
+                                        label = "Show guides",
+                                        choices = c("all", "last", "none"),
+                                        selected = "last"
+                                    ),
                                     actionButton(
                                         "grid_update",
                                         label = "Update grid plot"

R/vis_clus.R

@@ -41,8 +41,8 @@
 #' specifying which spots to exclude from the plot. Sets `auto_crop = FALSE`.
 #' @param guide_point_size A `numeric(1)` specifying the size of the points in 
 #' guide. Defaults to `point_size`. Increase to improve visability. 
-#' @param ... Passed to [paste0()][base::paste] for making the title of the
-#' plot following the `sampleid`.
+#' @param title_suffix A `character(1)` passed to [paste()][base::paste] to 
+#' modify the title of the plot following the `sampleid`.
 #'
 #' @return A [ggplot2][ggplot2::ggplot] object.
 #' @family Spatial cluster visualization functions
@@ -66,7 +66,7 @@
 #'         clustervar = "layer_guess_reordered",
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
-#'         ... = " LIBD Layers"
+#'         title_suffix = "LIBD Layers"
 #'     )
 #'     print(p1)
 #'
@@ -77,7 +77,7 @@
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
 #'         auto_crop = FALSE,
-#'         ... = " LIBD Layers"
+#'         title_suffix = "LIBD Layers"
 #'     )
 #'     print(p2)
 #'
@@ -87,7 +87,7 @@
 #'         clustervar = "layer_guess_reordered",
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
-#'         ... = " LIBD Layers",
+#'         title_suffix = " LIBD Layers",
 #'         spatial = FALSE
 #'     )
 #'     print(p3)
@@ -101,7 +101,7 @@
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
 #'         na_color = "white",
-#'         ... = " LIBD Layers"
+#'         title_suffix = " LIBD Layers"
 #'     )
 #'     print(p4)
 #'     
@@ -145,7 +145,7 @@ vis_clus <- function(
         na_color = "#CCCCCC40",
         is_stitched = FALSE,
         guide_point_size = point_size,
-        ...) {
+        title_suffix = NULL) {
     #   Verify existence and legitimacy of 'sampleid'
     if (
         !("sample_id" %in% colnames(colData(spe))) ||
@@ -187,7 +187,7 @@ vis_clus <- function(
         clustervar = clustervar,
         sampleid = sampleid,
         spatial = spatial,
-        title = paste0(sampleid, ...),
+        title = paste(sampleid, title_suffix),
         colors = get_colors(colors, d[, clustervar]),
         image_id = image_id,
         alpha = alpha,

R/vis_gene.R

@@ -139,7 +139,8 @@
 #'         sampleid = "151507",
 #'         geneid = white_matter_genes,
 #'         multi_gene_method = "z_score",
-#'         cap_percentile = 0.95
+#'         cap_percentile = 0.95,
+#'         title_suffix = "White Matter Genes"
 #'     )
 #'     print(p6)
 #'
@@ -149,7 +150,8 @@
 #'         spe = spe,
 #'         sampleid = "151507",
 #'         geneid = white_matter_genes,
-#'         multi_gene_method = "sparsity"
+#'         multi_gene_method = "sparsity",
+#'         title_suffix = "White Matter Genes"
 #'     )
 #'     print(p7)
 #'
@@ -159,7 +161,8 @@
 #'         spe = spe,
 #'         sampleid = "151507",
 #'         geneid = white_matter_genes,
-#'         multi_gene_method = "pca"
+#'         multi_gene_method = "pca",
+#'         title_suffix = "White Matter Genes"
 #'     )
 #'     print(p8)
 #' }
@@ -180,7 +183,7 @@ vis_gene <-
     multi_gene_method = c("z_score", "pca", "sparsity"),
     is_stitched = FALSE,
     cap_percentile = 1,
-    ...) {
+    title_suffix = NULL) {
         multi_gene_method <- rlang::arg_match(multi_gene_method)
         #   Verify existence and legitimacy of 'sampleid'
         if (
@@ -274,15 +277,15 @@ vis_gene <-
 
         #   Determine plot and legend titles
         if (ncol(cont_matrix) == 1) {
-            plot_title <- paste(sampleid, geneid, ...)
+            plot_title <- paste(sampleid, geneid, title_suffix)
             d$COUNT <- cont_matrix[, 1]
             if (!(geneid %in% colnames(colData(spe_sub)))) {
                 legend_title <- sprintf("%s\n min > %s", assayname, minCount)
             } else {
                 legend_title <- sprintf("min > %s", minCount)
             }
         } else {
-            plot_title <- paste(sampleid, ...)
+            plot_title <- paste(sampleid, title_suffix)
             if (multi_gene_method == "z_score") {
                 d$COUNT <- multi_gene_z_score(cont_matrix)
                 legend_title <- paste("Z score\n min > ", minCount)

R/vis_grid_clus.R

@@ -7,19 +7,25 @@
 #' @inheritParams vis_clus
 #' @param pdf_file A `character(1)` specifying the path for the resulting PDF.
 #' @param sort_clust A `logical(1)` indicating whether you want to sort
-#' the clusters by frequency using [sort_clusters()].
+#' the clusters by frequency using [sort_clusters()]. Defuault `FALSE`.
 #' @param return_plots A `logical(1)` indicating whether to print the plots
 #' to a PDF or to return the list of plots that you can then print using
 #' [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.
+#' @param guides A `character(1)` specifying which guides to print. Defaults to 
+#' `all` which plots all guides. `last` prints a guide for only on the last 
+#' sample. `none` prints no guides with the plots, but prints a guide on 
+#' separate page.
 #'
 #' @return A list of [ggplot2][ggplot2::ggplot] objects.
 #' @export
 #' @importFrom grDevices pdf dev.off
 #' @importFrom SummarizedExperiment colData<-
+#' @importFrom cowplot plot_grid get_legend
+#' @importFrom grid grid.newpage grid.draw
 #' @family Spatial cluster visualization functions
 #' @details This function prepares the data and then loops through
 #' [vis_clus()] for computing the list of [ggplot2][ggplot2::ggplot]
@@ -47,27 +53,30 @@
 #'     cowplot::plot_grid(plotlist = p_list, ncol = 2)
 #' }
 vis_grid_clus <-
-    function(
-        spe,
-        clustervar,
-        pdf_file,
-        sort_clust = TRUE,
-        colors = NULL,
-        return_plots = FALSE,
-        spatial = TRUE,
-        height = 24,
-        width = 36,
-        image_id = "lowres",
-        alpha = NA,
-        sample_order = unique(spe$sample_id),
-        point_size = 2,
-        auto_crop = TRUE,
-        na_color = "#CCCCCC40",
-        is_stitched = FALSE,
-        guide_point_size = point_size,
-        ...
+    function(spe,
+    clustervar,
+    pdf_file,
+    sort_clust = FALSE,
+    colors = NULL,
+    return_plots = FALSE,
+    spatial = TRUE,
+    height = 24,
+    width = 36,
+    image_id = "lowres",
+    alpha = NA,
+    sample_order = unique(spe$sample_id),
+    point_size = 2,
+    auto_crop = TRUE,
+    na_color = "#CCCCCC40",
+    is_stitched = FALSE,
+    guide_point_size = point_size,
+    guides = c("all", "last", "none"),
+    title_suffix = NULL
     ) {
-        stopifnot(all(sample_order %in% unique(spe$sample_id)))
+
+      stopifnot(all(sample_order %in% unique(spe$sample_id)))
+      ## check guides selection
+      guides <- rlang::arg_match(guides)
 
         if (sort_clust) {
             colData(spe)[[clustervar]] <-
@@ -88,15 +97,42 @@ vis_grid_clus <-
                     na_color = na_color,
                     is_stitched = is_stitched,
                     guide_point_size = guide_point_size,
-                    ...
+                    title_suffix = title_suffix
                 )
             })
         names(plots) <- sample_order
+
+        if(!guides == "all"){
+          ## get legend
+          suppressWarnings(legend <- cowplot::get_legend(plots[[1]]))
+
+          ## Set legend position to None on all plots
+          noguide <- function(gp){
+            gp + theme(legend.position = "None")
+          }
+          plots <- lapply(plots, noguide)
+
+          if(guides == "last") {
+            ## re-set legend in last plot
+            plots[[length(plots)]] <- plots[[length(plots)]] + theme(legend.position = "right")
+          } 
+
+        }
 
         if (!return_plots) {
+          if(guides %in% c("all", "last")){
+            pdf(pdf_file, height = height, width = width)
+            print(cowplot::plot_grid(plotlist = plots))
+            dev.off()
+
+          } else if(guides == "none"){
+            ## print guide on next page
             pdf(pdf_file, height = height, width = width)
             print(cowplot::plot_grid(plotlist = plots))
+            grid::grid.newpage()
+            grid::grid.draw(legend)
             dev.off()
+          }
             return(pdf_file)
         } else {
             return(plots)

R/vis_grid_gene.R

@@ -53,8 +53,7 @@ vis_grid_gene <-
     auto_crop = TRUE,
     na_color = "#CCCCCC40",
     is_stitched = FALSE,
-    cap_percentile = 1,
-    ...) {
+    cap_percentile = 1) {
         stopifnot(all(sample_order %in% unique(spe$sample_id)))
 
         plots <- lapply(sample_order, function(sampleid) {
@@ -73,8 +72,7 @@ vis_grid_gene <-
                 auto_crop = auto_crop,
                 na_color = na_color,
                 is_stitched = is_stitched,
-                cap_percentile = cap_percentile,
-                ...
+                cap_percentile = cap_percentile
             )
         })
         names(plots) <- sample_order

README.Rmd

@@ -140,7 +140,7 @@ vis_clus(
     clustervar = "spatialLIBD",
     sampleid = "151673",
     colors = libd_layer_colors,
-    ... = " DLPFC Human Brain Layers\nMade with research.libd.org/spatialLIBD/"
+    title_suffix = " DLPFC Human Brain Layers\nMade with research.libd.org/spatialLIBD/"
 )
 ```