From d809fc449843d4931049f5c4b2d2c3db2fa78955 Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Fri, 6 Jun 2025 17:06:02 +0200 Subject: [PATCH 1/9] introduce summarise.by to collapse data (e.g. by patient ID) and enable color.by = NULL to remove coloring of data points. --- R/geyserEnrichment.R | 65 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 55 insertions(+), 10 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index 2ab033c..f9eab90 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -21,6 +21,10 @@ #' *`"group"`* – natural sort of group labels; #' *`NULL`* – keep original ordering. #' @param facet.by Optional metadata column used to facet the plot. +#' @param summarise.by Optional metadata column used to summarise data. +#' @param summary.stat Optional Method used to summarize expression within each +#* group defined by summarise.by: one of `"mean"` (default), `"median"`, `"max"`, +#*`"sum"`, or `"geometric"` #' @param scale Logical; if `TRUE` scores are centered/scaled (Z‑score) prior #' to plotting. #' @param palette Character. Any palette from \code{\link[grDevices]{hcl.pals}}. @@ -50,6 +54,8 @@ geyserEnrichment <- function(input.data, order.by = NULL, scale = FALSE, facet.by = NULL, + summarise.by = NULL, + summary.stat = "mean", palette = "inferno") { ## ---- 0) Sanity checks ----------------------------------------------------- if (missing(gene.set) || length(gene.set) != 1L) @@ -61,10 +67,43 @@ geyserEnrichment <- function(input.data, if (identical(color.by, "group")) color.by <- group.by - ## ---- 1) Build tidy data.frame ------------------------------------------- + if (!is.null(summarise.by) && (identical(summarise.by, group.by) || + identical(summarise.by, facet.by))) + stop("'summarise.by' cannot be the same as 'group.by' or 'facet.by'. + Please choose a different metadata column.") + + # ---- 1) helper to match summary function ------------------------- + .match_summary_fun <- function(fun) { + if (is.function(fun)) return(fun) + if (!is.character(fun) || length(fun) != 1) + stop("'summary.stat' must be a single character keyword or a function") + kw <- tolower(fun) + fn <- switch(kw, + mean = base::mean, + median = stats::median, + sum = base::sum, + sd = stats::sd, + max = base::max, + min = base::min, + geometric = function(x) exp(mean(log(x + 1e-6))), + stop("Unsupported summary keyword: ", fun)) + fn + } + summary_fun <- .match_summary_fun(summary.stat) + + ## ---- 2) Build tidy data.frame ------------------------------------------- enriched <- .prepData(input.data, assay, gene.set, group.by, - split.by = NULL, facet.by = facet.by) + split.by = summarise.by, facet.by = facet.by) + ## Optionally summarise data with **base aggregate()** ---------------------- + if (!is.null(summarise.by)) { + grp_cols <- c(summarise.by, group.by, facet.by) + enriched <- aggregate(enriched[gene.set], + by = enriched[grp_cols], + FUN = summary_fun, + SIMPLIFY = FALSE) + } + ## Optionally Z‑transform ---------------------------------------------------- if (scale) enriched[[gene.set]] <- as.numeric(scale(enriched[[gene.set]])) @@ -73,12 +112,17 @@ geyserEnrichment <- function(input.data, if (!is.null(order.by)) enriched <- .orderFunction(enriched, order.by, group.by) - ## ---- 2) Plot -------------------------------------------------------------- - plt <- ggplot(enriched, aes(x = .data[[group.by]], - y = .data[[gene.set]], - colour = .data[[color.by]])) + + ## ---- 3) Plot -------------------------------------------------------------- + if (!is.null(color.by)) + plt <- ggplot(enriched, aes(x = .data[[group.by]], + y = .data[[gene.set]], + colour = .data[[color.by]])) + else + plt <- ggplot(enriched, aes(x = .data[[group.by]], + y = .data[[gene.set]])) + # Raw points -------------------------------------------------------------- - geom_jitter(width = 0.25, size = 1.5, alpha = 0.6, na.rm = TRUE) + + plt <- plt + geom_jitter(width = 0.25, size = 1.5, alpha = 0.6, na.rm = TRUE) + # White base interval + median point ------------------------------------- stat_pointinterval(interval_size_range = c(2, 3), fatten_point = 1.4, @@ -97,10 +141,11 @@ geyserEnrichment <- function(input.data, theme(legend.direction = "horizontal", legend.position = "bottom") - ## ---- 3) Colour scale ------------------------------------------------------ - plt <- .colorby(enriched, plt, color.by, palette, type = "color") + ## ---- 4) Colour scale ------------------------------------------------------ + if (!is.null(color.by)) + plt <- .colorby(enriched, plt, color.by, palette, type = "color") - ## ---- 4) Facetting --------------------------------------------------------- + ## ---- 5) Facetting --------------------------------------------------------- if (!is.null(facet.by)) plt <- plt + facet_grid(as.formula(paste(".~", facet.by))) From c10ffa36a34e6b5b0aacb6ffbbe9b201abfee36f Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Fri, 6 Jun 2025 17:06:55 +0200 Subject: [PATCH 2/9] roxygenise changes for geyserEnrichment --- man/geyserEnrichment.Rd | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/man/geyserEnrichment.Rd b/man/geyserEnrichment.Rd index db5370a..0a375b5 100644 --- a/man/geyserEnrichment.Rd +++ b/man/geyserEnrichment.Rd @@ -13,6 +13,8 @@ geyserEnrichment( order.by = NULL, scale = FALSE, facet.by = NULL, + summarise.by = NULL, + summary.stat = "mean", palette = "inferno" ) } @@ -44,6 +46,10 @@ to plotting.} \item{facet.by}{Optional metadata column used to facet the plot.} +\item{summarise.by}{Optional metadata column used to summarise data.} + +\item{summary.stat}{Optional Method used to summarize expression within each} + \item{palette}{Character. Any palette from \code{\link[grDevices]{hcl.pals}}.} } \value{ From 4f9de377bf1833607ed8458ffb24ef4439c8c69e Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Fri, 6 Jun 2025 17:14:45 +0200 Subject: [PATCH 3/9] fix formatting of param (was not correctly displayed before) --- R/geyserEnrichment.R | 6 +++--- R/heatmapEnrichment.R | 6 +++--- man/geyserEnrichment.Rd | 4 +++- man/heatmapEnrichment.Rd | 4 +++- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index f9eab90..7bcdb2d 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -22,9 +22,9 @@ #' *`NULL`* – keep original ordering. #' @param facet.by Optional metadata column used to facet the plot. #' @param summarise.by Optional metadata column used to summarise data. -#' @param summary.stat Optional Method used to summarize expression within each -#* group defined by summarise.by: one of `"mean"` (default), `"median"`, `"max"`, -#*`"sum"`, or `"geometric"` +#' @param summary.stat Optional method used to summarize expression within each +#' group defined by \code{summarise.by}. One of: \code{"mean"} (default), +#' \code{"median"}, \code{"max"}, \code{"sum"}, or \code{"geometric"}. #' @param scale Logical; if `TRUE` scores are centered/scaled (Z‑score) prior #' to plotting. #' @param palette Character. Any palette from \code{\link[grDevices]{hcl.pals}}. diff --git a/R/heatmapEnrichment.R b/R/heatmapEnrichment.R index 821f982..7f53333 100644 --- a/R/heatmapEnrichment.R +++ b/R/heatmapEnrichment.R @@ -17,9 +17,9 @@ #' @param facet.by Optional metadata column used to facet the plot. #' @param scale If \code{TRUE}, Z‑transforms each gene‑set column **after** #' summarization. -#' @param summary.stat Method used to summarize expression within each -#* group: one of `"mean"` (default), `"median"`, `"max"`, -#*`"sum"`, or `"geometric"` +#' @param summary.stat Optional method used to summarize expression within each +#' group. One of: \code{"mean"} (default), \code{"median"}, \code{"max"}, +#' \code{"sum"}, or \code{"geometric"}. #' @param palette Character. Any palette from \code{\link[grDevices]{hcl.pals}}. #' #' @return A \code{ggplot2} object. diff --git a/man/geyserEnrichment.Rd b/man/geyserEnrichment.Rd index 0a375b5..bd2f151 100644 --- a/man/geyserEnrichment.Rd +++ b/man/geyserEnrichment.Rd @@ -48,7 +48,9 @@ to plotting.} \item{summarise.by}{Optional metadata column used to summarise data.} -\item{summary.stat}{Optional Method used to summarize expression within each} +\item{summary.stat}{Optional method used to summarize expression within each +group defined by \code{summarise.by}. One of: \code{"mean"} (default), +\code{"median"}, \code{"max"}, \code{"sum"}, or \code{"geometric"}.} \item{palette}{Character. Any palette from \code{\link[grDevices]{hcl.pals}}.} } diff --git a/man/heatmapEnrichment.Rd b/man/heatmapEnrichment.Rd index ea10eda..722c4f2 100644 --- a/man/heatmapEnrichment.Rd +++ b/man/heatmapEnrichment.Rd @@ -38,7 +38,9 @@ are ordered by Ward‑linkage hierarchical clustering (Euclidean distance).} \item{scale}{If \code{TRUE}, Z‑transforms each gene‑set column **after** summarization.} -\item{summary.stat}{Method used to summarize expression within each} +\item{summary.stat}{Optional method used to summarize expression within each +group. One of: \code{"mean"} (default), \code{"median"}, \code{"max"}, +\code{"sum"}, or \code{"geometric"}.} \item{palette}{Character. Any palette from \code{\link[grDevices]{hcl.pals}}.} } From 256cb8839549d4098a18cd33eb7cc1e753344e7f Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Tue, 10 Jun 2025 17:32:07 +0200 Subject: [PATCH 4/9] enable color.by to use meta data that is different than other arguments such as group.by. Described in issue #163 --- R/geyserEnrichment.R | 8 +++++--- R/heatmapEnrichment.R | 3 ++- R/ridgeEnrichment.R | 2 +- R/scatterEnrichment.R | 3 ++- R/splitEnrichment.R | 3 ++- R/utils.R | 16 ++++++++-------- tests/testthat/test-splitEnrichment.R | 3 ++- 7 files changed, 22 insertions(+), 16 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index 7bcdb2d..61bac99 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -93,11 +93,11 @@ geyserEnrichment <- function(input.data, ## ---- 2) Build tidy data.frame ------------------------------------------- enriched <- .prepData(input.data, assay, gene.set, group.by, - split.by = summarise.by, facet.by = facet.by) + split.by = summarise.by, facet.by = facet.by, color.by = color.by) ## Optionally summarise data with **base aggregate()** ---------------------- if (!is.null(summarise.by)) { - grp_cols <- c(summarise.by, group.by, facet.by) + grp_cols <- c(summarise.by, group.by, facet.by, color.by) enriched <- aggregate(enriched[gene.set], by = enriched[grp_cols], FUN = summary_fun, @@ -116,10 +116,12 @@ geyserEnrichment <- function(input.data, if (!is.null(color.by)) plt <- ggplot(enriched, aes(x = .data[[group.by]], y = .data[[gene.set]], + group = .data[[group.by]], colour = .data[[color.by]])) else plt <- ggplot(enriched, aes(x = .data[[group.by]], - y = .data[[gene.set]])) + y = .data[[gene.set]]), + group = .data[[group.by]]) # Raw points -------------------------------------------------------------- plt <- plt + geom_jitter(width = 0.25, size = 1.5, alpha = 0.6, na.rm = TRUE) + diff --git a/R/heatmapEnrichment.R b/R/heatmapEnrichment.R index 7f53333..d03f293 100644 --- a/R/heatmapEnrichment.R +++ b/R/heatmapEnrichment.R @@ -70,7 +70,8 @@ heatmapEnrichment <- function(input.data, df <- .prepData(input.data, assay, gene.set.use, group.by = group.by, split.by = NULL, - facet.by = facet.by) + facet.by = facet.by, + color.by = NULL) # Which columns contain gene-set scores? if (identical(gene.set.use, "all")) diff --git a/R/ridgeEnrichment.R b/R/ridgeEnrichment.R index 9f38826..85d8584 100644 --- a/R/ridgeEnrichment.R +++ b/R/ridgeEnrichment.R @@ -61,7 +61,7 @@ ridgeEnrichment <- function(input.data, ## ---- 1 build long data.frame --------------------------------------- df <- .prepData(input.data, assay, gene.set.use, group.by, - split.by = NULL, facet.by = facet.by) + split.by = NULL, facet.by = facet.by, color.by = color.by) ## optional scaling (Z-transform per gene-set) ------------------------- if (scale) diff --git a/R/scatterEnrichment.R b/R/scatterEnrichment.R index 1f8338b..2a19f40 100644 --- a/R/scatterEnrichment.R +++ b/R/scatterEnrichment.R @@ -69,7 +69,8 @@ scatterEnrichment <- function(input.data, gene.set <- c(x.axis, y.axis) ## ---- 1 Assemble long data-frame ----------------------------------------- - enriched <- .prepData(input.data, assay, gene.set, group.by, NULL, facet.by) + enriched <- .prepData(input.data, assay, gene.set, group.by, NULL, facet.by, + color.by = NULL) if (scale) { enriched[, gene.set] <- apply(enriched[, gene.set, drop = FALSE], 2, scale) diff --git a/R/splitEnrichment.R b/R/splitEnrichment.R index c081b5d..7226b9b 100644 --- a/R/splitEnrichment.R +++ b/R/splitEnrichment.R @@ -56,7 +56,8 @@ splitEnrichment <- function(input.data, if (is.null(group.by)) group.by <- "ident" # Prepare tidy data with relevant metadata columns - enriched <- .prepData(input.data, assay, gene.set.use, group.by, split.by, facet.by) + enriched <- .prepData(input.data, assay, gene.set.use, group.by, split.by, + facet.by, color.by = NULL) # Determine the number of levels in the splitting variable split.levels <- unique(enriched[[split.by]]) diff --git a/R/utils.R b/R/utils.R index c713793..695f7e8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -41,10 +41,10 @@ # DATA.frame BUILDERS --------------------------------------------------------- # ----------------------------------------------------------------------------- .makeDFfromSCO <- function(input.data, assay = "escape", gene.set = NULL, - group.by = NULL, split.by = NULL, facet.by = NULL) { + group.by = NULL, split.by = NULL, facet.by = NULL, color.by = NULL) { if (is.null(assay)) stop("Please provide assay name") - cols <- unique(c(group.by, split.by, facet.by)) + cols <- unique(c(group.by, split.by, facet.by, color.by)) cnts <- .cntEval(input.data, assay = assay, type = "data") if (length(gene.set) == 1 && gene.set == "all") @@ -62,18 +62,18 @@ df } -.prepData <- function(input.data, assay, gene.set, group.by, split.by, facet.by) { +.prepData <- function(input.data, assay, gene.set, group.by, split.by, facet.by, color.by) { if (.is_seurat_or_sce(input.data)) { - df <- .makeDFfromSCO(input.data, assay, gene.set, group.by, split.by, facet.by) + df <- .makeDFfromSCO(input.data, assay, gene.set, group.by, split.by, facet.by, color.by) if (identical(gene.set, "all")) { - gene.set <- setdiff(colnames(df), c(group.by, split.by, facet.by)) + gene.set <- setdiff(colnames(df), c(group.by, split.by, facet.by, color.by)) } } else { # assume plain data.frame / matrix if (identical(gene.set, "all")) - gene.set <- setdiff(colnames(input.data), c(group.by, split.by, facet.by)) - df <- input.data[, c(gene.set, group.by, split.by, facet.by), drop = FALSE] + gene.set <- setdiff(colnames(input.data), c(group.by, split.by, facet.by, color.by)) + df <- input.data[, c(gene.set, group.by, split.by, facet.by, color.by), drop = FALSE] } - colnames(df) <- c(gene.set, group.by, split.by, facet.by) + colnames(df) <- unique(c(gene.set, group.by, split.by, facet.by, color.by)) df } diff --git a/tests/testthat/test-splitEnrichment.R b/tests/testthat/test-splitEnrichment.R index 556b58b..7c068be 100644 --- a/tests/testthat/test-splitEnrichment.R +++ b/tests/testthat/test-splitEnrichment.R @@ -70,7 +70,8 @@ test_that("order.by = 'mean' reorders x-axis levels by descending mean", { gene.set = "Tcells", group.by = "ident", split.by = "groups", - facet.by = NULL + facet.by = NULL, + color.by = NULL ) expected <- enr %>% From d0211905d28d4768527be1b8da84a1078ec4c22b Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Wed, 11 Jun 2025 09:31:56 +0200 Subject: [PATCH 5/9] move summary function to utils since its now used across multiple functions --- R/geyserEnrichment.R | 16 ---------------- R/heatmapEnrichment.R | 16 ---------------- R/utils.R | 17 +++++++++++++++++ 3 files changed, 17 insertions(+), 32 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index 61bac99..1be8ffc 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -73,22 +73,6 @@ geyserEnrichment <- function(input.data, Please choose a different metadata column.") # ---- 1) helper to match summary function ------------------------- - .match_summary_fun <- function(fun) { - if (is.function(fun)) return(fun) - if (!is.character(fun) || length(fun) != 1) - stop("'summary.stat' must be a single character keyword or a function") - kw <- tolower(fun) - fn <- switch(kw, - mean = base::mean, - median = stats::median, - sum = base::sum, - sd = stats::sd, - max = base::max, - min = base::min, - geometric = function(x) exp(mean(log(x + 1e-6))), - stop("Unsupported summary keyword: ", fun)) - fn - } summary_fun <- .match_summary_fun(summary.stat) ## ---- 2) Build tidy data.frame ------------------------------------------- diff --git a/R/heatmapEnrichment.R b/R/heatmapEnrichment.R index d03f293..cc42e24 100644 --- a/R/heatmapEnrichment.R +++ b/R/heatmapEnrichment.R @@ -47,22 +47,6 @@ heatmapEnrichment <- function(input.data, palette = "inferno") { # ---------- 1. helper to match summary function ------------------------- - .match_summary_fun <- function(fun) { - if (is.function(fun)) return(fun) - if (!is.character(fun) || length(fun) != 1) - stop("'summary.stat' must be a single character keyword or a function") - kw <- tolower(fun) - fn <- switch(kw, - mean = base::mean, - median = stats::median, - sum = base::sum, - sd = stats::sd, - max = base::max, - min = base::min, - geometric = function(x) exp(mean(log(x + 1e-6))), - stop("Unsupported summary keyword: ", fun)) - fn - } summary_fun <- .match_summary_fun(summary.stat) # ---------- 2. pull / tidy data ----------------------------------------- diff --git a/R/utils.R b/R/utils.R index 695f7e8..39a22aa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -443,4 +443,21 @@ utils::globalVariables(c( "gene.set.query", "index" )) +# helper to match summary function +.match_summary_fun <- function(fun) { + if (is.function(fun)) return(fun) + if (!is.character(fun) || length(fun) != 1) + stop("'summary.stat' must be a single character keyword or a function") + kw <- tolower(fun) + fn <- switch(kw, + mean = base::mean, + median = stats::median, + sum = base::sum, + sd = stats::sd, + max = base::max, + min = base::min, + geometric = function(x) exp(mean(log(x + 1e-6))), + stop("Unsupported summary keyword: ", fun)) + fn +} From 92a49df223efe6ea9b4c75d09d470c2e62f5c485 Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Wed, 11 Jun 2025 14:00:58 +0200 Subject: [PATCH 6/9] enable dgCMatrix input. didnt work before. --- R/geyserEnrichment.R | 32 ++++++++++++++++------ R/utils.R | 64 +++++++++++++++++++++++++++++++++++--------- 2 files changed, 76 insertions(+), 20 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index 1be8ffc..36d4cc8 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -79,18 +79,34 @@ geyserEnrichment <- function(input.data, enriched <- .prepData(input.data, assay, gene.set, group.by, split.by = summarise.by, facet.by = facet.by, color.by = color.by) + # Define all grouping variables that must be metadata columns + grouping_vars <- unique(c(summarise.by, group.by, facet.by)) + + # Determine if color.by is a feature + is_feature_color <- !is.null(color.by) && !(color.by %in% grouping_vars) && (color.by %in% colnames(enriched)) && !(color.by %in% grouping_vars) + ## Optionally summarise data with **base aggregate()** ---------------------- if (!is.null(summarise.by)) { - grp_cols <- c(summarise.by, group.by, facet.by, color.by) - enriched <- aggregate(enriched[gene.set], - by = enriched[grp_cols], - FUN = summary_fun, - SIMPLIFY = FALSE) + + # Features to summarize = gene.set (+ color.by if it's a feature) + summarise_vars <- unique(c(gene.set, if (is_feature_color) color.by)) + + # Perform aggregation + enriched <- aggregate(enriched[summarise_vars], + by = enriched[grouping_vars], + FUN = summary_fun, + simplify = TRUE) } - + ## Optionally Z‑transform ---------------------------------------------------- - if (scale) - enriched[[gene.set]] <- as.numeric(scale(enriched[[gene.set]])) + if (scale) { + enriched[[gene.set]] <- scale(as.numeric(enriched[[gene.set]])) + + # Also scale color.by if it's a feature + if (is_feature_color) { + enriched[[color.by]] <- scale(enriched[[color.by]]) + } + } ## Optionally reorder groups ------------------------------------------------- if (!is.null(order.by)) diff --git a/R/utils.R b/R/utils.R index 39a22aa..7209e1e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -44,37 +44,77 @@ group.by = NULL, split.by = NULL, facet.by = NULL, color.by = NULL) { if (is.null(assay)) stop("Please provide assay name") - cols <- unique(c(group.by, split.by, facet.by, color.by)) + + # Pull count matrix (features) and metadata cnts <- .cntEval(input.data, assay = assay, type = "data") + features <- rownames(cnts) + meta <- .grabMeta(input.data) + meta.cols <- colnames(meta) - if (length(gene.set) == 1 && gene.set == "all") - gene.set <- rownames(cnts) + # All potential column-like arguments + cols <- unique(c(group.by, split.by, facet.by, color.by)) - meta <- .grabMeta(input.data) - meta <- meta[, cols, drop = FALSE] + # Check that each is either metadata or a feature + bad.cols <- cols[!(cols %in% meta.cols | cols %in% features)] + if (length(bad.cols) > 0) { + stop("The following variables are not found in either metadata or features: ", paste(bad.cols, collapse = ", ")) + } + # Determine if color.by is a feature or meta + is_feature_color <- !is.null(color.by) && color.by %in% features + is_meta_color <- !is.null(color.by) && color.by %in% meta.cols + + # Prepare metadata subset + meta <- meta[, intersect(cols, meta.cols), drop = FALSE] + + # Convert gene.set if "all" + if (length(gene.set) == 1 && gene.set == "all") { + gene.set <- features + } + + # Build data frame with expression values if (length(gene.set) == 1) { df <- cbind(value = cnts[gene.set, ], meta) colnames(df)[1] <- gene.set } else { df <- cbind(Matrix::t(cnts[gene.set, , drop = FALSE]), meta) } - df + + # Add color.by feature expression if it's a gene but not in gene.set + if (is_feature_color && !(color.by %in% gene.set)) { + df[[color.by]] <- cnts[color.by, ] + } + + return(df) } + .prepData <- function(input.data, assay, gene.set, group.by, split.by, facet.by, color.by) { if (.is_seurat_or_sce(input.data)) { df <- .makeDFfromSCO(input.data, assay, gene.set, group.by, split.by, facet.by, color.by) + if (identical(gene.set, "all")) { - gene.set <- setdiff(colnames(df), c(group.by, split.by, facet.by, color.by)) + meta_cols <- c(group.by, split.by, facet.by) + # Do not remove color.by if it's also a feature + non_gene_color <- if (!is.null(color.by) && color.by %in% colnames(df) && !(color.by %in% gene.set)) color.by else NULL + gene.set <- setdiff(colnames(df), c(meta_cols, non_gene_color)) + } + + } else { + all.cols <- unique(c(gene.set, group.by, split.by, facet.by, color.by)) + missing.cols <- setdiff(all.cols, colnames(input.data)) + if (length(missing.cols) > 0) { + stop("The following columns are missing in the input data: ", paste(missing.cols, collapse = ", ")) } - } else { # assume plain data.frame / matrix - if (identical(gene.set, "all")) + + if (identical(gene.set, "all")) { gene.set <- setdiff(colnames(input.data), c(group.by, split.by, facet.by, color.by)) - df <- input.data[, c(gene.set, group.by, split.by, facet.by, color.by), drop = FALSE] + } + + df <- input.data[, unique(c(gene.set, group.by, split.by, facet.by, color.by)), drop = FALSE] } - colnames(df) <- unique(c(gene.set, group.by, split.by, facet.by, color.by)) - df + + return(df) } # ----------------------------------------------------------------------------- From 3b25b273955c318cf571b79495a009a83b32fe74 Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Wed, 11 Jun 2025 14:01:39 +0200 Subject: [PATCH 7/9] version bump --- DESCRIPTION | 2 +- NEWS.md | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 772045e..994f94e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: escape Title: Easy single cell analysis platform for enrichment -Version: 2.5.4 +Version: 2.5.5 Authors@R: c( person(given = "Nick", family = "Borcherding", role = c("aut", "cre"), email = "ncborch@gmail.com"), person(given = "Jared", family = "Andrews", role = c("aut"), email = "jared.andrews07@gmail.com"), diff --git a/NEWS.md b/NEWS.md index 98e3fae..7544cb3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ +# 2.5.5 (2025-06-11) + +## Bug fix & enhanced functionality +* Enable ```color.by``` for both metadata columns and features (other gene sets) +* Introduce ```summarise.by``` argument for ```geyserEnrichment()``` +* Enable scaling if color.by is another gene.set. Enable scaling for ```dgCMatrix``` + # 2.5.4 (2025-06-05) ## Bug fixes From b7ad30e4c2a8cd8ede63b46abfb34fd69c7f3492 Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Wed, 11 Jun 2025 15:44:00 +0200 Subject: [PATCH 8/9] fix missing attribute error caused by gseaEnrichment and fix plotting of gseaEnrichment --- R/gseaEnrichment.R | 6 +++--- R/utils.R | 3 +++ 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/gseaEnrichment.R b/R/gseaEnrichment.R index 4831b92..e6dbc42 100644 --- a/R/gseaEnrichment.R +++ b/R/gseaEnrichment.R @@ -178,7 +178,7 @@ gseaEnrichment <- function(input.data, ggplot2::geom_step(linewidth = 0.8) + ggplot2::geom_hline(yintercept = 0) + ggplot2::scale_colour_manual(values = cols, name = NULL) + - ggplot2::labs(y = "Running Enrichment Score") + + ggplot2::labs(y = paste0(gene.set.use, "\nRunning Enrichment Score")) + ggplot2::theme_classic() + ggplot2::theme(axis.title.x = element_blank(), axis.text.x = element_blank(), @@ -194,7 +194,7 @@ gseaEnrichment <- function(input.data, axis.text.y = element_blank(), axis.ticks.y = element_blank(), panel.border = element_rect(fill = NA, colour = "black", linewidth = 0.5)) - - p_top / p_mid + patchwork::plot_layout(heights = c(3, 0.4)) + + patchwork::wrap_plots(p_top, p_mid, ncol = 1, heights = c(3, 0.4)) } diff --git a/R/utils.R b/R/utils.R index 7209e1e..08a4733 100644 --- a/R/utils.R +++ b/R/utils.R @@ -498,6 +498,9 @@ utils::globalVariables(c( min = base::min, geometric = function(x) exp(mean(log(x + 1e-6))), stop("Unsupported summary keyword: ", fun)) + + # Attach keyword as attribute + attr(fn, "keyword") <- kw fn } From 7b09b866225356eb6f3bab89e1745a9efa0dfc79 Mon Sep 17 00:00:00 2001 From: toobiwankenobi Date: Wed, 11 Jun 2025 16:34:15 +0200 Subject: [PATCH 9/9] fix checks to determine if color.by is a feature or metadata --- R/geyserEnrichment.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/geyserEnrichment.R b/R/geyserEnrichment.R index 36d4cc8..31de66a 100644 --- a/R/geyserEnrichment.R +++ b/R/geyserEnrichment.R @@ -83,13 +83,18 @@ geyserEnrichment <- function(input.data, grouping_vars <- unique(c(summarise.by, group.by, facet.by)) # Determine if color.by is a feature - is_feature_color <- !is.null(color.by) && !(color.by %in% grouping_vars) && (color.by %in% colnames(enriched)) && !(color.by %in% grouping_vars) + all_features <- rownames(.cntEval(input.data, assay = assay, type = "data")) + + # Determine if color.by is a feature + is_feature_color <- !is.null(color.by) && + (color.by %in% all_features) ## Optionally summarise data with **base aggregate()** ---------------------- if (!is.null(summarise.by)) { - # Features to summarize = gene.set (+ color.by if it's a feature) + # add color.by to summarise_vars if it is a feautre, otherwise add to grouping_vars summarise_vars <- unique(c(gene.set, if (is_feature_color) color.by)) + grouping_vars <- unique(c(grouping_vars, if (!is_feature_color) color.by)) # Perform aggregation enriched <- aggregate(enriched[summarise_vars],