Rework simplification

NAMESPACE

@@ -135,6 +135,8 @@ export(list_flatten)
 export(list_merge)
 export(list_modify)
 export(list_rbind)
+export(list_simplify)
+export(list_transpose)
 export(list_update)
 export(lmap)
 export(lmap_at)

NEWS.md

@@ -49,8 +49,24 @@
 * `*_dfc()` and `*_dfr()` have been deprecated in favour of using the 
   appropriate map function along with `list_rbind()` or `list_cbind()` (#912).
 
+* `simplify()`, `simplify_all()`, and `as_vector()` have been deprecated in
+  favour of `list_simplify()`. It provides a more consistent definition of 
+  simplification (#900).
+
+* `transpose()` has been deprecated in favour of `list_transpose()` (#875).
+  It has built-in simplification.
+
 ## Features and fixes
 
+* New `list_simplify()` reduces a list of length-1 vectors to a simpler atomic
+  or S3 vector (#900).
+
+* New `list_transpose()` which automatically simplifies if possible (#875).
+
+* `accumulate()` and `accumulate2()` now both simplify the output if possible.
+  New arguments `simplify` and `ptype` allow you to control the details of
+  simplification (#774, #809).
+
 * New `list_update()` which is similar to `list_modify()` but doesn't work
   recursively (#822).
 

R/coercion.R

@@ -1,38 +1,35 @@
 #' Coerce a list to a vector
 #'
-#' `as_vector()` collapses a list of vectors into one vector. It
-#' checks that the type of each vector is consistent with
-#' `.type`. If the list can not be simplified, it throws an error.
-#' `simplify` will simplify a vector if possible; `simplify_all`
-#' will apply `simplify` to every element of a list.
+#' @description
+#' `r lifecycle::badge("deprecated")`
 #'
-#' `.type` can be a vector mold specifying both the type and the
-#' length of the vectors to be concatenated, such as `numeric(1)`
-#' or `integer(4)`. Alternatively, it can be a string describing
-#' the type, one of: "logical", "integer", "double", "complex",
-#' "character" or "raw".
+#' These functions are deprecated in favour of `list_simplify()`:
+#'
+#' * `as_vector(x)` is now `list_simplify(x)`
+#' * `simplify(x)` is now `list_simplify(strict = FALSE)`
+#' * `simplify_all(x)` is `map(x, list_simplify, strict = FALSE)`
 #'
 #' @param .x A list of vectors
-#' @param .type A vector mold or a string describing the type of the
-#'   input vectors. The latter can be any of the types returned by
-#'   [typeof()], or "numeric" as a shorthand for either
-#'   "double" or "integer".
+#' @param .type can be a vector mold specifying both the type and the
+#'   length of the vectors to be concatenated, such as `numeric(1)`
+#'   or `integer(4)`. Alternatively, it can be a string describing
+#'   the type, one of: "logical", "integer", "double", "complex",
+#'   "character" or "raw".
 #' @export
+#' @keywords internal
 #' @examples
-#' # Supply the type either with a string:
+#' # was
 #' as.list(letters) %>% as_vector("character")
+#' # now
+#' as.list(letters) %>% list_simplify(ptype = character())
 #'
-#' # Or with a vector mold:
-#' as.list(letters) %>% as_vector(character(1))
-#'
-#' # Vector molds are more flexible because they also specify the
-#' # length of the concatenated vectors:
+#' # was:
 #' list(1:2, 3:4, 5:6) %>% as_vector(integer(2))
-#'
-#' # Note that unlike vapply(), as_vector() never adds dimension
-#' # attributes. So when you specify a vector mold of size > 1, you
-#' # always get a vector and not a matrix
+#' # now:
+#' list(1:2, 3:4, 5:6) %>% list_c(ptype = integer())
 as_vector <- function(.x, .type = NULL) {
+  lifecycle::deprecate_warn("0.4.0", "as_vector()", "list_simplify()")
+
   if (can_simplify(.x, .type)) {
     unlist(.x)
   } else {
@@ -43,6 +40,7 @@ as_vector <- function(.x, .type = NULL) {
 #' @export
 #' @rdname as_vector
 simplify <- function(.x, .type = NULL) {
+  lifecycle::deprecate_warn("0.4.0", "as_vector()", "list_simplify()")
   if (can_simplify(.x, .type)) {
     unlist(.x)
   } else {
@@ -53,7 +51,17 @@ simplify <- function(.x, .type = NULL) {
 #' @export
 #' @rdname as_vector
 simplify_all <- function(.x, .type = NULL) {
-  map(.x, simplify, .type = .type)
+  lifecycle::deprecate_warn("0.4.0", "as_vector()", I("map() + list_simplify()"))
+
+  # Inline simplify to avoid double deprecation
+  simplify <- function(.x) {
+    if (can_simplify(.x, .type)) {
+      unlist(.x)
+    } else {
+      .x
+    }
+  }
+  map(.x, simplify)
 }
 
 

R/list-simplify.R

@@ -0,0 +1,89 @@
+#' Simplify a list to an atomic or S3 vector
+#'
+#' @details
+#' Simplification maintains a one-to-one correspondence between the input
+#' and output, implying that each element of `x` must contain a vector of
+#' length 1. If you don't want to maintain this correspondence, then you
+#' probably want either [list_c()] or [list_flatten()].
+#'
+#' @param x A list.
+#' @param strict What should happen if simplification fails? If `TRUE`,
+#'   will error. If `FALSE`, will return `x` unchanged.
+#' @param ptype An optional prototype to ensure that the output type is always
+#'   the same.
+#' @returns A vector the same length as `x`.
+#' @export
+#' @examples
+#' list_simplify(list(1, 2, 3))
+#'
+#' try(list_simplify(list(1, 2, "x")))
+#' try(list_simplify(list(1, 2, 1:3)))
+list_simplify <- function(x, strict = TRUE, ptype = NULL) {
+  simplify_impl(x, strict = strict, ptype = ptype)
+}
+
+# Wrapper used by purrr functions that do automatic simplification
+list_simplify_internal <- function(
+    x,
+    simplify = NA,
+    ptype = NULL,
+    error_arg = "x",
+    error_call = caller_env()
+  ) {
+  if (length(simplify) > 1 || !is.logical(simplify)) {
+    cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.")
+  }
+  if (!is.null(ptype) && isFALSE(simplify)) {
+    cli::cli_abort("Must not specify {.arg ptype} when `simplify = FALSE`.")
+  }
+
+  if (isFALSE(simplify)) {
+    return(x)
+  }
+
+  simplify_impl(
+    x,
+    strict = !is.na(simplify),
+    ptype = ptype,
+    error_arg = error_arg,
+    error_call = error_call
+  )
+}
+
+simplify_impl <- function(
+    x,
+    strict = TRUE,
+    ptype = NULL,
+    error_arg = "`x`",
+    error_call = caller_env()
+  ) {
+  vec_check_list(x, arg = error_arg, call = error_call)
+
+  can_simplify <- every(x, vec_is, size = 1)
+
+  if (can_simplify) {
+    tryCatch(
+      vec_unchop(x, ptype = ptype),
+      vctrs_error_incompatible_type = function(err) {
+        if (strict || !is.null(ptype)) {
+          cli::cli_abort(
+            "Failed to simplify {error_arg}.",
+            parent = err,
+            call = error_call
+          )
+        } else {
+          x
+        }
+      }
+    )
+  } else {
+    if (strict) {
+      cli::cli_abort(
+        "Failed to simplify {error_arg}: not all elements vectors of length 1.",
+        call = error_call
+      )
+    } else {
+      x
+    }
+  }
+}

R/list-transpose.R

@@ -0,0 +1,98 @@
+#' Transpose a list
+#'
+#' @description
+#' `list_transpose()` turns a list-of-lists "inside-out"; it turns a pair of
+#' lists into a list of pairs, or a list of pairs into pair of lists. For
+#' example, if you had a list of length `n` where each component had values `a`
+#' and `b`, `list_transpose()` would make a list with elements `a` and
+#' `b` that contained lists of length n.
+#'
+#' It's called transpose because `x[["a"]][["b"]]` is equivalent to
+#' `transpose(x)[["b"]][["a"]]`, i.e. transposing a list flips the order of
+#' indices in a similar way to transposing a matrix.
+#'
+#' @param x A list of vectors to transpose.
+#' @param template A "template" that specifies the names of output list.
+#'   Usually taken from the name of the first element of `x`.
+#' @param simplify Should the result be simplified?
+#'   * `TRUE`: simplify or die trying.
+#'   * `NA`: simplify if possible.
+#'   * `FALSE`: never try to simplify, always leaving as a list.
+#'
+#'   Alternatively, a named list specifying the simplification by output column.
+#' @param ptype An optional vector prototype used to control the simplification.
+#'   Alternatively, a named list specifying the prototype by output column.
+#' @param default A default value to use if a value is absent of `NULL`.
+#'   Alternatively, a named list specifying the prototype by output column.
+#' @export
+#' @examples
+#' # list_transpose() is useful in conjunction with safely()
+#' x <- list("a", 1, 2)
+#' y <- x %>% map(safely(log))
+#' y %>% str()
+#' # Put all the errors and results together
+#' y %>% list_transpose() %>% str()
+#' # Supply a default result to further simplify
+#' y %>% list_transpose(default = list(result = NA)) %>% str()
+#'
+#' # list_transpose() will try to simplify by default:
+#' x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6))
+#' x %>% list_transpose()
+#' # use simplify = FALSE to always return lists:
+#' x %>% list_transpose(simplify = FALSE) %>% str()
+#'
+#' # Provide explicit template if you know which elements you want to extract
+#' ll <- list(
+#'   list(x = 1, y = "one"),
+#'   list(z = "deux", x = 2)
+#' )
+#' ll %>% list_transpose()
+#' ll %>% list_transpose(template = c("x", "y", "z"))
+#'
+#' # And specify default if you want to simplify
+#' ll %>% list_transpose(c("x", "y", "z"), default = NA)
+list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) {
+  vec_check_list(x)
+  if (length(x) == 0) {
+    return(list())
+  }
+
+  template <- template %||%
+    names(x[[1]]) %||%
+    cli::cli_abort("First element of {.arg x} is unnamed, please supply {.arg template}.")
+  if (!is.character(template)) {
+    cli::cli_abort("{.arg template} must be a character vector.")
+  }
+
+  simplify <- match_template(simplify, template)
+  default <- match_template(default, template)
+  ptype <- match_template(ptype, template)
+
+  out <- rep_named(template, list())
+  for (nm in template) {
+    res <- map(x, nm, .default = default[[nm]])
+    res <- list_simplify_internal(res,
+      simplify = simplify[[nm]] %||% NA,
+      ptype = ptype[[nm]],
+      error_arg = paste0("output `", nm, "`")
+    )
+    out[[nm]] <- res
+  }
+
+  out
+}
+
+match_template <- function(x, template, error_arg = caller_arg(x), error_call = caller_env()) {
+  if (is_bare_list(x) && is_named(x)) {
+    extra_names <- setdiff(names(x), template)
+    if (length(extra_names)) {
+      cli::cli_abort(
+        "{.arg {error_arg}} contains unknown names: {.str {extra_names}}",
+        call = error_call
+      )
+    }
+    x
+  } else {
+    rep_named(template, list(x))
+  }
+}

R/reduce.R

@@ -342,11 +342,15 @@ seq_len2 <- function(start, end) {
 #'   the accumulation, rather than using `.x[[1]]`. This is useful if
 #'   you want to ensure that `reduce` returns a correct value when `.x`
 #'   is empty. If missing, and `.x` is empty, will throw an error.
-#'
 #' @param .dir The direction of accumulation as a string, one of
 #'   `"forward"` (the default) or `"backward"`. See the section about
 #'   direction below.
-#'
+#' @param .simplify If `NA`, the default, the accumulated list of
+#'   results is simplified to an atomic vector if possible.
+#'   If `TRUE`, the result is simplified, erroring if not possible.
+#'   If `FALSE`, the result is not simplified, always returning a list.
+#' @param .ptype If `simplify` is `TRUE`, optionally supply a vector prototype
+#'   to enforce the output types.
 #' @return A vector the same length of `.x` with the same names as `.x`.
 #'
 #'   If `.init` is supplied, the length is extended by 1. If `.x` has
@@ -454,26 +458,22 @@ seq_len2 <- function(start, end) {
 #'     ggtitle("Simulations of a random walk with drift")
 #' }
 #' @export
-accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward")) {
+accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = NA, .ptype = NULL) {
   .dir <- arg_match(.dir, c("forward", "backward"))
   .f <- as_mapper(.f, ...)
 
   res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE)
   names(res) <- accumulate_names(names(.x), .init, .dir)
 
-  # It would be unappropriate to simplify the result rowwise with
-  # `accumulate()` because it has invariants defined in terms of
-  # `length()` rather than `vec_size()`
-  if (some(res, is.data.frame)) {
-    res
-  } else {
-    vec_simplify(res)
-  }
+  res <- list_simplify_internal(res, .simplify, .ptype, error_arg = "accumulated results")
+  res
 }
 #' @rdname accumulate
 #' @export
-accumulate2 <- function(.x, .y, .f, ..., .init) {
-  reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE)
+accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) {
+  res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE)
+  res <- list_simplify_internal(res, .simplify, .ptype, error_arg = "accumulated results")
+  res
 }
 
 accumulate_names <- function(nms, init, dir) {