Color scale reuse

DESCRIPTION

@@ -208,29 +208,33 @@ Collate:
     'position-stack.R'
     'quick-plot.R'
     'reshape-add-margins.R'
+    'reuse-scale.R'
     'save.R'
     'scale-.R'
     'scale-alpha.R'
     'scale-binned.R'
     'scale-brewer.R'
+    'scale-viridis.R'
+    'scale-steps.R'
+    'scale-manual.R'
+    'scale-identity.R'
+    'scale-hue.R'
+    'scale-grey.R'
+    'scale-gradient.R'
     'scale-colour.R'
+    'scale-colour-ordinal.R'
+    'scale-color.R'
     'scale-continuous.R'
     'scale-date.R'
     'scale-discrete-.R'
     'scale-expansion.R'
-    'scale-gradient.R'
-    'scale-grey.R'
-    'scale-hue.R'
-    'scale-identity.R'
+    'scale-fill.R'
     'scale-linetype.R'
     'scale-linewidth.R'
-    'scale-manual.R'
     'scale-shape.R'
     'scale-size.R'
-    'scale-steps.R'
     'scale-type.R'
     'scale-view.R'
-    'scale-viridis.R'
     'scales-.R'
     'stat-align.R'
     'stat-bin.R'
@@ -272,5 +276,4 @@ Collate:
     'utilities-matrix.R'
     'utilities-resolution.R'
     'utilities-tidy-eval.R'
-    'zxx.R'
     'zzz.R'

NAMESPACE

@@ -486,6 +486,7 @@ export(render_axes)
 export(render_strips)
 export(reset_theme_settings)
 export(resolution)
+export(reuse_scale)
 export(scale_alpha)
 export(scale_alpha_binned)
 export(scale_alpha_continuous)

R/reuse-scale.R

@@ -0,0 +1,16 @@
+#' Make a copy of a color scale for a different aesthetic.
+#' Example use: `scale_outlinecolor_hue <- reuse_scale(scale_color_hue, "outlinecolor")`
+#' @param scale A color scale to copy from
+#' @param aesthetic The name of the new aesthetic or aesthetics to apply the color scale to
+#' @export
+reuse_scale <- function(scale, aesthetics) {
+  check_function(scale)
+  if (!"aesthetics" %in% fn_fmls_names(scale)) {
+    cli::cli_abort(c(
+      "The {.arg {deparse(substitute(scale))}} function must have an {.arg aesthetics} argument.",
+      i = "{.fn {deparse(substitute(scale))}} does not have that argument."
+    ))
+  }
+  formals(scale)$aesthetics <- aesthetics
+  scale
+}

R/scale-brewer.R

@@ -8,7 +8,7 @@
 #'
 #' @note
 #' The `distiller` scales extend `brewer` scales by smoothly
-#' interpolating 7 colours from any palette to a continuous scale. 
+#' interpolating 7 colours from any palette to a continuous scale.
 #' The `distiller` scales have a default direction = -1. To reverse, use direction = 1.
 #' The `fermenter` scales provide binned versions of the `brewer` scales.
 #'
@@ -86,12 +86,6 @@ scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, a
   discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...)
 }
 
-#' @export
-#' @rdname scale_brewer
-scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") {
-  discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...)
-}
-
 #' @export
 #' @rdname scale_brewer
 scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") {
@@ -112,23 +106,6 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = -
   # For diverging scales, you need an odd number to make sure the mid-point is in the center
 }
 
-#' @export
-#' @rdname scale_brewer
-scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") {
-  type <- arg_match0(type, c("seq", "div", "qual"))
-  if (type == "qual") {
-    cli::cli_warn(c(
-      "Using a discrete colour palette in a continuous scale",
-      "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
-    ))
-  }
-  continuous_scale(
-    aesthetics,
-    palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space),
-    na.value = na.value, guide = guide, ...
-  )
-}
-
 #' @export
 #' @rdname scale_brewer
 scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "colour") {
@@ -142,16 +119,3 @@ scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = -
   }
   binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)
 }
-
-#' @export
-#' @rdname scale_brewer
-scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, na.value = "grey50", guide = "coloursteps", aesthetics = "fill") {
-  type <- arg_match0(type, c("seq", "div", "qual"))
-  if (type == "qual") {
-    cli::cli_warn(c(
-      "Using a discrete colour palette in a binned scale",
-      "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead"
-    ))
-  }
-  binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...)
-}

R/scale-color.R

