diff --git a/NAMESPACE b/NAMESPACE index 9862e0d55..1a81bbeea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -92,6 +92,7 @@ export(plotDimRed) export(plotDoubletFinderResults) export(plotEmptyDropsResults) export(plotEmptyDropsScatter) +export(plotEnrichR) export(plotFindMarkerHeatmap) export(plotMASTThresholdGenes) export(plotMarkerDiffExp) diff --git a/R/enrichRSCE.R b/R/enrichRSCE.R index a65312e01..83ea21cdb 100644 --- a/R/enrichRSCE.R +++ b/R/enrichRSCE.R @@ -134,6 +134,42 @@ runEnrichR <- function(inSCE, return(inSCE) } +#' @title Plot EnrichR results +#' @description Plot results of EnrichR analysis as a barplot. +#' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved +#' EnrichR results. Required. +#' @param analysisName A string that identifies the specific analysis to plot. +#' Required. +#' @param showTerms Number of enrichment terms to show. Default is 20. +#' @param numChar Integer. Indicates the maximum number characters to be +#' displayed in the term names. Default is 40. +#' @param y Character string. Indicates the variable to be shown on the +#' y-axis. Can be one of "Count" or "Ratio". Results that include background +#' genes can only show "Count". Default is "Count". +#' @param orderBy Charachter string. Indicates how to order the results prior +#' to subsetting. Can be one of "P.value", "Adjusted.P.Value", +#' or "Combined.Score". Default is "Adjusted.P.value". +#' @param xlab Character vector. Label for x-axis. Default NULL. +#' @param ylab Character vector. Label for y-axis. Default NULL. +#' @param title Character string. Title of the plot. Default NULL. +#' @return A ggplot object of EnrichR results. +#' @export +plotEnrichR <- function(inSCE, + analysisName, + showTerms = 20, + numChar = 40, + y = "Count", + orderBy = "Adjusted.P.value", + xlab = NULL, + ylab = NULL, + title = NULL){ + res <- getEnrichRResult(inSCE, analysisName = analysisName) + p <- enrichR::plotEnrich(df = res$result, showTerms = showTerms, numChar = numChar, y = y, + orderBy = orderBy, xlab = xlab, ylab = ylab, title = title) + return(p) +} + + #' @title Get or Set EnrichR Result #' @rdname getEnrichRResult #' @param inSCE A \linkS4class{SingleCellExperiment} object. diff --git a/R/ggPerQCWrapper.R b/R/ggPerQCWrapper.R index 0af082fe7..e60a5fb89 100644 --- a/R/ggPerQCWrapper.R +++ b/R/ggPerQCWrapper.R @@ -5,52 +5,52 @@ #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runPerCellQC}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. Users may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{FALSE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{"median"}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. #' @param baseSize The base font size for all text. Default \code{15}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param transparency Transparency of the dots, values will be 0-1. Default \code{1}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{1}. -#' @param labelSamples Will label sample name in title of plot if \code{TRUE}. +#' @param labelSamples Will label sample name in title of plot if \code{TRUE}. #' Default \code{TRUE}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return list of .ggplot objects #' @seealso \code{\link{runPerCellQC}} @@ -89,13 +89,13 @@ plotRunPerCellQCResults <- function(inSCE, sample = rep(1, ncol(inSCE)) } samples <- unique(sample) - + if(combinePlot == "sample" && length(samples) == 1){ warning("'combinePlot' was set to 'sample' but the sample was not set, or there is only one type of sample specified.") combinePlot = "all" } - + if (length(samples) > 1) { combined.sum <- plotSCEViolinColData( inSCE=inSCE, @@ -119,7 +119,7 @@ plotRunPerCellQCResults <- function(inSCE, combinePlot = "all", plotLabels = "none" ) - + combined.detected <- plotSCEViolinColData( inSCE=inSCE, coldata="detected", @@ -164,12 +164,12 @@ plotRunPerCellQCResults <- function(inSCE, combinePlot = "all", plotLabels = "none" ) - + merged.plots <- list(combined.sum, combined.detected, combined.toppercent) names(merged.plots) <- c("Sum", "Detected", "TopPercent") - + if (any(grepl(pattern="subsets_",names(colData(inSCE)) - ) | grepl(pattern="mito_", names(colData(inSCE))))) { + ) | grepl(pattern="mito_", names(colData(inSCE))))) { subsets <- grep( pattern="subsets_", names(colData(inSCE)), value=TRUE @@ -179,7 +179,7 @@ plotRunPerCellQCResults <- function(inSCE, names(colData(inSCE)), value=TRUE ) subsets <- c(subsets, mitos) - + combined.subset <- lapply(subsets, function(x) { plotSCEViolinColData( inSCE=inSCE, @@ -208,22 +208,22 @@ plotRunPerCellQCResults <- function(inSCE, } else { combined.subset <- NULL } - + merged.plots <- list(Violin = merged.plots) } - + res.list <- c() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + if(combinePlot == "sample" | combinePlot == "none" | length(samples) == 1){ title = "Total counts per cell" if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) } - + if(combinePlot == "sample" | combinePlot == "all"){ baseSize = baseSize * 0.5 } @@ -249,7 +249,7 @@ plotRunPerCellQCResults <- function(inSCE, combinePlot="all" )) res.list <- c(res.list, violin.sum) - + title = "Total features detected per cell" if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) @@ -276,7 +276,7 @@ plotRunPerCellQCResults <- function(inSCE, combinePlot="all" )) res.list <- c(res.list, violin.detected) - + topPattern <- grep( pattern="percent.top_50$", names(colData(inSCESub)), value=TRUE @@ -308,7 +308,7 @@ plotRunPerCellQCResults <- function(inSCE, )) res.list <- c(res.list, violin.toppercent) names(res.list) <- c("Sum", "Detected", "TopPercent") - + if (any(grepl(pattern="subsets_", names(colData(inSCESub))) | grepl(pattern="mito_", names(colData(inSCESub))))) { subsets <- grep( @@ -320,7 +320,7 @@ plotRunPerCellQCResults <- function(inSCE, names(colData(inSCESub)), value=TRUE ) subsets <- c(subsets, mitos) - + violin.subset <- lapply(subsets, function(y) { title = paste0(y, " per cell") if(labelSamples && length(samples) > 1){ @@ -352,15 +352,15 @@ plotRunPerCellQCResults <- function(inSCE, } else { violin.subset <- NULL } - + if (!is.null(violin.subset)) { res.list <- c(res.list, violin.subset) } } - + return(res.list) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples if (combinePlot == "all") { @@ -374,7 +374,7 @@ plotRunPerCellQCResults <- function(inSCE, plotlist <- unlist(plotlist, recursive = FALSE) relHeights <- 1 } - + if (!is.null(combinePlot)) { if (combinePlot %in% c("all", "sample")) { plotlist <- .ggSCTKCombinePlots(plotlist, combinePlot = combinePlot, @@ -393,17 +393,17 @@ plotRunPerCellQCResults <- function(inSCE, #' @title Plots for runEmptyDrops outputs. #' @description A wrapper function which visualizes outputs from the -#' \code{\link{runEmptyDrops}} function stored in the \code{colData} slot of the +#' \code{\link{runEmptyDrops}} function stored in the \code{colData} slot of the #' \linkS4class{SingleCellExperiment} object. #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runEmptyDrops}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param fdrCutoff Numeric. Thresholds barcodes based on the FDR values from -#' \code{\link{runEmptyDrops}} as "Empty Droplet" or "Putative Cell". Default +#' \code{\link{runEmptyDrops}} as "Empty Droplet" or "Putative Cell". Default #' \code{0.01}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param titleSize Size of title of plot. Default \code{18}. @@ -412,19 +412,19 @@ plotRunPerCellQCResults <- function(inSCE, #' @param legendSize size of legend. Default \code{15}. #' @param legendTitleSize size of legend title. Default \code{16}. #' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or object, -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' while \code{"sample"} will output a list of plots separated by sample. +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' while \code{"sample"} will output a list of plots separated by sample. #' Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{1}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return list of .ggplot objects #' @seealso \code{\link{runEmptyDrops}}, \code{\link{plotEmptyDropsScatter}} @@ -471,7 +471,7 @@ plotEmptyDropsResults <- function(inSCE, sampleRelHeights = sampleRelHeights, sampleRelWidths = sampleRelWidths ) - + res.list <- list(scatterEmptyDrops) names(res.list) <- c("scatterEmptyDrops") return(res.list) @@ -479,14 +479,14 @@ plotEmptyDropsResults <- function(inSCE, #' @title Plots for runBarcodeRankDrops outputs. #' @description A wrapper function which visualizes outputs from the -#' \code{runBarcodeRankDrops} function stored in the \code{metadata} slot of +#' \code{runBarcodeRankDrops} function stored in the \code{metadata} slot of #' the \linkS4class{SingleCellExperiment} object. #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runBarcodeRankDrops}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param titleSize Size of title of plot. Default \code{18}. @@ -517,7 +517,7 @@ plotBarcodeRankDropsResults <- function(inSCE, axisSize = axisSize, legendSize = legendSize ) - + res.list <- list(scatterBarcodeRank) names(res.list) <- c("scatterBarcodeRank") return(res.list) @@ -530,71 +530,71 @@ plotBarcodeRankDropsResults <- function(inSCE, #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runCxds}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param shape If provided, add shapes based on the value. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. A user may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{TRUE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. -#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. +#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. #' Default \code{"UMAP"}. #' @param xlab Character vector. Label for x-axis. Default \code{NULL}. #' @param ylab Character vector. Label for y-axis. Default \code{NULL}. -#' @param dim1 1st dimension to be used for plotting. Can either be a string -#' which specifies the name of the dimension to be plotted from reducedDims, or -#' a numeric value which specifies the index of the dimension to be plotted. +#' @param dim1 1st dimension to be used for plotting. Can either be a string +#' which specifies the name of the dimension to be plotted from reducedDims, or +#' a numeric value which specifies the index of the dimension to be plotted. #' Default is \code{NULL}. -#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. +#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. #' Default is \code{NULL}. -#' @param bin Numeric vector. If single value, will divide the numeric values +#' @param bin Numeric vector. If single value, will divide the numeric values #' into \code{bin} groups. If more than one value, will bin numeric values using #' values as a cut point. Default \code{NULL}. #' @param binLabel Character vector. Labels for the bins created by \code{bin}. #' Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{NULL}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. -#' @param transparency Transparency of the dots, values will be 0-1. Default +#' @param transparency Transparency of the dots, values will be 0-1. Default #' \code{1}. #' @param baseSize The base font size for all text. Default \code{12}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}, \code{legendSize}, \code{legendTitleSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param legendSize size of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{NULL}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{c(1, 1, 1)}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param labelSamples Will label sample name in title of plot if TRUE. Default +#' @param labelSamples Will label sample name in title of plot if TRUE. Default #' \code{TRUE}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return list of .ggplot objects #' @seealso \code{\link{runScrublet}} @@ -676,17 +676,17 @@ plotScrubletResults <- function( merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list <- list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + if (combinePlot == "sample" | combinePlot == "all") { baseSize = baseSize * 0.5 } - + title = "Density, Scrublet Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -709,7 +709,7 @@ plotScrubletResults <- function( ) ) res.list <- c(res.list, densityScore) - + title = "Scrublet Doublet Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -744,16 +744,16 @@ plotScrubletResults <- function( ) ) res.list <- c(res.list, scatterScore) - + if (combinePlot != "all" | length(samples) == 1) { title = "Scrublet Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) } - + violinScore <- list( violin_doubletScore = plotSCEViolinColData( - inSCE = inSCESub, + inSCE = inSCESub, coldata = "scrublet_score", sample = sampleSub, xlab = "", @@ -768,7 +768,7 @@ plotScrubletResults <- function( title = title, titleSize = titleSize, dotSize = dotSize, - axisSize = axisSize, + axisSize = axisSize, axisLabelSize = axisLabelSize, summary = summary, summaryTextSize = summaryTextSize, @@ -777,7 +777,7 @@ plotScrubletResults <- function( ) res.list <- c(res.list, violinScore) } - + title = "Scrublet Doublet Assignment" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -803,7 +803,7 @@ plotScrubletResults <- function( defaultTheme = defaultTheme, title = title, titleSize = titleSize, - axisSize = axisSize, + axisSize = axisSize, axisLabelSize = axisLabelSize, labelClusters = FALSE, legendTitle = "Doublet \nAssignment", @@ -813,10 +813,10 @@ plotScrubletResults <- function( ) ) res.list <- c(res.list, scatterCall) - + return(res.list) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples plotlist <- c(merged.plots, list(Sample = plotlist)) @@ -825,7 +825,7 @@ plotScrubletResults <- function( plotLabels <- "none" relHeights <- 1 } - + if (!is.null(combinePlot)) { if (combinePlot %in% c("all", "sample")) { plotlist <- .ggSCTKCombinePlots(plotlist, combinePlot = combinePlot, @@ -838,7 +838,7 @@ plotScrubletResults <- function( sampleRelWidths = sampleRelWidths) } } - + return(plotlist) } @@ -849,76 +849,77 @@ plotScrubletResults <- function( #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runDoubletFinder}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param shape If provided, add shapes based on the value. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. A user may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{TRUE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. -#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. +#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. #' Default \code{"UMAP"}. #' @param xlab Character vector. Label for x-axis. Default \code{NULL}. #' @param ylab Character vector. Label for y-axis. Default \code{NULL}. -#' @param dim1 1st dimension to be used for plotting. Can either be a string -#' which specifies the name of the dimension to be plotted from reducedDims, or -#' a numeric value which specifies the index of the dimension to be plotted. +#' @param dim1 1st dimension to be used for plotting. Can either be a string +#' which specifies the name of the dimension to be plotted from reducedDims, or +#' a numeric value which specifies the index of the dimension to be plotted. #' Default is \code{NULL}. -#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. +#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. #' Default is \code{NULL}. -#' @param bin Numeric vector. If single value, will divide the numeric values +#' @param bin Numeric vector. If single value, will divide the numeric values #' into \code{bin} groups. If more than one value, will bin numeric values using #' values as a cut point. Default \code{NULL}. #' @param binLabel Character vector. Labels for the bins created by \code{bin}. #' Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{NULL}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. -#' @param transparency Transparency of the dots, values will be 0-1. Default +#' @param transparency Transparency of the dots, values will be 0-1. Default #' \code{1}. #' @param baseSize The base font size for all text. Default \code{12}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}, \code{legendSize}, \code{legendTitleSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param legendSize size of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{NULL}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{c(1, 1, 1)}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param labelSamples Will label sample name in title of plot if TRUE. Default +#' @param labelSamples Will label sample name in title of plot if TRUE. Default #' \code{TRUE}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return list of .ggplot objects #' @seealso \code{\link{runDoubletFinder}} #' @examples #' data(scExample, package="singleCellTK") +#' options(future.globals.maxSize = 786432000) #' sce <- subsetSCECols(sce, colData = "type != 'EmptyDroplet'") #' sce <- runQuickUMAP(sce) #' sce <- runDoubletFinder(sce) @@ -965,18 +966,18 @@ plotDoubletFinderResults <- function( sample <- rep(1, ncol(inSCE)) } samples <- unique(sample) - + if (!(reducedDimName %in% reducedDimNames(inSCE))) { stop("Specified `reducedDimName` is not found in input SingleCellExperiment object. Please check for spelling errors with reducedDimNames().") } - + df.scores <- grep( pattern = "doubletFinder_doublet_score_resolution_", names(colData(inSCE)), value = TRUE ) - + df.labels <- grep( pattern = "doubletFinder_doublet_label_resolution_", names(colData(inSCE)), value = TRUE @@ -1010,28 +1011,28 @@ plotDoubletFinderResults <- function( plotLabels = "none" ) }) - + names(merged.plots) <- vapply(df.scores, function(x) { paste0("Violin_", gsub( pattern = "doubletFinder_doublet_score_", "", x = x )) }, character(1)) - + # merged.plots <- list(merged.plots) merged.plots <- list(Violin = merged.plots) } - + res.list <- list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + if (combinePlot == "sample" | combinePlot == "all") { baseSize = baseSize * 0.5 } - + densityScore <- lapply(df.scores, function(y) { title <- paste( "Density, Doublet Score Resolution", @@ -1057,12 +1058,12 @@ plotDoubletFinderResults <- function( ) }) names(densityScore) <- vapply(df.scores, function(y) { - paste0("Density_", gsub(pattern = "doubletFinder_doublet_score_", "", + paste0("Density_", gsub(pattern = "doubletFinder_doublet_score_", "", x = y )) }, character(1)) res.list <- c(res.list, densityScore) - + scatterScore <- lapply(df.scores, function(y) { title <- paste( "Doublet Score Resolution", @@ -1071,7 +1072,7 @@ plotDoubletFinderResults <- function( if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) } - + plotSCEDimReduceColData( inSCE = inSCESub, sample = sampleSub, @@ -1100,7 +1101,7 @@ plotDoubletFinderResults <- function( combinePlot = "all" ) }) - + names(scatterScore) <- vapply(df.scores, function(y) { paste0("Scatter_Score_", gsub( pattern = "doubletFinder_doublet_score_", @@ -1108,20 +1109,20 @@ plotDoubletFinderResults <- function( )) }, character(1)) res.list <- c(res.list, scatterScore) - + if (combinePlot != "all" | length(samples) == 1) { - + violinScore <- lapply(df.scores, function(y) { title <- paste( "Doublet Score Resolution", gsub( pattern = "doubletFinder_doublet_score_resolution_", "", y)) - + if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) } - + plotSCEViolinColData( inSCE = inSCESub, coldata = y, @@ -1145,7 +1146,7 @@ plotDoubletFinderResults <- function( combinePlot = "all" ) }) - + names(violinScore) <- vapply(df.scores, function(y) { paste0("violin_", gsub( pattern = "doubletFinder_doublet_score_", @@ -1154,18 +1155,18 @@ plotDoubletFinderResults <- function( }, character(1)) res.list <- c(res.list, violinScore) } - + scatterCall <- lapply(df.labels, function(y) { title <- paste( "Doublet Call Resolution", gsub( pattern = "doubletFinder_doublet_label_resolution_", "", y)) - + if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) } - + plotSCEDimReduceColData( inSCE = inSCESub, sample = sampleSub, @@ -1195,7 +1196,7 @@ plotDoubletFinderResults <- function( combinePlot = "all" ) }) - + names(scatterCall) <- vapply(df.labels, function(y) { paste0("Scatter_Call_", gsub( pattern = "doubletFinder_doublet_label_", @@ -1235,70 +1236,70 @@ plotDoubletFinderResults <- function( #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runScDblFinder}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param shape If provided, add shapes based on the value. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. A user may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{TRUE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. -#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. +#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. #' Default \code{"UMAP"}. #' @param xlab Character vector. Label for x-axis. Default \code{NULL}. #' @param ylab Character vector. Label for y-axis. Default \code{NULL}. -#' @param dim1 1st dimension to be used for plotting. Can either be a string -#' which specifies the name of the dimension to be plotted from reducedDims, or -#' a numeric value which specifies the index of the dimension to be plotted. +#' @param dim1 1st dimension to be used for plotting. Can either be a string +#' which specifies the name of the dimension to be plotted from reducedDims, or +#' a numeric value which specifies the index of the dimension to be plotted. #' Default is \code{NULL}. -#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. +#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. #' Default is \code{NULL}. -#' @param bin Numeric vector. If single value, will divide the numeric values +#' @param bin Numeric vector. If single value, will divide the numeric values #' into \code{bin} groups. If more than one value, will bin numeric values using #' values as a cut point. Default \code{NULL}. #' @param binLabel Character vector. Labels for the bins created by \code{bin}. #' Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{NULL}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. -#' @param transparency Transparency of the dots, values will be 0-1. Default +#' @param transparency Transparency of the dots, values will be 0-1. Default #' \code{1}. #' @param baseSize The base font size for all text. Default \code{12}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}, \code{legendSize}, \code{legendTitleSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param legendSize size of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{NULL}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. #' @param relHeights Relative heights of plots when combine is set. Default \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{c(1, 1, 1)}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param labelSamples Will label sample name in title of plot if TRUE. Default +#' @param labelSamples Will label sample name in title of plot if TRUE. Default #' \code{TRUE}. #' @param samplePerColumn If \code{TRUE}, when there are multiple samples and combining -#' by \code{"all"}, the output .ggplot will have plots from each sample on a +#' by \code{"all"}, the output .ggplot will have plots from each sample on a #' single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return list of .ggplot objects #' @seealso \code{\link{runScDblFinder}} @@ -1349,7 +1350,7 @@ plotScDblFinderResults <- function( if (is.null(sample)) { sample = rep(1, ncol(inSCE)) } - + if (!(reducedDimName %in% reducedDimNames(inSCE))){ stop("Specified `reducedDimName` is not found in input SingleCellExperiment object. Please check for spelling errors @@ -1357,7 +1358,7 @@ plotScDblFinderResults <- function( } coldata = "scDblFinder_doublet_score" titleScDblFinder <- "ScDblFinder Doublet Score" - + samples <- unique(sample) if (length(samples) > 1) { merged.plots <- list(Score = plotSCEViolinColData( @@ -1385,13 +1386,13 @@ plotScDblFinderResults <- function( merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list <- list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + title = paste0("Density, ", titleScDblFinder) if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) @@ -1415,7 +1416,7 @@ plotScDblFinderResults <- function( combinePlot="all" )) res.list = c(res.list, densityScore) - + title = titleScDblFinder if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) @@ -1450,7 +1451,7 @@ plotScDblFinderResults <- function( combinePlot="all" )) res.list = c(res.list, scatterScore) - + if("scDblFinder_doublet_call" %in% names(SingleCellExperiment::colData(inSCE))){ title = "scDblFinder Doublet Assignment" if(labelSamples && length(samples) > 1){ @@ -1485,7 +1486,7 @@ plotScDblFinderResults <- function( )) res.list <- c(res.list, scatterCall) } - + if(combinePlot != "all" | length(samples) == 1){ if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) @@ -1514,7 +1515,7 @@ plotScDblFinderResults <- function( )) res.list = c(res.list, violinScore) } - + return(res.list) }) if (length(unique(samples)) > 1) { @@ -1547,71 +1548,71 @@ plotScDblFinderResults <- function( #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runCxds}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param shape If provided, add shapes based on the value. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. A user may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{TRUE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. -#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. +#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. #' Default \code{"UMAP"}. #' @param xlab Character vector. Label for x-axis. Default \code{NULL}. #' @param ylab Character vector. Label for y-axis. Default \code{NULL}. -#' @param dim1 1st dimension to be used for plotting. Can either be a string -#' which specifies the name of the dimension to be plotted from reducedDims, or -#' a numeric value which specifies the index of the dimension to be plotted. +#' @param dim1 1st dimension to be used for plotting. Can either be a string +#' which specifies the name of the dimension to be plotted from reducedDims, or +#' a numeric value which specifies the index of the dimension to be plotted. #' Default is \code{NULL}. -#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. +#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. #' Default is \code{NULL}. -#' @param bin Numeric vector. If single value, will divide the numeric values +#' @param bin Numeric vector. If single value, will divide the numeric values #' into \code{bin} groups. If more than one value, will bin numeric values using #' values as a cut point. Default \code{NULL}. #' @param binLabel Character vector. Labels for the bins created by \code{bin}. #' Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{NULL}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. -#' @param transparency Transparency of the dots, values will be 0-1. Default +#' @param transparency Transparency of the dots, values will be 0-1. Default #' \code{1}. #' @param baseSize The base font size for all text. Default \code{12}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}, \code{legendSize}, \code{legendTitleSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param legendSize size of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{NULL}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{c(1, 1, 1)}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param labelSamples Will label sample name in title of plot if TRUE. Default +#' @param labelSamples Will label sample name in title of plot if TRUE. Default #' \code{TRUE}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @seealso \code{\link{runCxds}} #' @return list of .ggplot objects @@ -1663,9 +1664,9 @@ plotCxdsResults <- function( if (is.null(sample)) { sample = rep(1, ncol(inSCE)) } - + if (!(reducedDimName %in% SingleCellExperiment::reducedDimNames(inSCE))) { - stop("Specified `reducedDimName` is not found in input", + stop("Specified `reducedDimName` is not found in input", "SingleCellExperiment object. Please check for spelling errors with ", "reducedDimNames().") } @@ -1698,13 +1699,13 @@ plotCxdsResults <- function( merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list <- list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + title = "Density, CXDS Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -1731,7 +1732,7 @@ plotCxdsResults <- function( ) ) res.list = c(res.list, densityScore) - + title = "CXDS Doublet Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -1767,7 +1768,7 @@ plotCxdsResults <- function( ) ) res.list = c(res.list, scatterScore) - + if (combinePlot != "all" | length(samples) == 1) { title = "CXDS Doublet Score" if (labelSamples && length(samples) > 1) { @@ -1799,7 +1800,7 @@ plotCxdsResults <- function( ) res.list = c(res.list, violinScore) } - + if ("scds_cxds_call" %in% names(SingleCellExperiment::colData(inSCE))) { title = "CXDS Doublet Assignment" if (labelSamples && length(samples) > 1) { @@ -1826,7 +1827,7 @@ plotCxdsResults <- function( defaultTheme = defaultTheme, title = title, titleSize = titleSize, - axisSize = axisSize, + axisSize = axisSize, axisLabelSize = axisLabelSize, labelClusters = FALSE, legendTitle = "Doublet \nAssignment", @@ -1869,71 +1870,71 @@ plotCxdsResults <- function( #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runBcds}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param shape If provided, add shapes based on the value. Default \code{NULL}. #' @param groupBy Groupings for each numeric value. A user may input a vector -#' equal length to the number of the samples in \code{inSCE}, or can be +#' equal length to the number of the samples in \code{inSCE}, or can be #' retrieved from the colData slot. Default \code{NULL}. -#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default +#' @param violin Boolean. If \code{TRUE}, will plot the violin plot. Default #' \code{TRUE}. -#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin +#' @param boxplot Boolean. If \code{TRUE}, will plot boxplots for each violin #' plot. Default \code{TRUE}. #' @param dots Boolean. If \code{TRUE}, will plot dots for each violin plot. #' Default \code{TRUE}. -#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. +#' @param reducedDimName Saved dimension reduction name in \code{inSCE}. #' Default \code{"UMAP"}. #' @param xlab Character vector. Label for x-axis. Default \code{NULL}. #' @param ylab Character vector. Label for y-axis. Default \code{NULL}. -#' @param dim1 1st dimension to be used for plotting. Can either be a string -#' which specifies the name of the dimension to be plotted from reducedDims, or -#' a numeric value which specifies the index of the dimension to be plotted. +#' @param dim1 1st dimension to be used for plotting. Can either be a string +#' which specifies the name of the dimension to be plotted from reducedDims, or +#' a numeric value which specifies the index of the dimension to be plotted. #' Default is \code{NULL}. -#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. +#' @param dim2 2nd dimension to be used for plotting. Similar to \code{dim1}. #' Default is \code{NULL}. -#' @param bin Numeric vector. If single value, will divide the numeric values +#' @param bin Numeric vector. If single value, will divide the numeric values #' into \code{bin} groups. If more than one value, will bin numeric values using #' values as a cut point. Default \code{NULL}. #' @param binLabel Character vector. Labels for the bins created by \code{bin}. #' Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.5}. #' @param summary Adds a summary statistic, as well as a crossbar to the -#' violin plot. Options are \code{"mean"} or \code{"median"}. Default +#' violin plot. Options are \code{"mean"} or \code{"median"}. Default #' \code{NULL}. #' @param summaryTextSize The text size of the summary statistic displayed #' above the violin plot. Default \code{3}. -#' @param transparency Transparency of the dots, values will be 0-1. Default +#' @param transparency Transparency of the dots, values will be 0-1. Default #' \code{1}. #' @param baseSize The base font size for all text. Default \code{12}. -#' Can be overwritten by \code{titleSize}, \code{axisSize}, and +#' Can be overwritten by \code{titleSize}, \code{axisSize}, and #' \code{axisLabelSize}, \code{legendSize}, \code{legendTitleSize}. #' @param titleSize Size of title of plot. Default \code{NULL}. #' @param axisSize Size of x/y-axis ticks. Default \code{NULL}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{NULL}. #' @param legendSize size of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{NULL}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{c(1, 1, 1)}. -#' @param plotNCols Number of columns when plots are combined in a grid. Default +#' @param plotNCols Number of columns when plots are combined in a grid. Default #' \code{NULL}. -#' @param plotNRows Number of rows when plots are combined in a grid. Default +#' @param plotNRows Number of rows when plots are combined in a grid. Default #' \code{NULL}. -#' @param labelSamples Will label sample name in title of plot if TRUE. Default +#' @param labelSamples Will label sample name in title of plot if TRUE. Default #' \code{TRUE}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @seealso \code{\link{runBcds}} #' @return list of .ggplot objects @@ -1984,9 +1985,9 @@ plotBcdsResults <- function( if (is.null(sample)) { sample = rep(1, ncol(inSCE)) } - + if (!(reducedDimName %in% SingleCellExperiment::reducedDimNames(inSCE))) { - stop("Specified `reducedDimName` is not found in input", + stop("Specified `reducedDimName` is not found in input", "SingleCellExperiment object. Please check for spelling errors with ", "reducedDimNames().") } @@ -2019,13 +2020,13 @@ plotBcdsResults <- function( merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list <- list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) sampleSub <- sample[sampleInd] inSCESub <- inSCE[, sampleInd] - + title = "Density, BCDS Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -2052,7 +2053,7 @@ plotBcdsResults <- function( ) ) res.list = c(res.list, densityScore) - + title = "BCDS Doublet Score" if (labelSamples && length(samples) > 1) { title = paste0(title, ", ", x) @@ -2088,7 +2089,7 @@ plotBcdsResults <- function( ) ) res.list = c(res.list, scatterScore) - + if (combinePlot != "all" | length(samples) == 1) { title = "BCDS Doublet Score" if (labelSamples && length(samples) > 1) { @@ -2120,7 +2121,7 @@ plotBcdsResults <- function( ) res.list = c(res.list, violinScore) } - + if ("scds_bcds_call" %in% names(SummarizedExperiment::colData(inSCE))) { title = "BCDS Doublet Assignment" if (labelSamples && length(samples) > 1) { @@ -2147,7 +2148,7 @@ plotBcdsResults <- function( defaultTheme = defaultTheme, title = title, titleSize = titleSize, - axisSize = axisSize, + axisSize = axisSize, axisLabelSize = axisLabelSize, labelClusters = FALSE, legendTitle = "Doublet \nAssignment", @@ -2297,7 +2298,7 @@ plotScdsHybridResults <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + if (!(reducedDimName %in% reducedDimNames(inSCE))){ stop("Specified `reducedDimName` is not found in input SingleCellExperiment object. Please check for spelling errors @@ -2331,7 +2332,7 @@ plotScdsHybridResults <- function(inSCE, merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list <- c() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) @@ -2360,7 +2361,7 @@ plotScdsHybridResults <- function(inSCE, combinePlot="all" )) res.list = c(res.list, densityScore) - + title = "CXDS BCDS Hybrid Score" if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) @@ -2393,7 +2394,7 @@ plotScdsHybridResults <- function(inSCE, combinePlot="all" )) res.list = c(res.list, scatterScore) - + if(combinePlot != "all" | length(samples) == 1){ title = "CXDS BCDS Hybrid Score" if(labelSamples && length(samples) > 1){ @@ -2423,7 +2424,7 @@ plotScdsHybridResults <- function(inSCE, )) res.list = c(res.list, violinScore) } - + if("scds_hybrid_call" %in% names(SingleCellExperiment::colData(inSCE))){ title = "CXDS BCDS Doublet Assignment" if(labelSamples && length(samples) > 1){ @@ -2458,10 +2459,10 @@ plotScdsHybridResults <- function(inSCE, )) res.list <- c(res.list, scatterCall) } - + return(res.list) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples plotlist <- c(merged.plots, list(Sample = plotlist)) @@ -2495,7 +2496,7 @@ plotScdsHybridResults <- function(inSCE, #' @param sample Character vector. Indicates which sample each cell belongs to. #' Default NULL. #' @param bgResult Boolean. If TRUE, will plot decontX results generated with -#' raw/droplet matrix Default FALSE. +#' raw/droplet matrix Default FALSE. #' @param shape If provided, add shapes based on the value. #' @param groupBy Groupings for each numeric value. A user may input a vector #' equal length to the number of the samples in the SingleCellExperiment @@ -2606,29 +2607,29 @@ plotDecontXResults <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + if (!(reducedDimName %in% reducedDimNames(inSCE))){ stop("Specified `reducedDimName` is not found in input SingleCellExperiment object. Please check for spelling errors with reducedDimNames().") } - + scoreCol <- "decontX_contamination" clusterCol <- "decontX_clusters" - + if (!isTRUE(bgResult) & !scoreCol %in% colnames(SummarizedExperiment::colData(inSCE))) { - stop("The result of running decontX without raw/droplet matrix - is not found in the input SingleCellExperiment object. + stop("The result of running decontX without raw/droplet matrix + is not found in the input SingleCellExperiment object. Please check whether runDecontX has been run without - 'background' parameter. ") + 'background' parameter. ") } - + if (isTRUE(bgResult)) { bgColId <- grep('decontX_contamination_bg', colnames(SummarizedExperiment::colData(inSCE))) - + if (length(bgColId) == 0) { - stop("The result of running decontX with raw/droplet matrix - is not found in the input SingleCellExperiment object. + stop("The result of running decontX with raw/droplet matrix + is not found in the input SingleCellExperiment object. Please check whether runDecontX has been run with 'background' parameter. ") } else { @@ -2636,7 +2637,7 @@ plotDecontXResults <- function(inSCE, clusterCol <- "decontX_clusters_bg" } } - + samples <- unique(sample) sampleVector <- sample if (length(samples) > 1) { @@ -2665,7 +2666,7 @@ plotDecontXResults <- function(inSCE, merged.plots <- list(merged.plots) names(merged.plots) <- "Violin" } - + res.list = list() plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) @@ -2695,7 +2696,7 @@ plotDecontXResults <- function(inSCE, combinePlot="all" )) res.list = c(res.list, densityContamination) - + scatterContamination <- list(scatter_decontXContamination = plotSCEDimReduceColData( inSCE=inSCESub, sample=sampleSub, @@ -2724,7 +2725,7 @@ plotDecontXResults <- function(inSCE, combinePlot="all" )) res.list = c(res.list, scatterContamination) - + if(combinePlot != "all" | length(samples) == 1){ title = "DecontX Contamination Score" if(labelSamples && length(samples) > 1){ @@ -2753,7 +2754,7 @@ plotDecontXResults <- function(inSCE, )) res.list = c(res.list, violinContamination) } - + if(is.null(legendSize) && !is.null(baseSize)){ legendSizeScatterCluster = baseSize - 1 }else{ @@ -2763,7 +2764,7 @@ plotDecontXResults <- function(inSCE, if(labelSamples && length(samples) > 1){ title = paste0(title, ", ", x) } - + scatterCluster <- list(scatter_decontXClusters = plotSCEDimReduceColData( inSCE=inSCESub, sample=sampleSub, @@ -2793,10 +2794,10 @@ plotDecontXResults <- function(inSCE, combinePlot="all" )) res.list = c(res.list, scatterCluster) - + return(res.list) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples plotlist <- c(merged.plots, list(Sample = plotlist)) diff --git a/R/ggPlotting.R b/R/ggPlotting.R index 4b327d3a7..a5577a151 100644 --- a/R/ggPlotting.R +++ b/R/ggPlotting.R @@ -93,7 +93,7 @@ combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop( @@ -104,14 +104,14 @@ } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x){ sceSampleInd <- which(sample == x) inSCESub <- inSCE[, sceSampleInd] colorBySub <- colorBy[sceSampleInd] - + dataframe <- data.frame(SingleCellExperiment::reducedDim( inSCESub, reducedDimName @@ -133,7 +133,7 @@ warning("More than two dimensions supplied in reducedDims. Using the first two.") } - + # If xlab and ylab are specified if (!is.null(xlab) & !is.null(ylab)) { colnames(dataframe) <- c(xlab, ylab) @@ -142,10 +142,10 @@ colnames(dataframe) <- c(paste0(reducedDimName, "_1"), paste0(reducedDimName, "_2")) } - + xdim <- colnames(dataframe)[1] ydim <- colnames(dataframe)[2] - + if (!is.null(conditionClass) & !is.null(colorBySub)) { if (conditionClass %in% c("character", "factor", "numeric")) { if (conditionClass == "character") { @@ -157,7 +157,7 @@ } } } - + if (!is.null(bin) & !is.null(colorBySub)) { colorBySub <- .binSCTK( value = colorBySub, @@ -165,11 +165,11 @@ binLabel = binLabel ) } - + if (!is.null(colorBySub)) { dataframe$color <- colorBySub } - + if (!is.null(groupBy)){ dataframe$groups <- factor(SingleCellExperiment::colData(inSCE)[[groupBy]]) } @@ -207,7 +207,7 @@ }else{ g <- g + ggplot2::theme_gray(base_size = baseSize) } - + g <- g + ggplot2::theme(axis.title = ggplot2::element_text(size = axisLabelSize), axis.text = @@ -230,12 +230,12 @@ g <- g + ggplot2::labs(color = "") + ggplot2::theme(legend.text=ggplot2::element_text(size=legendSize)) } - + if (!is.null(groupBy)){ g <- g + ggplot2::facet_wrap(~groups) } - - + + if (isTRUE(labelClusters) && class(colorBySub) %in% c("character", "factor")) { centroidList <- lapply(unique(colorBySub), function(x) { dataframe.sub <- dataframe[dataframe$color == x, ] @@ -250,15 +250,15 @@ color = centroid[, 3], Sample = rep(1, length(unique(colorBySub))) ) - + if (!is.null(shape)) { centroid$shape <- dataframe$shape[1] } - + if (!is.null(groupBy)){ g <- g + ggplot2::facet_wrap(~groups) } - + colnames(centroid)[seq_len(2)] <- c(xdim, ydim) g <- g + ggplot2::geom_point( data = centroid, @@ -276,12 +276,12 @@ } return(g) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples plotlist <- list(Sample = plotlist) } - + ##Needs to be turned off for Shiny User Interface if(combinePlot %in% c("all", "sample")){ figNcol = NULL @@ -297,7 +297,7 @@ }else if(combinePlot == "none" && length(plotlist) == 1){ plotlist <- plotlist[[1]] } - + return(plotlist) } #' @title Dimension reduction plot tool for colData @@ -411,9 +411,9 @@ plotSCEDimReduceColData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + colorPlot <- SingleCellExperiment::colData(inSCE)[, colorBy] - + g <- .ggScatter( inSCE = inSCE, sample = sample, @@ -543,65 +543,65 @@ plotSCEDimReduceFeatures <- function(inSCE, groupBy = NULL, combinePlot = "none", plotLabels = NULL) { - combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - - if(!is.null(featureDisplay)){ - featureDisplay <- match.arg(featureDisplay, - c("rownames", - colnames(SummarizedExperiment::rowData(inSCE))) + combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) + + if(!is.null(featureDisplay)){ + featureDisplay <- match.arg(featureDisplay, + c("rownames", + colnames(SummarizedExperiment::rowData(inSCE))) + ) + }else{ + if(exists(x = "featureDisplay", inSCE@metadata)){ + featureDisplay <- inSCE@metadata$featureDisplay + } + } + + mat <- getBiomarker( + inSCE = inSCE, + useAssay = useAssay, + gene = feature, + binary = "Continuous", + featureLocation = featureLocation, + featureDisplay = featureDisplay ) - }else{ - if(exists(x = "featureDisplay", inSCE@metadata)){ - featureDisplay <- inSCE@metadata$featureDisplay + counts <- mat[, 2] + + if(!is.null(featureDisplay)){ + title = utils::tail(colnames(mat),1) } - } - - mat <- getBiomarker( - inSCE = inSCE, - useAssay = useAssay, - gene = feature, - binary = "Continuous", - featureLocation = featureLocation, - featureDisplay = featureDisplay - ) - counts <- mat[, 2] - - if(!is.null(featureDisplay)){ - title = utils::tail(colnames(mat),1) - } - - g <- .ggScatter( - inSCE = inSCE, - sample = sample, - conditionClass = "numeric", - colorBy = counts, - shape = shape, - transparency = 1, - colorLow = colorLow, - colorMid = colorMid, - colorHigh = colorHigh, - reducedDimName = reducedDimName, - xlab = xlab, - ylab = ylab, - axisSize = axisSize, - axisLabelSize = axisLabelSize, - dim1 = dim1, - dim2 = dim2, - bin = bin, - binLabel = binLabel, - defaultTheme = defaultTheme, - dotSize = dotSize, - title = title, - titleSize = titleSize, - legendTitle = legendTitle, - legendTitleSize = legendTitleSize, - legendSize = legendSize, - groupBy = groupBy, - combinePlot = combinePlot, - plotLabels = plotLabels - ) - - return(g) + + g <- .ggScatter( + inSCE = inSCE, + sample = sample, + conditionClass = "numeric", + colorBy = counts, + shape = shape, + transparency = 1, + colorLow = colorLow, + colorMid = colorMid, + colorHigh = colorHigh, + reducedDimName = reducedDimName, + xlab = xlab, + ylab = ylab, + axisSize = axisSize, + axisLabelSize = axisLabelSize, + dim1 = dim1, + dim2 = dim2, + bin = bin, + binLabel = binLabel, + defaultTheme = defaultTheme, + dotSize = dotSize, + title = title, + titleSize = titleSize, + legendTitle = legendTitle, + legendTitleSize = legendTitleSize, + legendSize = legendSize, + groupBy = groupBy, + combinePlot = combinePlot, + plotLabels = plotLabels + ) + + return(g) } #' @title Dimension reduction plot tool for all types of data @@ -701,7 +701,7 @@ plotSCEScatter <- function(inSCE, combinePlot = "none", plotLabels = NULL){ combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!is.null(slot)){ if (slot == "reducedDims"){ annotation_clm <- substr(annotation, stringr::str_length(annotation), stringr::str_length(annotation)) @@ -711,16 +711,16 @@ plotSCEScatter <- function(inSCE, "Please run 'methods::slotNames' if you are unsure the", "specified slot exists.") } - + sceSubset <- do.call(slot, args = list(inSCE)) - + if (!annotation %in% names(sceSubset)) { stop("'annotation' must be an annotation stored within the specified slot of the SingleCellExperiment object.") } annotation.ix <- match(annotation, c(names(sceSubset))) } - + if (is.null(slot)){ colorPlot <- NULL }else if (slot == "assays" && !is.null(feature)) { @@ -735,7 +735,7 @@ plotSCEScatter <- function(inSCE, } else if (slot == "reducedDims") { colorPlot <- sceSubset[[annotation.ix]][, as.numeric(annotation_clm)] } - + g <- .ggScatter( inSCE = inSCE, sample = sample, @@ -852,9 +852,9 @@ plotSCEScatter <- function(inSCE, vcolor = "red", vsize = 1, vlinetype = 1) { - + mult_modules <- FALSE - + if (is.null(groupBy)) { if (length(colnames(y)) > 1){ mult_modules <- TRUE @@ -864,7 +864,7 @@ plotSCEScatter <- function(inSCE, groupBy <- rep("Sample", length(y)) } } - + if(!is.factor(groupBy)){ if(is.null(plotOrder)){ plotOrder = unique(groupBy) @@ -875,9 +875,9 @@ plotSCEScatter <- function(inSCE, groupBy <- factor(groupBy, levels = plotOrder) } } - + df <- data.frame(groupBy = groupBy, y = y) - + p <- ggplot2::ggplot(df) + ggplot2::aes_string( x = "groupBy", @@ -915,9 +915,9 @@ plotSCEScatter <- function(inSCE, size = titleSize )) } - + p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = axisSize)) - + if(length(unique(df$groupBy)) > 1){ p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1, @@ -927,11 +927,11 @@ plotSCEScatter <- function(inSCE, axis.ticks.x = ggplot2::element_blank(), axis.title.x = ggplot2::element_blank()) } - + if (mult_modules){ p <- p + xlab("Modules") } - + if (gridLine == TRUE){ p <- p + ggplot2::theme(panel.grid.major.y = ggplot2::element_line("grey")) } @@ -956,7 +956,7 @@ plotSCEScatter <- function(inSCE, summ$statY <- max(df$y) + (max(df$y) - min(df$y)) * 0.05 summary <- paste(toupper(substr(summary, 1, 1)), substr(summary, 2, nchar(summary)), sep="") - + ##Truncate label of mean/median if too many sample types if(length(levels(groupBy)) > 5){ if(all(summ$value>1)){ @@ -972,11 +972,11 @@ plotSCEScatter <- function(inSCE, summ$label <- paste0(summary,": ", signif(summ$value, 2)) } } - + if(!is.null(groupBy)){ summaryTextSize = summaryTextSize/length(levels(groupBy)) + 2 } - + p <- p + ggplot2::geom_text(data = summ, size = summaryTextSize, ggplot2::aes_string(x = "groupBy", y = "statY", @@ -997,7 +997,7 @@ plotSCEScatter <- function(inSCE, p <- .ggAddLine(p, vcutoff = vcutoff, vcolor = vcolor, vsize = vsize, vlinetype = vlinetype) } - + return(p) } @@ -1098,7 +1098,7 @@ plotSCEViolinColData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!is.null(coldata)) { if (!coldata %in% names(SummarizedExperiment::colData(inSCE))) { p <- paste(coldata) @@ -1108,7 +1108,7 @@ plotSCEViolinColData <- function(inSCE, } else { stop("You must define the desired colData to plot.") } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(coldata)) { @@ -1124,7 +1124,7 @@ plotSCEViolinColData <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop("'sample' must be the same length as the number", @@ -1133,7 +1133,7 @@ plotSCEViolinColData <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) @@ -1143,11 +1143,11 @@ plotSCEViolinColData <- function(inSCE, }else{ groupbySub <- NULL } - + if(!is.null(title) && length(samples) > 1){ title = paste(title, x, sep = ", ") } - + p <- .ggViolin( y = coldataSub, groupBy = groupbySub, @@ -1180,7 +1180,7 @@ plotSCEViolinColData <- function(inSCE, } return(p) }) - + ##Needs to be turned off for Shiny User Interface if(combinePlot %in% c("all", "sample")){ figNcol = NULL @@ -1196,7 +1196,7 @@ plotSCEViolinColData <- function(inSCE, }else if(combinePlot == "none" && length(plotlist) == 1){ plotlist <- plotlist[[1]] } - + return(plotlist) } @@ -1299,7 +1299,7 @@ plotSCEViolinAssayData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if(!is.null(featureDisplay)){ featureDisplay <- match.arg(featureDisplay, colnames(SummarizedExperiment::rowData(inSCE))) @@ -1308,7 +1308,7 @@ plotSCEViolinAssayData <- function(inSCE, featureDisplay <- inSCE@metadata$featureDisplay } } - + mat <- getBiomarker( inSCE = inSCE, useAssay = useAssay, @@ -1317,7 +1317,7 @@ plotSCEViolinAssayData <- function(inSCE, gene = feature, binary = "Continuous" ) - + counts <- mat[, 2] if (!is.null(groupBy)) { if (length(groupBy) > 1) { @@ -1348,9 +1348,9 @@ plotSCEViolinAssayData <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) countSub <- counts[sampleInd] @@ -1359,7 +1359,7 @@ plotSCEViolinAssayData <- function(inSCE, }else{ groupbySub <- NULL } - + p <- .ggViolin( y = countSub, groupBy = groupbySub, @@ -1390,7 +1390,7 @@ plotSCEViolinAssayData <- function(inSCE, } return(p) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples if(combinePlot == "sample"){ @@ -1414,7 +1414,7 @@ plotSCEViolinAssayData <- function(inSCE, }else if(combinePlot == "none" && length(plotlist) == 1){ plotlist <- plotlist[[1]] } - + return(plotlist) } @@ -1519,22 +1519,22 @@ plotSCEViolin <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!slotName %in% c("rowData", "colData", "assays", "metadata", "reducedDims")) { stop("'slotName' must be a slotName within the SingleCellExperiment object.", "Please run 'methods::slot' if you are unsure the", "specified slotName exists.") } - + sceSubset <- do.call(slotName, args = list(inSCE)) - + if (!itemName %in% names(sceSubset)) { stop("'itemName' must be an itemName stored within the specified slotName of the SingleCellExperiment object.") } - + itemName.ix <- match(itemName, names(sceSubset)) - + if (slotName == "assays" && !is.null(feature)) { counts <- sceSubset[[itemName.ix]] if (feature %in% rownames(counts)) { @@ -1552,7 +1552,7 @@ plotSCEViolin <- function(inSCE, } counts <- sceSubset[[itemName.ix]][,dimension] } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(counts)) { @@ -1568,7 +1568,7 @@ plotSCEViolin <- function(inSCE, groupBy <- SummarizedExperiment::colData(inSCE)[, groupBy] } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop("'sample' must be the same length as the number", @@ -1620,7 +1620,7 @@ plotSCEViolin <- function(inSCE, } return(p) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples if(!is.null(combinePlot)){ @@ -1632,7 +1632,7 @@ plotSCEViolin <- function(inSCE, plotlist <- plotlist[[1]] # plotlist <- unlist(plotlist, recursive=F) } - + ##Needs to be turned off for Shiny User Interface if(combinePlot %in% c("all", "sample") && length(unique(samples)) > 1){ @@ -1692,22 +1692,22 @@ plotSCEViolin <- function(inSCE, } groupBy <- factor(groupBy, levels = unique(groupBy)) df <- data.frame(x = groupBy, y = value) - + p <- ggplot2::ggplot(df, ggplot2::aes_string(x = value)) + ggplot2::geom_density() + ggplot2::facet_grid(. ~ x) - + if (defaultTheme == TRUE) { p <- .ggSCTKTheme(p, baseSize, groupBy, combinePlot) + ggplot2::theme(strip.background = ggplot2::element_blank()) }else{ p <- p + ggplot2::theme_gray(base_size = baseSize) } - + if (all(unique(groupBy) == "Sample")) { p <- p + ggplot2::theme(strip.text.x = ggplot2::element_blank()) } - + if (!is.null(title)) { p <- p + ggplot2::ggtitle(label = title) + ggplot2::theme(plot.title = ggplot2::element_text( @@ -1715,22 +1715,22 @@ plotSCEViolin <- function(inSCE, size = titleSize )) } - + if (!is.null(xlab)) { p <- p + ggplot2::xlab(xlab) + ggplot2::theme(axis.title.x = ggplot2::element_text(size = axisLabelSize)) } - + if (!is.null(ylab)) { p <- p + ggplot2::ylab(ylab) + ggplot2::theme(axis.title.y = ggplot2::element_text(size = axisLabelSize)) } p <- p + ggplot2::theme(axis.text = ggplot2::element_text(size = axisSize)) - + if (!is.null(cutoff)) { p <- p + ggplot2::geom_vline(xintercept = cutoff, color = "red") } - + return(p) } @@ -1785,7 +1785,7 @@ plotSCEDensityColData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!is.null(coldata)) { if (!coldata %in% names(SummarizedExperiment::colData(inSCE))) { p <- paste(coldata) @@ -1795,7 +1795,7 @@ plotSCEDensityColData <- function(inSCE, } else { stop("You must define the desired colData to plot.") } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(coldata)) { @@ -1811,7 +1811,7 @@ plotSCEDensityColData <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop( @@ -1822,9 +1822,9 @@ plotSCEDensityColData <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) coldataSub <- coldata[sampleInd] @@ -1833,7 +1833,7 @@ plotSCEDensityColData <- function(inSCE, } else { groupbySub <- NULL } - + if (!is.null(title) && length(samples) > 1) { title <- paste(title, x, sep = ", ") } @@ -1866,7 +1866,7 @@ plotSCEDensityColData <- function(inSCE, ncols = figNcol, labels = plotLabels) } - + return(plotlist) } @@ -1925,7 +1925,7 @@ plotSCEDensityAssayData <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if(!is.null(featureDisplay)){ featureDisplay <- match.arg(featureDisplay, colnames(SummarizedExperiment::rowData(inSCE))) @@ -1934,7 +1934,7 @@ plotSCEDensityAssayData <- function(inSCE, featureDisplay <- inSCE@metadata$featureDisplay } } - + mat <- getBiomarker( inSCE = inSCE, useAssay = useAssay, @@ -1944,14 +1944,14 @@ plotSCEDensityAssayData <- function(inSCE, featureDisplay = featureDisplay ) counts <- mat[, 2] - + if(!is.null(featureDisplay)){ title = utils::tail(colnames(mat),1) } if(is.null(xlab)){ xlab = "Expression" } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(counts)) { @@ -1967,7 +1967,7 @@ plotSCEDensityAssayData <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop( @@ -1978,9 +1978,9 @@ plotSCEDensityAssayData <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) countsSub <- counts[sampleInd] @@ -1989,11 +1989,11 @@ plotSCEDensityAssayData <- function(inSCE, } else { groupbySub <- NULL } - + if (!is.null(title) && length(samples) > 1) { title <- paste(title, x, sep = "_") } - + p <- .ggDensity( value = countsSub, groupBy = groupbySub, @@ -2008,7 +2008,7 @@ plotSCEDensityAssayData <- function(inSCE, ) return(p) }) - + ##Needs to be turned off for Shiny User Interface if(combinePlot %in% c("all", "sample")){ figNcol = NULL @@ -2083,22 +2083,22 @@ plotSCEDensity <- function(inSCE, combinePlot = "none", plotLabels = NULL) { combinePlot <- match.arg(combinePlot,c("all", "sample", "none")) - + if (!slotName %in% c("rowData", "colData", "assays", "metadata", "reducedDims")) { stop("'slotName' must be a slotName within the SingleCellExperiment object.", "Please run 'methods::slotNames' if you are unsure the", "specified slot exists.") } - + sceSubset <- do.call(slotName, args = list(inSCE)) - + if (!itemName %in% names(sceSubset)) { stop("'itemName' must be an itemName stored within the specified slot of the SingleCellExperiment object.") } - + itemName.ix <- match(itemName, names(sceSubset)) - + if (slotName == "assays" && !is.null(feature)) { counts <- sceSubset[[itemName.ix]] if (feature %in% rownames(counts)) { @@ -2116,7 +2116,7 @@ plotSCEDensity <- function(inSCE, } counts <- sceSubset[[itemName.ix]][,dimension] } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(counts)) { @@ -2132,7 +2132,7 @@ plotSCEDensity <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop( @@ -2143,9 +2143,9 @@ plotSCEDensity <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x) { sampleInd <- which(sample == x) countsSub <- counts[sampleInd] @@ -2154,11 +2154,11 @@ plotSCEDensity <- function(inSCE, } else { groupbySub <- NULL } - + if (!is.null(title) && length(samples) > 1) { title <- paste(title, x, sep = "_") } - + p <- .ggDensity( value = countsSub, groupBy = groupbySub, @@ -2175,7 +2175,7 @@ plotSCEDensity <- function(inSCE, if(!is.null(feature)){ names(plotlist) <- feature } - + ##Needs to be turned off for Shiny User Interface if(combinePlot %in% c("all", "sample")){ figNcol = NULL @@ -2191,23 +2191,23 @@ plotSCEDensity <- function(inSCE, }else if(combinePlot == "none" && length(plotlist) == 1){ plotlist <- plotlist[[1]] } - + return(plotlist) } #' @title Plots for runEmptyDrops outputs. #' @description A plotting function which visualizes outputs from the -#' \code{\link{runEmptyDrops}} function stored in the colData slot of the +#' \code{\link{runEmptyDrops}} function stored in the colData slot of the #' \linkS4class{SingleCellExperiment} object via scatter plots. #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runEmptyDrops}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. #' @param fdrCutoff Numeric. Thresholds barcodes based on the FDR values from -#' \code{\link{runEmptyDrops}} as "Empty Droplet" or "Putative Cell". Default +#' \code{\link{runEmptyDrops}} as "Empty Droplet" or "Putative Cell". Default #' \code{0.01}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.1}. #' @param title Title of plot. Default \code{NULL}. @@ -2219,20 +2219,20 @@ plotSCEDensity <- function(inSCE, #' @param legendTitle Title of legend. Default \code{NULL}. #' @param legendTitleSize size of legend title. Default \code{12}. #' @param legendSize size of legend. Default \code{10}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param relHeights Relative heights of plots when combine is set. Default +#' @param relHeights Relative heights of plots when combine is set. Default #' \code{1}. -#' @param relWidths Relative widths of plots when combine is set. Default +#' @param relWidths Relative widths of plots when combine is set. Default #' \code{1}. -#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and -#' combining by \code{"all"}, the output .ggplot will have plots from each +#' @param samplePerColumn If \code{TRUE}, when there are multiple samples and +#' combining by \code{"all"}, the output .ggplot will have plots from each #' sample on a single column. Default \code{TRUE}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. #' @return a ggplot object of the scatter plot. #' @seealso \code{\link{runEmptyDrops}}, \code{\link{plotEmptyDropsResults}} @@ -2266,9 +2266,9 @@ plotEmptyDropsScatter <- function(inSCE, if (is.null(sample)) { sample = rep(1, ncol(inSCE)) } - + samples <- unique(sample) - + plotlist <- lapply(samples, function(x) { sceSampleInd <- which(sample == x) inSCESub <- inSCE[, sceSampleInd] @@ -2281,22 +2281,22 @@ plotEmptyDropsScatter <- function(inSCE, return("Empty Droplet") } } - + })) - + df <- data.frame(x = inSCESub$dropletUtils_emptyDrops_total, y = -(inSCESub$dropletUtils_emptyDrops_logprob), isCell = isCell) - + p <- ggplot2::ggplot(df, ggplot2::aes_string("x", "y", color = "isCell")) + ggplot2::geom_point(size = dotSize) + ggplot2::guides(colour = ggplot2::guide_legend(override.aes = list(size = 2))) + ggplot2::scale_color_manual(values = c("gray", "red")) - + if (defaultTheme == TRUE) { p <- .ggSCTKTheme(p) } - + if (!is.null(title)) { if (length(samples) > 1) { title = paste(title, x, sep = "_") @@ -2327,14 +2327,14 @@ plotEmptyDropsScatter <- function(inSCE, } return(p) }) - + if (length(unique(samples)) > 1) { names(plotlist) <- samples plotlist <- list(Sample = plotlist) } else { plotlist <- plotlist[[1]] } - + ##Needs to be turned off for Shiny User Interface if (!combinePlot == "none") { if (combinePlot == "all" && length(unique(samples)) > 1) { @@ -2344,7 +2344,7 @@ plotEmptyDropsScatter <- function(inSCE, vjust = 0, rel_heights = sampleRelHeights, rel_widths = sampleRelWidths)) - + } else { return(plotlist) } @@ -2360,9 +2360,9 @@ plotEmptyDropsScatter <- function(inSCE, #' @param inSCE Input \linkS4class{SingleCellExperiment} object with saved #' dimension reduction components or a variable with saved results from #' \code{\link{runBarcodeRankDrops}}. Required. -#' @param sample Character vector or colData variable name. Indicates which +#' @param sample Character vector or colData variable name. Indicates which #' sample each cell belongs to. Default \code{NULL}. -#' @param defaultTheme Removes grid in plot and sets axis title size to +#' @param defaultTheme Removes grid in plot and sets axis title size to #' \code{10} when \code{TRUE}. Default \code{TRUE}. #' @param dotSize Size of dots. Default \code{0.1}. #' @param title Title of plot. Default \code{NULL}. @@ -2372,15 +2372,15 @@ plotEmptyDropsScatter <- function(inSCE, #' @param axisSize Size of x/y-axis ticks. Default \code{12}. #' @param axisLabelSize Size of x/y-axis labels. Default \code{15}. #' @param legendSize size of legend. Default \code{10}. -#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or -#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot -#' object, while \code{"sample"} will output a list of plots separated by +#' @param combinePlot Must be either \code{"all"}, \code{"sample"}, or +#' \code{"none"}. \code{"all"} will combine all plots into a single .ggplot +#' object, while \code{"sample"} will output a list of plots separated by #' sample. Default \code{"all"}. -#' @param sampleRelHeights If there are multiple samples and combining by +#' @param sampleRelHeights If there are multiple samples and combining by #' \code{"all"}, the relative heights for each plot. Default \code{1}. -#' @param sampleRelWidths If there are multiple samples and combining by +#' @param sampleRelWidths If there are multiple samples and combining by #' \code{"all"}, the relative widths for each plot. Default \code{1}. -#' @seealso \code{\link{plotBarcodeRankDropsResults}}, +#' @seealso \code{\link{plotBarcodeRankDropsResults}}, #' \code{\link{runBarcodeRankDrops}} #' @return a ggplot object of the scatter plot. #' @examples @@ -2406,34 +2406,34 @@ plotBarcodeRankScatter <- function(inSCE, if (is.null(sample)) { sample = rep("all_cells", ncol(inSCE)) } - + samples <- unique(sample) meta <- S4Vectors::metadata(inSCE)$sctk$runBarcodeRankDrops plotlist <- lapply(samples, function(x){ - + sampleMeta <- meta[[x]]$metaOutput knee <- sampleMeta$dropletUtils_barcodeRank_knee inflection <- sampleMeta$dropletUtils_barcodeRank_inflection df <- data.frame(rank = sampleMeta$dropletUtils_barcodeRank_rank, umi = sampleMeta$dropletUtils_barcodeRank_total) - - + + p <- ggplot2::ggplot(df, ggplot2::aes_string(x = "rank", y = "umi")) + ggplot2::geom_point(size = dotSize, shape = 20) + ggplot2::scale_x_log10() + ggplot2::scale_y_log10() - - p <- p + - ggplot2::geom_hline(ggplot2::aes(yintercept = knee, linetype = "Knee"), + + p <- p + + ggplot2::geom_hline(ggplot2::aes(yintercept = knee, linetype = "Knee"), colour = 'red') + - ggplot2::geom_hline(ggplot2::aes(yintercept = inflection, - linetype = "Inflection"), + ggplot2::geom_hline(ggplot2::aes(yintercept = inflection, + linetype = "Inflection"), colour = 'blue') + ggplot2::scale_linetype_manual( name = "", values = c(2, 2), guide = ggplot2::guide_legend(label.theme = ggplot2::element_text(size = legendSize), override.aes = list(color = c("blue", "red")))) - + if (isTRUE(defaultTheme)) { p <- .ggSCTKTheme(p) } @@ -2453,7 +2453,7 @@ plotBarcodeRankScatter <- function(inSCE, ggplot2::theme(axis.title.x = ggplot2::element_text(size = axisLabelSize), axis.text.x = ggplot2::element_text(size = axisSize)) } - + if (!is.null(ylab)) { p <- p + ggplot2::ylab(ylab) + ggplot2::theme(axis.title.y = ggplot2::element_text(size = axisLabelSize), @@ -2471,7 +2471,7 @@ plotBarcodeRankScatter <- function(inSCE, } else { plotlist <- plotlist[[1]] } - + ##Needs to be turned off for Shiny User Interface if (!combinePlot == "none") { if (combinePlot %in% c("all") && length(unique(sample)) > 1) { @@ -2529,17 +2529,17 @@ plotBarcodeRankScatter <- function(inSCE, if (is.null(groupBy)) { groupBy <- rep("Sample", length(y)) } - + df <- data.frame(x = groupBy, y = y) - + p <- ggplot2::ggplot(df) + ggplot2::aes_string( x = "groupBy", y = "y" ) - + p <- p + ggplot2::geom_bar(stat = "identity") - + if (defaultTheme == TRUE) { p <- .ggSCTKTheme(p) } @@ -2550,11 +2550,11 @@ plotBarcodeRankScatter <- function(inSCE, size = titleSize )) } - + ### p <- p + ggplot2::theme(axis.text.y = ggplot2::element_text(size = axisSize)) ### - + if(length(unique(df$groupBy)) > 1){ p <- p + ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1, @@ -2564,7 +2564,7 @@ plotBarcodeRankScatter <- function(inSCE, axis.ticks.x = ggplot2::element_blank(), axis.title.x = ggplot2::element_blank()) } - + if (gridLine == TRUE){ p <- p + ggplot2::theme(panel.grid.major.y = ggplot2::element_line("grey")) } @@ -2590,7 +2590,7 @@ plotBarcodeRankScatter <- function(inSCE, summary <- paste(toupper(substr(summary, 1, 1)), substr(summary, 2, nchar(summary)), sep="") summ$label <- paste0(summary,": ", round(summ$value, 5)) - + p <- p + ggrepel::geom_text_repel(data = summ, ggplot2::aes_string(x = "groupBy", y = "statY", @@ -2602,7 +2602,7 @@ plotBarcodeRankScatter <- function(inSCE, color = "red", linetype = "dashed") } - + return(p) } @@ -2671,7 +2671,7 @@ plotSCEBarColData <- function(inSCE, } else { stop("You must define the desired colData to plot.") } - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(coldata)) { @@ -2687,7 +2687,7 @@ plotSCEBarColData <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + if (!is.null(sample)) { if (length(sample) != ncol(inSCE)) { stop("'sample' must be the same length as the number", @@ -2696,7 +2696,7 @@ plotSCEBarColData <- function(inSCE, } else { sample <- rep(1, ncol(inSCE)) } - + p <- .ggBar( y = coldata, groupBy = groupBy, @@ -2710,7 +2710,7 @@ plotSCEBarColData <- function(inSCE, title = title, titleSize = titleSize ) - + return(p) } @@ -2781,7 +2781,7 @@ plotSCEBarAssayData <- function(inSCE, featureDisplay <- inSCE@metadata$featureDisplay } } - + mat <- getBiomarker( inSCE = inSCE, useAssay = useAssay, @@ -2791,7 +2791,7 @@ plotSCEBarAssayData <- function(inSCE, featureDisplay = featureDisplay ) counts <- mat[, 2] - + if (!is.null(groupBy)) { if (length(groupBy) > 1) { if (length(groupBy) != length(counts)) { @@ -2807,7 +2807,7 @@ plotSCEBarAssayData <- function(inSCE, groupBy <- as.character(SummarizedExperiment::colData(inSCE)[, groupBy]) } } - + p <- .ggBar( y = counts, groupBy = groupBy, @@ -2821,7 +2821,7 @@ plotSCEBarAssayData <- function(inSCE, title = title, titleSize = titleSize ) - + return(p) } @@ -2873,13 +2873,13 @@ setSCTKDisplayRow <- function(inSCE, samplePerColumn = TRUE, sampleRelHeights = 1, sampleRelWidths = 1) { - + if ("Violin" %in% names(plotlist)) { plotlistViolin <- plotlist$Violin } else { plotlistViolin <- NULL } - + if ("Sample" %in% names(plotlist)) { plotlistSample <- plotlist$Sample if (samplePerColumn) { @@ -2906,7 +2906,7 @@ setSCTKDisplayRow <- function(inSCE, }else{ plotlistSample <- NULL } - + if(!is.null(plotlistViolin) | !is.null(plotlistSample)){ plotlist <- c(plotlistViolin, plotlistSample) } @@ -2914,7 +2914,7 @@ setSCTKDisplayRow <- function(inSCE, if (is.null(ncols) && is.null(nrows)) { ncols <- round(sqrt(length(plotlist))) } - + if (combinePlot == "all") { plotRes <- cowplot::plot_grid( plotlist = plotlist, @@ -2923,7 +2923,7 @@ setSCTKDisplayRow <- function(inSCE, rel_heights = relHeights, rel_widths = relWidths ) - + return(plotRes) } else if (combinePlot == "sample") { #Will happen if "sample" is chosen and multiple samples exist, @@ -2952,7 +2952,7 @@ setSCTKDisplayRow <- function(inSCE, } .ggSCTKTheme <- function(gg, baseSize = 12, groupBy = NULL, combinePlot = "none") { - + scaleFactor <- .ggSetScaleFactor(groupBy = groupBy, combinePlot = combinePlot) return(gg + ggplot2::theme_bw(base_size = baseSize * scaleFactor) + diff --git a/R/htmlReports.R b/R/htmlReports.R index e767e244e..6470fb286 100644 --- a/R/htmlReports.R +++ b/R/htmlReports.R @@ -40,6 +40,7 @@ reportDropletQC <- function(inSCE, output_file = NULL, #' @description A function to generate .html Rmarkdown report containing the visualizations of the runCellQC function output #' @param inSCE A \link[SingleCellExperiment]{SingleCellExperiment} object containing #' the filtered count matrix with the output from runCellQC function +#' @param sample Character. The name of the saved column from the colData indicating the sample grouping variable. Default is "sample" #' @param useReducedDim Character. The name of the saved dimension reduction slot including cells #' from all samples in then\linkS4class{SingleCellExperiment} object, Default is NULL #' @param subTitle subtitle of the QC HTML report. Default is NULL. @@ -55,7 +56,8 @@ reportDropletQC <- function(inSCE, output_file = NULL, #' reportCellQC(inSCE = sce) #' } #' @export -reportCellQC <- function(inSCE, output_file = NULL, +reportCellQC <- function(inSCE, sample = "sample", + output_file = NULL, output_dir = NULL, subTitle = NULL, studyDesign = NULL, @@ -67,7 +69,7 @@ reportCellQC <- function(inSCE, output_file = NULL, #file.copy(system.file("rmarkdown/qc/CellQC.Rmd", package = "singleCellTK"), report_path, overwrite = TRUE) rmarkdown::render(system.file("rmarkdown/qc/CellQC.Rmd", package = "singleCellTK"), - params = list(object = inSCE, subTitle = subTitle, studyDesign = studyDesign, + params = list(object = inSCE, sample = sample, subTitle = subTitle, studyDesign = studyDesign, reducedDimName = useReducedDim), output_file = output_file, output_dir = output_dir, diff --git a/R/seuratFunctions.R b/R/seuratFunctions.R index ab2057e74..285f7d8a6 100644 --- a/R/seuratFunctions.R +++ b/R/seuratFunctions.R @@ -36,7 +36,7 @@ #' in inSCE\@\metadata$seurat$obj #' @return the Seurat object if it exists #' @noRd -.getSeuratObject <- function(inSCE) { +.getSeuratObject <- function(inSCE) { return(metadata(inSCE)$seurat$obj) } @@ -52,35 +52,35 @@ #' @noRd .addSeuratToMetaDataSCE <- function(inSCE, seuratObject) { seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + if(seurat.version >= 5.0){ - + seuratObject@assays$RNA@layers$counts <- methods::new("dgCMatrix") seuratObject@assays$RNA@layers$data <- methods::new("dgCMatrix") seuratObject@assays$RNA@layers$scale.data <- methods::new("dgCMatrix") inSCE@metadata$seurat$obj <- seuratObject - + # add var features if exists #if (!is.null(Seurat::VariableFeatures(seuratObject)) && length(Seurat::VariableFeatures(seuratObject)) > 0) { # inSCE@metadata$seurat$obj@assays$RNA$"var.features" <- # Seurat::VariableFeatures(object = seuratObject) #} - + #inSCE@metadata$seurat$obj@assays$RNA@layers$counts <- methods::new("dgCMatrix") #inSCE@metadata$seurat$obj@assays$RNA@layers$data <- methods::new("dgCMatrix") #inSCE@metadata$seurat$obj@assays$RNA@layers$scale.data <- matrix() - + # Determine if slot is called "meta.data" or "meta.features" if("meta.data" %in% methods::slotNames(seuratObject@assays$RNA)) { - inSCE@metadata$seurat$obj@assays$RNA@meta.data <- seuratObject@assays$RNA@meta.data + inSCE@metadata$seurat$obj@assays$RNA@meta.data <- seuratObject@assays$RNA@meta.data } else if ("meta.features" %in% methods::slotNames(seuratObject@assays$RNA)) { inSCE@metadata$seurat$obj@assays$RNA@meta.features <- seuratObject@assays$RNA@meta.features } - + inSCE@metadata$seurat$obj@meta.data <- seuratObject@meta.data - + inSCE@metadata$seurat$obj@commands <- seuratObject@commands - + inSCE@metadata$seurat$obj@reductions$pca <- seuratObject@reductions$pca inSCE@metadata$seurat$obj@reductions$ica <- seuratObject@reductions$ica inSCE@metadata$seurat$obj@reductions$tsne <- seuratObject@reductions$tsne @@ -93,7 +93,7 @@ seuratObject@assays$RNA@scale.data <- matrix() inSCE@metadata$seurat$obj <- seuratObject } - + return(inSCE) } @@ -275,10 +275,10 @@ runSeuratFindHVG <- function(inSCE, seuratObject <- convertSCEToSeurat(inSCE, normAssay = useAssay) } } - + # Get version number of object seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + seuratObject <- Seurat::FindVariableFeatures( seuratObject, selection.method = method, @@ -378,14 +378,14 @@ runSeuratFindHVG <- function(inSCE, } else if (method == "mean.var.plot") { if(seurat.version >= 5.0){ - cn <- colnames(seuratObject@assays$RNA@meta.data) + cn <- colnames(seuratObject@assays$RNA@meta.data) rowData(inSCE)$seurat_variableFeatures_mvp_dispersion <- unlist(seuratObject@assays$RNA@meta.data["vf_vst_counts_variance.standardized"]) rowData(inSCE)$seurat_variableFeatures_mvp_dispersionScaled <- unlist(seuratObject@assays$RNA@meta.data["vf_vst_counts_variance.standardized"]) rowData(inSCE)$seurat_variableFeatures_mvp_mean <- unlist(seuratObject@assays$RNA@meta.data["vf_vst_counts_variance.standardized"]) - rowData(inSCE)[,cn] <- seuratObject@assays$RNA@meta.data + rowData(inSCE)[,cn] <- seuratObject@assays$RNA@meta.data } else{ cn <- colnames(seuratObject@assays$RNA@meta.features) @@ -409,7 +409,7 @@ runSeuratFindHVG <- function(inSCE, } # create a feature subset - if(!is.null(createFeatureSubset)){ + if(!is.null(createFeatureSubset)){ inSCE <- setTopHVG(inSCE = inSCE, method = method, hvgNumber = hvgNumber, @@ -564,7 +564,7 @@ runSeuratICA <- verbose = FALSE) { params <- as.list(environment()) params$inSCE <- NULL - + if (!isTRUE(scale)) { # If not doing a scaling, put useAssay as scaled as RunPCA need it seuratObject <- @@ -904,10 +904,10 @@ runSeuratFindClusters <- function(inSCE, seuratObject <- convertSCEToSeurat(inSCE) } } - + # Get version number of object seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + seuratObject <- withr::with_seed(seed, { Seurat::FindNeighbors( seuratObject, @@ -1083,10 +1083,10 @@ runSeuratUMAP <- function(inSCE, #' @noRd .seuratGetVariableFeatures <- function(inSCE, numberOfFeatures) { seuratObject <- convertSCEToSeurat(inSCE) - + # Get version number of object seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + if(seurat.version >= 5.0){ if (length(SeuratObject::Features(seuratObject)) > 0) { return(SeuratObject::Features(seuratObject)[seq(numberOfFeatures)]) @@ -1320,10 +1320,10 @@ plotSeuratHeatmap <- function(plotObject, dims, ncol, labels) { seuratDataSlot = "counts", seuratAssaySlot = "RNA") { assay(inSCE, assaySlotSCE) <- NULL - + # Get version number of object seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + if(seurat.version >= 5.0){ temp.matrix <- seuratObject[[seuratAssaySlot]][seuratDataSlot] } @@ -1362,10 +1362,10 @@ convertSeuratToSCE <- function(seuratObject, normAssayName = "seuratNormData", scaledAssayName = "seuratScaledData") { - + # Get version number of object seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + if (seurat.version >= 5.0){ inSCE <- SingleCellExperiment( assays = list(counts = seuratObject@assays[[1]]$counts), @@ -1388,9 +1388,9 @@ convertSeuratToSCE <- if (length(methods::slot(seuratObject, "assays")[["RNA"]]@scale.data) > 0) { altExp(inSCE, scaledAssayName) <- SingleCellExperiment::SingleCellExperiment( list(counts = methods::slot(seuratObject@assays$RNA, "scale.data"))) - } + } } - + inSCE <- .addSeuratToMetaDataSCE(inSCE, seuratObject) return(inSCE) } @@ -1536,7 +1536,7 @@ convertSCEToSeurat <- colnames(temp) <- seuratColNames seuratObject <- Seurat::CreateSeuratObject(counts = temp) seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - + # Set normalized assay if (!is.null(normAssay) && normAssay %in% names(assays(inSCE))) { tempMatrix <- .convertToMatrix(assay(inSCE, normAssay)) @@ -1546,7 +1546,7 @@ convertSCEToSeurat <- rownames(tempMatrix) <- seuratRowNames colnames(tempMatrix) <- seuratColNames if(seurat.version >= 5.0){ - seuratObject[["RNA"]]$data <- tempMatrix + seuratObject[["RNA"]]$data <- tempMatrix } else{ seuratObject@assays$RNA@data <- tempMatrix @@ -1566,7 +1566,7 @@ convertSCEToSeurat <- tempMatrix <- as.matrix(assay(inSCE, scaledAssay)) rownames(tempMatrix) <- seuratRowNames colnames(tempMatrix) <- seuratColNames - + if(seurat.version >= 5.0){ seuratObject[["RNA"]]$scale.data <- tempMatrix } @@ -1574,22 +1574,22 @@ convertSCEToSeurat <- seuratObject@assays$RNA@scale.data <- tempMatrix } } - + if(seurat.version >= 5.0){ if (!is.null(inSCE@metadata$seurat$obj)) { # what is it looking for here? sequence? idk if ((nrow(inSCE@metadata$seurat$obj@assays$RNA) > 0 && ncol(inSCE@metadata$seurat$obj@assays$RNA) > 0) && !is.null(inSCE@metadata$seurat$obj@assays$RNA@meta.data$var.features)) { - seuratObject@assays$RNA@meta.data$var.features <- + seuratObject@assays$RNA@meta.data$var.features <- inSCE@metadata$seurat$obj@assays$RNA@meta.data$var.features } - + # if no, then set a new matrix to empty # if (is.null(inSCE@metadata$seurat$obj@assays$RNA@meta.data$var.features)) { - # seuratObject@assays$RNA@meta.data$var.features <- + # seuratObject@assays$RNA@meta.data$var.features <- # data.frame(matrix(NA, nrow = nrow(inSCE@metadata$seurat$obj@assays$RNA), ncol = ncol(inSCE@metadata$seurat$obj@assays$RNA))) # } - + if (!is.null(inSCE@metadata$seurat$obj@reductions) && !is.null(inSCE@metadata$seurat$obj@reductions$pca)) { seuratObject@reductions$pca <- inSCE@metadata$seurat$obj@reductions$pca @@ -1613,9 +1613,9 @@ convertSCEToSeurat <- inSCE@metadata$seurat$obj@reductions$umap } if (!is.null(inSCE@metadata$seurat$obj@meta.data)) { - #seuratObject@meta.data <- + #seuratObject@meta.data <- #inSCE@metadata$seurat$obj$meta.data[match(colnames(seuratObject), rownames(inSCE@metadata$seurat$obj$meta.data)),] - seuratObject <- + seuratObject <- SeuratObject::AddMetaData(seuratObject, inSCE@metadata$seurat$obj@meta.data[match(colnames(seuratObject), rownames(inSCE@metadata$seurat$obj@meta.data)),]) } if (!is.null(inSCE@metadata$seurat$obj@commands)) { @@ -1651,7 +1651,7 @@ convertSCEToSeurat <- } if (!is.null(inSCE@metadata$seurat$obj@meta.data)) { #seuratObject@meta.data <- inSCE@metadata$seurat$obj@meta.data[match(colnames(seuratObject), rownames(inSCE@metadata$seurat$obj@meta.data)),] - seuratObject <- + seuratObject <- SeuratObject::AddMetaData(seuratObject, inSCE@metadata$seurat$obj$meta.data[match(colnames(seuratObject), rownames(inSCE@metadata$seurat$obj$meta.data)),]) } if (!is.null(inSCE@metadata$seurat$obj@commands)) { @@ -1710,7 +1710,7 @@ convertSCEToSeurat <- } else { seuratObject@assays$RNA@meta.features <- as.data.frame(rowData(inSCE)) } - + # Set 'decontXCounts' assay to seurat object if required if ("decontXcounts" %in% SummarizedExperiment::assayNames(inSCE) && copyDecontX) { @@ -1720,13 +1720,13 @@ convertSCEToSeurat <- if(seurat.version >= 5.0){ # CreateAssayObject and similar were moved to SeuratObject now (added it to suggests) seuratObject[["decontXcounts"]] <- - SeuratObject::CreateAssay5Object(counts = .convertToMatrix(decontM)) + SeuratObject::CreateAssay5Object(counts = .convertToMatrix(decontM)) } else{ seuratObject[["decontXcounts"]] <- SeuratObject::CreateAssayObject(counts = .convertToMatrix(decontM)) } - + } # Ensuring that colnames from input SCE converted to Seurat object are same in the Seurat metadata slot @@ -1803,11 +1803,11 @@ runSeuratSCTransform <- function(inSCE, tSNE = TRUE, UMAP = TRUE, clusters = TRUE) { - + if (scaleData) { altExp(inSCE, "seuratScaledData") <- NULL } - + if(methods::is(inSCE@metadata$seurat$obj, "list")){ if (varFeatures) { inSCE@metadata$seurat$obj$RNA$"var.features" <- NULL @@ -1839,13 +1839,13 @@ runSeuratSCTransform <- function(inSCE, # logical() methods::slot(inSCE@metadata$seurat$obj, "assays")[["RNA"]]@meta.data <- data.frame(row.names = make.unique(gsub("_", "-", rownames(inSCE)))) - } + } else { methods::slot(inSCE@metadata$seurat$obj, "assays")[["RNA"]]@var.features <- logical() methods::slot(inSCE@metadata$seurat$obj, "assays")[["RNA"]]@meta.features <- data.frame(row.names = make.unique(gsub("_", "-", rownames(inSCE)))) - } + } inSCE@metadata$seurat$heatmap_pca <- NULL } if (PCA) { @@ -1863,9 +1863,9 @@ runSeuratSCTransform <- function(inSCE, if (clusters) { inSCE@metadata$seurat$obj@meta.data$seurat_clusters <- NULL } - + } - + return(inSCE) } @@ -2097,7 +2097,8 @@ runSeuratFindMarkers <- function(inSCE, #' @param features Specify the features to compute the plot against. #' @param groupVariable Specify the column name from the colData slot that #' should be used as grouping variable. -#' @param reducedDimName Specify the name of the dimensional reduction to be used. +#' Default is \code{NULL}. +#' @param reducedDimName Specify the name of the dimensional reduction to be used. #' Default is "seuratNormData". #' @param splitBy Specify the column name from the colData slot that should be #' used to split samples. @@ -2120,36 +2121,46 @@ plotSeuratGenes <- function(inSCE, useAssay = "seuratNormData", plotType, features, - groupVariable, + groupVariable = NULL, reducedDimName = "seuratUMAP", splitBy = NULL, cols = c("lightgrey", "blue"), ncol = 1, combine = FALSE) { + plotType <- match.arg(plotType, c("dot", "feature", "ridge", "heatmap", "violin")) + #setup seurat object and the corresponding groups seuratObject <- convertSCEToSeurat(inSCE, normAssay = useAssay, copyReducedDim = TRUE) seurat.version <- .getSeuratObjectMajorVersion(seuratObject) - - seuratObject <- - Seurat::ScaleData(seuratObject, features = features) + + if(plotType %in% c("dot", "heatmap")){ + if (length(features) < 2) { + stop("At least 2 features are required for this plotType.") + } + seuratObject <- + Seurat::ScaleData(seuratObject, features = features) + } + indices <- list() cells <- list() - groups <- unique(colData(inSCE)[[groupVariable]]) - for (i in seq(length(groups))) { - indices[[i]] <- which(colData(inSCE)[[groupVariable]] == groups[i], - arr.ind = TRUE) - cells[[i]] <- colnames(inSCE)[indices[[i]]] - cells[[i]] <- .convertToHyphen(cells[[i]]) - if(seurat.version >= 5.0){ - cells[[i]] <- unlist(cells[[i]]) + if(!is.null(groupVariable)){ + groups <- unique(colData(inSCE)[[groupVariable]]) + for (i in seq(length(groups))) { + indices[[i]] <- which(colData(inSCE)[[groupVariable]] == groups[i], + arr.ind = TRUE) + cells[[i]] <- colnames(inSCE)[indices[[i]]] + cells[[i]] <- .convertToHyphen(cells[[i]]) + if(seurat.version >= 5.0){ + cells[[i]] <- unlist(cells[[i]]) + } + Seurat::Idents(seuratObject, cells = cells[[i]]) <- groups[i] } - Seurat::Idents(seuratObject, cells = cells[[i]]) <- groups[i] } - + if (!is.null(splitBy)) { seuratObject[[splitBy]] <- colData(inSCE)[[splitBy]] } - + #plot required visualization if (plotType == "ridge") { return( diff --git a/inst/rmarkdown/qc/CellQC.Rmd b/inst/rmarkdown/qc/CellQC.Rmd index 501c3c7a6..1588b1edc 100644 --- a/inst/rmarkdown/qc/CellQC.Rmd +++ b/inst/rmarkdown/qc/CellQC.Rmd @@ -3,6 +3,7 @@ title: "SCTK Cell QC Report" date: "`r format(Sys.time(), '%B %d, %Y')`" params: object: object + sample: sample subTitle: subTitle studyDesign: studyDesign reducedDimName: reducedDimName @@ -14,6 +15,8 @@ output: collapsed: false code_folding: hide html_notebook: default +editor_options: + chunk_output_type: console ---