Cast before recycling in list_unchop()

Carefully retaining names without sacrificing performance to do so

Author: DavisVaughan

NEWS.md

@@ -1,5 +1,7 @@
 # vctrs (development version)
 
+* `list_unchop()` now works in an edge case with a single `NA` recycled to size 0 (#1989).
+
 * `list_unchop()` has gained new `size`, `default`, and `unmatched` arguments (#1982).
 
 * Functions backed by a dictionary based implementation are often significantly faster, depending on the exact inputs used. This includes: `vec_match()`, `vec_in()`, `vec_group_loc()`, `vec_count()`, `vec_unique()`, and more (#1976).

src/c-unchop.c

@@ -219,6 +219,9 @@ r_obj* list_unchop(r_obj* xs,
   r_keep_loc out_names_pi;
   KEEP_HERE(out_names, &out_names_pi);
 
+  r_keep_loc x_pi;
+  KEEP_HERE(r_null, &x_pi);
+
   r_ssize i = 0;
 
   struct vctrs_arg* p_x_arg = new_subscript_arg(
@@ -243,17 +246,36 @@ r_obj* list_unchop(r_obj* xs,
   };
 
   for (; i < xs_size; ++i) {
-    r_obj* x = r_list_get(xs, i);
+    r_obj* elt = r_list_get(xs, i);
 
-    if (x == r_null) {
+    if (elt == r_null) {
       continue;
     }
 
     r_obj* index = r_list_get(indices, i);
     const r_ssize index_size = r_length(index);
 
+    // Cast before recycling for maximal efficiency
+    // (i.e. cast `1L` to `1` before recycling to size `N`)
+    unchop_cast_opts.x = elt;
+    r_obj* x = vec_cast_opts(&unchop_cast_opts);
+    KEEP_AT(x, x_pi);
+
+    // FIXME: `vec_cast()` can currently drop names, so we carefully add them back
+    // if it looks like casting dropped them. This should be removed eventually.
+    // https://github.com/r-lib/vctrs/issues/623
+    if (x != elt) {
+      r_obj* names = KEEP(vec_names(elt));
+      if (names != r_null && vec_names(x) == r_null) {
+        x = vec_set_names(x, names);
+        KEEP_AT(x, x_pi);
+      }
+      FREE(1);
+    }
+
     // Each element of `xs` is recycled to its corresponding index's size
-    x = KEEP(vec_check_recycle(x, index_size, p_x_arg, error_call));
+    x = vec_check_recycle(x, index_size, p_x_arg, error_call);
+    KEEP_AT(x, x_pi);
 
     if (assign_names) {
       r_obj* outer = xs_is_named ? r_chr_get(xs_names, i) : r_null;
@@ -274,14 +296,9 @@ r_obj* list_unchop(r_obj* xs,
       FREE(2);
     }
 
-    unchop_cast_opts.x = x;
-    x = KEEP(vec_cast_opts(&unchop_cast_opts));
-
     // Total ownership of `proxy` because it was freshly created with `vec_init()`
     proxy = vec_proxy_assign_opts(proxy, index, x, VCTRS_OWNED_true, &unchop_assign_opts);
     KEEP_AT(proxy, proxy_pi);
-
-    FREE(2);
   }
 
   if (is_data_frame(proxy)) {
@@ -300,7 +317,7 @@ r_obj* list_unchop(r_obj* xs,
     out = vec_set_names(out, r_null);
   }
 
-  FREE(10);
+  FREE(11);
   return out;
 }
 

tests/testthat/test-slice-chop.R

@@ -1345,6 +1345,26 @@ test_that("list_unchop() fails if foreign classes are not homogeneous and there
   })
 })
 
+test_that("Size 1 unspecified `NA` that isn't used doesn't error", {
+  # Requires that casting happen before recycling, because the `NA` recycles
+  # to size zero since it isn't used, resulting in a logical rather than an
+  # unspecified (#1989).
+  expect_identical(
+    list_unchop(
+      list("x", NA),
+      indices = list(1L, integer())
+    ),
+    "x"
+  )
+  expect_identical(
+    list_unchop(
+      list("x", NA),
+      indices = list(integer(), 1L)
+    ),
+    NA_character_
+  )
+})
+
 test_that("list_unchop() `default` is inserted correctly", {
   xs <- list("a", "b")
   indices <- list(1, 3)