Added sanitise_dim function for Issue #801

R/facet-wrap.r

@@ -58,6 +58,9 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", shrin
     x = any(scales %in% c("free_x", "free")),
     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,
@@ -244,3 +247,63 @@ 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 <- sQuote(deparse(substitute(n)))
+  if (length(n) == 0)
+  {
+    if (!is.null(n))
+    {
+      warning(xname, " has length zero and will be treated as NULL.")
+    }
+    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,32 @@
+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.")
+})