Add .ptype and .size arguments, adjust NULL and empty handling

DESCRIPTION

@@ -8,6 +8,7 @@ Authors@R: c(
 Description: What the package does (one paragraph).
 License: MIT + file LICENSE
 Imports: 
+    purrr (>= 0.3.4),
     rlang (>= 1.0.2),
     vctrs (>= 0.4.1)
 Suggests: 

NAMESPACE

@@ -7,3 +7,4 @@ export(is_na)
 export(sample)
 import(rlang)
 import(vctrs)
+importFrom(purrr,discard)

R/coalesce.R

@@ -1,11 +1,14 @@
 #' Find first non-missing element
 #'
 #' Given a set of vectors, `coalesce()` finds the first non-missing value at
-#' each position. It's inspired by the SQL `COALESCE`` function which does the
+#' each position. It's inspired by the SQL `COALESCE` function which does the
 #' same thing for SQL `NULL`s.
 #'
-#' @param ... One or more vectors. Vectors are recycled to a common length
-#'   and cast to a common type.
+#' @param ... One or more vectors.
+#' @param .ptype The type to cast the vectors in `...` to. If `NULL`, the
+#'   vectors will be cast to their common type, which is consistent with SQL.
+#' @param .size The size to recycle the vectors in `...` to. If `NULL`, the
+#'   vectors will be recycled to their common size.
 #' @export
 #' @examples
 #' # Use a single value to replace all missing values
@@ -15,14 +18,7 @@
 #' # The equivalent to a missing value in a list is NULL
 #' coalesce(list(1, 2, NULL), list(NA))
 #'
-#' # data frames are coalesced, row by row, and the output will contain
-#' # columns that appear in any input
-#' coalesce(
-#'   data.frame(x = c(1, NA)),
-#'   data.frame(x = c(NA, 2), y = 3)
-#' )
-#'
-#' # Or match together a complete vector from missing pieces
+#' # Or generate a complete vector from partially missing pieces
 #' y <- c(1, 2, NA, NA, 5)
 #' z <- c(NA, NA, 3, 4, 5)
 #' coalesce(y, z)
@@ -33,17 +29,16 @@
 #'   c(NA, NA, 3, 4, 5)
 #' )
 #' coalesce(!!!vecs)
-coalesce <- function(...) {
+coalesce <- function(..., .ptype = NULL, .size = NULL) {
   args <- list2(...)
+  args <- discard(args, is.null)
 
-  n_args <- vec_size(args)
-
-  if (n_args == 0L) {
-    return(NULL)
+  if (length(args) == 0L) {
+    abort("`...` must contain at least one input.")
   }
 
-  args <- vec_cast_common(!!! args)
-  args <- vec_recycle_common(!!! args)
+  args <- vec_cast_common(!!!args, .to = .ptype)
+  args <- vec_recycle_common(!!!args, .size = .size)
 
   out <- args[[1L]]
   args <- args[-1L]
@@ -55,7 +50,7 @@ coalesce <- function(...) {
       break
     }
 
-    vec_slice(out, is_na) <- vec_slice(arg, is_na)
+    out <- vec_assign(out, is_na, vec_slice(arg, is_na))
   }
 
   out

R/funs-package.R

@@ -1,6 +1,7 @@
 #' @keywords internal
 #' @import vctrs
 #' @import rlang
+#' @importFrom purrr discard
 "_PACKAGE"
 
 # The following block is used by usethis to automatically manage

tests/testthat/_snaps/coalesce.md

@@ -0,0 +1,32 @@
+# `.size` overrides the common size
+
+    Code
+      coalesce(x, 1:2, .size = vec_size(x))
+    Condition
+      Error in `coalesce()`:
+      ! Can't recycle `..2` (size 2) to size 1.
+
+# must have at least one non-`NULL` vector
+
+    Code
+      coalesce()
+    Condition
+      Error in `coalesce()`:
+      ! `...` must contain at least one input.
+
+---
+
+    Code
+      coalesce(NULL, NULL)
+    Condition
+      Error in `coalesce()`:
+      ! `...` must contain at least one input.
+
+# inputs must be vectors
+
+    Code
+      coalesce(1, environment())
+    Condition
+      Error in `coalesce()`:
+      ! `..2` must be a vector, not an environment.
+

tests/testthat/test-coalesce.R

@@ -1,7 +1,3 @@
-test_that("empty call returns NULL", {
-  expect_equal(coalesce(), NULL)
-})
-
 test_that("performs vectorised replacement", {
   expect_equal(coalesce(NA, 1:2), 1:2)
   expect_equal(coalesce(c(NA, NA), 1), c(1, 1))
@@ -10,3 +6,78 @@ test_that("performs vectorised replacement", {
 test_that("terminates early if no missing", {
   expect_equal(coalesce(1:3, 1:3), 1:3)
 })
+
+test_that("only updates entirely missing matrix rows", {
+  x <- c(
+    1, NA,
+    NA, NA
+  )
+  x <- matrix(x, nrow = 2, byrow = TRUE)
+
+  y <- c(
+    2, 2,
+    NA, 1
+  )
+  y <- matrix(y, nrow = 2, byrow = TRUE)
+
+  expect <- c(
+    1, NA,
+    NA, 1
+  )
+  expect <- matrix(expect, nrow = 2, byrow = TRUE)
+
+  expect_identical(coalesce(x, y), expect)
+})
+
+test_that("only updates entirely missing data frame rows", {
+  x <- data_frame(x = c(1, NA), y = c(NA, NA))
+  y <- data_frame(x = c(2, NA), y = c(TRUE, TRUE))
+
+  expect <- data_frame(x = c(1, NA), y = c(NA, TRUE))
+
+  expect_identical(coalesce(x, y), expect)
+})
+
+test_that("only updates entirely missing rcrd observations", {
+  x <- new_rcrd(list(x = c(1, NA), y = c(NA, NA)))
+  y <- new_rcrd(list(x = c(2, NA), y = c(TRUE, TRUE)))
+
+  expect <- new_rcrd(list(x = c(1, NA), y = c(NA, TRUE)))
+
+  expect_identical(coalesce(x, y), expect)
+})
+
+test_that("`.ptype` overrides the common type (#64)", {
+  x <- c(1L, NA)
+  expect_identical(coalesce(x, 99, .ptype = x), c(1L, 99L))
+})
+
+test_that("`.size` overrides the common size", {
+  x <- 1L
+
+  expect_snapshot(error = TRUE, {
+    coalesce(x, 1:2, .size = vec_size(x))
+  })
+})
+
+test_that("must have at least one non-`NULL` vector", {
+  expect_snapshot(error = TRUE, {
+    coalesce()
+  })
+  expect_snapshot(error = TRUE, {
+    coalesce(NULL, NULL)
+  })
+})
+
+test_that("`NULL`s are discarded (#80)", {
+  expect_identical(
+    coalesce(c(1, NA, NA), NULL, c(1, 2, NA), NULL, 3),
+    c(1, 2, 3)
+  )
+})
+
+test_that("inputs must be vectors", {
+  expect_snapshot(error = TRUE, {
+    coalesce(1, environment())
+  })
+})