| 0b3c7f9a |
#' @title Plots heatmap based on Celda model
|
| ca5fb59d |
#' @description Renders a heatmap based on a matrix of counts where rows are
#' features and columns are cells.
#' @param counts Numeric matrix. Normalized counts matrix where rows represent
#' features and columns represent cells. .
|
| 0b3c7f9a |
#' @param z Numeric vector. Denotes cell population labels.
#' @param y Numeric vector. Denotes feature module labels.
|
| ca5fb59d |
#' @param featureIx Integer vector. Select features for display in heatmap. If
#' NULL, no subsetting will be performed. Default NULL.
#' @param cellIx Integer vector. Select cells for display in heatmap. If NULL,
#' no subsetting will be performed. Default NULL.
|
| 83c152c0 |
#' @param scaleRow Function. A function to scale each individual row. Set to
|
| ca5fb59d |
#' NULL to disable. Occurs after normalization and log transformation. Defualt
#' is 'scale' and thus will Z-score transform each row.
#' @param trim Numeric vector. Vector of length two that specifies the lower
#' and upper bounds for the data. This threshold is applied after row scaling.
#' Set to NULL to disable. Default c(-2,2).
#' @param clusterFeature Logical. Determines whether rows should be clustered.
#' Default TRUE.
#' @param clusterCell Logical. Determines whether columns should be clustered.
#' Default TRUE.
#' @param annotationCell Data frame. Additional annotations for each cell will
#' be shown in the column color bars. The format of the data frame should be
#' one row for each cell and one column for each annotation. Numeric variables
#' will be displayed as continuous color bars and factors will be displayed as
#' discrete color bars. Default NULL.
|
| 0b3c7f9a |
#' @param annotationFeature A data frame for the feature annotations (rows).
|
| ca5fb59d |
#' @param annotationColor List. Contains color scheme for all annotations. See
#' `?pheatmap` for more details.
#' @param colorScheme "Character. One of ""divergent"" or ""sequential"". A
#' ""divergent"" scheme is best for highlighting relative data (denoted by
#' 'colorSchemeCenter') such as gene expression data that has been normalized
#' and centered. A ""sequential"" scheme is best for highlighting data that
#' are ordered low to high such as raw counts or probabilities. Default
#' "divergent".
#' @param colorSchemeSymmetric Logical. When the colorScheme is "divergent"
#' and the data contains both positive and negative numbers, TRUE indicates
#' that the color scheme should be symmetric from
#' [-max(abs(data)), max(abs(data))]. For example, if the data ranges goes
#' from -1.5 to 2, then setting this to TRUE will force the color scheme to
#' range from -2 to 2. Default TRUE.
#' @param colorSchemeCenter Numeric. Indicates the center of a "divergent"
#' colorScheme. Default 0.
|
| 0b3c7f9a |
#' @param col Color for the heatmap.
|
| ca5fb59d |
#' @param breaks Numeric vector. A sequence of numbers that covers the range
#' of values in the normalized `counts`. Values in the normalized `matrix` are
#' assigned to each bin in `breaks`. Each break is assigned to a unique color
#' from `col`. If NULL, then breaks are calculated automatically. Default NULL.
#' @param legend Logical. Determines whether legend should be drawn. Default
#' TRUE.
#' @param annotationLegend Logical. Whether legend for all annotations should
#' be drawn. Default TRUE.
#' @param annotationNamesFeature Logical. Whether the names for features should
#' be shown. Default TRUE.
#' @param annotationNamesCell Logical. Whether the names for cells should be
#' shown. Default TRUE.
#' @param showNamesFeature Logical. Specifies if feature names should be shown.
#' Default TRUE.
#' @param showNamesCell Logical. Specifies if cell names should be shown.
#' Default FALSE.
#' @param hclustMethod Character. Specifies the method to use for the 'hclust'
#' function. See `?hclust` for possible values. Default "ward.D2".
#' @param treeheightFeature Numeric. Width of the feature dendrogram. Set to 0
#' to disable plotting of this dendrogram. Default: if clusterFeature == TRUE,
#' then treeheightFeature = 50, else treeheightFeature = 0.
#' @param treeheightCell Numeric. Height of the cell dendrogram. Set to 0 to
#' disable plotting of this dendrogram. Default: if clusterCell == TRUE, then
#' treeheightCell = 50, else treeheightCell = 0.
|
| 3a1a8944 |
#' @param silent Logical. Whether to plot the heatmap.
|
| 47b1783c |
#' @param ... Other arguments to be passed to underlying pheatmap function.
|
| 0b3c7f9a |
#' @examples
|
| a49fff03 |
#' data(celdaCGSim, celdaCGMod)
|
| ca5fb59d |
#' plotHeatmap(celdaCGSim$counts,
#' z = clusters(celdaCGMod)$z, y = clusters(celdaCGMod)$y)
|
| d1154f0b |
#' @return list A list containing dendrogram information and the heatmap grob
|
| 47b1783c |
#' @import graphics
|
| 7890fdf1 |
#' @import grid
|
| 0b3c7f9a |
#' @export
plotHeatmap <- function(counts,
z = NULL,
y = NULL,
scaleRow = scale,
trim = c(-2, 2),
featureIx = NULL,
cellIx = NULL,
clusterFeature = TRUE,
clusterCell = TRUE,
colorScheme = c("divergent", "sequential"),
colorSchemeSymmetric = TRUE,
colorSchemeCenter = 0,
col = NULL,
annotationCell = NULL,
annotationFeature = NULL,
annotationColor = NULL,
breaks = NULL,
legend = TRUE,
annotationLegend = TRUE,
annotationNamesFeature = TRUE,
annotationNamesCell = TRUE,
showNamesFeature = FALSE,
showNamesCell = FALSE,
hclustMethod = "ward.D2",
treeheightFeature = ifelse(clusterFeature, 50, 0),
treeheightCell = ifelse(clusterCell, 50, 0),
silent = FALSE,
...) {
|
| ca5fb59d |
|
| 0b3c7f9a |
# Check for same lengths for z and y group variables
if (!is.null(z) & length(z) != ncol(counts)) {
stop("Length of z must match number of columns in counts matrix")
|
| 47b1783c |
}
|
| 0b3c7f9a |
if (!is.null(y) & length(y) != nrow(counts)) {
stop("Length of y must match number of rows in counts matrix")
|
| 47b1783c |
}
|
| 0b3c7f9a |
colorScheme <- match.arg(colorScheme)
## Create cell annotation
if (!is.null(annotationCell) & !is.null(z)) {
if (is.null(rownames(annotationCell))) {
rownames(annotationCell) <- colnames(counts)
} else {
if (any(rownames(annotationCell) != colnames(counts))) {
stop("Row names of 'annotationCell' are different than the
column names of 'counts'")
}
}
annotationCell <- data.frame(cell = as.factor(z), annotationCell)
} else if (is.null(annotationCell) & !is.null(z)) {
annotationCell <- data.frame(cell = as.factor(z))
rownames(annotationCell) <- colnames(counts)
|
| 47b1783c |
} else {
|
| 0b3c7f9a |
annotationCell <- NA
|
| 47b1783c |
}
|
| 0b3c7f9a |
# Set feature annotation
if (!is.null(annotationFeature) & !is.null(y)) {
if (is.null(rownames(annotationFeature))) {
rownames(annotationFeature) <- rownames(counts)
} else {
if (any(rownames(annotationFeature) != rownames(counts))) {
stop("Row names of 'annotationFeature' are different than the
row names of 'counts'")
}
}
annotationFeature <- data.frame(module = as.factor(y),
annotationFeature)
} else if (is.null(annotationFeature) & !is.null(y)) {
annotationFeature <- data.frame(module = as.factor(y))
rownames(annotationFeature) <- rownames(counts)
|
| 47b1783c |
} else {
|
| 0b3c7f9a |
annotationFeature <- NA
|
| 47b1783c |
}
|
| 83c152c0 |
## Select subsets of features/cells
if (!is.null(featureIx)) {
counts <- counts[featureIx, , drop = FALSE]
if (length(annotationFeature) > 1 ||
(length(annotationFeature) == 1 & !is.na(annotationFeature))) {
annotationFeature <- annotationFeature[featureIx, , drop = FALSE]
}
if (!is.null(y)) {
y <- y[featureIx]
}
}
if (!is.null(cellIx)) {
counts <- counts[, cellIx, drop = FALSE]
if (length(annotationCell) > 1 ||
(length(annotationCell) == 1 & !is.na(annotationCell))) {
annotationCell <- annotationCell[cellIx, , drop = FALSE]
}
if (!is.null(z)) {
z <- z[cellIx]
}
}
|
| 0b3c7f9a |
## Set annotation colors
if (!is.null(z)) {
K <- sort(unique(z))
|
| b26d22a2 |
kCol <- distinctColors(length(K))
names(kCol) <- K
|
| 47b1783c |
|
| 0b3c7f9a |
if (!is.null(annotationColor)) {
if (!("cell" %in% names(annotationColor))) {
|
| b26d22a2 |
annotationColor <- c(list(cell = kCol), annotationColor)
|
| 0b3c7f9a |
}
} else {
|
| b26d22a2 |
annotationColor <- list(cell = kCol)
|
| 0b3c7f9a |
}
|
| 47b1783c |
}
|
| 0b3c7f9a |
if (!is.null(y)) {
L <- sort(unique(y))
|
| b26d22a2 |
lCol <- distinctColors(length(L))
names(lCol) <- L
|
| 0b3c7f9a |
if (!is.null(annotationColor)) {
if (!("module" %in% names(annotationColor))) {
|
| b26d22a2 |
annotationColor <- c(list(module = lCol), annotationColor)
|
| 0b3c7f9a |
}
} else {
|
| b26d22a2 |
annotationColor <- list(module = lCol)
|
| 0b3c7f9a |
}
|
| 47b1783c |
}
|
| 0b3c7f9a |
|
| 83c152c0 |
# scale indivisual rows by scaleRow
if (!is.null(scaleRow)) {
if (is.function(scaleRow)) {
cn <- colnames(counts)
counts <- t(base::apply(counts, 1, scaleRow))
colnames(counts) <- cn
} else {
stop("'scaleRow' needs to be of class 'function'")
|
| 0b3c7f9a |
}
|
| 47b1783c |
}
|
| 0b3c7f9a |
|
| 83c152c0 |
if (!is.null(trim)) {
if (length(trim) != 2) {
stop("'trim' should be a 2 element vector specifying the lower",
" and upper boundaries")
|
| 0b3c7f9a |
}
|
| 83c152c0 |
trim <- sort(trim)
counts[counts < trim[1]] <- trim[1]
counts[counts > trim[2]] <- trim[2]
|
| 47b1783c |
}
|
| 0b3c7f9a |
## Set color scheme and breaks
|
| b26d22a2 |
uBoundRange <- max(counts, na.rm = TRUE)
lboundRange <- min(counts, na.rm = TRUE)
|
| 0b3c7f9a |
if (colorScheme == "divergent") {
if (colorSchemeSymmetric == TRUE) {
|
| b26d22a2 |
uBoundRange <- max(abs(uBoundRange), abs(lboundRange))
lboundRange <- -uBoundRange
|
| 0b3c7f9a |
}
if (is.null(col)) {
col <- colorRampPalette(c("#1E90FF", "#FFFFFF", "#CD2626"),
space = "Lab")(100)
}
|
| b26d22a2 |
colLen <- length(col)
|
| 0b3c7f9a |
if (is.null(breaks)) {
|
| ca5fb59d |
breaks <- c(seq(lboundRange, colorSchemeCenter,
length.out = round(colLen / 2) + 1),
seq(colorSchemeCenter + 1e-6, uBoundRange,
length.out = colLen - round(colLen / 2)))
|
| 0b3c7f9a |
}
} else {
# Sequential color scheme
if (is.null(col)) {
col <- colorRampPalette(c("#FFFFFF", brewer.pal(n = 9,
name = "Blues")))(100)
}
|
| b26d22a2 |
colLen <- length(col)
|
| 0b3c7f9a |
if (is.null(breaks)) {
|
| b26d22a2 |
breaks <- seq(lboundRange, uBoundRange, length.out = colLen)
|
| 0b3c7f9a |
}
|
| 47b1783c |
}
|
| b26d22a2 |
sp <- semiPheatmap(mat = counts,
|
| 0b3c7f9a |
color = col,
breaks = breaks,
|
| b26d22a2 |
clusterCols = clusterCell,
clusterRows = clusterFeature,
annotationRow = annotationFeature,
annotationCol = annotationCell,
annotationColors = annotationColor,
|
| 0b3c7f9a |
legend = legend,
|
| b26d22a2 |
annotationLegend = annotationLegend,
annotationNamesRow = annotationNamesFeature,
annotationNamesCol = annotationNamesCell,
showRownames = showNamesFeature,
showColnames = showNamesCell,
clusteringMethod = hclustMethod,
treeHeightRow = treeheightFeature,
treeHeightCol = treeheightCell,
rowLabel = y,
colLabel = z,
|
| 0b3c7f9a |
silent = TRUE,
...)
|
| 47b1783c |
|
| 0b3c7f9a |
if (!isTRUE(silent)) {
grid::grid.newpage()
grid::grid.draw(sp$gtable)
}
invisible(sp)
}
|
