implement changes from review: better organized tests, improved argument documentation in aes(), improved the name of the warning functions, improved function detecting whether or not an expression refers to the plot data

Author: paleolimbot

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,10 @@ 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 = column_name`
+#'   describing which variables in the layer data should be mapped to which
+#'   aesthetics used by paired geom/stat. 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
@@ -344,30 +345,28 @@ mapped_aesthetics <- function(x) {
 #' @param data The data to be mapped from
 #'
 #' @noRd
-check_aes_extract_usage <- function(mapping, data) {
-  lapply(mapping, check_aes_extract_usage_quo, data)
-}
-
-check_aes_extract_usage_quo <- function(quosure, data) {
-  check_aes_extract_usage_expr(get_expr(quosure), data, get_env(quosure))
+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))
+  })
 }
 
-check_aes_extract_usage_expr <- function(x, data, env = emptyenv()) {
+warn_for_aes_extract_usage_expr <- function(x, data, env = emptyenv()) {
   if (is_call(x, "[[") || is_call(x, "$")) {
-    if (extract_target_is_data(x, data, env)) {
-      good_usage <- check_aes_get_alternative_usage(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, check_aes_extract_usage_expr, data, env)
+    lapply(x, warn_for_aes_extract_usage_expr, data, env)
   }
 }
 
-check_aes_get_alternative_usage <- function(x) {
+alternative_aes_extract_usage <- function(x) {
   if (is_call(x, "[[")) {
     good_call <- call2("[[", quote(.data), x[[3]])
     format(good_call)
@@ -378,7 +377,13 @@ check_aes_get_alternative_usage <- function(x) {
   }
 }
 
-extract_target_is_data <- function(x, data, env) {
-  data_eval <- try(eval_tidy(x[[2]], data, env), silent = TRUE)
-  identical(data_eval, data)
+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

@@ -243,7 +243,7 @@ Layer <- ggproto("Layer", NULL,
     evaled <- compact(evaled)
 
     # Check for discouraged usage in mapping
-    check_aes_extract_usage(aesthetics, data[setdiff(names(data), "PANEL")])
+    warn_for_aes_extract_usage(aesthetics, data[setdiff(names(data), "PANEL")])
 
     # Check aesthetic values
     nondata_cols <- check_nondata_cols(evaled)

man/aes.Rd

@@ -111,39 +111,44 @@ test_that("aes standardises aesthetic names", {
   expect_warning(aes(color = x, colour = y), "Duplicated aesthetics")
 })
 
-test_that("Improper use of $ and [[ is detected by check_aes_extract_usage()", {
+test_that("warn_for_aes_extract_usage() warns for discouraged uses of $ and [[ within aes()", {
 
-  returns_x <- function() "x"
   df <- data_frame(x = 1:5, nested_df = data_frame(x = 6:10))
 
-  # valid extraction in aes()
-  expect_silent(check_aes_extract_usage(aes(x), df))
-  expect_silent(check_aes_extract_usage(aes(.data$x), df))
-  expect_silent(check_aes_extract_usage(aes(.data[["x"]]), df))
-  expect_silent(check_aes_extract_usage(aes(.data[[!!quo("x")]]), df))
-  expect_silent(check_aes_extract_usage(aes(.data[[returns_x()]]), df))
-  expect_silent(check_aes_extract_usage(aes(!!sym("x")), df))
-  expect_silent(check_aes_extract_usage(aes(x * 10), df))
-  expect_silent(check_aes_extract_usage(aes(nested_df$x), df))
-  expect_silent(check_aes_extract_usage(aes(nested_df[["x"]]), df))
-  expect_silent(check_aes_extract_usage(aes(.data[[c("nested_df", "x")]]), df))
-  expect_silent(check_aes_extract_usage(aes(.data[[c(2, 1)]]), df))
-  expect_silent(check_aes_extract_usage(aes(.data[[1]]), df))
-
-  # bad: use of extraction
   expect_warning(
-    check_aes_extract_usage(aes(df$x), df),
+    warn_for_aes_extract_usage(aes(df$x), df),
     "Use of `df\\$x` is discouraged"
   )
+
   expect_warning(
-    check_aes_extract_usage(aes(df[["x"]]), df),
+    warn_for_aes_extract_usage(aes(df[["x"]]), df),
     'Use of `df\\[\\["x"\\]\\]` is discouraged'
   )
 })
 
-test_that("Warnings are issued for extract usage in plots", {
-  df <- data_frame(x = 1:3, y = 3:1)
-  p <- ggplot(df, aes(df$x, df$y)) + geom_point()
+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")
 })