Better infrastructure for default scales.

Add methods for date/datetime. #1526

Author: hadley

DESCRIPTION

@@ -170,6 +170,7 @@ Collate:
     'scale-manual.r'
     'scale-shape.r'
     'scale-size.r'
+    'scale-type.R'
     'scales-.r'
     'stat-bin.r'
     'stat-bin2d.r'

NAMESPACE

@@ -103,6 +103,7 @@ S3method(scale_type,default)
 S3method(scale_type,factor)
 S3method(scale_type,logical)
 S3method(scale_type,numeric)
+S3method(scale_type,ordered)
 S3method(str,uneval)
 S3method(summary,ggplot)
 S3method(widthDetails,stripGrob)
@@ -372,6 +373,8 @@ export(scale_color_identity)
 export(scale_color_manual)
 export(scale_colour_brewer)
 export(scale_colour_continuous)
+export(scale_colour_date)
+export(scale_colour_datetime)
 export(scale_colour_discrete)
 export(scale_colour_distiller)
 export(scale_colour_gradient)
@@ -383,6 +386,8 @@ export(scale_colour_identity)
 export(scale_colour_manual)
 export(scale_fill_brewer)
 export(scale_fill_continuous)
+export(scale_fill_date)
+export(scale_fill_datetime)
 export(scale_fill_discrete)
 export(scale_fill_distiller)
 export(scale_fill_gradient)
@@ -406,6 +411,8 @@ export(scale_shape_manual)
 export(scale_size)
 export(scale_size_area)
 export(scale_size_continuous)
+export(scale_size_date)
+export(scale_size_datetime)
 export(scale_size_discrete)
 export(scale_size_identity)
 export(scale_size_manual)

NEWS.md

@@ -1,5 +1,10 @@
 # ggplot2 2.0.0.9000
 
