From 3a32d5b782db1ec971d97bc9fd7407400cfc3d50 Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Mon, 20 Jan 2025 12:20:21 +0000 Subject: [PATCH 1/4] Add min and max value (#197) --- R/plotReducedDim.R | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/R/plotReducedDim.R b/R/plotReducedDim.R index 1d20d18..6eb3c98 100644 --- a/R/plotReducedDim.R +++ b/R/plotReducedDim.R @@ -56,6 +56,7 @@ #' \code{options(ggrastr.default.dpi)}, #' for example \code{options(ggrastr.default.dpi=300)}. #' @param by_exprs_values Alias for \code{by.assay.type}. +#' @param min.value,max.value Minimum and maximum values, beyond which \code{colour_by} values (if numeric) are truncated. Can be set to a numeric value to prevent outlying values from skewing the colour scale, or set to quantiles of the \code{colour_by} variable by setting to (e.g.) \code{"q10"} for the 10th quantile. #' @param ... Additional arguments for visualization, see #' \code{?"\link{scater-plot-args}"} for details. #' @@ -124,7 +125,9 @@ plotReducedDim <- function( swap_rownames = NULL, point.padding = NA, force = 1, rasterise = FALSE, scattermore = FALSE, bins = NULL, summary_fun = "sum", hex = FALSE, - by.assay.type=by_exprs_values, ... + by.assay.type=by_exprs_values, + min.value=NULL, max.value=NULL, + ... ) { ## Extract reduced dimension representation of cells @@ -162,6 +165,11 @@ plotReducedDim <- function( colour_by <- vis_out$colour_by shape_by <- vis_out$shape_by size_by <- vis_out$size_by + + if (is.numeric(df_to_plot$colour_by)) { + df_to_plot$colour_by <- .truncate_values(df_to_plot$colour_by, min.value, max.value) + + } ## Dispatching to the central plotter in the simple case of two dimensions. if (length(to_plot) == 2L) { @@ -298,3 +306,28 @@ paired_reddim_plot <- function(df_to_plot, to_plot, dimred, percentVar = NULL, } plot_out } + + + +.truncate_values <- function(values, min.value=NULL, max.value=NULL) { + if (!is.null(min.value)) { + min.value <- .handle_truncval(unlist(values), min.value) + values[values < min.value] <- min.value + } + if (!is.null(max.value)) { + max.value <- .handle_truncval(unlist(values), max.value) + values[values > max.value] <- max.value + } + values +} + +.handle_truncval <- function(col, truncval) { + if (is.character(truncval)) { + stopifnot(grepl("q\\d+", truncval)) + return (quantile(col, as.numeric(sub("q", "", truncval)) / 100)) + } + if (is.numeric(truncval)) { + # do nothing? + } + truncval +} From 435e3dd61e73e231fd8c9333956f08e90439f9cc Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Tue, 11 Feb 2025 12:51:03 +0000 Subject: [PATCH 2/4] Add news --- DESCRIPTION | 4 ++-- R/plotReducedDim.R | 7 +++++-- inst/NEWS.Rd | 9 ++++++++- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0278b1e..6830843 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,8 +12,8 @@ Authors@R: c( person("Leo", "Lahti", role=c("ctb"), email="leo.lahti@utu.fi", comment = c(ORCID = "0000-0001-5537-637X")), person("Tuomas", "Borman", role = c("ctb"), comment = c(ORCID = "0000-0002-8563-8884")) ) -Version: 1.35.1 -Date: 2025-01-31 +Version: 1.35.2 +Date: 2025-02-11 License: GPL-3 Title: Single-Cell Analysis Toolkit for Gene Expression Data in R Description: A collection of tools for doing various analyses of diff --git a/R/plotReducedDim.R b/R/plotReducedDim.R index 6eb3c98..8245d7d 100644 --- a/R/plotReducedDim.R +++ b/R/plotReducedDim.R @@ -322,9 +322,12 @@ paired_reddim_plot <- function(df_to_plot, to_plot, dimred, percentVar = NULL, } .handle_truncval <- function(col, truncval) { - if (is.character(truncval)) { + if (is.character(truncval) || is.factor(truncval)) { + if (!is.na(as.character(as.numeric(truncval)))) { + return (as.character(as.numeric(truncval))) + } stopifnot(grepl("q\\d+", truncval)) - return (quantile(col, as.numeric(sub("q", "", truncval)) / 100)) + return (quantile(col, as.numeric(sub("q", "", as.character(truncval))) / 100)) } if (is.numeric(truncval)) { # do nothing? diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index da17899..f58653c 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -1,7 +1,14 @@ \name{NEWS} \title{News for Package \pkg{scater}} -\section{Changes in version 1.28.0, Bioconductor 3.17 Release}{ +\section{Changes in version 1.36.0, Bioconductor 3.21 Release}{ + \itemize{ + \item Add \code{min.value,max.value} arguments to \code{plotReducedDim} + to enable truncating colour scales using a numeric value or a quantile (eg \code{"q10"}). + } +} + +\section{Changes in version 1.28.0, Bioconductor 3.18 Release}{ \itemize{ \item Change \code{exprs_values} (and similar) to \code{assay.type}. \item Tweak colouring of violin plots. From 891e12cda2af32dd259ddf41ee239ab08847d67b Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Tue, 11 Feb 2025 13:14:38 +0000 Subject: [PATCH 3/4] redock --- man/plotReducedDim.Rd | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/man/plotReducedDim.Rd b/man/plotReducedDim.Rd index 5068200..3f9d764 100644 --- a/man/plotReducedDim.Rd +++ b/man/plotReducedDim.Rd @@ -30,6 +30,8 @@ plotReducedDim( summary_fun = "sum", hex = FALSE, by.assay.type = by_exprs_values, + min.value = NULL, + max.value = NULL, ... ) } @@ -121,6 +123,8 @@ obtain expression values from, for use in point aesthetics - see the \code{assay.type} argument in \code{?\link{retrieveCellInfo}}.} +\item{min.value, max.value}{Minimum and maximum values, beyond which \code{colour_by} values (if numeric) are truncated. Can be set to a numeric value to prevent outlying values from skewing the colour scale, or set to quantiles of the \code{colour_by} variable by setting to (e.g.) \code{"q10"} for the 10th quantile.} + \item{...}{Additional arguments for visualization, see \code{?"\link{scater-plot-args}"} for details.} } From 5ecbd6c419990e5d937b9aa2e0f69750324bfaad Mon Sep 17 00:00:00 2001 From: Alan O'Callaghan Date: Tue, 11 Feb 2025 13:37:35 +0000 Subject: [PATCH 4/4] Add tests --- R/plotHighestExprs.R | 3 ++- tests/testthat/test-plot-dimred.R | 13 +++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/plotHighestExprs.R b/R/plotHighestExprs.R index 36d8be5..d29f8ea 100644 --- a/R/plotHighestExprs.R +++ b/R/plotHighestExprs.R @@ -110,7 +110,8 @@ plotHighestExprs <- function(object, n = 50, colour_cells_by = color_cells_by, ## Create the plot and annotations. plot_most_expressed <- ggplot(df_exprs_by_cell_long, aes_to_use) + geom_point(alpha = 0.6, shape = 124) plot_most_expressed <- plot_most_expressed + labs(x=assay.type, y="Feature") + theme_bw(8) + - theme(legend.position = c(1, 0), legend.justification = c(1, 0), + theme(legend.position.inside = c(1, 0), + legend.justification = c(1, 0), axis.text.x = element_text(colour = "gray35"), axis.text.y = element_text(colour = "gray35"), axis.title.x = element_text(colour = "gray35"), diff --git a/tests/testthat/test-plot-dimred.R b/tests/testthat/test-plot-dimred.R index a10fe1b..bc2ba36 100644 --- a/tests/testthat/test-plot-dimred.R +++ b/tests/testthat/test-plot-dimred.R @@ -48,6 +48,19 @@ test_that("we can produce PCA scatterplots", { expect_ggplot(plotPCA(example_sce, bins = 10, colour_by = "Gene_0001")) expect_ggplot(plotPCA(example_sce, bins = 10, colour_by = "Gene_0001", hex = TRUE)) + + # truncating color scale + expect_ggplot(plotPCA(example_sce, min.value = 1)) + expect_ggplot(plotPCA(example_sce, min.value = "1")) + expect_ggplot(plotPCA(example_sce, min.value = factor(1))) + expect_ggplot(plotPCA(example_sce, min.value = factor("q1"))) + expect_ggplot(plotPCA(example_sce, min.value = "q1")) + + expect_ggplot(plotPCA(example_sce, max.value = 2)) + expect_ggplot(plotPCA(example_sce, max.value = "2")) + expect_ggplot(plotPCA(example_sce, max.value = factor(2))) + expect_ggplot(plotPCA(example_sce, max.value = factor("q90"))) + expect_ggplot(plotPCA(example_sce, max.value = "q90")) }) test_that("we can produce PCA pairplots", {