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 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.
|
||||
#'
|
||||
#' @export
|
||||
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
|
||||
|
||||
# Retrieve colors
|
||||
# retrieve colors
|
||||
cols <- c(...)
|
||||
|
||||
# Defined colors
|
||||
# define color vector
|
||||
colors <- c(
|
||||
white = "#FFFFFF",
|
||||
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