+* `scale_size()` warns when used with categorical data.
+
+* `scale_size()`, `scale_colour()`, and `scale_fill()` gain date and date-time
+  variants (#1526).
+
 * `stat_function()` gains an `xlim` parameter (#1528).
 
 * `stat_summary()` preserves sorted x order which avoids artefacts when

R/scale-size.r

@@ -60,6 +60,7 @@ scale_size <- scale_size_continuous
 #' @export
 #' @usage NULL
 scale_size_discrete <- function(..., range = c(2, 6)) {
+  warning("Using size for a discrete variable is not advised.", call. = FALSE)
   discrete_scale("size", "size_d", function(n) {
     area <- seq(range[1] ^ 2, range[2] ^ 2, length.out = n)
     sqrt(area)
@@ -76,3 +77,18 @@ scale_size_area <- function(..., max_size = 6) {
     palette = abs_area(max_size),
     rescaler = rescale_max, ...)
 }
+
+#' @rdname scale_size
+#' @export
+#' @usage NULL
+scale_size_datetime <- function() {
+  scale_size_continuous(trans = "time")
+}
+
+#' @rdname scale_size
+#' @export
+#' @usage NULL
+scale_size_date <- function() {
+  scale_size_continuous(trans = "date")
+}
+

R/scale-type.R

@@ -0,0 +1,66 @@
+find_scale <- function(aes, x, env = parent.frame()) {
+  type <- scale_type(x)
+  candidates <- paste("scale", aes, type, sep = "_")
+
+  for (scale in candidates) {
+    scale_f <- find_global(scale, env, mode = "function")
+    if (!is.null(scale_f))
+      return(scale_f())
+  }
+
+  # Failure to find a scale is not an error because some "aesthetics" don't
+  # need scales (e.g. group), and it allows others to extend ggplot2 with
+  # their own aesthetics
+
+  return(NULL)
+}
+
+# Look for object first in parent environment and if not found, then in
+# ggplot2 namespace environment.  This makes it possible to override default
+# scales by setting them in the parent environment.
+find_global <- function(name, env, mode = "any") {
+  if (exists(name, envir = env, mode = mode)) {
+    return(get(name, envir = env, mode = mode))
+  }
+
+  nsenv <- asNamespace("ggplot2")
+  if (exists(name, envir = nsenv, mode = mode)) {
+    return(get(name, envir = nsenv, mode = mode))
+  }
+
+  NULL
+}
+
+# Determine default type of a scale
+scale_type <- function(x) UseMethod("scale_type")
+
+#' @export
+scale_type.default <- function(x) {
+  message("Don't know how to automatically pick scale for object of type ",
+          paste(class(x), collapse = "/"), ". Defaulting to continuous.")
+  "continuous"
+}
+
+#' @export
+scale_type.AsIs <- function(x) "identity"
+
+#' @export
+scale_type.logical <- function(x) "discrete"
+
+#' @export
+scale_type.character <- function(x) "discrete"
+
+#' @export
+scale_type.ordered <- function(x) c("ordinal", "discrete")
+
+#' @export
+scale_type.factor <- function(x) "discrete"
+
+#' @export
+scale_type.POSIXt <- function(x) c("datetime", "continuous")
+
+#' @export
+scale_type.Date <- function(x) c("date", "continuous")
+
+#' @export
+scale_type.numeric <- function(x) "continuous"

R/scales-.r

@@ -18,6 +18,10 @@ ScalesList <- ggproto("ScalesList", NULL,
   },
 
   add = function(self, scale) {
+    if (is.null(scale)) {
+      return()
+    }
+
     prev_aes <- self$find(scale$aesthetics)
     if (any(prev_aes)) {
       # Get only the first aesthetic name in the returned vector -- it can
@@ -98,14 +102,7 @@ scales_add_defaults <- function(scales, data, aesthetics, env) {
   )
 
   for (aes in names(datacols)) {
-    type <- scale_type(datacols[[aes]])
-    scale_name <- paste("scale", aes, type, sep = "_")
-
-    # Skip aesthetics with no scales (e.g. group, order, etc)
-    scale_f <- find_global(scale_name, env, mode = "function")
-    if (is.null(scale_f)) next
-
-    scales$add(scale_f())
+    scales$add(find_scale(aes, datacols[[aes]], env))
   }
 
 }
@@ -126,50 +123,3 @@ scales_add_missing <- function(plot, aesthetics, env) {
 }
 
 
-# Look for object first in parent environment and if not found, then in
-# ggplot2 namespace environment.  This makes it possible to override default
-# scales by setting them in the parent environment.
-find_global <- function(name, env, mode = "any") {
-  if (exists(name, envir = env, mode = mode)) {
-    return(get(name, envir = env, mode = mode))
-  }
-
-  nsenv <- asNamespace("ggplot2")
-  if (exists(name, envir = nsenv, mode = mode)) {
-    return(get(name, envir = nsenv, mode = mode))
-  }
-
-  NULL
-}
-
-
-# Determine default type of a scale
-scale_type <- function(x) UseMethod("scale_type")
-
-#' @export
-scale_type.default <- function(x) {
-  message("Don't know how to automatically pick scale for object of type ",
-    paste(class(x), collapse = "/"), ". Defaulting to continuous")
-  "continuous"
-}
-
-#' @export
-scale_type.AsIs <- function(x) "identity"
-
-#' @export
-scale_type.logical <- function(x) "discrete"
-
-#' @export
-scale_type.character <- function(x) "discrete"
-
-#' @export
-scale_type.factor <- function(x) "discrete"
-
-#' @export
-scale_type.POSIXt <- function(x) "datetime"
-
-#' @export
-scale_type.Date <- function(x) "date"
-
-#' @export
-scale_type.numeric <- function(x) "continuous"

R/zxx.r

@@ -10,6 +10,20 @@ scale_colour_discrete <- scale_colour_hue
 #' @usage NULL
 scale_colour_continuous <- scale_colour_gradient
 
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_colour_datetime <- function() {
+  scale_colour_continuous(trans = "time")
+}
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_colour_date <- function() {
+  scale_colour_continuous(trans = "date")
+}
+
 #' @export
 #' @rdname scale_hue
 #' @usage NULL
@@ -20,6 +34,21 @@ scale_fill_discrete <- scale_fill_hue
 #' @usage NULL
 scale_fill_continuous <- scale_fill_gradient
 
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_fill_datetime <- function() {
+  scale_fill_continuous(trans = "time")
+}
+
+#' @export
+#' @rdname scale_gradient
+#' @usage NULL
+scale_fill_date <- function() {
+  scale_fill_continuous(trans = "date")
+}
+
+
 # British to American spellings ----------------------------------------------
 
 #' @export