Merge pull request #97 from Nick-Eagles/cap_vis_gene

Add `vis_gene()` parameter `cap_percentile` to allow capping maximum expression

Author: lcolladotor

R/app_server.R

@@ -227,7 +227,8 @@ 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,
+                    cap_percentile = input$cap_percentile
                 )
                 if (!input$side_by_side_gene) {
                     p_result <- p
@@ -276,7 +277,8 @@ app_server <- function(input, output, session) {
                         point_size = isolate(input$pointsize),
                         sample_order = isolate(input$gene_grid_samples),
                         auto_crop = isolate(input$auto_crop),
-                        is_stitched = is_stitched
+                        is_stitched = is_stitched,
+                        cap_percentile = isolate(input$cap_percentile)
                     )
             },
             warning = function(w) {
@@ -725,6 +727,16 @@ app_server <- function(input, output, session) {
                 plot_title <- paste(sampleid, "PC1 min >", minCount)
             }
         }
+
+        #   Cap the expression values at the given percentile, if applicable
+        if (input$cap_percentile < 1) {
+            sorted_count = sort(d$COUNT)
+            cap = sorted_count[
+                as.integer(round(length(sorted_count) * input$cap_percentile))
+            ]
+            d$COUNT[d$COUNT > cap] = cap
+        }
+
         d$COUNT[d$COUNT <= minCount] <- NA
 
         ## Add the reduced dims
@@ -1012,7 +1024,8 @@ 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,
+                cap_percentile = input$cap_percentile
             ) +
             geom_point(
                 shape = 21,

R/app_ui.R

@@ -146,6 +146,18 @@ app_ui <- function() {
                             "You can manually enter any number then press enter in your keyboard. This is useful for extreme values."
                         ),
                         hr(),
+                        numericInput(
+                            inputId = "cap_percentile",
+                            label = "Maximum count percentile",
+                            value = 1,
+                            min = 0.05,
+                            max = 1,
+                            step = 0.05
+                        ),
+                        helpText(
+                            "When set below 1, counts above the given percentile (e.g. 0.95 for 95th) are capped, typically to control outliers"
+                        ),
+                        hr(),
                         selectInput(
                             inputId = "genecolor",
                             label = "Gene color scale",

R/vis_gene.R

@@ -36,6 +36,11 @@
 #' the proportion of continuous variables with positive values for each spot is
 #' computed. For more details, check the multi gene vignette at
 #' <https://research.libd.org/spatialLIBD/articles/multi_gene_plots.html>.
+#' @param cap_percentile A `numeric(1)` in (0, 1] determining the maximum
+#' percentile (as a proportion) at which to cap expression. For example, a value
+#' of 0.95 sets the top 5% of expression values to the 95th percentile value.
+#' This can help make the color scale more dynamic in the presence of high
+#' outliers. Defaults to `1`, which effectively performs no capping.
 #'
 #' @return A [ggplot2][ggplot2::ggplot] object.
 #' @export
@@ -128,12 +133,13 @@
 #'     )
 #'
 #'     ## Plot all white matter markers at once using the Z-score combination
-#'     ## method
+#'     ## method. Flatten this quantity at the top 5% of values for plotting
 #'     p6 <- vis_gene(
 #'         spe = spe,
 #'         sampleid = "151507",
 #'         geneid = white_matter_genes,
-#'         multi_gene_method = "z_score"
+#'         multi_gene_method = "z_score",
+#'         cap_percentile = 0.95
 #'     )
 #'     print(p6)
 #'
@@ -158,22 +164,24 @@
 #'     print(p8)
 #' }
 vis_gene <-
-    function(spe,
-    sampleid = unique(spe$sample_id)[1],
-    geneid = rowData(spe)$gene_search[1],
-    spatial = TRUE,
-    assayname = "logcounts",
-    minCount = 0,
-    viridis = TRUE,
-    image_id = "lowres",
-    alpha = NA,
-    cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"),
-    point_size = 2,
-    auto_crop = TRUE,
-    na_color = "#CCCCCC40",
-    multi_gene_method = c("z_score", "pca", "sparsity"),
-    is_stitched = FALSE,
-    ...) {
+    function(
+        spe,
+        sampleid = unique(spe$sample_id)[1],
+        geneid = rowData(spe)$gene_search[1],
+        spatial = TRUE,
+        assayname = "logcounts",
+        minCount = 0,
+        viridis = TRUE,
+        image_id = "lowres",
+        alpha = NA,
+        cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"),
+        point_size = 2,
+        auto_crop = TRUE,
+        na_color = "#CCCCCC40",
+        multi_gene_method = c("z_score", "pca", "sparsity"),
+        is_stitched = FALSE,
+        cap_percentile = 1,
+        ...) {
         multi_gene_method <- rlang::arg_match(multi_gene_method)
         #   Verify existence and legitimacy of 'sampleid'
         if (
@@ -201,6 +209,11 @@ vis_gene <-
             )
         }
 
+        #   Validate 'cap_percentile'
+        if (cap_percentile <= 0 || cap_percentile > 1) {
+            stop("'cap_percentile' must be in (0, 1]", call. = FALSE)
+        }
+
         spe_sub <- spe[, spe$sample_id == sampleid]
 
         if (is_stitched) {
@@ -282,6 +295,16 @@ vis_gene <-
                 legend_title <- paste("PC1\n min > ", minCount)
             }
         }
+
+        #   Cap the expression values at the given percentile, if applicable
+        if (cap_percentile < 1) {
+            sorted_count = sort(d$COUNT)
+            cap = sorted_count[
+                as.integer(round(length(sorted_count) * cap_percentile))
+            ]
+            d$COUNT[d$COUNT > cap] = cap
+        }
+
         d$COUNT[d$COUNT <= minCount] <- NA
 
         p <- vis_gene_p(

R/vis_grid_gene.R

@@ -54,6 +54,7 @@ vis_grid_gene <-
         auto_crop = TRUE,
         na_color = "#CCCCCC40",
         is_stitched = FALSE,
+        cap_percentile = 1,
         ...) {
         stopifnot(all(sample_order %in% unique(spe$sample_id)))
 
@@ -73,6 +74,7 @@ vis_grid_gene <-
                 auto_crop = auto_crop,
                 na_color = na_color,
                 is_stitched = is_stitched,
+                cap_percentile = cap_percentile,
                 ...
             )
         })

inst/app/www/documentation_spe.md

@@ -52,6 +52,7 @@ Throughout the rest of this document, we'll refer to this object by the name `sp
 * `Image name`: the name of the background image to use. You can edit this image on the `Edit image` tab.
 * `Spot transparency level`: the transparency of the spots in the visualizations. It can be useful if the spot colors are blocking the background image.
 * `Minimum count value`: Values from the selected `continuous variable to plot` at or below this threshold will not be displayed.
+* `Maximum count percentile`: Sets the maximum count to display based on percentile, with acceptable values in (0, 1]. For example, a value of 0.95 sets the top 5% of counts to the value at the 95th percentile. This can be useful to make the color scale more dynamic in the presence of a small set of high outliers. This setting applies to plots of continuous variables only.
 * `Gene color scale`: Whether to use the color blind friendly palette (`viridis`) or to use a custom palette that we used for our `paper`. Other options from the [viridisLite R package](https://sjmgarnier.github.io/viridisLite/reference/viridis.html#details) are also supported.
 * `Gene color direction`: whether colors should be ordered from darkest to lightest or in the reverse direction.