tidyverse · clauswilke · Jul 23, 2018 · Jul 11, 2018 · Jul 11, 2018 · Jul 11, 2018
diff --git a/NAMESPACE b/NAMESPACE
@@ -506,6 +506,7 @@ export(scale_y_time)
 export(sec_axis)
 export(set_last_plot)
 export(should_stop)
+export(standardise_aes_names)
 export(stat)
 export(stat_bin)
 export(stat_bin2d)

diff --git a/NEWS.md b/NEWS.md
@@ -7,6 +7,10 @@
     feed data columns into `aes()` or into parameters of geoms or stats. However,
     doing so remains discouraged (@clauswilke).
 
+*   Aesthetic names are now consistently standardised both in `aes()` and in the
+    `aesthetics` argument of scale functions. Also, the US spelling "color"
+    is now always internally converted to "colour", even when part of a longer
+    aesthetic name (e.g., `point_color`) (@clauswilke, #2649).
 
 # ggplot2 3.0.0
 

diff --git a/R/aes.r b/R/aes.r
@@ -7,9 +7,9 @@ NULL
 #' properties (aesthetics) of geoms. Aesthetic mappings can be set in
 #' [ggplot2()] and in individual layers.
 #'
-#' This function also standardises aesthetic names by performing partial
-#' matching, converting color to colour, and translating old style R names to
-#' ggplot names (e.g. pch to shape, cex to size).
+#' This function also standardises aesthetic names by converting `color` to `colour`
+#' (also in substrings, e.g. `point_color` to `point_colour`) and translating old style
+#' R names to ggplot names (eg. `pch` to `shape`, `cex` to `size`).
 #'
 #' @section Quasiquotation:
 #'
@@ -143,13 +143,34 @@ print.uneval <- function(x, ...) {
   new_aes(NextMethod())
 }
 
-# Rename American or old-style aesthetics name
-rename_aes <- function(x) {
-  # Convert prefixes to full names
-  full <- match(names(x), ggplot_global$all_aesthetics)
-  names(x)[!is.na(full)] <- ggplot_global$all_aesthetics[full[!is.na(full)]]
+#' Standardise aesthetic names
+#'
+#' This function standardises aesthetic names by converting `color` to `colour`
+#' (also in substrings, e.g. `point_color` to `point_colour`) and translating old style
+#' R names to ggplot names (eg. `pch` to `shape`, `cex` to `size`).
+#' @param x Character vector of aesthetics names, such as `c("colour", "size", "shape")`.
+#' @return Character vector of standardised names.
+#' @keywords internal
+#' @export
+standardise_aes_names <- function(x) {
+  # convert US to UK spelling of colour
+  x <- sub("color", "colour", x, fixed = TRUE)
 
-  plyr::rename(x, ggplot_global$base_to_ggplot, warn_missing = FALSE)
+  # convert old-style aesthetics names to ggplot version
+  plyr::revalue(x, ggplot_global$base_to_ggplot, warn_missing = FALSE)
+}
+
+# x is a list of aesthetic mappings, as generated by aes()
+rename_aes <- function(x) {
 aes <- function(x, y, ...) { 
   exprs <- rlang::enquos(x = x, y = y, ...) 
   is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1)) 
   aes <- new_aes(exprs[!is_missing], env = parent.frame()) 
   rename_aes(aes) 
 } 
 g$default_aes <- defaults(rename_aes(new), old) 
 args <- rename_aes(args) 
 mapping <- rename_aes(mapping) 
 args <- rename_aes(args) 
 # Split up params between aesthetics, geom, and stat 
 params <- rename_aes(params) 
 override.aes = rename_aes(override.aes), 
 aes <- function(x, y, ...) { 
   exprs <- rlang::enquos(x = x, y = y, ...) 
   is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1)) 
  
   aes <- new_aes(exprs[!is_missing], env = parent.frame()) 
   rename_aes(aes) 
 } 
 g$default_aes <- defaults(rename_aes(new), old) 
 args <- rename_aes(args) 
 mapping <- rename_aes(mapping) 
 args <- rename_aes(args) 
 # Split up params between aesthetics, geom, and stat 
 params <- rename_aes(params) 
 override.aes = rename_aes(override.aes), 
+  names(x) <- standardise_aes_names(names(x))
+  duplicated_names <- names(x)[duplicated(names(x))]
+  if (length(duplicated_names) > 0L) {
+    duplicated_message <- paste0(unique(duplicated_names), collapse = ", ")
+    warning(
+      "Duplicated aesthetics after name standardisation: ", duplicated_message, call. = FALSE
+    )
+  }
+  x
 }
 
 # Look up the scale that should be used for a given aesthetic

diff --git a/R/scale-.r b/R/scale-.r
@@ -556,6 +556,8 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(),
   rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_,
   trans = "identity", guide = "legend", position = "left", super = ScaleContinuous) {
 
+  aesthetics <- standardise_aes_names(aesthetics)
+
   check_breaks_labels(breaks, labels)
 
   position <- match.arg(position, c("left", "right", "top", "bottom"))
@@ -622,6 +624,8 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(),
   na.translate = TRUE, na.value = NA, drop = TRUE,
   guide = "legend", position = "left", super = ScaleDiscrete) {
 
+  aesthetics <- standardise_aes_names(aesthetics)
+
   check_breaks_labels(breaks, labels)
 
   position <- match.arg(position, c("left", "right", "top", "bottom"))

diff --git a/man/aes.Rd b/man/aes.Rd
diff --git a/man/ggtheme.Rd b/man/ggtheme.Rd
diff --git a/man/scale_viridis.Rd b/man/scale_viridis.Rd
diff --git a/man/standardise_aes_names.Rd b/man/standardise_aes_names.Rd
diff --git a/tests/testthat/test-aes.r b/tests/testthat/test-aes.r
@@ -98,6 +98,19 @@ test_that("labelling doesn't cause error if aesthetic is NULL", {
   expect_null(p$labels$x)
 })
 
+test_that("aes standardises aesthetic names", {
+  # test a few common cases
+  expect_identical(aes(color = x), aes(colour = x))
+  expect_identical(aes(pch = x), aes(shape = x))
+
+  # US to British spelling in substrings
+  expect_identical(aes(point_color = x), aes(point_colour = x))
+  expect_identical(aes(color_point = x), aes(colour_point = x))
+
+  # warning when standardisation creates duplicates
+  expect_warning(aes(color = x, colour = y), "Duplicated aesthetics")
+})
+
 
 # Visual tests ------------------------------------------------------------