allow map_*_channels to broadcast singletons

R/interlaced.R

@@ -269,8 +269,12 @@ flatten_channels.interlacer_interlaced <- function(x, ...) {
 #'
 #' @export
 map_value_channel <- function(x, fn) {
+  out <- fn(value_channel(x))
+  if (length(out) == 1) {
+    out <- if_else(is.na(x), NA, out)
+  }
   new_interlaced(
-    fn(value_channel(x)),
+    out,
     na_channel(x)
   )
 }
@@ -279,9 +283,13 @@ map_value_channel <- function(x, fn) {
 #' @rdname map_value_channel
 #' @export
 map_na_channel <- function(x, fn) {
+  out <- fn(na_channel(x))
+  if (length(out) == 1) {
+    out <- if_else(is.na(x), out, NA)
+  }
   new_interlaced(
     value_channel(x),
-    fn(na_channel(x))
+    out
   )
 }
 

tests/testthat/test-interlaced.R

@@ -38,9 +38,36 @@ test_that("map_value_channel works", {
     vec_c("z", "b", "c", na("reason"))
   )
 
+  # Cannot nest interlaced values into the value channel
   expect_error(
     map_value_channel(foo, \(x) if_else(x == "a", na("z"), x))
   )
+
+  # Singleton fns will be broadcasted
+  expect_equal(
+    map_value_channel(foo, \(x) "bar"),
+    vec_c("bar", "bar", "bar", na("reason"))
+  )
+})
+
+test_that("map_na_channel works", {
+  foo <- vec_c("a", "b", "c", na("reason"), na("reason2"))
+
+  expect_equal(
+    map_na_channel(foo, \(x) if_else(x == "reason", "z", x)),
+    vec_c("a", "b", "c", na("z"), na("reason2"))
+  )
+
+  # Cannot nest interlaced values into the value channel
+  expect_error(
+    map_na_channel(foo, \(x) if_else(x == "reason", na("z"), x))
+  )
+
+  # Singleton fns will be broadcasted
+  expect_equal(
+    map_na_channel(foo, \(x) "bar"),
+    vec_c("a", "b", "c", na("bar"), na("bar"))
+  )
 })
 
 test_that("rep() works", {