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(1)` of number of markers you'd like to plot
#' @param rank_col The `character(1)` name of column to rank genes by in
#' `stats`.
#' @param anno_col The `character(1)` name of column containing annotation in
#' `stats`.
#' @param gene_col The `character(1)` name of column containing gene name in
#' `stats` should be the same syntax as `rownames(sce)`.
#' @param cellType_col The `character(1)` name of `colData()` column containing
#' cell type for `sce` data. It should match `cellType.target` in `stats`.
#' @param color_pal A named `character(1)` vector that contains a color pallet
#' matching the `cell_type` values.
#' @inheritParams plot_gene_express
#'
#' @return A `ggplot2` object created with `plot_gene_express()`. It is
#' a `scater::plotExpression()` style violin plot for selected marker genes.
#' @export
#'
#' @examples
#' ## Download the processed study data from
#' ## <https://github.com/LieberInstitute/Human_DLPFC_Deconvolution>.
#' if (!exists("sce_DLPFC_example")) sce_DLPFC_example <- fetch_deconvo_data("sce_DLPFC_example")
#'
#' ## load example marker stats
#' data("marker_test")
#'
#' ## Plot the top markers for Astrocytes
#' 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)
}