Merge pull request #1376 from lionel-/labels-deprecation

Handle deprecated labellers

Author: hadley

R/facet-grid-.r

@@ -221,6 +221,9 @@ facet_grid <- function(facets, margins = FALSE, scales = "fixed", space = "fixed
     stop("Must specify at least one variable to facet by", call. = FALSE)
   }
 
+  # Check for deprecated labellers
+  labeller <- check_labeller(labeller)
+
   facet(
     rows = rows, cols = cols, margins = margins, shrink = shrink,
     free = free, space_free = space_free, labeller = labeller,

R/facet-labels.r

@@ -555,3 +555,21 @@ adjust_angle <- function(angle) {
     angle + 180
   }
 }
+
+# Check for old school labeller
+check_labeller <- function(labeller) {
+  labeller <- match.fun(labeller)
+  is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
+
+  if (is_deprecated) {
+    old_labeller <- labeller
+    labeller <- function(labels) {
+      Map(old_labeller, names(labels), labels)
+    }
+    warning("The labeller API has been updated. Labellers taking `variable`",
+      "and `value` arguments are now deprecated. See labellers documentation.",
+      call. = FALSE)
+  }
+
+  labeller
+}

R/facet-wrap.r

@@ -93,6 +93,9 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
     ncol <- sanitise_dim(ncol)
   }
 
+  # Check for deprecated labellers
+  labeller <- check_labeller(labeller)
+
   facet(
     facets = as.quoted(facets), free = free, shrink = shrink,
     as.table = as.table, switch = switch,

tests/testthat/test-facet-labels.r

@@ -133,3 +133,17 @@ test_that("as_labeller() deals with non-labellers", {
   p2 <- p + facet_wrap(~am, labeller = labeller(am = function(x) paste0(x, "-foo")))
   expect_equal(get_labels_matrix(p2), cbind(c("0-foo", "1-foo")))
 })
+
+test_that("old school labellers still work", {
+  my_labeller <- function(variable, value) {
+    paste0("var = ", as.character(value))
+  }
+
+  expect_warning(p <-
+    ggplot(mtcars, aes(disp, drat)) +
+    geom_point() +
+    facet_grid(~cyl, labeller = my_labeller))
+
+  expected_labels <- cbind(paste("var =", c(4, 6, 8)))
+  expect_identical(get_labels_matrix(p, "cols"), expected_labels)
+})