Retain "ordering" attribute of chunk_size and scheduling (#309)

* Explicitly retain `"ordering"` attribute of `chunk_size`

* Explicitly retain `"ordering"` attribute of `scheduling`

Author: DavisVaughan

NEWS.md

@@ -19,6 +19,9 @@
 * When a furrr function errors, purrr's error index is no longer confusingly
   reported (#250).
 
+* `furrr_options()` no longer drops the `"ordering"` attribute when casting
+  non-integer `chunk_size` or `scheduling` to integer (#289, #290).
+
 * furrr now looks up the purrr mapping function on the worker itself, rather
   than sending over its own copy of the function. This avoids possible issues
   when you have, say, purrr 1.0.0 locally but purrr 0.3.5 on the worker, where

R/furrr-options.R

@@ -366,27 +366,28 @@ validate_seed_list <- function(x) {
 }
 
 validate_scheduling <- function(x) {
-  if (length(x) != 1L) {
-    abort("`scheduling` must be length 1.")
+  vctrs::obj_check_vector(x, arg = "scheduling")
+  vctrs::vec_check_size(x, size = 1L, arg = "scheduling")
+
+  if (is.na(x)) {
+    abort("`scheduling` can't be `NA`.")
   }
 
-  if (identical(x, Inf)) {
+  if (is_bool(x)) {
     return(x)
   }
 
-  if (is.logical(x)) {
-    if (!is_bool(x)) {
-      abort("A logical `scheduling` value can't be `NA`.")
-    }
+  if (x < 0L) {
+    abort("`scheduling` must be greater than or equal to zero.")
+  }
 
+  if (is.infinite(x)) {
     return(x)
   }
 
+  ordering <- attr(x, "ordering")
   x <- vctrs::vec_cast(x, integer(), x_arg = "scheduling")
-
-  if (x < 0L) {
-    abort("`scheduling` must be greater than or equal to zero.")
-  }
+  attr(x, "ordering") <- ordering
 
   x
 }
@@ -396,12 +397,8 @@ validate_chunk_size <- function(x) {
     return(x)
   }
 
-  if (identical(x, Inf)) {
-    return(x)
-  }
-
-  vctrs::vec_assert(x, size = 1L, arg = "chunk_size")
-  x <- vctrs::vec_cast(x, integer(), x_arg = "chunk_size")
+  vctrs::obj_check_vector(x, arg = "chunk_size")
+  vctrs::vec_check_size(x, size = 1L, arg = "chunk_size")
 
   if (is.na(x)) {
     abort("`chunk_size` can't be `NA`.")
@@ -411,6 +408,14 @@ validate_chunk_size <- function(x) {
     abort("`chunk_size` must be greater than zero.")
   }
 
+  if (is.infinite(x)) {
+    return(x)
+  }
+
+  ordering <- attr(x, "ordering")
+  x <- vctrs::vec_cast(x, integer(), x_arg = "chunk_size")
+  attr(x, "ordering") <- ordering
+
   x
 }
 

tests/testthat/test-furrr-options.R

@@ -262,11 +262,49 @@ test_that("validates `seed`", {
 # ------------------------------------------------------------------------------
 # furrr_options(scheduling =)
 
+test_that("can specify `scheduling`", {
+  x <- furrr_options(scheduling = TRUE)
+  expect_identical(x$scheduling, TRUE)
+
+  x <- furrr_options(scheduling = FALSE)
+  expect_identical(x$scheduling, FALSE)
+
+  x <- furrr_options(scheduling = 0)
+  expect_identical(x$scheduling, 0L)
+
+  x <- furrr_options(scheduling = 5)
+  expect_identical(x$scheduling, 5L)
+
+  x <- furrr_options(scheduling = Inf)
+  expect_identical(x$scheduling, Inf)
+})
+
 test_that("validates `scheduling`", {
   expect_error(furrr_options(scheduling = c(1, 2)))
+  expect_error(furrr_options(scheduling = c(TRUE, FALSE)))
   expect_error(furrr_options(scheduling = "x"))
   expect_error(furrr_options(scheduling = 1.5))
   expect_error(furrr_options(scheduling = NA))
+  expect_error(furrr_options(scheduling = -Inf))
+  expect_error(furrr_options(scheduling = lm(1 ~ 1)))
+})
+
+test_that("`scheduling` supports an `ordering` attribute (#289)", {
+  # Integer `scheduling`
+  x <- furrr_options(scheduling = structure(2L, ordering = "random"))
+  expect_identical(x$scheduling, structure(2L, ordering = "random"))
+
+  # Double `scheduling`
+  x <- furrr_options(scheduling = structure(2, ordering = "random"))
+  expect_identical(x$scheduling, structure(2L, ordering = "random"))
+
+  # Inf `scheduling`
+  x <- furrr_options(scheduling = structure(Inf, ordering = "random"))
+  expect_identical(x$scheduling, structure(Inf, ordering = "random"))
+
+  # Logical `scheduling`
+  x <- furrr_options(scheduling = structure(TRUE, ordering = "random"))
+  expect_identical(x$scheduling, structure(TRUE, ordering = "random"))
 })
 
 # ------------------------------------------------------------------------------
@@ -275,13 +313,33 @@ test_that("validates `scheduling`", {
 test_that("can specify `chunk_size`", {
   x <- furrr_options(chunk_size = 2)
   expect_identical(x$chunk_size, 2L)
+
+  x <- furrr_options(chunk_size = Inf)
+  expect_identical(x$chunk_size, Inf)
 })
 
 test_that("validates `chunk_size`", {
+  expect_error(furrr_options(chunk_size = 0))
   expect_error(furrr_options(chunk_size = c(1, 2)))
   expect_error(furrr_options(chunk_size = "x"))
   expect_error(furrr_options(chunk_size = 1.5))
   expect_error(furrr_options(chunk_size = NA))
+  expect_error(furrr_options(chunk_size = -Inf))
+  expect_error(furrr_options(chunk_size = lm(1 ~ 1)))
+})
+
+test_that("`chunk_size` supports an `ordering` attribute (#290)", {
+  # Integer `chunk_size`
+  x <- furrr_options(chunk_size = structure(2L, ordering = "random"))
+  expect_identical(x$chunk_size, structure(2L, ordering = "random"))
+
+  # Double `chunk_size`
+  x <- furrr_options(chunk_size = structure(2, ordering = "random"))
+  expect_identical(x$chunk_size, structure(2L, ordering = "random"))
+
+  # Inf `chunk_size`
+  x <- furrr_options(chunk_size = structure(Inf, ordering = "random"))
+  expect_identical(x$chunk_size, structure(Inf, ordering = "random"))
 })
 
 # ------------------------------------------------------------------------------