Merge branch 'richierocks-master'

NEWS

@@ -1,6 +1,9 @@
 ggplot2 1.0.1.9000
 ----------------------------------------------------------------
 
+* `facet_wrap()` more carefully checks its `nrow` and `ncol` arguments
+  to ensure that they're specified correctly (@richierocks, #962)
+
 * Improved the calculation of segments needed to draw the curve representing
   a line when plotted in polar coordinates. In some cases, the last segment
   of a multi-segment line was not drawn (@BrianDiggs, #952)

R/facet-wrap.r

@@ -61,6 +61,9 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
     y = any(scales %in% c("free_y", "free"))
   )
 
+  nrow <- sanitise_dim(nrow)
+  ncol <- sanitise_dim(ncol)
+
   facet(
     facets = as.quoted(facets), free = free, shrink = shrink,
     as.table = as.table, drop = drop,
@@ -246,3 +249,59 @@ facet_axes.wrap <- function(facet, panel, coord, theme) {
 facet_vars.wrap <- function(facet) {
   paste(lapply(facet$facets, paste, collapse = ", "), collapse = " ~ ")
 }
+
+#' Sanitise the number of rows or columns
+#'
+#' Cleans up the input to be an integer greater than or equal to one, or
+#' \code{NULL}. Intended to be used on the \code{nrow} and \code{ncol}
+#' arguments of \code{facet_wrap}.
+#' @param n Hopefully an integer greater than or equal to one, or \code{NULL},
+#' though other inputs are handled.
+#' @return An integer greater than or equal to one, or \code{NULL}.
+#' @note If the length of the input is greater than one, only the first element
+#' is returned, with a warning.
+#' If the input is not an integer, it will be coerced to be one.
+#' If the value is less than one, \code{NULL} is returned, effectively ignoring
+#' the argument.
+#' Multiple warnings may be generated.
+#' @examples
+#' # Valid input just gets returns unchanged
+#' sanitise_dim(1)
+#' sanitise_dim(NULL)
+#' \dontrun{
+#' # Only the first element of vectors get returned
+#' sanitise_dim(10:1)
+#' # Non-integer values are coerced to integer
+#' sanitise_dim(pi)
+#' # Missing values, values less than one and non-numeric values are
+#' # treated as NULL
+#' sanitise_dim(NA_integer_)
+#' sanitise_dim(0)
+#' sanitise_dim("foo")
+#' }
+#' @noRd
+sanitise_dim <- function(n) {
+  xname <- paste0("`", deparse(substitute(n)), "`")
+  if (length(n) == 0) {
+    if (!is.null(n)) {
+      warning(xname, " has length zero and will be treated as NULL.",
+        call. = FALSE)
+    }
+    return(NULL)
+  }
+  if (length(n) > 1) {
+    warning("Only the first value of ", xname, " will be used.", call. = FALSE)
+    n <- n[1]
+  }
+  if (!is.numeric(n) || (!is.na(n) && n != round(n))) {
+    warning("Coercing ", xname, " to be an integer.", call. = FALSE)
+    n <- as.integer(n)
+  }
+  if (is.na(n) || n < 1) {
+    warning(xname, " is missing or less than 1 and will be treated as NULL.",
+      call. = FALSE)
+    return(NULL)
+  }
+  n
+}
+

inst/tests/test-sanitise-dim.r

@@ -0,0 +1,34 @@
+context("sanitise_dim")
+
+test_that("sanitise_dim returns NULL for zero-length inputs, with appropriate warnings", {
+  expect_identical(sanitise_dim(NULL), NULL)
+  n <- integer()
+  y <- expect_identical(suppressWarnings(sanitise_dim(n)), NULL)
+  expect_warning(sanitise_dim(n), "`n` has length zero and will be treated as NULL.")
+})
+
+test_that("sanitise_dim returns the first element or NULL for non-positive integer inputs, with appropriate warnings", {
+  n <- 1:2
+  expect_identical(suppressWarnings(sanitise_dim(n)), 1L)
+  expect_warning(sanitise_dim(n), "Only the first value of `n` will be used.")
+  n2 <- 0:1
+  expect_identical(suppressWarnings(sanitise_dim(n2)), NULL)
+  expect_warning(sanitise_dim(n2), "Only the first value of `n2` will be used.")
+  expect_warning(sanitise_dim(n2), "`n2` is missing or less than 1 and will be treated as NULL.")
+})
+
+test_that("sanitise_dim returns a NULL for missing inputs, with appropriate warnings", {
+  n <- NA_integer_
+  expect_identical(suppressWarnings(sanitise_dim(n)), NULL)
+  expect_warning(sanitise_dim(n), "`n` is missing or less than 1 and will be treated as NULL.")
+})
+
+test_that("sanitise_dim returns a positive integer or NULL for non-integer inputs, with appropriate warnings", {
+  n <- 1.5
+  expect_identical(suppressWarnings(sanitise_dim(n)), 1L)
+  expect_warning(sanitise_dim(n), "Coercing `n` to be an integer.")
+  n2 <- 0.9999999
+  expect_identical(suppressWarnings(sanitise_dim(n2)), NULL)
+  expect_warning(sanitise_dim(n2), "Coercing `n2` to be an integer.")
+  expect_warning(sanitise_dim(n2), "`n2` is missing or less than 1 and will be treated as NULL.")
+})