fix tint and shade functions; create brewer functions; fix #97; fix #99…

…; fix #100; fix #101; fix #102

DESCRIPTION

@@ -16,6 +16,7 @@ License: GPL (>= 3)
 Depends: 
     R (>= 4.1.0)
 Imports: 
+    cli,
     ggplot2,
     stringr,
     systemfonts,

NAMESPACE

@@ -4,6 +4,7 @@ S3method(print,palette)
 export(acdc_amber)
 export(acdc_blue)
 export(acdc_blue_grey)
+export(acdc_brewer_palettes)
 export(acdc_corporate_green)
 export(acdc_cyan)
 export(acdc_deep_orange)
@@ -46,6 +47,10 @@ export(nhs_purple)
 export(nhs_warm_yellow)
 export(nhs_white)
 export(nhs_yellow)
+export(paleta_create_brewer)
+export(paleta_create_divergent)
+export(paleta_create_qualitative)
+export(paleta_create_sequential)
 export(paleta_fonts)
 export(set_acdc_font)
 export(set_nhs_font)
@@ -97,6 +102,9 @@ export(wb_light_aqua)
 export(wb_light_orange)
 export(wb_palettes)
 export(wb_white)
+importFrom(cli,cli_abort)
+importFrom(cli,cli_alert_success)
+importFrom(cli,cli_bullets)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_line)
 importFrom(ggplot2,element_rect)

R/paleta.R

@@ -17,5 +17,6 @@
 #' @importFrom grid unit
 #' @importFrom grDevices col2rgb rgb
 #' @importFrom graphics rect par image text
+#' @importFrom cli cli_abort  cli_alert_success cli_bullets
 #'
 "_PACKAGE"

R/paleta_brewer.R

