Make mutation and cluster plotting single sample compatible

NEWS.md

@@ -12,6 +12,7 @@
 * Add option to use scale bars instead of y-axes.
 * Wrapper function for `SRCgrob` to automatically save plots to file
 * Add option to annotate the CCF summary heatmap with the cell values.
+* Add support for 1xn and 1x1 heatmaps.
 
 ## Update
 * Fixed angle calculation bug where child angles do not follow

R/create.ccf.heatmap.R

@@ -5,6 +5,7 @@ create.ccf.heatmap <- function(
     distance.method = 'euclidean',
     xaxis.lab = '',
     xlab.label = 'SNVs',
+    yaxis.lab = colnames(x),
     print.colour.key = FALSE,
     colour.scheme = c('white', 'blue'),
     ...
@@ -21,7 +22,7 @@ create.ccf.heatmap <- function(
         cols.distance.method = distance.method,
         xaxis.lab = xaxis.lab,
         xlab.label = xlab.label,
-        yaxis.lab = colnames(x),
+        yaxis.lab = yaxis.lab,
         print.colour.key = print.colour.key,
         colourkey.labels.at = col.labels,
         colour.scheme = colour.scheme,

R/create.ccf.summary.heatmap.R

@@ -92,9 +92,21 @@ create.ccf.summary.heatmap <- function(
         xat = sample.xaxis$at
         );
 
+    same.as.matrix <- !is.matrix(arr)
+    if (same.as.matrix) {
+        # I don't know why this sequence works but simply setting as.data.frame does not work
+        arr <- as.data.frame(arr)
+        colnames(arr) <- as.character(unique(DF$ID))
+        arr <- as.matrix(arr)
+        hm.args.x <- as.data.frame(arr)
+        } else {
+        hm.args.x <- arr
+        }
+
     hm.args <- list(
-        x = arr,
+        x = hm.args.x,
         cluster.dimensions = 'none',
+        clustering.method = 'none',
         xlab.label = 'Clone',
         xlab.cex = ifelse(is.null(clone.colours), subplot.xlab.cex, 0),
         xaxis.lab = rownames(arr),
@@ -107,7 +119,8 @@ create.ccf.summary.heatmap <- function(
         yaxis.cex = subplot.yaxis.cex,
         yaxis.fontface = subplot.yaxis.fontface,
         print.colour.key = FALSE,
-        colour.scheme = colour.scheme
+        colour.scheme = colour.scheme,
+        same.as.matrix = same.as.matrix
         );
 
     if (add.median.text) {
@@ -118,14 +131,23 @@ create.ccf.summary.heatmap <- function(
         hm.args$text.col <- ifelse(arr > contrast.thres, 'white', 'black');
         }
 
+    if (nrow(hm.args.x) == 1 & ncol(hm.args.x) == 1) {
+        colour.scheme <- colour.scheme[length(colour.scheme)];
+        hm.args$x <- as.data.frame(colour.scheme);
+        hm.args$input.colours <- TRUE;
+        hm.args$yat <- 1;
+        hm.args$col.pos <- 1.5;
+        hm.args$row.pos <- 1;
+        }
+
     hm <- do.call(BoutrosLab.plotting.general::create.heatmap, hm.args);
 
     legend.ccf <- BoutrosLab.plotting.general::legend.grob(
         list(
             legend = list(
                 title = 'CCF',
                 labels = c(signif(min(arr), 2), rep('', legend.size), signif(max(arr), 2)),
-                colours = c('white', 'blue'),
+                colours = colour.scheme,
                 border = 'black',
                 continuous = TRUE,
                 cex = legend.label.cex
@@ -137,6 +159,16 @@ create.ccf.summary.heatmap <- function(
         );
 
     if (!is.null(clone.colours)) {
+        if (length(clone.colours) == 1) {
+        clone.cov <- BoutrosLab.plotting.general::create.heatmap(
+            x = as.data.frame(clone.colours),
+            xlab.label = 'Clone',
+            input.colours = TRUE,
+            clustering.method = 'none',
+            print.colour.key = FALSE,
+            yaxis.tck = 0
+            );
+        } else {
         clone.cov <- BoutrosLab.plotting.general::create.heatmap(
             x = t(clone.colours[rownames(arr)]),
             xlab.label = 'Clone',
@@ -151,6 +183,7 @@ create.ccf.summary.heatmap <- function(
             print.colour.key = FALSE,
             yaxis.tck = 0
             );
+            }
         plot.list <- list(clone.bar, hm, sample.bar, clone.cov);
         layout.skip <- c(FALSE, TRUE, FALSE, FALSE, FALSE, TRUE);
         layout.height <- 3;

R/create.cluster.heatmap.R

@@ -25,17 +25,24 @@ create.cluster.heatmap <- function(
     if (is.null(clone.colours)) {
         clone.colours <- get.colours(DF$clone.id, return.names = TRUE);
         }
-    DF              <- droplevels(DF)[order(DF$clone.id, -abs(DF$CCF)), ];
-    snv.order       <- unique(DF[, c('SNV.id', 'clone.id')]);
-    arr             <- data.frame.to.array(DF);
-    arr             <- arr[snv.order$SNV.id, rev(levels(DF$ID))];
+    DF        <- droplevels(DF)[order(DF$clone.id, -abs(DF$CCF)), ];
+    snv.order <- unique(DF[, c('SNV.id', 'clone.id')]);
+    arr       <- data.frame.to.array(DF);
+    arr       <- arr[snv.order$SNV.id, rev(levels(DF$ID))];
 
     if (!is.null(xaxis.col)) {
         xaxis.label <- unique(DF[DF$SNV.id %in% rownames(arr), xaxis.col]);
     } else {
         xaxis.label <- NULL;
         }
 
+    if (!is.matrix(arr)) {
+        arr <- t(arr);
+        yaxis.label <- levels(DF$ID);
+    } else {
+        yaxis.label <- colnames(arr);
+        }
+
     if (!is.null(ccf.limits)) {
         if (length(ccf.limits) != 2) {
             stop('ccf.limits must be a vector of length 2');
@@ -49,6 +56,7 @@ create.cluster.heatmap <- function(
         cluster.dimensions = 'none',
         xlab.label = '',
         xaxis.lab = xaxis.label,
+        yaxis.lab = yaxis.label,
         colour.scheme = colour.scheme,
         ...
         );

man/create.ccf.heatmap.Rd

@@ -12,6 +12,7 @@ create.ccf.heatmap(
     distance.method = 'euclidean',
     xaxis.lab = '',
     xlab.label = 'SNVs',
+    yaxis.lab = colnames(x),
     print.colour.key = FALSE,
     colour.scheme = c('white', 'blue'),
     ...
@@ -24,6 +25,7 @@ create.ccf.heatmap(
     \item{distance.method}{Defaults to \dQuote{euclidean}.}
     \item{xaxis.lab}{Defaults to an empty string.}
     \item{xlab.label}{Defaults to \dQuote{SNVs}.}
+    \item{yaxis.lab}{Defaults to the column names of array \code{x}.}
     \item{print.colour.key}{Defaults to \code{FALSE}.}
     \item{colour.scheme}{Defaults to \code{c('white', 'blue')}.}
     \item{...}{Pass through argument. See BoutrosLab.plotting.general::create.heatmap() for further details.}