Add guide options to vis_grid_clus()

NAMESPACE

@@ -89,6 +89,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)
@@ -104,6 +105,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/app_server.R

@@ -161,7 +161,7 @@ app_server <- function(input, output, session) {
             point_size = input$pointsize,
             auto_crop = input$auto_crop,
             is_stitched = is_stitched,
-            ... = paste(" with", input$cluster)
+            title_suffix = paste("with", input$cluster)
         )
         if (!input$side_by_side_histology) {
             return(p)
@@ -202,7 +202,7 @@ app_server <- function(input, output, session) {
                 point_size = isolate(input$pointsize),
                 auto_crop = isolate(input$auto_crop),
                 is_stitched = is_stitched,
-                ... = paste(" with", isolate(input$cluster))
+                title_suffix = paste("with", isolate(input$cluster))
             )
         cowplot::plot_grid(
             plotlist = plots,

R/vis_clus.R

@@ -39,8 +39,8 @@
 #' <http://research.libd.org/visiumStitched/reference/build_spe.html>; in
 #' particular, expects a logical colData column `exclude_overlapping`
 #' specifying which spots to exclude from the plot. Sets `auto_crop = FALSE`.
-#' @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
@@ -64,7 +64,7 @@
 #'         clustervar = "layer_guess_reordered",
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
-#'         ... = " LIBD Layers"
+#'         title_suffix = "LIBD Layers"
 #'     )
 #'     print(p1)
 #'
@@ -75,7 +75,7 @@
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
 #'         auto_crop = FALSE,
-#'         ... = " LIBD Layers"
+#'         title_suffix = "LIBD Layers"
 #'     )
 #'     print(p2)
 #'
@@ -85,7 +85,7 @@
 #'         clustervar = "layer_guess_reordered",
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
-#'         ... = " LIBD Layers",
+#'         title_suffix = " LIBD Layers",
 #'         spatial = FALSE
 #'     )
 #'     print(p3)
@@ -99,7 +99,7 @@
 #'         sampleid = "151673",
 #'         colors = libd_layer_colors,
 #'         na_color = "white",
-#'         ... = " LIBD Layers"
+#'         title_suffix = " LIBD Layers"
 #'     )
 #'     print(p4)
 #' }
@@ -128,7 +128,7 @@ vis_clus <- function(
         auto_crop = TRUE,
         na_color = "#CCCCCC40",
         is_stitched = FALSE,
-        ...) {
+        title_suffix = NULL) {
     #   Verify existence and legitimacy of 'sampleid'
     if (
         !("sample_id" %in% colnames(colData(spe))) ||
@@ -170,7 +170,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]
@@ -50,7 +56,7 @@ vis_grid_clus <-
     function(spe,
     clustervar,
     pdf_file,
-    sort_clust = TRUE,
+    sort_clust = FALSE,
     colors = NULL,
     return_plots = FALSE,
     spatial = TRUE,
@@ -63,8 +69,12 @@ vis_grid_clus <-
     auto_crop = TRUE,
     na_color = "#CCCCCC40",
     is_stitched = FALSE,
-    ...) {
-        stopifnot(all(sample_order %in% unique(spe$sample_id)))
+    guides = c("all", "last", "none"),
+    title_suffix = NULL) {
+
+      stopifnot(all(sample_order %in% unique(spe$sample_id)))
+      ## check guides selection
+      guides <- rlang::arg_match(guides)
 
         if (sort_clust) {
             colData(spe)[[clustervar]] <-
@@ -82,17 +92,42 @@ vis_grid_clus <-
                     point_size = point_size,
                     auto_crop = auto_crop,
                     na_color = na_color,
-                    is_stitched = is_stitched,
-                    ...
+                    is_stitched = is_stitched
                 )
             })
         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/"
 )
 ```
 

README.md

@@ -61,9 +61,9 @@ pre-print](https://www.biorxiv.org/content/10.1101/2020.02.28.969931v1)
 for more details about this project.
 
 If you write about this website, the data or the R package please use
-the <code>\#spatialLIBD</code> hashtag. See previous tagged Bluesky posts 
-<a href="https://bsky.app/search?q=%23spatialLIBD">here</a>.
-Thank you!
+the <code>\#spatialLIBD</code> hashtag. See previous tagged Bluesky
+posts <a href="https://bsky.app/search?q=%23spatialLIBD">here</a>. Thank
+you!
 
 ## Study design
 
@@ -188,6 +188,10 @@ details, check the help file for `fetch_data()`.
 ``` r
 ## Load the package
 library("spatialLIBD")
+#> Warning: package 'SingleCellExperiment' was built under R version 4.4.2
+#> Warning: package 'MatrixGenerics' was built under R version 4.4.2
+#> Warning: package 'IRanges' was built under R version 4.4.2
+#> Warning: package 'GenomeInfoDb' was built under R version 4.4.2
 
 ## Download the spot-level data
 spe <- fetch_data(type = "spe")
@@ -210,24 +214,18 @@ spe
 #> altExpNames(0):
 #> spatialCoords names(2) : pxl_col_in_fullres pxl_row_in_fullres
 #> imgData names(4): sample_id image_id data scaleFactor
-```
-
-``` r
 
 ## Note the memory size
 lobstr::obj_size(spe)
 #> 2.04 GB
-```
-
-``` r
 
 ## Remake the logo image with histology information
 vis_clus(
     spe = spe,
     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/"
 )
 ```
 
@@ -366,7 +364,7 @@ By contributing to this project, you agree to abide by its terms.
   *[rcmdcheck](https://CRAN.R-project.org/package=rcmdcheck)* customized
   to use [Bioconductor’s docker
   containers](https://www.bioconductor.org/help/docker/) and
-  *[BiocCheck](https://bioconductor.org/packages/3.19/BiocCheck)*.
+  *[BiocCheck](https://bioconductor.org/packages/3.20/BiocCheck)*.
 - Code coverage assessment is possible thanks to
   [codecov](https://codecov.io/gh) and
   *[covr](https://CRAN.R-project.org/package=covr)*.
@@ -383,7 +381,7 @@ By contributing to this project, you agree to abide by its terms.
 For more details, check the `dev` directory.
 
 This package was developed using
-*[biocthis](https://bioconductor.org/packages/3.19/biocthis)*.
+*[biocthis](https://bioconductor.org/packages/3.20/biocthis)*.
 
 <a href="https://www.libd.org/"><img src="http://lcolladotor.github.io/img/LIBD_logo.jpg" width="250px"></a>
 
@@ -396,5 +394,5 @@ This package was developed using
   window.dataLayer = window.dataLayer || [];
   function gtag(){dataLayer.push(arguments);}
   gtag('js', new Date());
-  gtag('config', 'G-QKT3SV9EFL');
+&#10;  gtag('config', 'G-QKT3SV9EFL');
 </script>