From b1a67997a6c39cdd8233260d92904d2062ac37a7 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 17 Sep 2024 10:04:45 +0200
Subject: [PATCH 1/3] collect all default colour scales in one place

---
 R/scale-colour.R |  99 ++++++++++++++++++++++++++++++++++++++++++++++
 R/scale-hue.R    | 100 -----------------------------------------------
 2 files changed, 99 insertions(+), 100 deletions(-)

diff --git a/R/scale-colour.R b/R/scale-colour.R
index 71255e2033..2d8d9f338c 100644
--- a/R/scale-colour.R
+++ b/R/scale-colour.R
@@ -193,6 +193,105 @@ scale_fill_binned <- function(...,
   }
 }
 
+#' Discrete colour scales
+#'
+#' The default discrete colour scale. Defaults to [scale_fill_hue()]/[scale_fill_brewer()]
+#' unless `type` (which defaults to the `ggplot2.discrete.fill`/`ggplot2.discrete.colour` options)
+#' is specified.
+#'
+#' @param ... Additional parameters passed on to the scale type,
+#' @param type One of the following:
+#'   * A character vector of color codes. The codes are used for a 'manual' color
+#'   scale as long as the number of codes exceeds the number of data levels
+#'   (if there are more levels than codes, [scale_colour_hue()]/[scale_fill_hue()]
+#'   are used to construct the default scale). If this is a named vector, then the color values
+#'   will be matched to levels based on the names of the vectors. Data values that
+#'   don't match will be set as `na.value`.
+#'   * A list of character vectors of color codes. The minimum length vector that exceeds the
+#'   number of data levels is chosen for the color scaling. This is useful if you
+#'   want to change the color palette based on the number of levels.
+#'   * A function that returns a discrete colour/fill scale (e.g., [scale_fill_hue()],
+#'   [scale_fill_brewer()], etc).
+#' @export
+#' @seealso
+#' The `r link_book("discrete colour scales section", "scales-colour#sec-colour-discrete")`
+#' @examples
+#' # Template function for creating densities grouped by a variable
+#' cty_by_var <- function(var) {
+#'   ggplot(mpg, aes(cty, colour = factor({{var}}), fill = factor({{var}}))) +
+#'     geom_density(alpha = 0.2)
+#' }
+#'
+#' # The default, scale_fill_hue(), is not colour-blind safe
+#' cty_by_var(class)
+#'
+#' # (Temporarily) set the default to Okabe-Ito (which is colour-blind safe)
+#' okabe <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
+#' withr::with_options(
+#'   list(ggplot2.discrete.fill = okabe),
+#'   print(cty_by_var(class))
+#' )
+#'
+#' # Define a collection of palettes to alter the default based on number of levels to encode
+#' discrete_palettes <- list(
+#'   c("skyblue", "orange"),
+#'   RColorBrewer::brewer.pal(3, "Set2"),
+#'   RColorBrewer::brewer.pal(6, "Accent")
+#' )
+#' withr::with_options(
+#'   list(ggplot2.discrete.fill = discrete_palettes), {
+#'   # 1st palette is used when there 1-2 levels (e.g., year)
+#'   print(cty_by_var(year))
+#'   # 2nd palette is used when there are 3 levels
+#'   print(cty_by_var(drv))
+#'   # 3rd palette is used when there are 4-6 levels
+#'   print(cty_by_var(fl))
+#' })
+#'
+scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour")) {
+  # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
+  type <- type %||% scale_colour_hue
+  args <- list2(...)
+  args$call <- args$call %||% current_call()
+
+  if (is.function(type)) {
+    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
+      args$call <- NULL
+    }
+    check_scale_type(
+      exec(type, !!!args),
+      "scale_colour_discrete",
+      "colour",
+      scale_is_discrete = TRUE
+    )
+  } else {
+    exec(scale_colour_qualitative, !!!args, type = type)
+  }
+}
+
+#' @rdname scale_colour_discrete
+#' @export
+scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) {
+  # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
+  type <- type %||% scale_fill_hue
+  args <- list2(...)
+  args$call <- args$call %||% current_call()
+
+  if (is.function(type)) {
+    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
+      args$call <- NULL
+    }
+    check_scale_type(
+      exec(type, !!!args),
+      "scale_fill_discrete",
+      "fill",
+      scale_is_discrete = TRUE
+    )
+  } else {
+    exec(scale_fill_qualitative, !!!args, type = type)
+  }
+}
+
 
 # helper function to make sure that the provided scale is of the correct
 # type (i.e., is continuous and works with the provided aesthetic)
