Merge pull request #45 from OxfordIHTM/dev

add tests

DESCRIPTION

@@ -21,11 +21,13 @@ Imports:
 Suggests: 
     covr,
     sf,
-    spelling
+    spelling,
+    testthat (>= 3.0.0)
 Encoding: UTF-8
 Language: en-GB
 LazyData: true
 RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 URL: https://oxford-ihtm.io/oxthema/,https://github.com/OxfordIHTM/oxthema
 BugReports: https://github.com/OxfordIHTM/oxthema/issues
+Config/testthat/edition: 3

R/create_palette.R

@@ -10,7 +10,6 @@
 #' @param n Number of colours desired/required. Oxford palettes have at least
 #'   5 colours. All colour schemes are derived from the University of Oxford
 #'   [visual identity guidelines](https://communications.web.ox.ac.uk/communications-resources/visual-identity/identity-guidelines).
-#'   #If NULL (default), use all colours.
 #' @param type A character value for type of palette to use. Can be either
 #'   sequential, divergent, or qualitative.
 #'
@@ -108,12 +107,24 @@ create_palette_divergent <- function(n, name) {
 create_palette_qualitative <- function(n, name) {
   ## Check if specified palette is qualitative ----
   if (
-    !name %in%
-    c("pastel", "dark", "heritage", "contemporary", "celebratory", "corporate")
+    !name %in% c(
+      "pastel", "dark", "heritage", "contemporary",
+      "celebratory", "corporate", "innovative"
+    )
   ) stop (
     "Selected palette is not a qualitative palette. Please verify and try again."
   )
 
+  ## Check if number of colours is compatible with theme packs ----
+  if (n > 5 & !name %in% c("pastel", "dark")) {
+    warning (
+      paste(
+        "The Oxford theme packs palette has maximum 5 colours. Returning 5 colours."
+      )
+    )
+    n <- 8
+  }
+
   ## Check if number of colours is compatible with pastel ----
   if (n > 8 & name == "pastel") {
     warning (
@@ -134,11 +145,16 @@ create_palette_qualitative <- function(n, name) {
     n <- 7
   }
 
-  ## Get base palette ----
-  pal <- oxford_brewer_palettes()[[name]]
+  if (name %in% c("pastel", "dark")) {
+    ## Get base palette ----
+    pal <- oxford_brewer_palettes()[[name]]
+  } else {
+    ## Get base palette ----
+    pal <- oxford_theme_palettes()[[name]]
+  }
 
   ## Update palette to n ----
-  pal <- grDevices::colorRampPalette(pal)(n)
+  pal <- pal[seq_len(n)]
 
   ## Create palette class ----
   class(pal) <- "palette"
@@ -153,7 +169,7 @@ create_palette_qualitative <- function(n, name) {
 #' @export
 #'
 create_brewer_palette <- function(n, name,
-                                  type = c("sequential", "divergent", "qualitative")) {
+                                  type = c("sequential", "divergent")) {
   ## Determine type of palette ----
   type <- match.arg(type)
 
@@ -162,8 +178,6 @@ create_brewer_palette <- function(n, name,
 
   if (type == "divergent") pal <- create_palette_divergent(n = n, name = name)
 
-  if (type == "qualitative") pal <- create_palette_qualitative(n = n, name = name)
-
   ## Return palette ----
   pal
 }

tests/testthat.R

@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(oxthema)
+
+test_check("oxthema")

tests/testthat/test-create_palette.R

@@ -0,0 +1,41 @@
+# Tests for functions to create palette ----------------------------------------
+
+xx <- create_palette_sequential(5, "blues")
+
+testthat::expect_s3_class(xx, class = "palette")
+testthat::expect_equal(length(xx), 5)
+
+testthat::expect_warning(create_palette_sequential(2, "blues"))
+testthat::expect_warning(create_palette_sequential(10, "blues"))
+testthat::expect_error(create_palette_sequential(5, "brbg"))
+
+
+xx <- create_palette_divergent(5, "brbg")
+
+testthat::expect_s3_class(xx, class = "palette")
+testthat::expect_equal(length(xx), 5)
+
+testthat::expect_warning(create_palette_divergent(2, "brbg"))
+testthat::expect_warning(create_palette_divergent(12, "brbg"))
+testthat::expect_error(create_palette_divergent(5, "blues"))
+
+xx <- create_palette_qualitative(n = 5, "corporate")
+
+testthat::expect_s3_class(xx, class = "palette")
+testthat::expect_equal(length(xx), 5)
+
+testthat::expect_warning(create_palette_qualitative(8, "dark"))
+testthat::expect_warning(create_palette_qualitative(9, "pastel"))
+testthat::expect_warning(create_palette_qualitative(6, "innovative"))
+testthat::expect_error(create_palette_qualitative(5, "blues"))
+
+xx <- create_brewer_palette(n = 7, name = "blues", type = "sequential")
+
+testthat::expect_s3_class(xx, class = "palette")
+testthat::expect_equal(length(xx), 7)
+
+xx <- create_brewer_palette(n = 7, name = "brbg", type = "divergent")
+
+testthat::expect_s3_class(xx, class = "palette")
+testthat::expect_equal(length(xx), 7)
+