Add tate-color palette

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: see
 Title: Model Visualisation Toolbox for 'easystats' and 'ggplot2'
-Version: 0.8.5.6
+Version: 0.8.5.7
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NAMESPACE

@@ -110,6 +110,7 @@ export(palette_okabeito)
 export(palette_pizza)
 export(palette_see)
 export(palette_social)
+export(palette_tate)
 export(pizza_colors)
 export(plots)
 export(scale_color_bluebrown)
@@ -138,6 +139,9 @@ export(scale_color_see_d)
 export(scale_color_social)
 export(scale_color_social_c)
 export(scale_color_social_d)
+export(scale_color_tate)
+export(scale_color_tate_c)
+export(scale_color_tate_d)
 export(scale_colour_bluebrown)
 export(scale_colour_bluebrown_c)
 export(scale_colour_bluebrown_d)
@@ -164,6 +168,9 @@ export(scale_colour_see_d)
 export(scale_colour_social)
 export(scale_colour_social_c)
 export(scale_colour_social_d)
+export(scale_colour_tate)
+export(scale_colour_tate_c)
+export(scale_colour_tate_d)
 export(scale_fill_bluebrown)
 export(scale_fill_bluebrown_c)
 export(scale_fill_bluebrown_d)
@@ -190,8 +197,12 @@ export(scale_fill_see_d)
 export(scale_fill_social)
 export(scale_fill_social_c)
 export(scale_fill_social_d)
+export(scale_fill_tate)
+export(scale_fill_tate_c)
+export(scale_fill_tate_d)
 export(see_colors)
 export(social_colors)
+export(tate_colors)
 export(theme_abyss)
 export(theme_blackboard)
 export(theme_lucid)

NEWS.md

@@ -4,6 +4,9 @@
 
 - New `plot()` method for `performance::check_dag()`.
 
+- New color palette `tate`, inspired by the colors of the Tate Modern museum in
+  London. See `?scale_color_tate`.
+
 # see 0.8.5
 
 ## Major Changes

R/scale_color_tate.R

