Re-implement assign_in() (#919)

* Can assign even when parent doesn't exist. Fixes #704.
* Can assign `NULL`. Fixes #636
* Can use `zap()` to remove elements.

Fixes #634 since `pluck()` is now permissive.

NEWS.md

@@ -38,6 +38,11 @@
 
 ## Features and fixes
 
+* `pluck<-`/`assign_in()` can now modify non-existing locations (#704).
+
+* `pluck<-`/`assign_in()` now sets elements to `NULL` rather than removing them
+  (#636). Now use the explicit `zap()` if you want to remove elements.
+
 * `map2()`, `modify2()`, and `pmap()` now use tidyverse recycling rules where
   vectors of length 1 are recycled to any size but all others must have
   the same length (#878).

R/modify.R

@@ -272,63 +272,6 @@ modify_at.logical <- function(.x, .at, .f, ...) {
   .x
 }
 
-#' Modify a pluck location
-#'
-#' @description
-#'
-#' * `assign_in()` takes a data structure and a [pluck][pluck] location,
-#'   assigns a value there, and returns the modified data structure.
-#'
-#' * `modify_in()` applies a function to a pluck location, assigns the
-#'   result back to that location with [assign_in()], and returns the
-#'   modified data structure.
-#'
-#' The pluck location must exist.
-#'
-#' @inheritParams pluck
-#' @param .f A function to apply at the pluck location given by `.where`.
-#' @param ... Arguments passed to `.f`.
-#' @param .where,where A pluck location, as a numeric vector of
-#'   positions, a character vector of names, or a list combining both.
-#'   The location must exist in the data structure.
-#'
-#' @seealso [pluck()]
-#' @examples
-#' # Recall that pluck() returns a component of a data structure that
-#' # might be arbitrarily deep
-#' x <- list(list(bar = 1, foo = 2))
-#' pluck(x, 1, "foo")
-#'
-#' # Use assign_in() to modify the pluck location:
-#' assign_in(x, list(1, "foo"), 100)
-#'
-#' # modify_in() applies a function to that location and update the
-#' # element in place:
-#' modify_in(x, list(1, "foo"), ~ .x * 200)
-#'
-#' # Additional arguments are passed to the function in the ordinary way:
-#' modify_in(x, list(1, "foo"), `+`, 100)
-#' @export
-modify_in <- function(.x, .where, .f, ...) {
-  .where <- as.list(.where)
-  .f <- rlang::as_function(.f)
-
-  value <- .f(chuck(.x, !!!.where), ...)
-  assign_in(.x, .where, value)
-}
-#' @rdname modify_in
-#' @param value A value to replace in `.x` at the pluck location.
-#' @export
-assign_in <- function(x, where, value) {
-  # Check value exists at pluck location
-  chuck(x, !!!where)
-
-  call <- reduce_subset_call(quote(x), as.list(where))
-  call <- call("<-", call, value)
-  eval_bare(call)
-  x
-}
-
 #' @rdname modify
 #' @export
 modify2 <- function(.x, .y, .f, ...) {

R/pluck.R

@@ -41,7 +41,6 @@
 #' obj2 <- list("b", list(2, elt = "bar"))
 #' x <- list(obj1, obj2)
 #'
-#'
 #' # pluck() provides a way of retrieving objects from such data
 #' # structures using a combination of numeric positions, vector or
 #' # list names, and accessor functions.
@@ -75,37 +74,12 @@
 #' try(chuck(x, 10))
 #' try(chuck(x, 1, 10))
 #'
-#'
 #' # The map() functions use pluck() by default to retrieve multiple
 #' # values from a list:
 #' map(x, 2)
 #'
-#' # Pass multiple indexes with a list:
-#' map(x, list(2, "elt"))
-#'
-#' # This is equivalent to:
-#' map(x, pluck, 2, "elt")
-#'
-#' # You can also supply a default:
-#' map(x, list(2, "elt", 10), .default = "superb default")
-#'
-#' # Or use the strict variant:
-#' try(map(x, chuck, 2, "elt", 10))
-#'
-#'
-#' # You can also assign a value in a pluck location with pluck<-:
-#' pluck(x, 2, 2, "elt") <- "quuux"
-#' x
-#'
-#' # This is a shortcut for the prefix function assign_in():
-#' y <- assign_in(x, list(2, 2, "elt"), value = "QUUUX")
-#' y
-#'
-#'
 #' # pluck() also supports accessor functions:
 #' my_element <- function(x) x[[2]]$elt
-#'
-#' # The accessor can then be passed to pluck:
 #' pluck(x, 1, my_element)
 #' pluck(x, 2, my_element)
 #'
@@ -115,7 +89,6 @@
 #' # expression:
 #' my_element(x[[1]])
 #'
-#'
 #' # If you have a list of accessors, you can splice those in with `!!!`:
 #' idx <- list(1, my_element)
 #' pluck(x, !!!idx)
@@ -211,3 +184,75 @@ attr_getter <- function(attr) {
   force(attr)
   function(x) attr(x, attr, exact = TRUE)
 }
+
+
+#' Modify a pluck location
+#'
+#' @description
+#'
+#' * `assign_in()` takes a data structure and a [pluck] location,
+#'   assigns a value there, and returns the modified data structure.
+#'
+#' * `modify_in()` applies a function to a pluck location, assigns the
+#'   result back to that location with [assign_in()], and returns the
+#'   modified data structure.
+#'
+#' @inheritParams pluck
+#' @param .f A function to apply at the pluck location given by `.where`.
+#' @param ... Arguments passed to `.f`.
+#' @param .where,where A pluck location, as a numeric vector of
+#'   positions, a character vector of names, or a list combining both.
+#'   The location must exist in the data structure.
+#' @seealso [pluck()]
+#' @export
+#' @examples
+#' # Recall that pluck() returns a component of a data structure that
+#' # might be arbitrarily deep
+#' x <- list(list(bar = 1, foo = 2))
+#' pluck(x, 1, "foo")
+#'
+#' # Use assign_in() to modify the pluck location:
+#' str(assign_in(x, list(1, "foo"), 100))
+#' # Or zap to remove it
+#' str(assign_in(x, list(1, "foo"), zap()))
+#'
+#' # Like pluck(), this works even when the element (or its parents) don't exist
+#' pluck(x, 1, "baz")
+#' str(assign_in(x, list(2, "baz"), 100))
+#'
+#' # modify_in() applies a function to that location and update the
+#' # element in place:
+#' modify_in(x, list(1, "foo"), ~ .x * 200)
+#'
+#' # Additional arguments are passed to the function in the ordinary way:
+#' modify_in(x, list(1, "foo"), `+`, 100)
+modify_in <- function(.x, .where, .f, ...) {
+  .where <- as.list(.where)
+  .f <- rlang::as_function(.f)
+
+  value <- .f(pluck(.x, !!!.where), ...)
+  assign_in(.x, .where, value)
+}
+#' @rdname modify_in
+#' @param value A value to replace in `.x` at the pluck location.
+#'   Use `zap()` to instead remove the element.
+#' @export
+assign_in <- function(x, where, value) {
+  n <- length(where)
+  if (n == 0) {
+    abort("`where` must contain at least one element")
+  } else if (n > 1) {
+    old <- pluck(x, where[[1]], .default = list())
+    if (!is_zap(value) || !identical(old, list())) {
+      value <- assign_in(old, where[-1], value)
+    }
+  }
+
+  if (is_zap(value)) {
+    x[[where[[1]]]] <- NULL
+  } else {
+    list_slice2(x, where[[1]]) <- value
+  }
+
+  x
+}

tests/testthat/_snaps/pluck.md

@@ -44,3 +44,16 @@
       Error in `stop_bad_type()`:
       ! Index 1 must be a character or numeric vector, not a logical vector
 
+# assign_in() requires at least one location
+
+    Code
+      assign_in(x, NULL, value = "foo")
+    Condition
+      Error in `assign_in()`:
+      ! `where` must contain at least one element
+    Code
+      pluck(x) <- "foo"
+    Condition
+      Error in `assign_in()`:
+      ! `where` must contain at least one element
+