Skip to content

Commit

Permalink
Correct errors in clone color methods. Add tests.
Browse files Browse the repository at this point in the history
  • Loading branch information
@aholmes
aholmes committed Mar 6, 2025
1 parent 0cedb62 commit 438447a
Show file tree
Hide file tree
Showing 5 changed files with 246 additions and 2 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,3 +28,4 @@ Suggests:
VignetteBuilder: knitr
LazyLoad: yes
LazyData: yes
RoxygenNote: 7.3.1
18 changes: 16 additions & 2 deletions R/utility.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,6 +69,11 @@ get.encoded.distance <- function(points) {
#' Any colors specified in `clone.colours` are maintained in the order
#' specified and are used as the first colors for the `clone.ids`.
#'
#' if `clone.colours` is NULL or an empty vector, _and_
#' `minimum.number.of.colours` is 0, `NULL` is returned
#' so BPG's default color selection can be used without needing to
#' check for `NULL`.
#'
#' @param clone.colours A vector of colors assigned to clones. If `NULL`, colors will be generated automatically.
#' @param clone.ids A vector of clone identifiers.
#' @param minimum.number.of.colours An integer specifying the minimum number of colors required.
Expand All @@ -89,7 +94,7 @@ get.clone.colours <- function(clone.colours, clone.ids, minimum.number.of.colour
);
}

