Better strategy for detecting calculated aes.

Closes #935

Author: hadley

DESCRIPTION

@@ -48,6 +48,7 @@ LazyData: true
 Collate:
     'aaa-.r'
     'aaa-constants.r'
+    'aes-calculated.r'
     'aes-colour-fill-alpha.r'
     'aes-group-order.r'
     'aes-linetype-size-shape.r'

R/aes-calculated.r

@@ -0,0 +1,53 @@
+# Regex to determine if an identifier refers to a calculated aesthetic
+match_calculated_aes <- "^\\.\\.([a-zA-z._]+)\\.\\.$"
+
+# Determine if aesthetic is calculated
+is_calculated_aes <- function(aesthetics) {
+  vars <- lapply(aesthetics, find_vars)
+
+  vapply(vars, function(x) any(grepl(match_calculated_aes, x)), logical(1))
+}
+
+find_vars <- function(expr) {
+  if (is.name(expr)) {
+    as.character(expr)
+  } else if (is.atomic(expr)) {
+    character()
+  } else if (is.call(expr)) {
+    unlist(lapply(expr[-1], find_vars))
+  } else if (is.pairlist(expr)) {
+    # In the unlikely event of an anonymous function
+    unlist(lapply(expr, find_vars))
+  } else {
+    stop("Unknown input:", class(expr)[1])
+  }
+}
+
+# Strip dots from expressions
+strip_dots <- function(aesthetics) {
+  strings <- lapply(aesthetics, deparse)
+  strings <- lapply(strings, gsub, pattern = .calculated_aes_regex,
+    replacement = "\\1")
+  lapply(strings, function(x) parse(text = x)[[1]])
+}
+
+
+strip_dots <- function(expr) {
+  if (is.atomic(expr)) {
+    expr
+  } else if (is.name(expr)) {
+    as.name(gsub(match_calculated_aes, "\\1", as.character(expr)))
+  } else if (is.call(expr)) {
+    expr[-1] <- lapply(expr[-1], strip_dots)
+    expr
+  } else if (is.pairlist(expr)) {
+    # In the unlikely event of an anonymous function
+    as.pairlist(lapply(expr, expr))
+  } else if (is.list(expr)) {
+    # For list of aesthetics
+    lapply(expr, strip_dots)
+  } else {
+    stop("Unknown input:", class(expr)[1])
+  }
+}
+

R/labels.r

@@ -65,7 +65,7 @@ ggtitle <- function(label) {
 # Convert aesthetic mapping into text labels
 make_labels <- function(mapping) {
   remove_dots <- function(x) {
-    gsub(.calculated_aes_regex, "\\1", x)
+    gsub(match_calculated_aes, "\\1", x)
   }
 
   lapply(mapping, function(x) remove_dots(deparse(x)))

R/layer.r

@@ -257,20 +257,3 @@ Layer <- proto(expr = {
 #' @keywords internal
 #' @export
 layer <- Layer$new
-
-# Regex to determine if an identifier refers to a calculated aesthetic
-.calculated_aes_regex <- "^\\.\\.([a-zA-z._]+)\\.\\.$"
-
-# Determine if aesthetic is calculated
-is_calculated_aes <- function(aesthetics) {
-  stats <- rep(FALSE, length(aesthetics))
-  grepl(.calculated_aes_regex, sapply(aesthetics, deparse))
-}
-
-# Strip dots from expressions
-strip_dots <- function(aesthetics) {
-  strings <- lapply(aesthetics, deparse)
-  strings <- lapply(strings, gsub, pattern = .calculated_aes_regex,
-                    replacement = "\\1")
-  lapply(strings, function(x) parse(text = x)[[1]])
-}

inst/tests/test-layer.r

@@ -1,7 +1,18 @@
 context("Layer")
 
-test_that("Correctly decide if a variable is a calculated aesthetic", {
-  expect_true(is_calculated_aes(aes(x=..density..)))
-  expect_false(is_calculated_aes(aes(x=a..x..b)))
-  expect_equal(as.character(strip_dots(aes(x=..density..))), "density")
+test_that("Bare name surround by .. is calculated", {
+  expect_true(is_calculated_aes(aes(..density..)))
+  expect_true(is_calculated_aes(aes(..DENSITY..)))
+  expect_false(is_calculated_aes(aes(a..x..b)))
+})
+
+test_that("Calling using variable surround by .. is calculated", {
+  expect_true(is_calculated_aes(aes(mean(..density..))))
+  expect_true(is_calculated_aes(aes(mean(..DENSITY..))))
+  expect_false(is_calculated_aes(aes(x=mean(a..x..b))))
+})
+
+test_that("strip_dots remove dots around calculated aesthetics", {
+  expect_equal(strip_dots(aes(x=..density..))$x, quote(density))
+  expect_equal(strip_dots(aes(mean(..density..)))$x, quote(mean(density)))
 })