Better handling of zero-row rowwise mutates() (#6369)

Fixes #6303

Co-authored-by: Davis Vaughan <[email protected]>

NEWS.md

@@ -1,5 +1,7 @@
 # dplyr (development version)
 
+* Rowwise-`mutate()` behaves a little better with 0-row inputs (#6303).
+
 * A rowwise `mutate()` now automatically unlists list-columns containing 
   length 1 vectors (#6302).
 

R/mutate.R

@@ -337,7 +337,12 @@ mutate_cols <- function(.data, dots, caller_env, error_call = caller_env()) {
               )
             }
             result_ptype <- attr(result, "ptype", exact = TRUE)
-            result <- vec_unchop(result, ptype = result_ptype)
+            if (length(result) == 0 && is.null(result_ptype)) {
+              # i.e. `vec_ptype_finalise(unspecified())` (#6369)
+              result <- logical()
+            } else {
+              result <- vec_unchop(result, ptype = result_ptype)
+            }
           }
         } else if (!quo_is_symbolic(quo) && !is.null(quo_get_expr(quo))) {
           # constant, we still need both `result` and `chunks`

src/chop.cpp

@@ -17,11 +17,26 @@ void dplyr_lazy_vec_chop_grouped(SEXP chops_env, SEXP rows, SEXP data, bool roww
     SEXP prom = PROTECT(Rf_allocSExp(PROMSXP));
     SET_PRENV(prom, R_EmptyEnv);
     SEXP column = p_data[i];
-    if (rowwise && vctrs::vec_is_list(column) && Rf_length(column) > 0) {
-      SET_PRCODE(prom, column);
+
+    if (rowwise && vctrs::vec_is_list(column)) {
+      if (Rf_length(column) == 0) {
+        SEXP ptype = PROTECT(Rf_getAttrib(column, Rf_install("ptype")));
+        column = PROTECT(Rf_allocVector(VECSXP, 1));
+        if (ptype != R_NilValue) {
+          SET_VECTOR_ELT(column, 0, ptype);
+        } else {
+          // i.e. `vec_ptype_finalise(unspecified())` (#6369)
+          SET_VECTOR_ELT(column, 0, Rf_allocVector(LGLSXP, 1));
+        }
+        SET_PRCODE(prom, column);
+        UNPROTECT(2);
+      } else {
+        SET_PRCODE(prom, column);
+      }
     } else {
       SET_PRCODE(prom, Rf_lang3(dplyr::functions::vec_chop, column, rows));
     }
+
     SET_PRVALUE(prom, R_UnboundValue);
 
     Rf_defineVar(rlang::str_as_symbol(p_names[i]), prom, chops_env);

tests/testthat/test-mutate.r

@@ -198,14 +198,27 @@ test_that("mutate works on zero-row grouped data frame (#596)", {
   expect_equal(group_data(res)$b, factor(character(0)))
 })
 
-test_that("mutate works on zero-row rowwise data frame (#4224)", {
-  dat <- data.frame(a = numeric(0))
-  res <- dat %>% rowwise() %>% mutate(a2 = a * 2)
-  expect_type(res$a2, "double")
-  expect_s3_class(res, "rowwise_df")
-  expect_equal(res$a2, numeric(0))
-})
+test_that("mutate preserves class of zero-row rowwise (#4224, #6303)", {
+  # Each case needs to test both x and identity(x) because these flow
+  # through two slightly different pathways.
+
+  rf <- rowwise(tibble(x = character(0)))
+  out <- mutate(rf, x2 = identity(x), x3 = x)
+  expect_equal(out$x2, character())
+  expect_equal(out$x3, character())
 
+  # including list-of classes of list-cols where possible
+  rf <- rowwise(tibble(x = list_of(.ptype = character())))
+  out <- mutate(rf, x2 = identity(x), x3 = x)
+  expect_equal(out$x2, character())
+  expect_equal(out$x3, character())
+
+  # an empty list is turns into a logical (aka unspecified)
+  rf <- rowwise(tibble(x = list()))
+  out <- mutate(rf, x2 = identity(x), x3 = x)
+  expect_equal(out$x2, logical())
+  expect_equal(out$x3, logical())
+})
 
 test_that("mutate works on empty data frames (#1142)", {
   df <- data.frame()