Add argument validation to color and tests for color functions
This commit is contained in:
parent
ead630c106
commit
94045e30c0
2 changed files with 103 additions and 3 deletions
20
R/color.R
20
R/color.R
|
|
@ -9,19 +9,33 @@
|
||||||
#' * All , categorical colors start with ", cat_";
|
#' * All , categorical colors start with ", cat_";
|
||||||
#' * All sequential colors start with "seq_";
|
#' * All sequential colors start with "seq_";
|
||||||
#'
|
#'
|
||||||
#' Then, a number indi, cates the number of colors that belong to the palettes, a string the name of the palette, and, finally, a number the position of the color. E.g., "seq_5_red_4" would be the 4th color of a continuous palettes of 5 colors in the red band. Exception is made for white, light_grey, dark_grey, and black.
|
#' Then, a number indicates the number of colors that belong to the palettes, a string the name of the palette, and, finally, a number the position of the color. E.g., "seq_5_red_4" would be the 4th color of a continuous palettes of 5 colors in the red band. Exception is made for white, light_grey, dark_grey, and black.
|
||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
#' @return Hex codes named or unnamed.
|
#' @return Hex codes named or unnamed.
|
||||||
#'
|
#'
|
||||||
#' @export
|
#' @export
|
||||||
color <- function(..., unname = TRUE) {
|
color <- function(..., unname = TRUE) {
|
||||||
|
#------ Checks
|
||||||
|
|
||||||
|
# unname is a logical scalar
|
||||||
|
checkmate::assert_logical(unname, len = 1)
|
||||||
|
|
||||||
|
# all elements in ... are character strings
|
||||||
|
dots <- list(...)
|
||||||
|
if (length(dots) > 0) {
|
||||||
|
# Check each argument is a single character string
|
||||||
|
for (i in seq_along(dots)) {
|
||||||
|
checkmate::assert_string(dots[[i]], .var.name = paste0("Argument #", i))
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#------ Prep
|
#------ Prep
|
||||||
|
|
||||||
# Retrieve colors
|
# retrieve colors
|
||||||
cols <- c(...)
|
cols <- c(...)
|
||||||
|
|
||||||
# Defined colors
|
# define color vector
|
||||||
colors <- c(
|
colors <- c(
|
||||||
white = "#FFFFFF",
|
white = "#FFFFFF",
|
||||||
lighter_grey = "#F5F5F5",
|
lighter_grey = "#F5F5F5",
|
||||||
|
|
|
||||||
86
tests/testthat/test-color.R
Normal file
86
tests/testthat/test-color.R
Normal file
|
|
@ -0,0 +1,86 @@
|
||||||
|
# Tests for color functions
|
||||||
|
|
||||||
|
test_that("color returns expected hex codes", {
|
||||||
|
# Test default behavior (returning all colors when no args provided)
|
||||||
|
all_colors <- color(unname = FALSE)
|
||||||
|
expect_type(all_colors, "character")
|
||||||
|
expect_true(length(all_colors) > 0)
|
||||||
|
expect_named(all_colors)
|
||||||
|
|
||||||
|
# Test requesting specific colors
|
||||||
|
expect_identical(color("white"), "#FFFFFF")
|
||||||
|
expect_identical(color("black"), "#000000")
|
||||||
|
|
||||||
|
# Test requesting multiple colors
|
||||||
|
expect_identical(
|
||||||
|
color("white", "black"),
|
||||||
|
c("#FFFFFF", "#000000")
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test requesting multiple colors with names preserved
|
||||||
|
named_colors <- color("white", "black", unname = FALSE)
|
||||||
|
expect_identical(
|
||||||
|
named_colors,
|
||||||
|
c(white = "#FFFFFF", black = "#000000")
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test requesting non-existent color
|
||||||
|
expect_error(
|
||||||
|
color("nonexistent_color"),
|
||||||
|
"Some colors not defined"
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("color_pattern works as expected", {
|
||||||
|
# Positive test cases
|
||||||
|
cat_colors <- color_pattern("cat_", unname = FALSE)
|
||||||
|
expect_true(length(cat_colors) > 0)
|
||||||
|
expect_true(all(startsWith(names(cat_colors), "cat_")))
|
||||||
|
|
||||||
|
seq_colors <- color_pattern("seq_")
|
||||||
|
expect_true(length(seq_colors) > 0)
|
||||||
|
|
||||||
|
# Test with a pattern that should match nothing
|
||||||
|
expect_warning(
|
||||||
|
color_pattern("xyz_nonexistent_"),
|
||||||
|
"No colors match the pattern"
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test argument validation
|
||||||
|
expect_error(color_pattern(123))
|
||||||
|
expect_error(color_pattern(c("cat_", "seq_")))
|
||||||
|
expect_error(
|
||||||
|
color_pattern("cat_", unname = "yes"),
|
||||||
|
"Assertion on 'unname' failed"
|
||||||
|
)
|
||||||
|
})
|
||||||
|
|
||||||
|
test_that("color function parameter validation", {
|
||||||
|
# Empty call should return all colors
|
||||||
|
all_colors <- color()
|
||||||
|
expect_type(all_colors, "character")
|
||||||
|
expect_true(length(all_colors) > 0)
|
||||||
|
|
||||||
|
# unname parameter behavior
|
||||||
|
named_all <- color(unname = FALSE)
|
||||||
|
expect_named(named_all)
|
||||||
|
unnamed_all <- color(unname = TRUE)
|
||||||
|
expect_null(names(unnamed_all))
|
||||||
|
|
||||||
|
# Test validation of ... arguments to ensure they're strings
|
||||||
|
expect_error(color(123), "Assertion on 'Argument #1' failed")
|
||||||
|
expect_error(color(TRUE), "Assertion on 'Argument #1' failed")
|
||||||
|
expect_error(
|
||||||
|
color(list("white")),
|
||||||
|
"Assertion on 'Argument #1' failed"
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test that vectors are not allowed
|
||||||
|
expect_error(
|
||||||
|
color(c("white", "black")),
|
||||||
|
"Assertion on 'Argument #1' failed: Must have length 1."
|
||||||
|
)
|
||||||
|
|
||||||
|
# Multiple arguments should still work as long as each is a single string
|
||||||
|
expect_length(color("white", "black"), 2)
|
||||||
|
})
|
||||||
Loading…
Add table
Reference in a new issue