R/plot_marker_express.R

In lahuuki/DeconvoBuddies: Helper Functions for LIBD Deconvolution

#' 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
#' #plot_marker_express(sce = sce.test, stat = marker_test, cell_type = "Astro", gene_col = "Symbol")
#' #plot_marker_express(sce = sce.test, stat = marker_test, cell_type = "Micro", gene_col = "Symbol", n_genes = 1, rank_col = "rank_ratio", anno_col = "anno_ratio", plot_points = TRUE)
#' #plot_marker_express(sce = sce.test, stat = marker_test, cell_type = "Oligo", gene_col = "Symbol", n_genes = 10, rank_col = "rank_ratio", anno_col = "anno_ratio")
#' #plot_marker_express(sce = sce.test, stat = marker_test, cell_type = "Excit.1", gene_col = "Symbol", n_genes = 5, rank_col = "rank_ratio", anno_col = "anno_ratio")
#' @family expression plotting functions
#' @importFrom magrittr |>
#' @importFrom ggplot2 ggplot geom_violin geom_text facet_wrap stat_summary
plot_marker_express <- function(
        sce,
        stats,
        cell_type,
        n_genes = 4,
        rank_col = "rank_ratio",
        anno_col = "anno_ratio",
        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) |>
        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,
        cat = 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)
}