Don't switch scale type when using defaults (#4456)

Author: clauswilke

R/scale-colour.r

@@ -74,9 +74,11 @@
 #' options(ggplot2.continuous.fill = tmp) # restore previous setting
 #' @export
 scale_colour_continuous <- function(...,
-                                    type = getOption("ggplot2.continuous.colour", default = "gradient")) {
+                                    type = getOption("ggplot2.continuous.colour")) {
+  type <- type %||% "gradient"
+
   if (is.function(type)) {
-    type(...)
+    check_scale_type(type(...), "scale_colour_continuous", "colour")
   } else if (identical(type, "gradient")) {
     scale_colour_gradient(...)
   } else if (identical(type, "viridis")) {
@@ -89,9 +91,11 @@ scale_colour_continuous <- function(...,
 #' @rdname scale_colour_continuous
 #' @export
 scale_fill_continuous <- function(...,
-                                  type = getOption("ggplot2.continuous.fill", default = "gradient")) {
+                                  type = getOption("ggplot2.continuous.fill")) {
+  type <- type %||% "gradient"
+
   if (is.function(type)) {
-    type(...)
+    check_scale_type(type(...), "scale_fill_continuous", "fill")
   } else if (identical(type, "gradient")) {
     scale_fill_gradient(...)
   } else if (identical(type, "viridis")) {
@@ -104,29 +108,68 @@ scale_fill_continuous <- function(...,
 #' @export
 #' @rdname scale_colour_continuous
 scale_colour_binned <- function(...,
-                                type = getOption("ggplot2.binned.colour", default = getOption("ggplot2.continuous.colour", default = "gradient"))) {
+                                type = getOption("ggplot2.binned.colour")) {
   if (is.function(type)) {
-    type(...)
-  } else if (identical(type, "gradient")) {
-    scale_colour_steps(...)
-  } else if (identical(type, "viridis")) {
-    scale_colour_viridis_b(...)
+    check_scale_type(type(...), "scale_colour_binned", "colour")
   } else {
-    abort("Unknown scale type")
+    type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
+    # don't use fallback from scale_colour_continuous() if it is
+    # a function, since that would change the type of the color
+    # scale from binned to continuous
+    if (is.function(type_fallback)) {
+      type_fallback <- "gradient"
+    }
+    type <- type %||% type_fallback
+
+    if (identical(type, "gradient")) {
+      scale_colour_steps(...)
+    } else if (identical(type, "viridis")) {
+      scale_colour_viridis_b(...)
+    } else {
+      abort("Unknown scale type")
+    }
   }
 }
 
 #' @export
 #' @rdname scale_colour_continuous
 scale_fill_binned <- function(...,
-                              type = getOption("ggplot2.binned.fill", default = getOption("ggplot2.continuous.fill", default = "gradient"))) {
+                              type = getOption("ggplot2.binned.fill")) {
   if (is.function(type)) {
-    type(...)
-  } else if (identical(type, "gradient")) {
-    scale_fill_steps(...)
-  } else if (identical(type, "viridis")) {
-    scale_fill_viridis_b(...)
+    check_scale_type(type(...), "scale_fill_binned", "fill")
   } else {
-    abort("Unknown scale type")
+    type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient")
+    # don't use fallback from scale_colour_continuous() if it is
+    # a function, since that would change the type of the color
+    # scale from binned to continuous
+    if (is.function(type_fallback)) {
+      type_fallback <- "gradient"
+    }
+    type <- type %||% type_fallback
+
+    if (identical(type, "gradient")) {
+      scale_fill_steps(...)
+    } else if (identical(type, "viridis")) {
+      scale_fill_viridis_b(...)
+    } else {
+      abort("Unknown scale 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)
+check_scale_type <- function(scale, name, aesthetic) {
+  if (!is.ggproto(scale) || !inherits(scale, "Scale")) {
+    abort(glue("The `type` argument of `{name}()` must return a continuous scale for the {aesthetic} aesthetic. The provided object is not a scale function."))
+  }
+  if (!isTRUE(aesthetic %in% scale$aesthetics)) {
+    abort(glue("The `type` argument of `{name}()` must return a continuous scale for the {aesthetic} aesthetic. The provided scale works with the following aesthetics: {glue_collapse(scale$aesthetics, sep = ', ')}"))
   }
+  if (isTRUE(scale$is_discrete())) {
+    abort(glue("The `type` argument of `{name}()` must return a continuous scale for the {aesthetic} aesthetic, but the provided scale is discrete."))
+  }
+
+  scale
 }

man/scale_colour_continuous.Rd

@@ -0,0 +1,20 @@
+context("test-scale-colour-continuous.R")
+
+test_that("type argument is checked for proper input", {
+  expect_error(
+    scale_colour_continuous(type = function() "abc"),
+    "is not a scale function"
+  )
+  expect_error(
+    scale_fill_continuous(type = geom_point),
+    "is not a scale function"
+  )
+  expect_error(
+    scale_colour_binned(type = function(...) scale_colour_binned(aesthetics = c("fill", "point_colour"))),
+    "works with the following aesthetics: fill, point_colour"
+  )
+  expect_error(
+    scale_fill_binned(type = scale_fill_brewer),
+    "provided scale is discrete"
+  )
+})