Merge branch 'master' into v3.2.0-rc

Author: thomasp85

CONTRIBUTING.md

@@ -6,7 +6,7 @@ quickly as possible. The guide is divided into two main pieces:
 1. Filing a bug report or feature request in an issue.
 1. Suggesting a change via a pull request.
 
-Please note that ggplot2 is released with a [Contributor Code of Conduct](.github/CODE_OF_CONDUCT.md). By contributing to this project, 
+Please note that ggplot2 is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project, 
 you agree to abide by its terms.
 
 ## Issues

R/aes.r

@@ -8,8 +8,8 @@ NULL
 #' [ggplot2()] and in individual layers.
 #'
 #' 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`).
+#' (also in substrings, e.g., `point_color` to `point_colour`) and translating old style
+#' R names to ggplot names (e.g., `pch` to `shape` and `cex` to `size`).
 #'
 #' @section Quasiquotation:
 #'
@@ -22,9 +22,13 @@ NULL
 #' programming vignette](http://dplyr.tidyverse.org/articles/programming.html)
 #' to learn more about these techniques.
 #'
-#' @param x,y,... List of name value pairs giving aesthetics to map to
-#'   variables. The names for x and y aesthetics are typically omitted because
-#'   they are so common; all other aesthetics must be named.
+#' @param x,y,... List of name-value pairs in the form `aesthetic = variable`
+#'   describing which variables in the layer data should be mapped to which
+#'   aesthetics used by the paired geom/stat. The expression `variable` is
+#'   evaluated within the layer data, so there is no need to refer to
+#'   the original dataset (i.e., use `ggplot(df, aes(variable))`
+#'   instead of `ggplot(df, aes(df$variable))`). The names for x and y aesthetics
+#'   are typically omitted because they are so common; all other aesthetics must be named.
 #' @seealso [vars()] for another quoting function designed for
 #'   faceting specifications.
 #' @return A list with class `uneval`. Components of the list are either
@@ -334,3 +338,55 @@ mapped_aesthetics <- function(x) {
   is_null <- vapply(x, is.null, logical(1))
   names(x)[!is_null]
 }
+
+
+#' Check a mapping for discouraged usage
+#'
+#' Checks that `$` and `[[` are not used when the target *is* the data
+#'
+#' @param mapping A mapping created with [aes()]
+#' @param data The data to be mapped from
+#'
+#' @noRd
+warn_for_aes_extract_usage <- function(mapping, data) {
+  lapply(mapping, function(quosure) {
+    warn_for_aes_extract_usage_expr(get_expr(quosure), data, get_env(quosure))
+  })
+}
+
+warn_for_aes_extract_usage_expr <- function(x, data, env = emptyenv()) {
+  if (is_call(x, "[[") || is_call(x, "$")) {
+    if (extract_target_is_likely_data(x, data, env)) {
+      good_usage <- alternative_aes_extract_usage(x)
+      warning(
+        "Use of `", format(x), "` is discouraged. ",
+        "Use `", good_usage,  "` instead.",
+        call. = FALSE
+      )
+    }
+  } else if (is.call(x)) {
+    lapply(x, warn_for_aes_extract_usage_expr, data, env)
+  }
+}
+
+alternative_aes_extract_usage <- function(x) {
+  if (is_call(x, "[[")) {
+    good_call <- call2("[[", quote(.data), x[[3]])
+    format(good_call)
+  } else if (is_call(x, "$")) {
+    as.character(x[[3]])
+  } else {
+    stop("Don't know how to get alternative usage for `", format(x), "`", call. = FALSE)
+  }
+}
+
+extract_target_is_likely_data <- function(x, data, env) {
+  if (!is.name(x[[2]])) {
+    return(FALSE)
+  }
+
+  tryCatch({
+    data_eval <- eval_tidy(x[[2]], data, env)
+    identical(data_eval, data)
+  }, error = function(err) FALSE)
+}

R/coord-.r