if (!is.null(clone.colours)) {
if (!is.null(clone.colours) && !is.null(clone.ids)) {
unique.clone.ids <- unique(clone.ids);
sampled.colors <- sample(colors(), size = length(unique.clone.ids));
sampled.colors[seq_along(clone.colours)] <- clone.colours;
Expand All @@ -109,6 +114,11 @@ get.clone.colours <- function(clone.colours, clone.ids, minimum.number.of.colour
#' Any colors specified in `clone.colours` are maintained in the order
#' specified and are used as the first colors for the `clone.ids`.
#'
#' if `clone.colours` is NULL or an empty vector, _and_
#' `minimum.number.of.colours` is 0, `NULL` is returned
#' so BPG's default color selection can be used without needing to
#' check for `NULL`.
#'
#' @param clone.colours A vector of colors assigned to clones. If `NULL`, colors will be generated automatically.
#' @param clone.ids A vector of clone identifiers.
#' @param clone.order An optional vector specifying the order of clones. If `NULL`, clone order is not gauranteed.
Expand All @@ -120,7 +130,11 @@ get.clone.colours <- function(clone.colours, clone.ids, minimum.number.of.colour
#' \item{clone.order}{The ordered clones.}
#' }
get.clone.colours.in.order <- function(clone.colours, clone.ids, clone.order = NULL, minimum.number.of.colours = 0) {
if (is.null(clone.order)) {
if (is.null(clone.colours) && is.null(clone.order)) {
clone.ids <- NULL;
}

if (is.null(clone.order) && !is.null(clone.ids)) {
unique.clone.ids <- unique(clone.ids);
clone.order <- c(clone.order, unique.clone.ids[!unique.clone.ids %in% clone.order]);
}
Expand Down
29 changes: 29 additions & 0 deletions man/get.clone.colours.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

41 changes: 41 additions & 0 deletions man/get.clone.colours.in.order.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

159 changes: 159 additions & 0 deletions tests/testthat/test-utility.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -76,3 +76,162 @@ test_that(

expect_equal(order(result), expected.order);
});

test_that(
'get.clone.colours returns expected vectors', {
result <- get.clone.colours(NULL, NULL);
expect_null(result);
result <- get.clone.colours(NULL, c('ABC', 'DEF'));
expect_null(result);
result <- get.clone.colours(c('red','green'), NULL);
expect_null(result);
result <- get.clone.colours(c(), c());
expect_null(result);
result <- get.clone.colours(NULL, c());
expect_null(result);
result <- get.clone.colours(c(), NULL);
expect_null(result);
result <- get.clone.colours(c(), c('ABC', 'DEF'));
expect_null(result);
result <- get.clone.colours(c('red', 'green'), c());
expect_null(result);
result <- get.clone.colours(c('red','green'), c('ABC','DEF'));
expect_equal(result, c(ABC = 'red', DEF = 'green'));
result <- get.clone.colours(c('red'), c('ABC','DEF'));
expect_equal(names(result), c('ABC', 'DEF'));
expect_true(result['ABC'] == 'red');
expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
result <- get.clone.colours(c(NULL,'red'), c('ABC','DEF'));
expect_equal(names(result), c('ABC', 'DEF'));
expect_true(result['ABC'] == 'red');
expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
result <- get.clone.colours(c('red',NULL), c('ABC','DEF'));
expect_equal(names(result), c('ABC', 'DEF'));
expect_true(result['ABC'] == 'red');
expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
result <- get.clone.colours(c('red','green'), c('ABC'));
expect_equal(result, c(ABC = 'red'));
result <- get.clone.colours(c('red','green'), c(NULL,'ABC'));
expect_equal(result, c(ABC = 'red'));
result <- get.clone.colours(c('red','green'), c('ABC',NULL));
expect_equal(result, c(ABC = 'red'));
});

test_that(
'get.clone.colours returns expected vectors with minimum colours specified', {
result <- get.clone.colours(NULL, NULL, 3)
expect_null(result);
result <- get.clone.colours(c('red', 'green'), NULL, 3)
expect_null(result);
result <- get.clone.colours(c('red'), NULL, 3)
expect_null(result);
result <- get.clone.colours(c('red', 'green'), c('ABC','DEF'), 3)
expect_equal(result, c(ABC = 'red', DEF = 'green'));
result <- get.clone.colours(c('red'), c('ABC','DEF'), 3)
expect_equal(names(result), c('ABC', 'DEF'));
expect_true(result['ABC'] == 'red');
expect_true(!is.na(result['DEF']) && nzchar(result['DEF']));
result <- get.clone.colours(c('red', 'green'), c('ABC'), 3)
expect_equal(result, c(ABC = 'red'));
});

test_that(
'get.clone.colours.in.order returns expected vectors when order is not specified', {
# get.clone.colours.in.order has same result as get.clone.colours
# with the change that a named list is returned with two members
result <- get.clone.colours.in.order(NULL, NULL)
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(NULL, c('ABC', 'DEF'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c('red','green'), NULL)
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c(), c())
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(NULL, c())
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c(), NULL)
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c(), c('ABC', 'DEF'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c('red', 'green'), c())
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c('red','green'), c('ABC','DEF'))
expect_true(setequal(result,list(clone.colours = c(ABC = 'red',DEF = 'green'), clone.order = c('ABC','DEF'))))
result <- get.clone.colours.in.order(c('red'), c('ABC','DEF'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('ABC', 'DEF'))
expect_true(result$clone.colours['ABC'] == 'red')
expect_true(!is.na(result$clone.colours['DEF']) && nzchar(result$clone.colours['DEF']))
expect_equal(result$clone.order, c('ABC','DEF'))

result <- get.clone.colours.in.order(c(NULL,'red'), c('ABC','DEF'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('ABC','DEF'))
expect_true(result$clone.colours['ABC'] == 'red')
expect_true(!is.na(result$clone.colours['DEF']) && nzchar(result$clone.colours['DEF']))
expect_equal(result$clone.order, c('ABC','DEF'))

result <- get.clone.colours.in.order(c('red',NULL), c('ABC','DEF'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('ABC','DEF'))
expect_true(result$clone.colours['ABC'] == 'red')
expect_true(!is.na(result$clone.colours['DEF']) && nzchar(result$clone.colours['DEF']))
expect_equal(result$clone.order, c('ABC','DEF'))

result <- get.clone.colours.in.order(c('red','green'), c('ABC'))
expect_true(setequal(result,list(clone.colours = c(ABC = 'red'), clone.order = c('ABC'))))
result <- get.clone.colours.in.order(c('red','green'), c(NULL,'ABC'))
expect_true(setequal(result,list(clone.colours = c(ABC = 'red'), clone.order = c('ABC'))))
result <- get.clone.colours.in.order(c('red','green'), c('ABC',NULL))
expect_true(setequal(result,list(clone.colours = c(ABC = 'red'), clone.order = c('ABC'))))
});

test_that(
'get.clone.colours.in.order returns expected vectors when order is specified', {
# get.clone.colours.in.order with order specified
result <- get.clone.colours.in.order(NULL, NULL, c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(NULL, c('ABC', 'DEF'), c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red','green'), NULL)
expect_true(setequal(result, list(clone.colours = NULL, clone.order = NULL)))
result <- get.clone.colours.in.order(c(), c(), c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(NULL, c(), c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c(), NULL, c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c(), c('ABC', 'DEF'), c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = NULL, clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red', 'green'), c(), c('DEF','ABC'))
expect_true(setequal(result, list(clone.colours = c(DEF = 'red',ABC = 'green'), clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red','green'), c('ABC','DEF'), c('DEF','ABC'))
expect_true(setequal(result,list(clone.colours = c(DEF = 'red',ABC = 'green'), clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red'), c('ABC','DEF'), c('DEF','ABC'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('DEF', 'ABC'))
expect_true(result$clone.colours['DEF'] == 'red')
expect_true(!is.na(result$clone.colours['ABC']) && nzchar(result$clone.colours['ABC']))
expect_equal(result$clone.order, c('DEF','ABC'))

result <- get.clone.colours.in.order(c(NULL,'red'), c('ABC','DEF'), c('DEF','ABC'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('DEF','ABC'))
expect_true(result$clone.colours['DEF'] == 'red')
expect_true(!is.na(result$clone.colours['ABC']) && nzchar(result$clone.colours['ABC']))
expect_equal(result$clone.order, c('DEF','ABC'))

result <- get.clone.colours.in.order(c('red',NULL), c('ABC','DEF'), c('DEF','ABC'))
expect_equal(names(result), c('clone.colours', 'clone.order'))
expect_equal(names(result$clone.colours), c('DEF','ABC'))
expect_true(result$clone.colours['DEF'] == 'red')
expect_true(!is.na(result$clone.colours['ABC']) && nzchar(result$clone.colours['ABC']))
expect_equal(result$clone.order, c('DEF','ABC'))

result <- get.clone.colours.in.order(c('red','green'), c('ABC'), c('DEF','ABC'))
expect_true(setequal(result,list(clone.colours = c(DEF = 'red',ABC = 'green'), clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red','green'), c(NULL,'ABC'), c('DEF','ABC'))
expect_true(setequal(result,list(clone.colours = c(DEF = 'red',ABC = 'green'), clone.order = c('DEF','ABC'))))
result <- get.clone.colours.in.order(c('red','green'), c('ABC',NULL), c('DEF','ABC'))
expect_true(setequal(result,list(clone.colours = c(DEF = 'red',ABC = 'green'), clone.order = c('DEF','ABC'))))
});

0 comments on commit 438447a

Please sign in to comment.