centralise argument checking in compute_bins()

Author: teunbrand

R/bin.R

@@ -54,19 +54,12 @@ bin_breaks <- function(breaks, closed = c("right", "left")) {
 
 bin_breaks_width <- function(x_range, width = NULL, center = NULL,
                              boundary = NULL, closed = c("right", "left")) {
-  check_length(x_range, 2L)
 
-  # binwidth seems to be the argument name supplied to width. (stat-bin and stat-bindot)
-  check_number_decimal(width, min = 0, allow_infinite = FALSE, arg = "binwidth")
-
-  if (!is.null(boundary) && !is.null(center)) {
-    cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.")
-  } else if (is.null(boundary)) {
+  if (is.null(boundary)) {
     if (is.null(center)) {
       # If neither edge nor center given, compute both using tile layer's
       # algorithm. This puts min and max of data in outer half of their bins.
       boundary <- width / 2
-
     } else {
       # If center given but not boundary, compute boundary.
       boundary <- center - width / 2
@@ -75,9 +68,6 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
 
   # Find the left side of left-most bin: inputs could be Dates or POSIXct, so
   # coerce to numeric first.
-  x_range <- as.numeric(x_range)
-  width <- as.numeric(width)
-  boundary <- as.numeric(boundary)
   shift <- floor((x_range[1] - boundary) / width)
   origin <- boundary + shift * width
 
@@ -104,9 +94,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
 
 bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
                             boundary = NULL, closed = c("right", "left")) {
-  check_length(x_range, 2L)
 
-  check_number_whole(bins, min = 1)
   if (zero_range(x_range)) {
     # 0.1 is the same width as the expansion `default_expansion()` gives for 0-width data
     width <- 0.1
@@ -128,27 +116,38 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
 
 # Compute bins ------------------------------------------------------------
 
-compute_bins <- function(x, scale, breaks = NULL, binwidth = NULL, bins = NULL,
+compute_bins <- function(x, scale = NULL, breaks = NULL, binwidth = NULL, bins = NULL,
                          center = NULL, boundary = NULL,
                          closed = c("right", "left")) {
 
+  range <- if (is.scale(scale)) scale$dimension() else range(x)
+  check_length(range, 2L)
+
   if (!is.null(breaks)) {
     if (is.function(breaks)) {
       breaks <- breaks(x)
     }
-    if (!scale$is_discrete()) {
+    if (is.scale(scale) && !scale$is_discrete()) {
       breaks <- scale$transform(breaks)
     }
+    check_numeric(breaks)
     bins <- bin_breaks(breaks, closed)
     return(bins)
   }
 
+  check_number_decimal(boundary, allow_infinite = FALSE, allow_null = TRUE)
+  check_number_decimal(center, allow_infinite = FALSE, allow_null = TRUE)
+  if (!is.null(boundary) && !is.null(center)) {
+    cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified.")
+  }
+
   if (!is.null(binwidth)) {
     if (is.function(binwidth)) {
       binwidth <- binwidth(x)
     }
+    check_number_decimal(binwidth, min = 0, allow_infinite = FALSE)
     bins <- bin_breaks_width(
-      scale$dimension(), binwidth,
+      range, binwidth,
       center = center, boundary = boundary, closed = closed
     )
     return(bins)
@@ -157,8 +156,9 @@ compute_bins <- function(x, scale, breaks = NULL, binwidth = NULL, bins = NULL,
   if (is.function(bins)) {
     bins <- bins(x)
   }
+  check_number_whole(bins, min = 1, allow_infinite = FALSE)
   bin_breaks_bins(
-    scale$dimension(), bins,
+    range, bins,
     center = center, boundary = boundary, closed = closed
   )
 }
@@ -253,13 +253,6 @@ fix_bin_params = function(params, fun, version) {
     params$right <- NULL
   }
 
-  if (!is.null(params$boundary) && !is.null(params$center)) {
-    cli::cli_abort(
-      "Only one of {.arg boundary} and {.arg center} may be specified \\
-      in {.fn {fun}}."
-    )
-  }
-
   if (is.null(params$breaks %||% params$binwidth %||% params$bins)) {
     cli::cli_inform(
       "{.fn {fun}} using {.code bins = 30}. Pick better value {.arg binwidth}."

tests/testthat/_snaps/stat-bin.md

@@ -23,51 +23,30 @@
 
 # inputs to binning are checked
 
-    Computation failed in `stat_bin()`.
-    Caused by error in `bins()`:
-    ! `breaks` must be a <numeric> vector, not a character vector.
+    `breaks` must be a <numeric> vector, not a character vector.
 
 ---
 
-    `x_range` must be a vector of length 2, not length 1.
+    `binwidth` must be a number, not a character vector.
 
 ---
 
-    Computation failed in `stat_bin()`.
-    Caused by error in `bin_breaks_width()`:
-    ! `binwidth` must be a number, not a character vector.
+    `binwidth` must be a number larger than or equal to 0, not the number -4.
 
 ---
 
-    Computation failed in `stat_bin()`.
-    Caused by error in `bin_breaks_width()`:
-    ! `binwidth` must be a number larger than or equal to 0, not the number -4.
-
----
-
-    `x_range` must be a vector of length 2, not length 1.
-
----
-
-    Computation failed in `stat_bin()`.
-    Caused by error in `bin_breaks_bins()`:
-    ! `bins` must be a whole number larger than or equal to 1, not the number -4.
+    `bins` must be a whole number larger than or equal to 1, not the number -4.
 
 # setting boundary and center
 
-    Code
-      comp_bin(df, boundary = 5, center = 0)
-    Condition
-      Error in `stat_bin()`:
-      ! Problem while computing stat.
-      i Error occurred in the 1st layer.
-      Caused by error in `fix_bin_params()`:
-      ! Only one of `boundary` and `center` may be specified in `stat_bin()`.
+    Computation failed in `stat_bin()`.
+    Caused by error in `compute_bins()`:
+    ! Only one of `boundary` and `center` may be specified.
 
 # bin errors at high bin counts
 
     Code
-      bin_breaks_width(c(1, 2e+06), 1)
+      compute_bins(c(1, 2e+06), binwidth = 1)
     Condition
       Error in `bin_breaks_width()`:
       ! The number of histogram bins must be less than 1,000,000.

tests/testthat/_snaps/stat-bin2d.md

@@ -1,12 +1,12 @@
 # binwidth is respected
 
     Computation failed in `stat_bin2d()`.
-    Caused by error in `bin2d_breaks()`:
+    Caused by error in `compute_bins()`:
     ! `binwidth` must be a number, not a double vector.
 
 ---
 
     Computation failed in `stat_bin2d()`.
-    Caused by error in `bin2d_breaks()`:
-    ! `origin` must be a number, not a double vector.
+    Caused by error in `compute_bins()`:
+    ! `boundary` must be a number or `NULL`, not a double vector.
 

tests/testthat/test-stat-bin.R

@@ -147,19 +147,19 @@ test_that("bins is strictly adhered to", {
 
   # Default case
   nbreaks <- vapply(nbins, function(bins) {
-    length(bin_breaks_bins(c(0, 10), bins)$breaks)
+    length(compute_bins(c(0, 10), bins = bins)$breaks)
   }, numeric(1))
   expect_equal(nbreaks, nbins + 1)
 
   # Center is provided
   nbreaks <- vapply(nbins, function(bins) {
-    length(bin_breaks_bins(c(0, 10), bins, center = 0)$breaks)
+    length(compute_bins(c(0, 10), bins = bins, center = 0)$breaks)
   }, numeric(1))
   expect_equal(nbreaks, nbins + 1)
 
   # Boundary is provided
   nbreaks <- vapply(nbins, function(bins) {
-    length(bin_breaks_bins(c(0, 10), bins, boundary = 0)$breaks)
+    length(compute_bins(c(0, 10), bins = bins, boundary = 0)$breaks)
   }, numeric(1))
   expect_equal(nbreaks, nbins + 1)
 
@@ -172,13 +172,10 @@ comp_bin <- function(df, ...) {
 
 test_that("inputs to binning are checked", {
   dat <- data_frame(x = c(0, 10))
-  expect_snapshot_error(comp_bin(dat, breaks = letters))
-  expect_snapshot_error(bin_breaks_width(3))
-  expect_snapshot_error(comp_bin(dat, binwidth = letters))
-  expect_snapshot_error(comp_bin(dat, binwidth = -4))
-
-  expect_snapshot_error(bin_breaks_bins(3))
-  expect_snapshot_error(comp_bin(dat, bins = -4))
+  expect_snapshot_error(compute_bins(dat, breaks = letters))
+  expect_snapshot_error(compute_bins(dat, binwidth = letters))
+  expect_snapshot_error(compute_bins(dat, binwidth = -4))
+  expect_snapshot_error(compute_bins(dat, bins = -4))
 })
 
 test_that("closed left or right", {
@@ -208,14 +205,14 @@ test_that("setting boundary and center", {
   df <- data_frame(x = c(0, 30))
 
   # Error if both boundary and center are specified
-  expect_snapshot(comp_bin(df, boundary = 5, center = 0), error = TRUE)
+  expect_snapshot_warning(comp_bin(df, boundary = 5, center = 0, bins = 30))
 
   res <- comp_bin(df, binwidth = 10, boundary = 0, pad = FALSE)
   expect_identical(res$count, c(1, 0, 1))
   expect_identical(res$xmin[1], 0)
   expect_identical(res$xmax[3], 30)
 
-  res <- comp_bin(df, binwidth = 10, center = 0, pad = FALSE)
+  res <- comp_bin(df, binwidth = 10, center = 0, boundary = NULL, pad = FALSE)
   expect_identical(res$count, c(1, 0, 0, 1))
   expect_identical(res$xmin[1], df$x[1] - 5)
   expect_identical(res$xmax[4], df$x[2] + 5)
@@ -230,7 +227,7 @@ test_that("weights are added", {
 })
 
 test_that("bin errors at high bin counts", {
-  expect_snapshot(bin_breaks_width(c(1, 2e6), 1), error = TRUE)
+  expect_snapshot(compute_bins(c(1, 2e6), binwidth =  1), error = TRUE)
 })
 
 # stat_count --------------------------------------------------------------

tests/testthat/test-stat-bin2d.R

@@ -14,7 +14,7 @@ test_that("binwidth is respected", {
   expect_snapshot_warning(ggplot_build(p))
 
   p <- ggplot(df, aes(x, y)) +
-    stat_bin_2d(geom = "tile", origin = c(0.25, 0.5, 0.75))
+    stat_bin_2d(geom = "tile", boundary = c(0.25, 0.5, 0.75))
   expect_snapshot_warning(ggplot_build(p))
 })