@@ -0,0 +1,234 @@
+#'
+#' Create new palettes based on organisational palettes
+#'
+#' These functions apply a similar approach used and demonstrated by
+#' [ColorBrewer](https://colorbrewer2.org) and has been patterned after the
+#' syntax of the `RColorBrewer` package
+#'
+#' @param org Name of organisation. Currently supports only *"acdc"* for the
+#'   Africa CDC colour palettes.
+#' @param name Name of the organisational palette to use
+#' @param n Number of colours desired/required. Organisational palettes should
+#'   have at least 3 colours and up to 9 colours maximum. All colour schemes are
+#'   derived from an organisation's brand/style guidelines.
+#' @param type A character value for type of palette to use. Can be either
+#'   *"sequential"*, *"divergent"*, or *"qualitative"*.
+#'
+#' @returns A character vector of desired/required colours with length
+#'   equivalent to `n`
+#'
+#' @examples
+#' paleta_create_sequential(n = 5, org = "acdc", name = "blues")
+#'
+#' @rdname create_paleta
+#' @export
+#'
+
+paleta_create_sequential <- function(n, org, name) {
+  ## Check if specified palette is found in specified org palette ----
+  paleta_check_colour(name = name, org = org)
+
+  ## Check if specified palette is sequential ----
+  paleta_check_type(name = name, pal_type = "sequential")
+
+  ## Check if number of colours is compatible with sequential ----
+  if (n < 3) {
+    cli::cli_bullets(
+      "!" = "Sequential palettes have minimum 3 colours",
+      "i" = "Returning 3 colours"
+    )
+
+    n <- 3
+  }
+
+  if (n > 9) {
+    cli::cli_bullets(
+      "!" = "Sequential palettes have maximum 9 colours",
+      "i" = "Returning 9 colours"
+    )
+
+    n <- 9
+  }
+
+  ## Get base palette ----
+  pal <- get(paste0(org, "_brewer_palettes"))[[name]]
+
+  ## Update palette to n ----
+  pal <- grDevices::colorRampPalette(pal)(n)
+
+  ## Create palette class ----
+  class(pal) <- "palette"
+
+  ## Return palette ----
+  pal
+}
+
+
+#'
+#' @rdname create_paleta
+#' @export
+#'
+paleta_create_divergent <- function(n, name, org) {
+  ## Check if specified palette is found in specified org palette ----
+  paleta_check_colour(name = name, org = org)
+
+  ## Check if specified palette is divergent ----
+  paleta_check_type(name = name, pal_type = "divergent")
+
+  ## Check if number of colours is compatible with divergent ----
+  if (n < 3) {
+    cli::cli_bullets(
+      "!" = "Divergent palettes have minimum 3 colours",
+      "i" = "Returning 3 colours"
+    )
+
+    n <- 3
+  }
+
+  if (n > 11) {
+    cli::cli_bullets(
+      "!" = "Divergent palettes have maximum 11 colours",
+      "i" = "Returning 11 colours"
+    )
+
+    n <- 11
+  }
+
+  ## Get base palette ----
+  pal <- get(paste0(org, "_brewer_palettes"))[[name]]
+
+  ## Update palette to n ----
+  pal <- grDevices::colorRampPalette(pal)(n)
+
+  ## Create palette class ----
+  class(pal) <- "palette"
+
+  ## Return palette ----
+  pal
+}
+
+#'
+#' @rdname create_paleta
+#' @export
+#'
+paleta_create_qualitative <- function(n, name, org) {
+  ## Check if specified palette is found in specified org palette ----
+  paleta_check_colour(name = name, org = org)
+
+  ## Check if specified palette is divergent ----
+  paleta_check_type(name = name, pal_type = "qualitative")
+
+  ## Get base palette ----
+  pal <- get(paste0(org, "_brewer_palettes"))[[name]]
+
+  ## Check that n is not more than length(pal) ----
+  if (n > length(pal)) {
+    cli::cli_bullets(
+      "!" = "{.code n = {n}} is greater than available colours in {name} palette",
+      "i" = "Returning all colours in {name} colour palette"
+    )
+
+    n <- length(pal)
+  }
+
+  ## Update palette to n ----
+  pal <- pal[seq_len(n)]
+
+  ## Create palette class ----
+  class(pal) <- "palette"
+
+  ## Return palette ----
+  pal
+}
+
+
+#'
+#' @rdname create_paleta
+#' @export
+#'
+paleta_create_brewer <- function(n, name, org,
+                                 type = c("sequential", 
+                                          "divergent", 
+                                          "qualitative")) {
+  ## Determine type of palette ----
+  type <- match.arg(type)
+
+  pal <- parse(
+    text = paste0("paleta_create_", type, "(n = n, name = name, org = org)")
+  ) |>
+    eval()
+
+  ## Return palette ----
+  pal
+}
+
+#'
+#' Palette types
+#' 
+#' @keywords internal
+#' 
+
+paleta_brewer_types <- list(
+  sequential = c(
+    "blues", "bugn", "bupu", "gnbu", "greens", "greys", "pubu", "pubugn", 
+    "purd", "rdpu", "reds", "ylgn", "ylgnbu", "ylorbr", "ylorrd"
+  ),
+  divergent = c(
+    "brbg", "piylgn", "prgn", "puor", "rdbu", "rdgy","rdylbu", "rdylgn"
+  ),
+  qualitative = c(
+    "pastel1", "pastel2", "pastel3", "dark", "light", "bright"
+  )
+)
+
+#'
+#' Check if a colour palette name is from a specified organisation
+#' 
+#' @keywords internal
+#' 
+
+paleta_check_colour <- function(name, org) {
+  x <- get(paste0(org, "_brewer_palettes"))[[name]]
+
+  if (is.null(x)) {
+    cli::cli_abort(
+      "Colour palette {.val {name}} is not a {org} colour palette"
+    )
+  } else {
+    cli::cli_alert_success(
+      "Colour palette {.val {name}} is a {org} colour palette"
+    )
+  }
+
+  ## Return colour palette ----
+  x
+}
+
+#'
+#' Check if a colour palette is divergent, sequential, or qualitative
+#' 
+#' @keywords internal
+#' 
+
+paleta_check_type <- function(name, 
+                              pal_type = c("sequential", 
+                                           "divergent", 
+                                           "qualitative")) {
+  pal_type <- match.arg(pal_type)
+
+  type_check <- name %in% paleta_brewer_types[[pal_type]]
+
+  if (!type_check) {
+    cli::cli_abort(
+      "{name} is not a {pal_type} colour palette"
+    )
+
+    FALSE
+  } else {
+    cli::cli_alert_success(
+      "{name} is a {pal_type} colour palette"
+    )
+
+    TRUE
+  }
+}

