Hwinata refactor colour fxns

NAMESPACE

@@ -27,3 +27,4 @@ export(create.clone.genome.distribution.plot)
 
 export(data.frame.to.array)
 export(update.descendant.property)
+export(get.colours.in.order)

NEWS.md

@@ -13,6 +13,8 @@
 * 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.
+* Add `get.colours.in.order` function to get a list of colours and corresponding clone ID order.
+* Add `sample.order` and `clone.order` as input parameters to `create.cluster.heatmap`
 
 ## Update
 * Fixed angle calculation bug where child angles do not follow

R/create.cluster.heatmap.R

@@ -1,6 +1,8 @@
 create.cluster.heatmap <- function(
     DF,
     ccf.limits = NULL,
+    sample.order = NULL,
+    clone.order = NULL,
     clone.colours = NULL,
     height = 6,
     width = 11,
@@ -18,9 +20,17 @@ create.cluster.heatmap <- function(
     ...
     ) {
 
-    if (is.null(levels(DF$ID))) {
-        DF$ID <- factor(DF$ID, levels = sort(unique(DF$ID)));
+    # Define the order of the samples
+    if (is.null(sample.order)) {
+        sample.order <- sort(unique(DF$ID));
         }
+    DF$ID <- factor(DF$ID, levels = sample.order);
+
+    # Define the order of the clones
+    if (is.null(clone.order)) {
+        clone.order <- sort(unique(DF$clone.id));
+        }
+    DF$clone.id <- factor(DF$clone.id, levels = clone.order);
 
     if (is.null(clone.colours)) {
         clone.colours <- get.colours(DF$clone.id, return.names = TRUE);

R/get.colours.R

@@ -1,23 +1,18 @@
 get.colours <- function(
     value.list,
-    return.names = FALSE,
-    predetermined.colours = NULL
+    return.names = FALSE
     ) {
-    colours <- grDevices::colors()[grep('(white|gr(a|e)y)', grDevices::colors(), invert = T)];
-    unique.values <- unique(value.list);
-    n <- length(unique.values);
-
-    col.list <- sample(colours, n);
 
-    if (!is.null(predetermined.colours) && !is.null(value.list)) {
-        col.list[seq_along(predetermined.colours)] <- predetermined.colours;
+    if (is.null(value.list)) {
+        return(setNames(character(0), character(0)));
         }
 
-    if (is.null(levels(value.list))) {
-        value.list <- factor(value.list, levels = unique.values);
-        }
+    colours <- grDevices::colors()[grep('(white|gr(a|e)y)', grDevices::colors(), invert = TRUE)];
+    unique.values <- sort(unique(value.list));
+    n <- length(unique.values);
 
-    names(col.list) <- levels(value.list);
+    col.list <- sample(colours, n);
+    names(col.list) <- unique.values;
 
     if (return.names) {
         return(col.list);

man/create.ccf.summary.heatmap.Rd

@@ -36,8 +36,8 @@ create.ccf.summary.heatmap(
     \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.}
     \item{ccf.limits}{CCF limits to be applied to the heatmap. Must be a vector of length 2 for min and max thresholds. Defaults to \code{NULL}}
     \item{median.col}{Defaults to \dQuote{median.ccf.per.sample}}
-    \item{clone.order}{Defaults to \code{NULL}}
-    \item{sample.order}{Defaults to \code{NULL}}
+    \item{clone.order}{Define clone ID order. Defaults to \code{NULL}}
+    \item{sample.order}{Define sample ID order. Defaults to \code{NULL}}
     \item{colour.scheme}{Heatmap colour scheme. Defaults to \code{c('white', 'blue')}}
     \item{clone.colours}{A named vector specifying the color to use for each clone to generate a covariate heatmap. If \code{NULL}, no covariates will be added.}
     \item{subplot.xlab.cex}{Subplot parameter. Defaults to 1.2}

man/create.cluster.heatmap.Rd

@@ -8,6 +8,8 @@ Creates a heatmap of cancer cell fraction (CCF) distribution across tumour sampl
 create.cluster.heatmap(
     DF,
     ccf.limits = NULL,
+    sample.order = NULL,
+    clone.order = NULL,
     clone.colours = NULL,
     height = 6,
     width = 11,
@@ -28,6 +30,8 @@ create.cluster.heatmap(
 \arguments{
     \item{DF}{A data-frame with the following column names: 'ID', 'SNV.id', 'clone.id', 'CCF'.}
     \item{ccf.limits}{CCF limits to be applied to the heatmap. Must be a vector of length 2 for min and max thresholds. Defaults to \code{NULL}}
+    \item{clone.order}{Define clone ID order. Defaults to \code{NULL}}
+    \item{sample.order}{Define sample ID order. Defaults to \code{NULL}}
     \item{clone.colours}{Named list to provide a colour scheme for the clone ID covariate bar. If NULL, colours will be randomly generated. Defaults to \code{NULL}.}
     \item{height}{Defaults to 6}
     \item{width}{Defaults to 11}

tests/testthat/test-get.colours.R

@@ -63,64 +63,16 @@ test_that('get.colours returns an empty color vector when value.list is empty an
 
 test_that(
     'get.colours returns expected vectors', {
-        result <- get.colours(NULL, predetermined.colours = NULL);
+        result <- get.colours(NULL);
+        expect_equal(length(result), 0);
         expect.character.vector(result);
-        result <- get.colours(c('ABC', 'DEF'), predetermined.colours = NULL);
+        result <- get.colours(c('ABC', 'DEF'));
         expect_equal(names(result), c('ABC', 'DEF'));
         expect_true(!is.na(result['ABC']) && nzchar(result['ABC']));
         expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(NULL, predetermined.colours = c('red','green'));
+        result <- get.colours(c());
+        expect_equal(length(result), 0);
         expect.character.vector(result);
-        result <- get.colours(c(), predetermined.colours = c());
-        expect.character.vector(result);
-        result <- get.colours(NULL, predetermined.colours = c());
-        expect.character.vector(result);
-        result <- get.colours(c(), predetermined.colours = NULL);
-        expect.character.vector(result);
-        result <- get.colours(c('ABC', 'DEF'), predetermined.colours = c())
-        expect_equal(names(result), c('ABC', 'DEF'));
-        expect_true(!is.na(result['ABC']) && nzchar(result['ABC']));
-        expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(c(), predetermined.colours = c('red', 'green'));
-        expect.character.vector(result);
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c('red','green'));
-        expect_equal(result, c(ABC = 'red', DEF = 'green'));
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c('red'));
-        expect_equal(names(result), c('ABC', 'DEF'));
-        expect_true(result['ABC'] == 'red');
-        expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c(NULL,'red'));
-        expect_equal(names(result), c('ABC', 'DEF'));
-        expect_true(result['ABC'] == 'red');
-        expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c('red',NULL));
-        expect_equal(names(result), c('ABC', 'DEF'));
-        expect_true(result['ABC'] == 'red');
-        expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(c('ABC'), predetermined.colours = c('red','green'));
-        expect_equal(result, c(ABC = 'red'));
-        result <- get.colours(c(NULL,'ABC'), predetermined.colours = c('red','green'));
-        expect_equal(result, c(ABC = 'red'));
-        result <- get.colours(c('ABC',NULL), predetermined.colours = c('red','green'));
-        expect_equal(result, c(ABC = 'red'));
-    });
-
-test_that(
-    'get.colours returns expected vectors with minimum colours specified', {
-        result <- get.colours(NULL, predetermined.colours = NULL)
-        expect.character.vector(result);
-        result <- get.colours(NULL, predetermined.colours = c('red', 'green'))
-        expect.character.vector(result);
-        result <- get.colours(NULL, predetermined.colours = c('red'))
-        expect.character.vector(result);
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c('red', 'green'))
-        expect_equal(result, c(ABC = 'red', DEF = 'green'));
-        result <- get.colours(c('ABC','DEF'), predetermined.colours = c('red'))
-        expect_equal(names(result), c('ABC', 'DEF'));
-        expect_true(result['ABC'] == 'red');
-        expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
-        result <- get.colours(c('ABC'), predetermined.colours = c('red', 'green'))
-        expect_equal(result, c(ABC = 'red'));
     });
 
 test_that(