R/dgi_palette.R

In taylordunn/dgitheme: DGI Clinical Theme

# DGI Clinical palette functions

dgi_colors_list <- c(
  `teal` = "#42b99c",
  `light grey` = "#dcddde",
  `black` = "#000000",
  `blue` = "#1c9bc0",
  `sea green` = "#1cb4c6",
  `white` = "#ffffff",
  # Below are not brand colors, but may be of use
  # This red is complementary to the main teal (i.e. they are high contrast)
  #  because they are on opposite sides of the color wheel
  `red` = "#b9425f",
  # These colors are split-complementary
  `brown` = "#b97642",
  `chestnut` = "#b94250",
  # These colors are triadic (evenly spaced around the color wheel)
  `yellow` = "#b99342",
  `violet` = "#b9428b",
  # Splitting the violet above makes a tetradic group (four colors)
  `orange` = "#b95842",
  `purple` = "#7042b9",
  # This five color set was generated using coolors.co
  `pastel red` = "#f26a68",
  `lapis lazuli` = "#2b7da0",
  `hansa yellow` = "#f2d76d",
  `dark liver` = "#514d4d"
)

#' @title DGI Clinical colors
#' @description Function to extract DGI colors as hex codes.
#'
#' @rdname dgi_colors
#' @export
#' @param ... Character names of DGI colors. Any combination of "teal", "light grey", "black", "blue", "sea green", "white", "red", "brown", "chestnut", "yellow", "violet", "orange", "purple", "pastel red", "lapis lazuli", "hansa yellow", or "dark liver". By default, returns all colors in a vector.
#' @examples
#' library(ggplot2)
#'
#' ggplot(mtcars, aes(hp, mpg)) +
#'   geom_point(size = 4, color = dgi_colors("teal")) +
#'   theme_minimal()
#'
#' ggplot(mtcars, aes(hp, mpg, color = factor(cyl))) +
#'   geom_point(size = 4) +
#'   scale_color_manual(values = dgi_colors()[1:3]) +
#'   theme_minimal()
#'
#' ggplot(mtcars, aes(hp, mpg, color = factor(cyl))) +
#'   geom_point(size = 4) +
#'   scale_color_manual(values = dgi_colors("teal", "light grey", "black")) +
#'   theme_minimal()
dgi_colors <- function(...) {
  colors <- c(...)

  if (is.null(colors))
    return(unname(dgi_colors_list))

  unname(dgi_colors_list[colors])
}

dgi_palettes <- list(
  # The 3 main DGI colors
  `main` = dgi_colors("teal", "light grey", "black"),
  # The three cool (blue/green) colours
  `cool` = dgi_colors("teal", "blue", "sea green"),
  # Greyscale
  `grey` = dgi_colors("black", "light grey", "white"),
  # All 6 official colors
  `official` = dgi_colors("teal", "light grey", "black",
                          "blue", "sea green", "white"),
  # Various two-color combinations, for sequential and diverging palettes
  `teal white` = dgi_colors("teal", "white"),
  `teal black` = dgi_colors("teal", "black"),
  `teal grey` = dgi_colors("teal", "light grey"),
  `blue white` = dgi_colors("blue", "white"),
  `blue black` = dgi_colors("blue", "black"),
  `blue grey` = dgi_colors("blue", "light grey"),
  `sea green white` = dgi_colors("sea green", "white"),
  `sea green black` = dgi_colors("sea green", "black"),
  `sea green grey` = dgi_colors("sea green", "light grey"),
  # Complementary, two colors
  `complementary` = dgi_colors("teal", "red"),
  # Split-complementary, three colors
  `split-complementary` = dgi_colors("teal", "brown", "chestnut"),
  # Triadic, three colors
  `triadic` = dgi_colors("teal", "yellow", "violet"),
  # Tetradic, four colors
  `tetradic` = dgi_colors("teal", "yellow", "orange", "purple"),
  # An automatically generated five color qualitative set
  `qualitative` = dgi_colors("teal", "pastel red", "lapis lazuli",
                             "hansa yellow", "dark liver")
)

#' @title DGI Clinical palettes
#' @description Returns a function for interpolating a DGI color palette.
#'
#' @rdname dgi_pal
#' @inheritDotParams grDevices::colorRampPalette
#' @export
#' @param palette Character name of palette: "main" (default), "cool", "grey", "mixed", "teal white", "teal black", "teal grey", "blue white", "blue black", "blue grey", "sea green white", "sea green black", "sea green grey", "complementary", "split-complementary", "triadic", "tetradic", or "qualitative".
#' @param reverse Boolean to reverse palette order, default FALSE.
#' @examples
#' library(scales)
#' show_col(dgi_pal()(3))
#' show_col(dgi_pal("official")(6))
#' show_col(dgi_pal(palette = "blue black")(4))
#' show_col(dgi_pal(palette = "teal light grey white")(3))
#' show_col(dgi_pal(palette = "teal white")(6))
#' show_col(dgi_pal(palette = "sea green black")(9))
#' show_col(dgi_pal(palette = "complementary")(2))
#' show_col(dgi_pal(palette = "split-complementary")(3))
#' show_col(dgi_pal(palette = "triadic")(3))
#' show_col(dgi_pal(palette = "tetradic")(4))
#' show_col(dgi_pal(palette = "qualitative")(5))
#' @importFrom grDevices colorRampPalette
dgi_pal <- function(palette = "main", reverse = FALSE, ...) {
  palette <- tolower(palette)
  pal <- dgi_palettes[[palette]]

  if (reverse) pal <- rev(pal)

  colorRampPalette(pal, ...)
}