R/theme_acdc.R

@@ -108,6 +108,59 @@ acdc_palettes <- list(
   acdc_teals        = c("#CCE9E6", "#99D3CD", "#66BEB4", "#33A89B", acdc_teal)
 )
 
+#'
+#' @examples
+#' acdc_brewer_palettes
+#'
+#' @rdname acdc_palette
+#' @export
+#'
+acdc_brewer_palettes <- list(
+  blues  = rev(c(acdc_blue, acdc_blue_grey, acdc_palettes$acdc_blues[2])),
+  bugn   = c(acdc_blue, acdc_lime, acdc_teal),
+  bupu   = c(acdc_blue, acdc_blue_grey, acdc_purple),
+  gnbu   = c(acdc_teal, acdc_lime, acdc_blue),
+  pubu   = c(acdc_purple, acdc_blue_grey, acdc_blue),
+  pubugn = c(acdc_purple, acdc_blue, acdc_lime),
+  purd   = c(acdc_purple, acdc_plum, acdc_pink),
+  rdpu   = c(acdc_red, acdc_pink, acdc_purple),
+  ylgn   = c(acdc_amber, acdc_teal, acdc_green),
+  ylgnbu = c(acdc_amber, acdc_lime, acdc_blue),
+  ylorrd = c(acdc_amber, acdc_deep_orange, acdc_red),
+  piylgn = c(acdc_pink, acdc_amber, acdc_lime),
+  prgn   = c(acdc_purple, acdc_mauve, acdc_green),
+  puor   = c(acdc_purple, acdc_amber, acdc_deep_orange),
+  rdbu   = c(acdc_red, acdc_plum, acdc_blue),
+  rdylbu = c(acdc_red, acdc_amber, acdc_blue),
+  rdylgn = c(acdc_red, acdc_amber, acdc_lime),
+  pastel1 = c(
+    acdc_palettes$acdc_blues[3], 
+    acdc_palettes$acdc_plums[3], 
+    acdc_palettes$acdc_blue_grey[3], 
+    acdc_palettes$acdc_amber[3], 
+    acdc_palettes$acdc_cyan[3], 
+    acdc_palettes$acdc_deep_orange[3], 
+    acdc_palettes$acdc_purple[3], 
+    acdc_palettes$acdc_lime[3], 
+    acdc_palettes$acdc_mauve[3], 
+    acdc_palettes$acdc_pink[3], 
+    acdc_palettes$acdc_teal[3]
+  ),
+  pastel2 = c(
+    acdc_palettes$acdc_blues[2], 
+    acdc_palettes$acdc_plums[2], 
+    acdc_palettes$acdc_blue_grey[2], 
+    acdc_palettes$acdc_amber[2], 
+    acdc_palettes$acdc_cyan[2], 
+    acdc_palettes$acdc_deep_orange[2], 
+    acdc_palettes$acdc_purple[2], 
+    acdc_palettes$acdc_lime[2], 
+    acdc_palettes$acdc_mauve[2], 
+    acdc_palettes$acdc_pink[2], 
+    acdc_palettes$acdc_teal[2]
+  )
+)
+
 
 #'
 #' Africa CDC fonts

inst/WORDLIST

@@ -1,9 +1,8 @@
-Acumin
 Aleo
 CMD
-Calibri
 CodeFactor
 Codecov
+ColorBrewer
 Frutiger
 IBRD
 ICSID
@@ -19,12 +18,12 @@ Rudis
 Univers
 WBG
 WIP
+acdc
 bl
 cmyk
 computing's
 ernest
 guevarra
-heirarchical
 hrbrthemes
 io
 organisations’