Refactor sg_palette and improve handling of palette_type in other fns

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sgplot
 Title: Graphic Styles and Colours for Scottish Government Plots
-Version: 0.3.0
+Version: 0.3.0.9000
 Authors@R: c(
     person("Scottish Government", , , "[email protected]", role = c("cph", "fnd")),
     person("Alice", "Hannah", , "[email protected]", c("aut", "cre"))
@@ -13,7 +13,7 @@ URL:
 BugReports: https://github.com/ScotGovAnalysis/sgplot/issues
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends:
   R (>= 2.10)
 Imports:

NAMESPACE

@@ -1,5 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(available_palette_types)
+export(available_palettes)
+export(check_palette)
+export(check_palette_type)
 export(mm_to_inch)
 export(scale_colour_continuous_sg)
 export(scale_colour_discrete_sg)

NEWS.md

@@ -1,3 +1,5 @@
+# sgplot (development version)
+
 # sgplot 0.3.0
 
 * Add Social Security Scotland colours (`sss_colour_values`) and palettes (`sss_colour_palettes`)

R/scale_continuous_sg.R

@@ -20,30 +20,16 @@
 #' @export
 
 scale_colour_continuous_sg <- function(palette = "sequential",
-                                       palette_type = c("sg", "sss", "af"),
+                                       palette_type = "sg",
                                        reverse = FALSE,
                                        na_colour = "grey50",
                                        guide = "colourbar",
                                        ...) {
 
-  palette_type <- match.arg(palette_type)
-
-  palette_list <- switch(
-    palette_type,
-    af  = sgplot::af_colour_palettes,
-    sg  = sgplot::sg_colour_palettes,
-    sss = sgplot::sss_colour_palettes
-  )
-
-  # Error if palette doesn't exist
-  if (!palette %in% names(palette_list)) {
-    cli::cli_abort(c(
-      "x" = paste("`{palette}` is not a valid palette name in",
-                  "`{palette_type}_colour_palettes`.")
-    ))
-  }
-
-  colours <- as.vector(palette_list[[palette]])
+  colours <-
+    sg_palette(palette = palette,
+               palette_type = palette_type,
+               reverse = reverse)(n = NULL)
 
   ggplot2::continuous_scale(
     aesthetics = "colour",
@@ -52,36 +38,23 @@ scale_colour_continuous_sg <- function(palette = "sequential",
     guide      = guide,
     ...
   )
+
 }
 
 #' @export
 #' @rdname scale_colour_continuous_sg
 
 scale_fill_continuous_sg <- function(palette = "sequential",
-                                     palette_type = c("sg", "sss", "af"),
+                                     palette_type = "sg",
                                      reverse = FALSE,
                                      na_colour = "grey50",
                                      guide = "colourbar",
                                      ...) {
 
-  palette_type <- match.arg(palette_type)
-
-  palette_list <- switch(
-    palette_type,
-    af  = sgplot::af_colour_palettes,
-    sg  = sgplot::sg_colour_palettes,
-    sss = sgplot::sss_colour_palettes
-  )
-
-  # Error if palette doesn't exist
-  if (!palette %in% names(palette_list)) {
-    cli::cli_abort(c(
-      "x" = paste("`{palette}` is not a valid palette name in",
-                  "`{palette_type}_colour_palettes`.")
-    ))
-  }
-
-  colours <- as.vector(palette_list[[palette]])
+  colours <-
+    sg_palette(palette = palette,
+               palette_type = palette_type,
+               reverse = reverse)(n = NULL)
 
   ggplot2::continuous_scale(
     aesthetics = "fill",
@@ -90,4 +63,5 @@ scale_fill_continuous_sg <- function(palette = "sequential",
     guide      = guide,
     ...
   )
+
 }

R/scale_discrete_sg.R

@@ -2,9 +2,8 @@
 #'
 #' @param palette Name of palette to use; e.g. "main", "sequential", "focus".
 #' Default value is "main".
-#' @param palette_type Either "sg" to use Scottish Government palettes
-#' (default), "sss" to use Social Security Scotland palettes or "af" to use
-#' Analysis Function palettes.
+#' @param palette_type Name of palette type to use. Defaults to "sg". For all
+#' available palette types, run `available_palette_types()`.
 #' @param reverse Boolean value to indicate whether the palette should be
 #' reversed.
 #' @param ... Additional arguments passed to scale type.
@@ -28,12 +27,10 @@
 #' @export
 
 scale_colour_discrete_sg <- function(palette = "main",
-                                     palette_type = c("sg", "sss", "af"),
+                                     palette_type = "sg",
                                      reverse = FALSE,
                                      ...) {
 
-  palette_type <- match.arg(palette_type)
-
   ggplot2::discrete_scale(
     aesthetics = "colour",
     palette = sg_palette(palette, reverse, palette_type = palette_type),
@@ -47,12 +44,10 @@ scale_colour_discrete_sg <- function(palette = "main",
 #' @rdname scale_colour_discrete_sg
 
 scale_fill_discrete_sg <- function(palette = "main",
-                                   palette_type = c("sg", "sss", "af"),
+                                   palette_type = "sg",
                                    reverse = FALSE,
                                    ...) {
 
-  palette_type <- match.arg(palette_type)
-
   ggplot2::discrete_scale(
     aesthetics = "fill",
     palette = sg_palette(palette, reverse, palette_type = palette_type),

R/sg_palette.R

@@ -1,94 +1,100 @@
-#' Return function to use Scottish Government colour palette
+#' Return function to use sgplot colour palette
 #'
 #' @param palette Name of palette to use.
 #' @param reverse Boolean value to indicate whether the palette should be
 #' reversed.
 #' @param colour_names Boolean value to indicate whether colour names should be
 #' included.
-#' @param palette_type Either "sg" to use Scottish Government palettes
-#' (default), "sss" to use Social Security Scotland palettes or "af" to use
-#' Analysis Function palettes.
+#' @param palette_type Name of palette type to use. Defaults to "sg". For all
+#' available palette types, run `available_palette_types()`.
+#'
+#' @return Function with one argument, `n`.
 #'
 #' @noRd
 
 sg_palette <- function(palette = "main",
                        reverse = FALSE,
                        colour_names = FALSE,
-                       palette_type = c("sg", "sss", "af"),
+                       palette_type = "sg",
                        error_call = rlang::caller_env(),
                        error_arg = rlang::caller_arg(palette)) {
 
-  palette_type <- rlang::arg_match(palette_type)
+  check_palette(palette_type, palette)
 
-  palette_list <- switch(
-    palette_type,
-    af  = sgplot::af_colour_palettes,
-    sss = sgplot::sss_colour_palettes,
-    sg  = sgplot::sg_colour_palettes
-  )
+  function(n) {
+    pal <- get_colours(palette_type, palette, n)
 
-  # Check valid palette name
-  if (!palette %in% names(palette_list)) {
-    cli::cli_abort(
-      c("x" = paste("{.str {palette}} is not a valid palette name ",
-                    "for {.str {palette_type}} palette type."),
-        "i" = "Available palette{?s}: {.str {names(palette_list)}}."),
-      call = error_call
-    )
+    if (reverse) pal <- rev(pal)
+
+    if (!colour_names) pal <- as.vector(pal)
+
+    pal
   }
 
-  function(n) {
-    n_available <- length(palette_list[[palette]])
-
-    # Use 'main2' if AF main palette used and only 2 colours required
-    if (
-      palette_type == "af" &&
-        n == 2 &&
-        palette != "main2" &&
-        grepl("main", palette)
-    ) {
-      palette <- "main2"
-      cli::cli_warn(c(
-        "!" = "Using {.str main2} as only two colours are required."
-      ))
-    }
-
-    ext_palettes <- subset(
-      names(palette_list),
-      stringr::str_detect(names(palette_list), "^main([5-9]|-extended)")
-    )
+}
 
-    # Error if more colours requested than exist in palette
-    if (n > n_available) {
-      cli::cli_abort(
-        c(
-          "x" = paste("{.arg {error_arg}} must contain at least",
-                      "{n} colours."),
-          "i" = paste("The {.str {palette}} palette from the ",
-                      "{.str {palette_type}} palette type",
-                      "only contains {n_available} colours."),
-          if (n > 4) {
-            c("i" = paste("Accessibility guidance recommends a limit of four",
-                          "colours per chart. If more than four colours are",
-                          "required, first consider chart redesign."))
-          },
-          if (n > 4 & !is.null(ext_palettes)) {
-            c("i" = paste("If it is essential to use more than four colours,",
-                          "the {.str {ext_palettes}} palette{?s} can be used."))
-          }
-        ),
-        call = error_call
-      )
-    }
 
-    pal <- palette_list[[palette]][seq_len(n)]
+#' Get colours
+#'
+#' @description This function checks that the required number of colours are
+#' available from the selected palette and palette type, and if so returns them.
+#' If not, a helpful error is returned.
+#'
+#' @param palette_type,palette String.
+#' @param n Number of colours required.
+#'
+#' @return Named character vector of colours, length `n`.
+#'
+#' @noRd
+
+get_colours <- function(palette_type, palette, n) {
 
-    if (reverse) pal <- rev(pal)
+  all_palettes <- eval(parse(
+    text = paste0("sgplot::", palette_type, "_colour_palettes")
+  ))
+
+  n_available <- length(all_palettes[[palette]])
+
+  if (is.null(n)) n <- n_available
+
+  # Use 'main2' if AF main palette used and only 2 colours required
+  if (
+    palette_type == "af" &&
+      n == 2 &&
+      palette != "main2" &&
+      grepl("main", palette)
+  ) {
+    palette <- "main2"
+    cli::cli_warn(c(
+      "!" = "Using {.str main2} as only two colours are required."
+    ))
+  }
+
+  # Error if more colours requested than exist in palette
+  if (n > n_available) {
+    ext_palettes <- grep("^main([5-9]|-extended)",
+                         available_palettes(palette_type),
+                         value = TRUE)
 
-    if (colour_names) {
-      pal
-    } else {
-      as.vector(pal)
-    }
+    cli::cli_abort(
+      c(
+        "x" = "{.arg {palette}} must contain at least {n} colours.",
+        "i" = paste("The {.str {palette}} palette from the ",
+                    "{.str {palette_type}} palette type",
+                    "only contains {n_available} colours."),
+        if (n > 4) {
+          c("i" = paste("Accessibility guidance recommends a limit of four",
+                        "colours per chart. If more than four colours are",
+                        "required, first consider chart redesign."))
+        },
+        if (n > 4 & !is.null(ext_palettes)) {
+          c("i" = paste("If it is essential to use more than four colours,",
+                        "the {.str {ext_palettes}} palette{?s} can be used."))
+        }
+      )
+    )
   }
+
+  all_palettes[[palette]][seq_len(n)]
+
 }