diff --git a/R/scale-hue.R b/R/scale-hue.R
index 414f10864e..311533e283 100644
--- a/R/scale-hue.R
+++ b/R/scale-hue.R
@@ -78,106 +78,6 @@ scale_fill_hue <- function(name = waiver(), ..., h = c(0, 360) + 15, c = 100,
   )
 }
 
-
-#' Discrete colour scales
-#'
-#' The default discrete colour scale. Defaults to [scale_fill_hue()]/[scale_fill_brewer()]
-#' unless `type` (which defaults to the `ggplot2.discrete.fill`/`ggplot2.discrete.colour` options)
-#' is specified.
-#'
-#' @param ... Additional parameters passed on to the scale type,
-#' @param type One of the following:
-#'   * A character vector of color codes. The codes are used for a 'manual' color
-#'   scale as long as the number of codes exceeds the number of data levels
-#'   (if there are more levels than codes, [scale_colour_hue()]/[scale_fill_hue()]
-#'   are used to construct the default scale). If this is a named vector, then the color values
-#'   will be matched to levels based on the names of the vectors. Data values that
-#'   don't match will be set as `na.value`.
-#'   * A list of character vectors of color codes. The minimum length vector that exceeds the
-#'   number of data levels is chosen for the color scaling. This is useful if you
-#'   want to change the color palette based on the number of levels.
-#'   * A function that returns a discrete colour/fill scale (e.g., [scale_fill_hue()],
-#'   [scale_fill_brewer()], etc).
-#' @export
-#' @seealso
-#' The `r link_book("discrete colour scales section", "scales-colour#sec-colour-discrete")`
-#' @examples
-#' # Template function for creating densities grouped by a variable
-#' cty_by_var <- function(var) {
-#'   ggplot(mpg, aes(cty, colour = factor({{var}}), fill = factor({{var}}))) +
-#'     geom_density(alpha = 0.2)
-#' }
-#'
-#' # The default, scale_fill_hue(), is not colour-blind safe
-#' cty_by_var(class)
-#'
-#' # (Temporarily) set the default to Okabe-Ito (which is colour-blind safe)
-#' okabe <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
-#' withr::with_options(
-#'   list(ggplot2.discrete.fill = okabe),
-#'   print(cty_by_var(class))
-#' )
-#'
-#' # Define a collection of palettes to alter the default based on number of levels to encode
-#' discrete_palettes <- list(
-#'   c("skyblue", "orange"),
-#'   RColorBrewer::brewer.pal(3, "Set2"),
-#'   RColorBrewer::brewer.pal(6, "Accent")
-#' )
-#' withr::with_options(
-#'   list(ggplot2.discrete.fill = discrete_palettes), {
-#'   # 1st palette is used when there 1-2 levels (e.g., year)
-#'   print(cty_by_var(year))
-#'   # 2nd palette is used when there are 3 levels
-#'   print(cty_by_var(drv))
-#'   # 3rd palette is used when there are 4-6 levels
-#'   print(cty_by_var(fl))
-#' })
-#'
-scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour")) {
-  # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
-  type <- type %||% scale_colour_hue
-  args <- list2(...)
-  args$call <- args$call %||% current_call()
-
-  if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
-    }
-    check_scale_type(
-      exec(type, !!!args),
-      "scale_colour_discrete",
-      "colour",
-      scale_is_discrete = TRUE
-    )
-  } else {
-    exec(scale_colour_qualitative, !!!args, type = type)
-  }
-}
-
-#' @rdname scale_colour_discrete
-#' @export
-scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) {
-  # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
-  type <- type %||% scale_fill_hue
-  args <- list2(...)
-  args$call <- args$call %||% current_call()
-
-  if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
-    }
-    check_scale_type(
-      exec(type, !!!args),
-      "scale_fill_discrete",
-      "fill",
-      scale_is_discrete = TRUE
-    )
-  } else {
-    exec(scale_fill_qualitative, !!!args, type = type)
-  }
-}
-
 scale_colour_qualitative <- function(name = waiver(), ..., type = NULL,
                                      h = c(0, 360) + 15, c = 100, l = 65,
                                      h.start = 0, direction = 1,

From c62ee7ea2530e81e3ebeb0bf95b777ebb48b9207 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 17 Sep 2024 11:36:36 +0200
Subject: [PATCH 2/3] add `palette` arguments

---
 R/scale-colour.R | 114 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 103 insertions(+), 11 deletions(-)

diff --git a/R/scale-colour.R b/R/scale-colour.R
index 2d8d9f338c..1cb8fc29c5 100644
--- a/R/scale-colour.R
+++ b/R/scale-colour.R
@@ -77,8 +77,24 @@
 #' v
 #' options(ggplot2.continuous.fill = tmp) # restore previous setting
 #' @export
-scale_colour_continuous <- function(...,
-                                    type = getOption("ggplot2.continuous.colour")) {
+scale_colour_continuous <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.continuous.colour"),
+    aesthetics = "colour",
+    guide = "colourbar") {
+
+  if (!is.null(palette)) {
+    scale <- continuous_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = as_continuous_pal(palette),
+      guide = guide,
+      ...
+    )
+    return(scale)
+  }
+
   type <- type %||% "gradient"
   args <- list2(...)
   args$call <- args$call %||% current_call()
@@ -102,8 +118,24 @@ scale_colour_continuous <- function(...,
 
 #' @rdname scale_colour_continuous
 #' @export
-scale_fill_continuous <- function(...,
-                                  type = getOption("ggplot2.continuous.fill")) {
+scale_fill_continuous <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.continuous.fill"),
+    aesthetics = "fill",
+    guide = "colourbar") {
+
+  if (!is.null(palette)) {
+    scale <- continuous_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = as_continuous_pal(palette),
+      guide = guide,
+      ...
+    )
+    return(scale)
+  }
+
   type <- type %||% "gradient"
   args <- list2(...)
   args$call <- args$call %||% current_call()
@@ -127,9 +159,25 @@ scale_fill_continuous <- function(...,
 
 #' @export
 #' @rdname scale_colour_continuous
-scale_colour_binned <- function(...,
-                                type = getOption("ggplot2.binned.colour")) {
   args <- list2(...)
+scale_colour_binned <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.binned.colour"),
+    aesthetics = "colour",
+    guide = "coloursteps") {
+
+  if (!is.null(palette)) {
+    scale <- binned_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = pal_binned(as_discrete_pal(palette)),
+      guide = guide,
+      ...
+    )
+    return(scale)
+  }
+
   args$call <- args$call %||% current_call()
   if (is.function(type)) {
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
@@ -161,9 +209,23 @@ scale_colour_binned <- function(...,
 
 #' @export
 #' @rdname scale_colour_continuous
-scale_fill_binned <- function(...,
-                              type = getOption("ggplot2.binned.fill")) {
-  args <- list2(...)
+scale_fill_binned <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.binned.fill"),
+    aesthetics = "fill",
+    guide = "coloursteps") {
+
+  if (!is.null(palette)) {
+    scale <- binned_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = pal_binned(as_discrete_pal(palette)),
+      guide = guide,
+      ...
+    )
+    scale
+  }
   args$call <- args$call %||% current_call()
   if (is.function(type)) {
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
@@ -248,7 +310,22 @@ scale_fill_binned <- function(...,
 #'   print(cty_by_var(fl))
 #' })
 #'
-scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour")) {
+scale_colour_discrete <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.discrete.colour"),
+    aesthetics = "colour") {
+
+  if (!is.null(palette)) {
+    scale <- discrete_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = as_discrete_pal(palette),
+      ...
+    )
+    return(scale)
+  }
+
   # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
   type <- type %||% scale_colour_hue
   args <- list2(...)
@@ -271,7 +348,22 @@ scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour
 
 #' @rdname scale_colour_discrete
 #' @export
-scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) {
+scale_fill_discrete <- function(
+    ...,
+    palette = NULL,
+    type = getOption("ggplot2.discrete.fill"),
+    aesthetics = "fill") {
+
+  if (!is.null(palette)) {
+    scale <- discrete_scale(
+      aesthetics = aesthetics,
+      scale_name = deprecated(), # to pass `...` to non-deprecated arguments
+      palette = as_discrete_pal(palette),
+      ...
+    )
+    return(scale)
+  }
+
   # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito)
   type <- type %||% scale_fill_hue
   args <- list2(...)

From cbfc6d9efbc4399d544d6036f544635a1a560825 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 17 Sep 2024 11:36:44 +0200
Subject: [PATCH 3/3] fixup type mechanism

---
 R/scale-colour.R | 32 +++++++++++++++++---------------
 1 file changed, 17 insertions(+), 15 deletions(-)

diff --git a/R/scale-colour.R b/R/scale-colour.R
index 1cb8fc29c5..08c6accd41 100644
--- a/R/scale-colour.R
+++ b/R/scale-colour.R
@@ -96,12 +96,12 @@ scale_colour_continuous <- function(
   }
 
   type <- type %||% "gradient"
-  args <- list2(...)
+  args <- list2(..., aesthetics = aesthetics, guide = guide)
   args$call <- args$call %||% current_call()
 
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(exec(type, !!!args), "scale_colour_continuous", "colour")
   } else if (identical(type, "gradient")) {
@@ -137,12 +137,12 @@ scale_fill_continuous <- function(
   }
 
   type <- type %||% "gradient"
-  args <- list2(...)
+  args <- list2(..., aesthetics = aesthetics, guide = guide)
   args$call <- args$call %||% current_call()
 
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(exec(type, !!!args), "scale_fill_continuous", "fill")
   } else if (identical(type, "gradient")) {
@@ -159,7 +159,6 @@ scale_fill_continuous <- function(
 
 #' @export
 #' @rdname scale_colour_continuous
-  args <- list2(...)
 scale_colour_binned <- function(
     ...,
     palette = NULL,
@@ -178,10 +177,11 @@ scale_colour_binned <- function(
     return(scale)
   }
 
+  args <- list2(..., aesthetics = aesthetics, guide = guide)
   args$call <- args$call %||% current_call()
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(exec(type, !!!args), "scale_colour_binned", "colour")
   } else {
@@ -226,10 +226,12 @@ scale_fill_binned <- function(
     )
     scale
   }
+
+  args <- list2(..., aesthetics = aesthetics, guide = guide)
   args$call <- args$call %||% current_call()
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(exec(type, !!!args), "scale_fill_binned", "fill")
   } else {
@@ -332,8 +334,8 @@ scale_colour_discrete <- function(
   args$call <- args$call %||% current_call()
 
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(
       exec(type, !!!args),
@@ -370,8 +372,8 @@ scale_fill_discrete <- function(
   args$call <- args$call %||% current_call()
 
   if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
+    if (!any(c("...") %in% fn_fmls_names(type))) {
+      args <- args[intersect(names(args), fn_fmls_names(type))]
     }
     check_scale_type(
       exec(type, !!!args),