#' Plot gene expression violin plots for top marker genes for one cell type
#'
#' This function plots the top n marker genes for a specified cell type based off of
#' the `stats` table from `get_mean_ratio2()`.
#' The gene expression is plotted as violin plot with `plot_gene_express` and adds
#' annotations to each plot.
#'
#' @param sce [SummarizedExperiment-class][SummarizedExperiment::SummarizedExperiment-class] object
#' @param stats A `data.frame()` generated by get_mean_ratio and/or findMarkers_1vAll
#' @param cell_type A `character()` target cell type to plot markers for
#' @param n_genes An `integer()` of number of markers you'd like to plot
#' @param rank_col The `character()` name of column to rank genes by in `stats`
#' @param anno_col The `character()` name of column containing annotation in `stats`
#' @param gene_col The `character()` name of column containing gene name in `stats` should be the same syntax as `rownames(sce)`
#' @param cellType_col The `character()` name of colData column containing cell type for sce data,
#' matches `cellType.target` in `stats`
#' @param color_pal A named `character(1)` vector that contains a color pallet matching the `cell_type` values
#' @param plot_points A logical indicating whether to plot points over the violin,
#' defaults to `FALSE` as these often become overplotted and quite large (especially when saved as PDF)
#' @param ncol = Number of columns for the facet in the final plot. Defaults to 2.
#'
#' @return plotExpression style violin plot for selected marker genes
#' @export
#'
#' @examples
#' if (!exists("sce_DLPFC_example")) sce_DLPFC_example <- fetch_deconvo_data("sce_DLPFC_example")
#' ## plot the top markers for Astrocytes in
#' plot_marker_express(
#' sce = sce_DLPFC_example,
#' stat = marker_test,
#' cellType_col = "cellType_broad_hc",
#' cell_type = "Astro",
#' gene_col = "gene"
#' )
#' @family expression plotting functions
#' @importFrom ggplot2 ggplot geom_violin geom_text facet_wrap stat_summary
plot_marker_express <- function(
sce,
stats,
cell_type,
n_genes = 4,
rank_col = "MeanRatio.rank",
anno_col = "MeanRatio.anno",
gene_col = "gene",
cellType_col = "cellType",
color_pal = NULL,
plot_points = FALSE,
ncol = 2) {
stopifnot(cellType_col %in% colnames(colData(sce)))
stopifnot(cell_type %in% sce[[cellType_col]])
stopifnot(cell_type %in% stats$cellType.target)
# RCMD fix
rank_int <- Symbol <- anno_str <- cellType.target <- Feature <- NULL
title <- paste(cell_type, "Top", n_genes, "Markers")
# message(title)
max_digits <- nchar(n_genes)
stopifnot(rank_col %in% colnames(stats))
stopifnot(anno_col %in% colnames(stats))
stopifnot(gene_col %in% colnames(stats))
lookup <- c(
rank_col = rank_col,
anno_col = anno_col,
gene_col = gene_col
)
stats_filter <- stats |>
dplyr::rename(dplyr::all_of(lookup)) |>
dplyr::select(gene_col, gene_col, rank_col, cellType.target, anno_col) |>
dplyr::filter(
cellType.target == cell_type,
rank_col <= n_genes
) |>
mutate(
Feature = paste0(stringr::str_pad(rank_col, max_digits, "left"), ": ", gene_col),
Var1 = Feature,
anno_str = paste0("\n ", anno_col)
)
# return(stats_filter)
if (!any(stats_filter$gene_col %in% rownames(sce))) {
warning("genes from gene_col don't match rownames(sce), be sure to supply the correct column from stats")
}
marker_sce <- sce[stats_filter$gene_col, ]
rownames(marker_sce) <- stats_filter$Feature
pe <- plot_gene_express(
sce = marker_sce,
genes = stats_filter$Feature,
category = cellType_col,
color_pal = color_pal,
title = title,
plot_points = plot_points,
ncol = ncol
) +
ggplot2::geom_text(
data = stats_filter, ggplot2::aes(x = -Inf, y = Inf, label = anno_str),
vjust = "inward", hjust = "inward", size = 2.5
)
return(pe)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.