@@ -0,0 +1,115 @@
+#' @include scale-brewer.R scale-colour-ordinal.R scale-colour.R scale-gradient.R scale-grey.R scale-hue.R scale-identity.R scale-manual.R scale-steps.R scale-viridis.R
+NULL
+
+
+# British to American spellings ----------------------------------------------
+
+#' @export
+#' @rdname scale_brewer
+#' @usage NULL
+scale_color_brewer <- scale_colour_brewer
+
+#' @export
+#' @rdname scale_brewer
+#' @usage NULL
+scale_color_distiller <- scale_colour_distiller
+
+#' @export
+#' @rdname scale_brewer
+#' @usage NULL
+scale_color_fermenter <- scale_colour_fermenter
+
+#' @export
+#' @rdname scale_colour_continuous
+#' @usage NULL
+scale_color_continuous <- scale_colour_continuous
+
+#' @export
+#' @rdname scale_colour_continuous
+#' @usage NULL
+scale_color_binned <- scale_colour_binned
+
+#' @export
+#' @rdname scale_colour_discrete
+#' @usage NULL
+scale_color_discrete <- scale_colour_discrete
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_color_gradient <- scale_colour_gradient
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_color_gradient2 <- scale_colour_gradient2
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_color_gradientn <- scale_colour_gradientn
+
+#' @export
+#' @rdname scale_steps
+#' @usage NULL
+scale_color_steps <- scale_colour_steps
+
+#' @export
+#' @rdname scale_steps
+#' @usage NULL
+scale_color_steps2 <- scale_colour_steps2
+
+#' @export
+#' @rdname scale_steps
+#' @usage NULL
+scale_color_stepsn <- scale_colour_stepsn
+
+#' @export
+#' @rdname scale_grey
+#' @usage NULL
+scale_color_grey <- scale_colour_grey
+
+#' @export
+#' @rdname scale_hue
+#' @usage NULL
+scale_color_hue <- scale_colour_hue
+
+#' @export
+#' @rdname scale_identity
+#' @usage NULL
+scale_color_identity <- scale_colour_identity
+
+#' @export
+#' @rdname scale_manual
+#' @usage NULL
+scale_color_manual <- scale_colour_manual
+
+#' @export
+#' @rdname scale_viridis
+#' @usage NULL
+scale_color_viridis_d <- scale_colour_viridis_d
+
+#' @export
+#' @rdname scale_viridis
+#' @usage NULL
+scale_color_viridis_c <- scale_colour_viridis_c
+
+#' @export
+#' @rdname scale_viridis
+#' @usage NULL
+scale_color_viridis_b <- scale_colour_viridis_b
+
+#' @export
+#' @rdname scale_viridis
+#' @usage NULL
+scale_color_ordinal <- scale_colour_ordinal
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_color_datetime <- scale_colour_datetime
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_color_date <- scale_colour_date

R/scale-colour-ordinal.R

@@ -0,0 +1,72 @@
+#' @include scale-viridis.R
+
+# Default scales -------------------------------------------------------------
+
+#' @export
+#' @rdname scale_viridis
+#' @usage NULL
+scale_colour_ordinal <- function(..., aesthetics = "colour", type = getOption(glue("ggplot2.ordinal.{aesthetics[1]}"))) {
+  type <- type %||% scale_colour_viridis_d
+  args <- list2(...)
+  args$call <- args$call %||% current_call()
+  if (is.function(type)) {
+    if (any(c("...", "call") %in% fn_fmls_names(type))) {
+      args$call <- args$call %||% current_call()
+    }
+    exec(type, !!!args, aesthetics = aesthetics)
+  } else {
+    exec(
+      discrete_scale,
+      aesthetics = aesthetics,
+      palette = ordinal_pal(type),
+      !!!args
+    )
+  }
+}
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_colour_datetime <- function(...,
+                                  aesthetics = "colour",
+                                  low = "#132B43",
+                                  high = "#56B1F7",
+                                  space = "Lab",
+                                  na.value = "grey50",
+                                  guide = "colourbar") {
+  datetime_scale(
+    aesthetics,
+    "time",
+    palette = seq_gradient_pal(low, high, space),
+    na.value = na.value,
+    guide = guide,
+    ...
+  )
+}
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_colour_date <- function(...,
+                              aesthetics = "colour",
+                              low = "#132B43",
+                              high = "#56B1F7",
+                              space = "Lab",
+                              na.value = "grey50",
+                              guide = "colourbar") {
+  datetime_scale(
+    aesthetics,
+    "date",
+    palette = seq_gradient_pal(low, high, space),
+    na.value = na.value,
+    guide = guide,
+    ...
+  )
+}
+
+ordinal_pal <- function(colours, na.color = "grey50", alpha = TRUE) {
+  pal <- scales::colour_ramp(colours, na.color = na.color, alpha = alpha)
+  function(n) {
+    pal(seq(0, 1, length.out = n))
+  }
+}