From cfacdeae748bededb1297fbe66503cde19f88d68 Mon Sep 17 00:00:00 2001 From: Richard J Cotton Date: Sun, 11 May 2014 11:42:40 +0300 Subject: [PATCH 01/10] Added sanitise_dim function. --- R/facet-wrap.r | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 9f1213c2af..2a4f7a22dd 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -244,3 +244,62 @@ 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") +#' } +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 +} + From a37cf3b7a200e83a2491989d0f0315482a457dd4 Mon Sep 17 00:00:00 2001 From: Richard J Cotton Date: Sun, 11 May 2014 11:43:15 +0300 Subject: [PATCH 02/10] facet_wrap calls sanitise_dim. --- R/facet-wrap.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 2a4f7a22dd..72afdd0f8b 100644 --- a/R/facet-wrap.r +++ b/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, From 904533acd0ba77b2a029d6185ecff542fe9cd2f0 Mon Sep 17 00:00:00 2001 From: Richard J Cotton Date: Sun, 11 May 2014 11:43:40 +0300 Subject: [PATCH 03/10] Added tests for sanitise_dim. --- inst/tests/test-sanitise-dim.r | 76 ++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 inst/tests/test-sanitise-dim.r diff --git a/inst/tests/test-sanitise-dim.r b/inst/tests/test-sanitise-dim.r new file mode 100644 index 0000000000..16d51b7656 --- /dev/null +++ b/inst/tests/test-sanitise-dim.r @@ -0,0 +1,76 @@ +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 input for positive integer inputs", + { + for(n in c(1, sample(.Machine$integer.max, 10))) + { + expect_identical(sanitise_dim(n), n) + } + } +) + +test_that( + "sanitise_dim returns NULL for non-positive integer inputs, with appropriate warnings", + { + for(n in c(0, -1, -sample(.Machine$integer.max, 10))) + { + 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 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.") + } +) + +test_that( + "sanitise_dim returns NULL for non-numeric inputs, with appropriate warnings", + { + n <- "foo" + expect_identical(suppressWarnings(sanitise_dim(n)), NULL) + expect_warning(sanitise_dim(n), "Coercing .n. to be an integer.") + expect_warning(sanitise_dim(n), ".n. is missing or less than 1 and will be treated as NULL.") + } +) + From 530cdc760070b2266294223f96bbdf91a482f370 Mon Sep 17 00:00:00 2001 From: richierocks Date: Fri, 12 Jun 2015 19:04:38 +0300 Subject: [PATCH 04/10] spaces after 'if' to conform to house style --- R/facet-wrap.r | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 72afdd0f8b..d300c67f1e 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -280,25 +280,25 @@ facet_vars.wrap <- function(facet) { sanitise_dim <- function(n) { xname <- sQuote(deparse(substitute(n))) - if(length(n) == 0) + if (length(n) == 0) { - if(!is.null(n)) + if (!is.null(n)) { warning(xname, " has length zero and will be treated as NULL.") } return(NULL) } - if(length(n) > 1) + 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))) + 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) + if (is.na(n) || n < 1) { warning(xname, " is missing or less than 1 and will be treated as NULL.", call. = FALSE) return(NULL) From a731972ee17ebd5227494d0fd89a121af671c578 Mon Sep 17 00:00:00 2001 From: richierocks Date: Fri, 12 Jun 2015 19:05:04 +0300 Subject: [PATCH 05/10] added @noRd to sanitise_dim --- R/facet-wrap.r | 1 + 1 file changed, 1 insertion(+) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index d300c67f1e..2e4b429135 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -277,6 +277,7 @@ facet_vars.wrap <- function(facet) { #' sanitise_dim(0) #' sanitise_dim("foo") #' } +#' @noRd sanitise_dim <- function(n) { xname <- sQuote(deparse(substitute(n))) From cafa30d71f7000c576bd2ebb93b085ada407595d Mon Sep 17 00:00:00 2001 From: richierocks Date: Sat, 13 Jun 2015 14:28:52 +0300 Subject: [PATCH 06/10] removed some unit tests for sanitise_dim --- inst/tests/test-sanitise-dim.r | 32 -------------------------------- 1 file changed, 32 deletions(-) diff --git a/inst/tests/test-sanitise-dim.r b/inst/tests/test-sanitise-dim.r index 16d51b7656..3086dfad48 100644 --- a/inst/tests/test-sanitise-dim.r +++ b/inst/tests/test-sanitise-dim.r @@ -8,27 +8,6 @@ test_that( } ) -test_that( - "sanitise_dim returns the input for positive integer inputs", - { - for(n in c(1, sample(.Machine$integer.max, 10))) - { - expect_identical(sanitise_dim(n), n) - } - } -) - -test_that( - "sanitise_dim returns NULL for non-positive integer inputs, with appropriate warnings", - { - for(n in c(0, -1, -sample(.Machine$integer.max, 10))) - { - 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 the first element or NULL for non-positive integer inputs, with appropriate warnings", { @@ -63,14 +42,3 @@ test_that( expect_warning(sanitise_dim(n2), ".n2. is missing or less than 1 and will be treated as NULL.") } ) - -test_that( - "sanitise_dim returns NULL for non-numeric inputs, with appropriate warnings", - { - n <- "foo" - expect_identical(suppressWarnings(sanitise_dim(n)), NULL) - expect_warning(sanitise_dim(n), "Coercing .n. to be an integer.") - expect_warning(sanitise_dim(n), ".n. is missing or less than 1 and will be treated as NULL.") - } -) - From 406982ecc4d8c3ee42a67210cfcb2def83201c70 Mon Sep 17 00:00:00 2001 From: richierocks Date: Sat, 13 Jun 2015 14:33:26 +0300 Subject: [PATCH 07/10] sanitise_dim tests formateed to house style --- inst/tests/test-sanitise-dim.r | 70 ++++++++++++++-------------------- 1 file changed, 29 insertions(+), 41 deletions(-) diff --git a/inst/tests/test-sanitise-dim.r b/inst/tests/test-sanitise-dim.r index 3086dfad48..0fab846300 100644 --- a/inst/tests/test-sanitise-dim.r +++ b/inst/tests/test-sanitise-dim.r @@ -1,44 +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 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 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 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.") - } -) +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.") +}) From 4e7181c2fe2c7b3e8bcb5e61bbbcd002132d5cf0 Mon Sep 17 00:00:00 2001 From: hadley Date: Thu, 18 Jun 2015 08:35:10 -0500 Subject: [PATCH 08/10] Style fixes --- R/facet-wrap.r | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 514e1f86ff..75ec561d13 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -60,7 +60,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed", x = any(scales %in% c("free_x", "free")), y = any(scales %in% c("free_y", "free")) ) - + nrow <- sanitise_dim(nrow) ncol <- sanitise_dim(ncol) @@ -251,17 +251,17 @@ facet_vars.wrap <- function(facet) { } #' 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 +#' @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 +#' If the value is less than one, \code{NULL} is returned, effectively ignoring #' the argument. #' Multiple warnings may be generated. #' @examples @@ -273,37 +273,33 @@ facet_vars.wrap <- function(facet) { #' 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 +#' # 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) -{ +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.") + 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) - { + 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))) - { + 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) + 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 From dd51b72472f8e74bc7d1b92cd43895004636b2a0 Mon Sep 17 00:00:00 2001 From: hadley Date: Thu, 18 Jun 2015 08:38:58 -0500 Subject: [PATCH 09/10] Eliminate use of sQuote --- R/facet-wrap.r | 2 +- inst/tests/test-sanitise-dim.r | 18 ++++++++++-------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 75ec561d13..9580ba12bb 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -281,7 +281,7 @@ facet_vars.wrap <- function(facet) { #' } #' @noRd sanitise_dim <- function(n) { - xname <- sQuote(deparse(substitute(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.", diff --git a/inst/tests/test-sanitise-dim.r b/inst/tests/test-sanitise-dim.r index 0fab846300..375c434ff1 100644 --- a/inst/tests/test-sanitise-dim.r +++ b/inst/tests/test-sanitise-dim.r @@ -1,32 +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.") + 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.") + 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.") + 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.") + 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.") + 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.") + 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.") }) From 736ec3e8504f76d6829646842e2e9959f60ded3c Mon Sep 17 00:00:00 2001 From: hadley Date: Thu, 18 Jun 2015 08:39:54 -0500 Subject: [PATCH 10/10] Update news --- NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS b/NEWS index cd166d53d3..16785040a4 100644 --- a/NEWS +++ b/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)