#' @title DGI Clinical color and fill scales
#' @inheritDotParams ggplot2::discrete_scale
#' @description The \code{scale_color_dgi} and \code{scale_fill_dgi} functions provide various palettes with DGI Clinical brand colors for use with \code{ggplot2}.
#' @rdname scale_color_dgi
#' @aliases scale_colour_dgi
#' @export
#' @param palette Character name of palette: "main" (default), "cool", "grey", "mixed", "teal white", "teal black", "teal grey", "blue white", "blue black", "blue grey", "sea green white", "sea green black", "sea green grey", "complementary", "split-complementary", "triadic", "tetradic", or "qualitative".
#' @param reverse Boolean to reverse palette order, default FALSE.
#' @param type Type of data, "discrete" (default) or "continuous". If "discrete", and the number of levels > number of colors, then additional colors will be generated by interpolation with \code{grDevices::colorRampPalette()}.
#' @examples
#' library(ggplot2)
#' library(dplyr)
#'
#' # The default palette for scale_color_dgi() is "main", which returns the
#' #  three primary DGI colors
#' ggplot(mtcars, aes(hp, mpg, color = factor(cyl))) +
#'   geom_point(size = 4) +
#'   scale_color_dgi() +
#'   theme_minimal()
#' # In this case, there are five Month values, so two additional colors are
#' #  automatically interpolated
#' ggplot(airquality, aes(x = Day, y = Temp,
#'                        group = as.factor(Month), color = as.factor(Month))) +
#'   geom_point(size = 2.5) +
#'   scale_color_dgi() +
#'   theme_minimal()
#' ggplot(airquality, aes(x = Day, y = Temp,
#'                        group = as.factor(Month), color = Month)) +
#'   geom_point(size = 2.5) +
#'   scale_color_dgi(type = "continuous") +
#'   theme_minimal()
#'
#' # Generate some three-dimensional data
#' df <- data.frame(
#'   x = runif(100),
#'   y = runif(100),
#'   z = rnorm(100)
#' )
#' ggplot(df, aes(x, y)) +
#'   geom_point(aes(color = z), size = 4) +
#'   scale_color_dgi(type = "continuous", reverse = TRUE) +
#'   theme_minimal()
#'
#' # A number of color palettes, using teal as the base, are also available
#' # Two-color complementary
#' ggplot(mtcars, aes(x = factor(am), y = disp, fill = factor(am))) +
#'   geom_boxplot() +
#'   scale_fill_dgi("complementary")
#' # Three-color split-complementary
#' ggplot(iris, aes(x = Sepal.Width, y = Sepal.Length, color = Species)) +
#'   geom_point(size = 4) +
#'   scale_color_dgi("split-complementary")
#' # Triadic
#' ggplot(iris, aes(x = Sepal.Width, y = Sepal.Length, color = Species)) +
#'   geom_point(size = 4) +
#'   scale_color_dgi("triadic")
#' # Tetradic
#' data.frame(Titanic) %>%
#'   group_by(Class, Survived) %>%
#'   summarise(n = sum(Freq)) %>%
#'   ggplot(aes(Survived, n, fill = Class)) +
#'   geom_col(position = "dodge") +
#'   scale_fill_dgi("tetradic")
#' # A five color qualitative scale
#' diamonds %>%
#'   group_by(cut) %>%
#'   sample_n(100) %>%
#'   ggplot(aes(carat, price, color = cut)) +
#'   geom_point(size = 3) +
#'   scale_color_dgi("qualitative")
#'
#' @importFrom ggplot2 discrete_scale scale_color_gradientn
scale_color_dgi <- function(palette = "main", type = "discrete",
                            reverse = FALSE, ...) {
  pal <- dgi_pal(palette = palette, reverse = reverse)

  if (type == "discrete") {
    ggplot2::discrete_scale("color", "dgi",
                            palette = pal, ...)
  } else {
    ggplot2::scale_color_gradientn(colors = pal(256), ...)
  }
}

#' @rdname scale_color_dgi
#' @export
#'
#' @importFrom ggplot2 discrete_scale scale_color_gradientn
scale_fill_dgi <- function(palette = "main", type = "discrete",
                            reverse = FALSE, ...) {
  pal <- dgi_pal(palette = palette, reverse = reverse)

  if (type == "discrete") {
    ggplot2::discrete_scale("fill", "dgi",
                            palette = pal, ...)
  } else {
    ggplot2::scale_fill_gradientn(colors = pal(256), ...)
  }
}