warn about discouraged $ and [[ usage in usage within aes() (#3346, f…

…ixes #2693)

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/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(

tests/testthat/test-aes.r

@@ -111,6 +111,46 @@ test_that("aes standardises aesthetic names", {
   expect_warning(aes(color = x, colour = y), "Duplicated aesthetics")
 })
 
+test_that("warn_for_aes_extract_usage() warns for discouraged uses of $ and [[ within aes()", {
+
+  df <- data_frame(x = 1:5, nested_df = data_frame(x = 6:10))
+
+  expect_warning(
+    warn_for_aes_extract_usage(aes(df$x), df),
+    "Use of `df\\$x` is discouraged"
+  )
+
+  expect_warning(
+    warn_for_aes_extract_usage(aes(df[["x"]]), df),
+    'Use of `df\\[\\["x"\\]\\]` is discouraged'
+  )
+})
+
+test_that("warn_for_aes_extract_usage() does not evaluate function calls", {
+  df <- data_frame(x = 1:5, nested_df = data_frame(x = 6:10))
+  returns_df <- function() df
+
+  expect_warning(warn_for_aes_extract_usage(aes(df$x), df))
+  expect_silent(warn_for_aes_extract_usage(aes(returns_df()$x), df))
+})
+
+test_that("warn_for_aes_extract_usage() does not warn for valid uses of $ and [[ within aes()", {
+  df <- data_frame(x = 1:5, nested_df = data_frame(x = 6:10))
+
+  # use of .data
+  expect_silent(warn_for_aes_extract_usage(aes(.data$x), df))
+  expect_silent(warn_for_aes_extract_usage(aes(.data[["x"]]), df))
+
+  # use of $ for a nested data frame column
+  expect_silent(warn_for_aes_extract_usage(aes(nested_df$x), df))
+  expect_silent(warn_for_aes_extract_usage(aes(nested_df[["x"]]), df))
+})
+
+test_that("Warnings are issued when plots use discouraged extract usage within aes()", {
+  df <- data_frame(x = 1:3, y = 1:3)
+  p <- ggplot(df, aes(df$x, y)) + geom_point()
+  expect_warning(ggplot_build(p), "Use of `df\\$x` is discouraged")
+})
 
 # Visual tests ------------------------------------------------------------