@@ -0,0 +1,229 @@
+#' Tate Modern color palette
+#'
+#' A color palette inspired by paintings in the Tate Modern Art Museum in London.
+#' Use `scale_color_tate_d()` for *discrete* categories and
+#' `scale_color_tate_c()` for a *continuous* scale.
+#'
+#' @inheritParams palette_tate
+#' @inheritParams scale_color_flat
+#'
+#' @examples
+#' library(ggplot2)
+#' library(see)
+#'
+#' ggplot(iris, aes(x = Species, y = Sepal.Length, fill = Species)) +
+#'   geom_boxplot() +
+#'   theme_modern() +
+#'   scale_fill_tate_d()
+#'
+#' ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width, colour = Species)) +
+#'   geom_point() +
+#'   theme_abyss() +
+#'   scale_colour_tate(palette = "fontana")
+#' @export
+scale_color_tate <- function(palette = "history",
+                             discrete = TRUE,
+                             reverse = FALSE,
+                             aesthetics = "color",
+                             ...) {
+  pal <- palette_tate(palette = palette, reverse = reverse)
+
+  if (discrete) {
+    discrete_scale(aesthetics = aesthetics, palette = pal, ...)
+  } else {
+    scale_color_gradientn(colours = pal(256), aesthetics = aesthetics, ...)
+  }
+}
+
+
+
+# Aliases -----------------------------------------------------------------
+
+
+#' @rdname scale_color_tate
+#' @export
+scale_color_tate_d <- function(palette = "history",
+                               discrete = TRUE,
+                               reverse = FALSE,
+                               aesthetics = "color",
+                               ...) {
+  scale_color_tate(
+    palette = palette,
+    discrete = discrete,
+    reverse = reverse,
+    aesthetics = aesthetics,
+    ...
+  )
+}
+
+#' @rdname scale_color_tate
+#' @export
+scale_color_tate_c <- function(palette = "history",
+                               discrete = FALSE,
+                               reverse = FALSE,
+                               aesthetics = "color",
+                               ...) {
+  scale_color_tate(
+    palette = palette,
+    discrete = discrete,
+    reverse = reverse,
+    aesthetics = aesthetics,
+    ...
+  )
+}
+
+#' @rdname scale_color_tate
+#' @export
+scale_colour_tate <- scale_color_tate
+
+#' @rdname scale_color_tate
+#' @export
+scale_colour_tate_c <- scale_color_tate_c
+
+#' @rdname scale_color_tate
+#' @export
+scale_colour_tate_d <- scale_color_tate_d
+
+
+
+
+
+# Fill --------------------------------------------------------------------
+
+
+
+#' @rdname scale_color_tate
+#' @export
+scale_fill_tate <- function(palette = "history",
+                            discrete = TRUE,
+                            reverse = FALSE,
+                            aesthetics = "fill",
+                            ...) {
+  pal <- palette_tate(palette = palette, reverse = reverse)
+
+  if (discrete) {
+    discrete_scale(aesthetics = aesthetics, palette = pal, ...)
+  } else {
+    scale_fill_gradientn(colours = pal(256), aesthetics = aesthetics, ...)
+  }
+}
+
+
+#' @rdname scale_color_tate
+#' @export
+scale_fill_tate_d <- function(palette = "history",
+                              discrete = TRUE,
+                              reverse = FALSE,
+                              aesthetics = "fill",
+                              ...) {
+  scale_fill_tate(
+    palette = palette,
+    discrete = discrete,
+    reverse = reverse,
+    aesthetics = aesthetics,
+    ...
+  )
+}
+
+#' @rdname scale_color_tate
+#' @export
+scale_fill_tate_c <- function(palette = "history",
+                              discrete = FALSE,
+                              reverse = FALSE,
+                              aesthetics = "fill",
+                              ...) {
+  scale_fill_tate(
+    palette = palette,
+    discrete = discrete,
+    reverse = reverse,
+    aesthetics = aesthetics,
+    ...
+  )
+}
+
+
+
+# Palette --------------------------------------------------------------------
+
+
+tate_colors_list <- c(
+  # history palette
+  `dark green` = "#625F0E",
+  brown = "#543111",
+  amber = "#B47C01",
+  grey = "#595645",
+  beige = "#9A8351",
+  # fontana palette
+  scarlett = "#7D2D36",
+  red = "#A5102E",
+  rose = "#C97B6F",
+  yellow = "#C78F52"
+)
+
+
+#' Extract tate colors as hex codes
+#'
+#' Can be used to get the hex code of specific colors from the tate color
+#' palette. Use `tate_colors()` to see all available colors.
+#'
+#' @inheritParams flat_colors
+#'
+#' @return A character vector with color-codes.
+#'
+#' @examples
+#' tate_colors()
+#'
+#' tate_colors("indigo", "lime")
+#' @export
+tate_colors <- function(...) {
+  cols <- c(...)
+
+  if (is.null(cols)) {
+    return(tate_colors_list)
+  }
+
+  tate_colors_list[cols]
+}
+
+
+tate_palettes <- list(
+  full = tate_colors(),
+  history = tate_colors("dark green", "brown", "amber", "grey", "beige"),
+  fontana = tate_colors("scarlett", "red", "rose", "yellow")
+)
+
+
+#' Tate Modern color palette
+#'
+#' @inheritParams palette_flat
+#'
+#' @details This function is usually not called directly, but from within
+#'   [`scale_color_tate()`][scale_color_tate].
+#'
+#' @export
+palette_tate <- function(palette = "history", reverse = FALSE, ...) {
+  .retrieve_palette(palette, tate_palettes, reverse = reverse, ...)
+}
+
+
+
+
+
+# helper -----------------------
+
+.retrieve_palette <- function(palette, palette_list, reverse = FALSE, ...) {
+  if (!palette %in% names(palette_list)) {
+    msg <- c(paste0(
+      "Palette name not available. `palette` must be one of ",
+      datawizard::text_concatenate(names(palette_list), last = " or ", enclose = "`"),
+      "."
+    ), "Using default palette now.")
+    insight::format_warning(msg)
+    palette <- 1
+  }
+  pal <- palette_list[[palette]]
+
+  if (reverse) pal <- rev(pal)
+
+  grDevices::colorRampPalette(pal, ...)
+}