@@ -158,9 +158,9 @@ expand_default <- function(scale, discrete = c(0, 0.6, 0, 0.6), continuous = c(0
 # generated
 render_axis <- function(panel_params, axis, scale, position, theme) {
   if (axis == "primary") {
-    guide_axis(panel_params[[paste0(scale, ".major")]], panel_params[[paste0(scale, ".labels")]], position, theme)
+    draw_axis(panel_params[[paste0(scale, ".major")]], panel_params[[paste0(scale, ".labels")]], position, theme)
   } else if (axis == "secondary" && !is.null(panel_params[[paste0(scale, ".sec.major")]])) {
-    guide_axis(panel_params[[paste0(scale, ".sec.major")]], panel_params[[paste0(scale, ".sec.labels")]], position, theme)
+    draw_axis(panel_params[[paste0(scale, ".sec.major")]], panel_params[[paste0(scale, ".sec.labels")]], position, theme)
   } else {
     zeroGrob()
   }

R/coord-map.r

@@ -289,8 +289,8 @@ CoordMap <- ggproto("CoordMap", Coord,
     pos <- self$transform(x_intercept, panel_params)
 
     axes <- list(
-      top = guide_axis(pos$x, panel_params$x.labels, "top", theme),
-      bottom = guide_axis(pos$x, panel_params$x.labels, "bottom", theme)
+      top = draw_axis(pos$x, panel_params$x.labels, "top", theme),
+      bottom = draw_axis(pos$x, panel_params$x.labels, "bottom", theme)
     )
     axes[[which(arrange == "secondary")]] <- zeroGrob()
     axes
@@ -313,8 +313,8 @@ CoordMap <- ggproto("CoordMap", Coord,
     pos <- self$transform(x_intercept, panel_params)
 
     axes <- list(
-      left = guide_axis(pos$y, panel_params$y.labels, "left", theme),
-      right = guide_axis(pos$y, panel_params$y.labels, "right", theme)
+      left = draw_axis(pos$y, panel_params$y.labels, "left", theme),
+      right = draw_axis(pos$y, panel_params$y.labels, "right", theme)
     )
     axes[[which(arrange == "secondary")]] <- zeroGrob()
     axes

R/coord-polar.r

@@ -190,7 +190,7 @@ CoordPolar <- ggproto("CoordPolar", Coord,
   render_axis_h = function(panel_params, theme) {
     list(
       top = zeroGrob(),
-      bottom = guide_axis(NA, "", "bottom", theme)
+      bottom = draw_axis(NA, "", "bottom", theme)
     )
   },
 

R/coord-sf.R

@@ -243,10 +243,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
 
     if (length(tick_positions) > 0) {
-      top <- guide_axis(
+      top <- draw_axis(
         tick_positions,
         tick_labels,
-        position = "top",
+        axis_position = "top",
         theme = theme
       )
     } else {
@@ -279,10 +279,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
 
     if (length(tick_positions) > 0) {
-      bottom <- guide_axis(
+      bottom <- draw_axis(
         tick_positions,
         tick_labels,
-        position = "bottom",
+        axis_position = "bottom",
         theme = theme
       )
     } else {
@@ -321,10 +321,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
 
     if (length(tick_positions) > 0) {
-      right <- guide_axis(
+      right <- draw_axis(
         tick_positions,
         tick_labels,
-        position = "right",
+        axis_position = "right",
         theme = theme
       )
     } else {
@@ -357,10 +357,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     tick_labels <- c(ticks1$degree_label, ticks2$degree_label)
 
     if (length(tick_positions) > 0) {
-      left <- guide_axis(
+      left <- draw_axis(
         tick_positions,
         tick_labels,
-        position = "left",
+        axis_position = "left",
         theme = theme
       )
     } else {

R/facet-.r

@@ -563,7 +563,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) {
     if (drop) {
       new <- unique_combs(new)
     }
-    base <- rbind(base, df.grid(old, new))
+    base <- unique(rbind(base, df.grid(old, new)))
   }
 
   if (empty(base)) {

R/geom-abline.r

@@ -76,21 +76,20 @@ geom_abline <- function(mapping = NULL, data = NULL,
                         show.legend = NA) {
 
   # If nothing set, default to y = x
-  if (missing(mapping) && missing(slope) && missing(intercept)) {
+  if (is.null(mapping) && missing(slope) && missing(intercept)) {
     slope <- 1
     intercept <- 0
   }
 
   # Act like an annotation
   if (!missing(slope) || !missing(intercept)) {
 
-    # Warn if supplied mapping is going to be overwritten
-    if (!missing(mapping)) {
-      warning(paste0("Using `intercept` and/or `slope` with `mapping` may",
-                     " not have the desired result as mapping is overwritten",
-                     " if either of these is specified\n"
-              )
-      )
+    # Warn if supplied mapping and/or data is going to be overwritten
+    if (!is.null(mapping)) {
+      warn_overwritten_args("geom_abline()", "mapping", c("slope", "intercept"))
+    }
+    if (!is.null(data)) {
+      warn_overwritten_args("geom_abline()", "data", c("slope", "intercept"))
     }
 
     if (missing(slope)) slope <- 1
@@ -141,3 +140,34 @@ GeomAbline <- ggproto("GeomAbline", Geom,
 
   draw_key = draw_key_abline
 )
+
+warn_overwritten_args <- function(fun_name, overwritten_arg, provided_args, plural_join = " and/or ") {
+  overwritten_arg_text <- paste0("`", overwritten_arg, "`")
+
+  n_provided_args <- length(provided_args)
+  if (n_provided_args == 1) {
+    provided_arg_text <- paste0("`", provided_args, "`")
+    verb <- "was"
+  } else if (n_provided_args == 2) {
+    provided_arg_text <- paste0("`", provided_args, "`", collapse = plural_join)
+    verb <- "were"
+  } else {
+    provided_arg_text <- paste0(
+      paste0("`", provided_args[-n_provided_args], "`", collapse = ", "),
+      ",", plural_join,
+      "`", provided_args[n_provided_args], "`"
+    )
+    verb <- "were"
+  }
+
+  warning(
+    sprintf(
+      "%s: Ignoring %s because %s %s provided.",
+      fun_name,
+      overwritten_arg_text,
+      provided_arg_text,
+      verb
+    ),
+    call. = FALSE
+  )
+}

R/geom-hline.r

@@ -11,14 +11,14 @@ geom_hline <- function(mapping = NULL, data = NULL,
 
   # Act like an annotation
   if (!missing(yintercept)) {
-    # Warn if supplied mapping is going to be overwritten
-    if (!missing(mapping)) {
-      warning(paste0("Using both `yintercept` and `mapping` may not have the",
-                     " desired result as mapping is overwritten if",
-                     " `yintercept` is specified\n"
-              )
-      )
+    # Warn if supplied mapping and/or data is going to be overwritten
+    if (!is.null(mapping)) {
+      warn_overwritten_args("geom_hline()", "mapping", "yintercept")
     }
+    if (!is.null(data)) {
+      warn_overwritten_args("geom_hline()", "data", "yintercept")
+    }
+
     data <- new_data_frame(list(yintercept = yintercept))
     mapping <- aes(yintercept = yintercept)
     show.legend <- FALSE

R/geom-vline.r

@@ -11,14 +11,14 @@ geom_vline <- function(mapping = NULL, data = NULL,
 
   # Act like an annotation
   if (!missing(xintercept)) {
-    # Warn if supplied mapping is going to be overwritten
-    if (!missing(mapping)) {
-      warning(paste0("Using both `xintercept` and `mapping` may not have the",
-                     " desired result as mapping is overwritten if",
-                     " `xintercept` is specified\n"
-              )
-      )
+    # Warn if supplied mapping and/or data is going to be overwritten
+    if (!is.null(mapping)) {
+      warn_overwritten_args("geom_vline()", "mapping", "xintercept")
     }
+    if (!is.null(data)) {
+      warn_overwritten_args("geom_vline()", "data", "xintercept")
+    }
+
     data <- new_data_frame(list(xintercept = xintercept))
     mapping <- aes(xintercept = xintercept)
     show.legend <- FALSE

R/layer.r

@@ -238,10 +238,14 @@ Layer <- ggproto("Layer", NULL,
 
     scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env)
 
-    # Evaluate and check aesthetics
+    # Evaluate aesthetics
     evaled <- lapply(aesthetics, eval_tidy, data = data)
     evaled <- compact(evaled)
 
+    # Check for discouraged usage in mapping
+    warn_for_aes_extract_usage(aesthetics, data[setdiff(names(data), "PANEL")])
+
+    # Check aesthetic values
     nondata_cols <- check_nondata_cols(evaled)
     if (length(nondata_cols) > 0) {
       msg <- paste0(

R/theme.r

@@ -612,21 +612,38 @@ merge_element.element <- function(new, old) {
   new
 }
 
-# Combine the properties of two elements
-#
-# @param e1 An element object
-# @param e2 An element object which e1 inherits from
+#' Combine the properties of two elements
+#'
+#' @param e1 An element object
+#' @param e2 An element object from which e1 inherits
+#'
+#' @noRd
+#'
 combine_elements <- function(e1, e2) {
 
   # If e2 is NULL, nothing to inherit
-  if (is.null(e2) || inherits(e1, "element_blank"))  return(e1)
+  if (is.null(e2) || inherits(e1, "element_blank")) {
+    return(e1)
+  }
+
   # If e1 is NULL inherit everything from e2
-  if (is.null(e1)) return(e2)
+  if (is.null(e1)) {
+    return(e2)
+  }
+
+  # If neither of e1 or e2 are element_* objects, return e1
+  if (!inherits(e1, "element") && !inherits(e2, "element")) {
+    return(e1)
+  }
+
   # If e2 is element_blank, and e1 inherits blank inherit everything from e2,
   # otherwise ignore e2
   if (inherits(e2, "element_blank")) {
-    if (e1$inherit.blank) return(e2)
-    else return(e1)
+    if (e1$inherit.blank) {
+      return(e2)
+    } else {
+      return(e1)
+    }
   }
 
   # If e1 has any NULL properties, inherit them from e2