Correctly treat NULL return values from .f() in modify() family

 Fix tidyverse#753, Fix tidyverse#655, Fix tidyverse#746

R/modify.R

@@ -135,8 +135,12 @@ modify <- function(.x, .f, ...) {
 modify.default <- function(.x, .f, ...) {
   .f <- as_mapper(.f, ...)
 
-  for (i in seq_along(.x)) {
-    .x[[i]] <- .f(.x[[i]], ...)
+  if (is.recursive(.x)) {
+    .x <- modify_list_with_ix(.x, seq_along(.x), .f, ...)
+  } else {
+    for (i in seq_along(.x)) {
+      .x[[i]] <- .f(.x[[i]], ...)
+    }
   }
 
   .x
@@ -155,12 +159,18 @@ modify_if.default <- function(.x, .p, .f, ..., .else = NULL) {
   index <- seq_along(.x)
 
   .f <- as_mapper(.f, ...)
-  for (i in index[sel]) {
-    .x[[i]] <- .f(.x[[i]], ...)
+  if (is.recursive(.x)) {
+    .x <- modify_list_with_ix(.x, index[sel], .f, ...)
+  } else {
+    for (i in index[sel]) {
+      .x[[i]] <- .f(.x[[i]], ...)
+    }
   }
 
   if (!is_null(.else)) {
     .else <- as_mapper(.else, ...)
+    if (is.recursive(.x))
+      .x <- modify_list_with_ix(.x, index[!sel], .f, ...)
     for (i in index[!sel]) {
       .x[[i]] <- .else(.x[[i]], ...)
     }
@@ -473,3 +483,23 @@ inv_which <- function(x, sel) {
     stop("unrecognised index type", call. = FALSE)
   }
 }
+
+# protected list modifier
+modify_list_with_ix <- function(x, ix, f, ...) {
+  orig_len <- length(x)
+  for (i in ix) {
+    elt <- f(x[[i]], ...)
+    if (is.null(elt)) {
+      ## this might break if [] is unwisely overloaded
+      x[i] <- list(NULL)
+      if (length(x) != orig_len)
+        stop(sprintf("Modifier returned NULL. Cannot assin NULLs into %s",
+                     friendly_type_of(x)), call. = FALSE)
+    } else {
+      x[[i]] <- elt
+    }
+  }
+  x
+}
+
+

tests/testthat/test-modify.R

@@ -92,6 +92,24 @@ test_that("`.else` modifies false elements", {
   expect_identical(modify_if(iris, is.factor, as.character, .else = as.integer), exp)
 })
 
+test_that("modify family preserves NULLs", {
+  l <- list(a = 1, b = NULL, c = 3)
+  expect_identical(modify(l, identity), l)
+  expect_identical(modify_at(l, "b", identity), l)
+  expect_identical(modify_if(l, is.null, identity), l)
+  expect_identical(modify(l, ~ if(!is.null(.x)) .x + .y, 10),
+                   list(a = 11, b = NULL, c = 13))
+  expect_identical(modify_if(list(1, 2), ~ .x == 2, ~ NULL),
+                   list(1, NULL))
+})
+
+test_that("modify() fails on NULL assignment to data.frames", {
+  df <- data.frame(a = 1, b = 2, c = 3)
+  expect_error(modify(df, function(x) NULL))
+  expect_error(modify_at(df, "b", function(x) NULL))
+  expect_error(modify_if(df, is.numeric, function(x) NULL))
+})
+
 # modify_depth ------------------------------------------------------------
 
 test_that("modify_depth modifies values at specified depth", {
@@ -141,4 +159,10 @@ test_that("modify_at() can use tidyselect", {
   expect_is(two$cyl, "character")
 })
 
+test_that("modify_depth() treats NULLs correctly", {
+  ll <- list(a = NULL, b = list(b1 = NULL, b2 = "hello"))
+  expect_identical(modify_depth(ll, .depth = 2, identity, .ragged = TRUE), ll)
+  expect_identical(modify_depth(ll, .depth = 2, is.character, .ragged = TRUE),
+                   list(a = NULL, b = list(b1 = FALSE, b2 = TRUE)))
+})