From bcc54150c231ba179cb7aa816eec4d72b253c7c7 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 31 Aug 2022 11:50:26 -0500 Subject: [PATCH 01/33] Implement list_simplify() and use it in accumulate() --- R/list-simplify.R | 29 ++++++++++++++++++++ R/reduce.R | 29 +++++++++++--------- R/utils.R | 15 ----------- man/accumulate.Rd | 20 +++++++++++--- tests/testthat/_snaps/list-simplify.md | 30 +++++++++++++++++++++ tests/testthat/test-list-simplify.R | 37 ++++++++++++++++++++++++++ tests/testthat/test-reduce.R | 8 +++--- tests/testthat/test-utils.R | 24 ----------------- 8 files changed, 134 insertions(+), 58 deletions(-) create mode 100644 R/list-simplify.R create mode 100644 tests/testthat/_snaps/list-simplify.md create mode 100644 tests/testthat/test-list-simplify.R diff --git a/R/list-simplify.R b/R/list-simplify.R new file mode 100644 index 00000000..1bb8d1f5 --- /dev/null +++ b/R/list-simplify.R @@ -0,0 +1,29 @@ +# Internal helper used by list_transform() and accumulate() +# when simplify = TRUE (the default) +list_simplify <- function(x, ptype = NULL) { + vec_assert(x, list()) + + # We choose not to simply data frames to keep length invariants + can_simplify <- every(x, ~ vec_is(.x, size = 1) && !is.data.frame(.x)) + + if (can_simplify) { + if (!is.null(ptype)) { + vec_c(!!!x, .ptype = ptype) + } else { + tryCatch( + vec_c(!!!x), + vctrs_error_incompatible_type = function(err) x + ) + } + } else { + x + } +} + +check_ptype_simplify <- function(ptype = NULL, simplify = TRUE) { + rlang:::check_bool(simplify) + + if (!is.null(ptype) && !simplify) { + abort("Must not specific `ptype` when `simplify = FALSE`") + } +} diff --git a/R/reduce.R b/R/reduce.R index 26e92080..d7d98f24 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -343,11 +343,13 @@ 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 `TRUE`, the default, the accumulated list of +#' results is simplified to an atomic vector if possible. +#' @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 +456,29 @@ 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 = TRUE, .ptype = NULL) { .dir <- arg_match(.dir, c("forward", "backward")) .f <- as_mapper(.f, ...) + check_ptype_simplify(.ptype, .simplify) 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) + if (.simplify) { + res <- list_simplify(res, .ptype) } + 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 = TRUE, .ptype = NULL) { + check_ptype_simplify(.ptype, .simplify) + + res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE) + if (.simplify) { + res <- list_simplify(res, .ptype) + } + res } accumulate_names <- function(nms, init, dir) { diff --git a/R/utils.R b/R/utils.R index 39dfbdc8..cedf6252 100644 --- a/R/utils.R +++ b/R/utils.R @@ -280,21 +280,6 @@ quo_invert <- function(call) { quo_is_constant <- function(quo) { is_reference(quo_get_env(quo), empty_env()) } - -vec_simplify <- function(x) { - if (!vctrs::vec_is_list(x)) { - return(x) - } - if (!every(x, ~ vctrs::vec_is(.x) && vctrs::vec_size(.x) == 1L)) { - return(x) - } - - tryCatch( - vctrs_error_incompatible_type = function(...) x, - vctrs::vec_c(!!!x) - ) -} - quo_is_same_env <- function(x, env) { quo_env <- quo_get_env(x) is_reference(quo_env, env) || is_reference(quo_env, empty_env()) diff --git a/man/accumulate.Rd b/man/accumulate.Rd index 621e14f6..f1036ca8 100644 --- a/man/accumulate.Rd +++ b/man/accumulate.Rd @@ -5,9 +5,17 @@ \alias{accumulate2} \title{Accumulate intermediate results of a vector reduction} \usage{ -accumulate(.x, .f, ..., .init, .dir = c("forward", "backward")) - -accumulate2(.x, .y, .f, ..., .init) +accumulate( + .x, + .f, + ..., + .init, + .dir = c("forward", "backward"), + .simplify = TRUE, + .ptype = NULL +) + +accumulate2(.x, .y, .f, ..., .init, .simplify = TRUE, .ptype = NULL) } \arguments{ \item{.x}{A list or atomic vector.} @@ -35,6 +43,12 @@ is empty. If missing, and \code{.x} is empty, will throw an error.} \code{"forward"} (the default) or \code{"backward"}. See the section about direction below.} +\item{.simplify}{If \code{TRUE}, the default, the accumulated list of +results is simplified to an atomic vector if possible.} + +\item{.ptype}{If \code{simplify} is \code{TRUE}, optionally supply a vector prototype +to enforce the output types.} + \item{.y}{For \code{accumulate2()} \code{.y} is the second argument of the pair. It needs to be 1 element shorter than the vector to be accumulated (\code{.x}). If \code{.init} is set, \code{.y} needs to be one element shorted than the diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md new file mode 100644 index 00000000..f5550222 --- /dev/null +++ b/tests/testthat/_snaps/list-simplify.md @@ -0,0 +1,30 @@ +# ptype is checked + + Code + list_simplify(list(1, 2), ptype = character()) + Condition + Error: + ! Can't convert to . + +# x must be a list + + Code + list_simplify(1:5) + Condition + Error in `list_simplify()`: + ! `x` must be a vector with type . + Instead, it has type . + +# verifies simplify and ptype + + Code + check_ptype_simplify(NULL, 1) + Condition + Error in `check_ptype_simplify()`: + ! `simplify` must be `TRUE` or `FALSE`, not a number. + Code + check_ptype_simplify(integer(), FALSE) + Condition + Error in `check_ptype_simplify()`: + ! Must not specific `ptype` when `simplify = FALSE` + diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R new file mode 100644 index 00000000..80b99c57 --- /dev/null +++ b/tests/testthat/test-list-simplify.R @@ -0,0 +1,37 @@ +test_that("simplification requires vectors", { + expect_equal(list_simplify(list(mean)), list(mean)) +}) + +test_that("simplification requires length 1 inputs", { + expect_equal(list_simplify(list(1, 2:3)), list(1, 2:3)) + expect_equal(list_simplify(list(1, 2, 3)), c(1, 2, 3)) +}) + +test_that("simplification requires common type", { + expect_equal(list_simplify(list(1, 2)), c(1, 2)) + expect_equal(list_simplify(list(1, "a")), list(1, "a")) +}) + +test_that("never simplifies data frames", { + x <- list(data.frame(x = 1), data.frame(y = 1)) + expect_equal(list_simplify(x), x) +}) + +test_that("ptype is checked", { + expect_equal(list_simplify(list(1, 2), ptype = double()), c(1, 2)) + expect_snapshot(list_simplify(list(1, 2), ptype = character()), error = TRUE) +}) + + +# argument checking ------------------------------------------------------- + +test_that("x must be a list", { + expect_snapshot(list_simplify(1:5), error = TRUE) +}) + +test_that("verifies simplify and ptype", { + expect_snapshot(error = TRUE, { + check_ptype_simplify(NULL, 1) + check_ptype_simplify(integer(), FALSE) + }) +}) diff --git a/tests/testthat/test-reduce.R b/tests/testthat/test-reduce.R index e4e38166..0f627371 100644 --- a/tests/testthat/test-reduce.R +++ b/tests/testthat/test-reduce.R @@ -162,8 +162,8 @@ test_that("basic accumulate2() works", { paste2 <- function(x, y, sep) paste(x, y, sep = sep) x <- c("a", "b", "c") - expect_equal(accumulate2(x, c("-", "."), paste2), list("a", "a-b", "a-b.c")) - expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), list("x", "x.a", "x.a-b", "x.a-b.c")) + expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b", "a-b.c")) + expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), c("x", "x.a", "x.a-b", "x.a-b.c")) }) test_that("can terminate accumulate2() early", { @@ -177,8 +177,8 @@ test_that("can terminate accumulate2() early", { } x <- c("a", "b", "c") - expect_equal(accumulate2(x, c("-", "."), paste2), list("a", "a-b")) - expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), list("x", "x.a", "x.a-b")) + expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b")) + expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), c("x", "x.a", "x.a-b")) }) test_that("accumulate2() forces arguments (#643)", { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 1829d053..7794a20f 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -74,30 +74,6 @@ test_that("quo_invert() unwraps constants", { expect_identical(quo_invert(call), new_quosure(quote(foo(foo, NULL)), quo_get_env(foo))) }) -test_that("vec_simplify() coerces atomic inputs", { - expect_identical( - vec_simplify(list(1, TRUE)), - c(1, 1) - ) - expect_identical( - vec_simplify(list("foo", factor("bar"))), - c("foo", "bar") - ) - expect_identical( - vec_simplify(list(data.frame(x = FALSE), data.frame(x = 1L))), - data.frame(x = 0:1) - ) -}) - -test_that("vec_simplify() ignores complex inputs", { - expect_identical(vec_simplify(list(1L, 2:3)), list(1L, 2:3)) - expect_identical(vec_simplify(list(1, "a")), list(1, "a")) - expect_identical(vec_simplify(1:3), 1:3) - expect_identical(vec_simplify(list(identity)), list(identity)) - expect_identical(vec_simplify(mtcars), mtcars) -}) - - # Lifecycle --------------------------------------------------------------- test_that("%@% is an infix attribute accessor", { From 1ead93bdd672de8009f000654827a0acdd7ee428 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 31 Aug 2022 13:46:38 -0500 Subject: [PATCH 02/33] Try a strict argument --- R/list-simplify.R | 17 +++++++++++--- R/list-transpose.R | 56 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+), 3 deletions(-) create mode 100644 R/list-transpose.R diff --git a/R/list-simplify.R b/R/list-simplify.R index 1bb8d1f5..ef25ee84 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,6 +1,6 @@ # Internal helper used by list_transform() and accumulate() # when simplify = TRUE (the default) -list_simplify <- function(x, ptype = NULL) { +list_simplify <- function(x, ptype = NULL, strict = FALSE) { vec_assert(x, list()) # We choose not to simply data frames to keep length invariants @@ -12,14 +12,25 @@ list_simplify <- function(x, ptype = NULL) { } else { tryCatch( vec_c(!!!x), - vctrs_error_incompatible_type = function(err) x + vctrs_error_incompatible_type = function(err) { + if (strict) { + abort("Failed to simplify", parent = err) + } else { + x + } + } ) } } else { - x + if (strict) { + abort("Failed to simplify: not all elements vectors of length 1") + } else { + x + } } } + check_ptype_simplify <- function(ptype = NULL, simplify = TRUE) { rlang:::check_bool(simplify) diff --git a/R/list-transpose.R b/R/list-transpose.R new file mode 100644 index 00000000..7aa20474 --- /dev/null +++ b/R/list-transpose.R @@ -0,0 +1,56 @@ +#' @examples +#' # transpose() is useful in conjunction with safely() & quietly() +#' x <- list("a", 1, 2) +#' y <- x %>% map(safely(log)) +#' y %>% str() +#' y %>% list_transpose() %>% str() +#' y %>% list_transpose(default = list(result = NA)) %>% str() +#' +#' # list_tranpose() will 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 component names to prevent loss of those that don't +#' # appear in first component +#' ll <- list( +#' list(x = 1, y = "one"), +#' list(z = "deux", x = 2) +#' ) +#' ll %>% list_transpose() +#' ll %>% list_transpose(c("x", "y", "z")) +#' ll %>% list_transpose(c("x", "y", "z"), default = NA) +list_transpose <- function(x, template = vec_index(x[[1]]), simplify = TRUE, ptype = NULL, default = NULL) { + vec_assert(x, list()) + if (length(x) == 0) { + return(list()) + } + + # TODO: name these appropriate + if (is_bool(simplify)) { + simplify <- rep(list(simplify), length(template)) + } + if (!(has_names(default) && is.list(default))) { + default <- rep(list(default), length(template)) + } + if (!(has_names(ptype) && is.list(ptype))) { + ptype <- rep(list(ptype), length(template)) + } + + out <- vector("list", length(template)) + if (is.character(template)) { + names(out) <- template + } + + for (i in seq_along(template)) { + res <- map(x, template[[i]], .default = default[[i]]) + if (simplify[[i]]) { + res <- list_simplify(res, ptype[[i]]) + } + out[[i]] <- res + } + + out +} + From a927496c347b9cbe7a25ac40d9713b4d9af4a77f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 2 Sep 2022 07:33:27 -0500 Subject: [PATCH 03/33] Tweak simplify spec --- R/list-simplify.R | 26 ++++++++++++++------------ R/reduce.R | 19 +++++++------------ man/accumulate.Rd | 10 ++++++---- tests/testthat/_snaps/list-simplify.md | 13 ------------- tests/testthat/test-list-simplify.R | 7 ------- 5 files changed, 27 insertions(+), 48 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index ef25ee84..40b51861 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,9 +1,20 @@ # Internal helper used by list_transform() and accumulate() # when simplify = TRUE (the default) -list_simplify <- function(x, ptype = NULL, strict = FALSE) { +list_simplify <- function(x, simplify = NA, ptype = NULL) { vec_assert(x, list()) + if (length(simplify) > 1 || !is.logical(simplify)) { + abort("`simplify` must be `TRUE`, `FALSE`, or `NA`") + } + if (!is.null(ptype) && isFALSE(simplify)) { + abort("Must not specify `ptype` when `simplify = FALSE`") + } - # We choose not to simply data frames to keep length invariants + if (isFALSE(simplify)) { + return(x) + } + strict <- !is.na(simplify) + + # We choose not to simply data frames to preserve length invariants can_simplify <- every(x, ~ vec_is(.x, size = 1) && !is.data.frame(.x)) if (can_simplify) { @@ -23,18 +34,9 @@ list_simplify <- function(x, ptype = NULL, strict = FALSE) { } } else { if (strict) { - abort("Failed to simplify: not all elements vectors of length 1") + abort("Failed to simplify: not all elements vectors of length 1") } else { x } } } - - -check_ptype_simplify <- function(ptype = NULL, simplify = TRUE) { - rlang:::check_bool(simplify) - - if (!is.null(ptype) && !simplify) { - abort("Must not specific `ptype` when `simplify = FALSE`") - } -} diff --git a/R/reduce.R b/R/reduce.R index d7d98f24..35da2e24 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -346,8 +346,10 @@ seq_len2 <- function(start, end) { #' @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 `TRUE`, the default, the accumulated list of +#' @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`. @@ -456,28 +458,21 @@ seq_len2 <- function(start, end) { #' ggtitle("Simulations of a random walk with drift") #' } #' @export -accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = TRUE, .ptype = NULL) { +accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = NA, .ptype = NULL) { .dir <- arg_match(.dir, c("forward", "backward")) .f <- as_mapper(.f, ...) - check_ptype_simplify(.ptype, .simplify) res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE) names(res) <- accumulate_names(names(.x), .init, .dir) - if (.simplify) { - res <- list_simplify(res, .ptype) - } + res <- list_simplify(res, .simplify, .ptype) res } #' @rdname accumulate #' @export -accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = TRUE, .ptype = NULL) { - check_ptype_simplify(.ptype, .simplify) - +accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) { res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE) - if (.simplify) { - res <- list_simplify(res, .ptype) - } + res <- list_simplify(res, .simplify, .ptype) res } diff --git a/man/accumulate.Rd b/man/accumulate.Rd index f1036ca8..400440a6 100644 --- a/man/accumulate.Rd +++ b/man/accumulate.Rd @@ -11,11 +11,11 @@ accumulate( ..., .init, .dir = c("forward", "backward"), - .simplify = TRUE, + .simplify = NA, .ptype = NULL ) -accumulate2(.x, .y, .f, ..., .init, .simplify = TRUE, .ptype = NULL) +accumulate2(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) } \arguments{ \item{.x}{A list or atomic vector.} @@ -43,8 +43,10 @@ is empty. If missing, and \code{.x} is empty, will throw an error.} \code{"forward"} (the default) or \code{"backward"}. See the section about direction below.} -\item{.simplify}{If \code{TRUE}, the default, the accumulated list of -results is simplified to an atomic vector if possible.} +\item{.simplify}{If \code{NA}, the default, the accumulated list of +results is simplified to an atomic vector if possible. +If \code{TRUE}, the result is simplified, erroring if not possible. +If \code{FALSE}, the result is not simplified, always returning a list.} \item{.ptype}{If \code{simplify} is \code{TRUE}, optionally supply a vector prototype to enforce the output types.} diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index f5550222..a1b80fde 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -15,16 +15,3 @@ ! `x` must be a vector with type . Instead, it has type . -# verifies simplify and ptype - - Code - check_ptype_simplify(NULL, 1) - Condition - Error in `check_ptype_simplify()`: - ! `simplify` must be `TRUE` or `FALSE`, not a number. - Code - check_ptype_simplify(integer(), FALSE) - Condition - Error in `check_ptype_simplify()`: - ! Must not specific `ptype` when `simplify = FALSE` - diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R index 80b99c57..489ab8ba 100644 --- a/tests/testthat/test-list-simplify.R +++ b/tests/testthat/test-list-simplify.R @@ -28,10 +28,3 @@ test_that("ptype is checked", { test_that("x must be a list", { expect_snapshot(list_simplify(1:5), error = TRUE) }) - -test_that("verifies simplify and ptype", { - expect_snapshot(error = TRUE, { - check_ptype_simplify(NULL, 1) - check_ptype_simplify(integer(), FALSE) - }) -}) From be3fe11f9ab3f1e072105df7e49b5d38c45359f9 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 2 Sep 2022 07:44:58 -0500 Subject: [PATCH 04/33] Finish off list_transpose() --- R/list-transpose.R | 54 +++++++++++++++++++++++++++------------------- 1 file changed, 32 insertions(+), 22 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 7aa20474..00b58174 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -1,12 +1,12 @@ #' @examples -#' # transpose() is useful in conjunction with safely() & quietly() +#' # list_tranpose() is useful in conjunction with safely() #' x <- list("a", 1, 2) #' y <- x %>% map(safely(log)) #' y %>% str() #' y %>% list_transpose() %>% str() #' y %>% list_transpose(default = list(result = NA)) %>% str() #' -#' # list_tranpose() will simplify by default: +#' # list_tranpose() 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: @@ -20,37 +20,47 @@ #' ) #' ll %>% list_transpose() #' ll %>% list_transpose(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 = vec_index(x[[1]]), simplify = TRUE, ptype = NULL, default = NULL) { +list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) { vec_assert(x, list()) if (length(x) == 0) { return(list()) } - # TODO: name these appropriate - if (is_bool(simplify)) { - simplify <- rep(list(simplify), length(template)) - } - if (!(has_names(default) && is.list(default))) { - default <- rep(list(default), length(template)) - } - if (!(has_names(ptype) && is.list(ptype))) { - ptype <- rep(list(ptype), length(template)) + template <- template %||% + names(x[[1]]) %||% + cli::cli_abort("First element of {.arg x} is unnamed, please supply `template.") + if (!is.character(template)) { + cli::cli_abort("{.arg template} must be a character vector") } - out <- vector("list", length(template)) - if (is.character(template)) { - names(out) <- template - } + simplify <- match_template(simplify, template) + default <- match_template(default, template) + ptype <- match_template(ptype, template) - for (i in seq_along(template)) { - res <- map(x, template[[i]], .default = default[[i]]) - if (simplify[[i]]) { - res <- list_simplify(res, ptype[[i]]) - } - out[[i]] <- res + out <- rep_named(template, list()) + for (nm in template) { + res <- map(x, nm, .default = default[[nm]]) + res <- list_simplify(res, simplify = simplify[[nm]], ptype = ptype[[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)) + } +} From 17bffabee5f733ac224f32743ecb2a8192149621 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 2 Sep 2022 07:46:21 -0500 Subject: [PATCH 05/33] Use vec_unchop() --- R/list-simplify.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 40b51861..185eb91b 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -19,10 +19,10 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { if (can_simplify) { if (!is.null(ptype)) { - vec_c(!!!x, .ptype = ptype) + vec_unchop(x, ptype = ptype) } else { tryCatch( - vec_c(!!!x), + vec_unchop(x), vctrs_error_incompatible_type = function(err) { if (strict) { abort("Failed to simplify", parent = err) From 8d63020bb012ea8dd4d585d46a892d508789e814 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 2 Sep 2022 07:51:18 -0500 Subject: [PATCH 06/33] Remove out of date comment --- R/list-simplify.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 185eb91b..ab12b9f4 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,5 +1,3 @@ -# Internal helper used by list_transform() and accumulate() -# when simplify = TRUE (the default) list_simplify <- function(x, simplify = NA, ptype = NULL) { vec_assert(x, list()) if (length(simplify) > 1 || !is.logical(simplify)) { From 71ba50cbc790cee203c0d4316146e15b4b8f4222 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 14:52:58 -0500 Subject: [PATCH 07/33] Feedback from code review --- R/list-simplify.R | 7 ++++--- tests/testthat/_snaps/list-simplify.md | 3 +-- tests/testthat/test-list-simplify.R | 7 +++---- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index ab12b9f4..c6a6e47e 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,5 +1,6 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { - vec_assert(x, list()) + vec_check_list(x) + if (length(simplify) > 1 || !is.logical(simplify)) { abort("`simplify` must be `TRUE`, `FALSE`, or `NA`") } @@ -7,13 +8,13 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { abort("Must not specify `ptype` when `simplify = FALSE`") } + # Ensures result is a list if (isFALSE(simplify)) { return(x) } strict <- !is.na(simplify) - # We choose not to simply data frames to preserve length invariants - can_simplify <- every(x, ~ vec_is(.x, size = 1) && !is.data.frame(.x)) + can_simplify <- every(x, vec_is, size = 1) if (can_simplify) { if (!is.null(ptype)) { diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index a1b80fde..fd1ffe4d 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -12,6 +12,5 @@ list_simplify(1:5) Condition Error in `list_simplify()`: - ! `x` must be a vector with type . - Instead, it has type . + ! `x` must be a list, not an integer vector. diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R index 489ab8ba..0f8210d8 100644 --- a/tests/testthat/test-list-simplify.R +++ b/tests/testthat/test-list-simplify.R @@ -12,9 +12,9 @@ test_that("simplification requires common type", { expect_equal(list_simplify(list(1, "a")), list(1, "a")) }) -test_that("never simplifies data frames", { - x <- list(data.frame(x = 1), data.frame(y = 1)) - expect_equal(list_simplify(x), x) +test_that("can simplify one-row data frames", { + x <- list(data.frame(x = 1), data.frame(y = 2)) + expect_equal(list_simplify(x), data.frame(x = c(1, NA), y = c(NA, 2))) }) test_that("ptype is checked", { @@ -22,7 +22,6 @@ test_that("ptype is checked", { expect_snapshot(list_simplify(list(1, 2), ptype = character()), error = TRUE) }) - # argument checking ------------------------------------------------------- test_that("x must be a list", { From 20387d0098c5c3b89cd7eb6d8a2f33f4e0ad68ae Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:20:46 -0500 Subject: [PATCH 08/33] Finish off list_simplify() tests --- R/list-simplify.R | 24 ++++++-------- tests/testthat/_snaps/list-simplify.md | 44 ++++++++++++++++++++++++-- tests/testthat/test-list-simplify.R | 17 +++++++++- 3 files changed, 68 insertions(+), 17 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index c6a6e47e..524c9b30 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -17,23 +17,19 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { can_simplify <- every(x, vec_is, size = 1) if (can_simplify) { - if (!is.null(ptype)) { - vec_unchop(x, ptype = ptype) - } else { - tryCatch( - vec_unchop(x), - vctrs_error_incompatible_type = function(err) { - if (strict) { - abort("Failed to simplify", parent = err) - } else { - x - } + tryCatch( + vec_unchop(x, ptype = ptype), + vctrs_error_incompatible_type = function(err) { + if (strict || !is.null(ptype)) { + cli::cli_abort("Failed to simplify {.arg x}.", parent = err) + } else { + x } - ) - } + } + ) } else { if (strict) { - abort("Failed to simplify: not all elements vectors of length 1") + cli::cli_abort("Failed to simplify {.arg x}: not all elements vectors of length 1.") } else { x } diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index fd1ffe4d..9aedd341 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -3,10 +3,34 @@ Code list_simplify(list(1, 2), ptype = character()) Condition - Error: + Error in `list_simplify()`: + ! Failed to simplify `x`. + Caused by error: ! Can't convert to . -# x must be a list +# strict simplification will error + + Code + list_simplify(list(1, "a"), simplify = TRUE) + Condition + Error in `list_simplify()`: + ! Failed to simplify `x`. + Caused by error: + ! Can't combine `..1` and `..2` . + Code + list_simplify(list(1, 1:2), simplify = TRUE) + Condition + Error in `list_simplify()`: + ! Failed to simplify `x`: not all elements vectors of length 1. + Code + list_simplify(list(1, 2), simplify = TRUE, ptype = character()) + Condition + Error in `list_simplify()`: + ! Failed to simplify `x`. + Caused by error: + ! Can't convert to . + +# validates inputs Code list_simplify(1:5) @@ -14,3 +38,19 @@ Error in `list_simplify()`: ! `x` must be a list, not an integer vector. +--- + + Code + list_simplify(list(), simplify = 1) + Condition + Error in `list_simplify()`: + ! `simplify` must be `TRUE`, `FALSE`, or `NA` + +--- + + Code + list_simplify(list(), simplify = FALSE, ptype = integer()) + Condition + Error in `list_simplify()`: + ! Must not specify `ptype` when `simplify = FALSE` + diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R index 0f8210d8..1b27939e 100644 --- a/tests/testthat/test-list-simplify.R +++ b/tests/testthat/test-list-simplify.R @@ -22,8 +22,23 @@ test_that("ptype is checked", { expect_snapshot(list_simplify(list(1, 2), ptype = character()), error = TRUE) }) +test_that("can suppress simplification", { + x <- list(1, 2) + expect_equal(list_simplify(x, simplify = FALSE), x) +}) + +test_that("strict simplification will error", { + expect_snapshot(error = TRUE, { + list_simplify(list(1, "a"), simplify = TRUE) + list_simplify(list(1, 1:2), simplify = TRUE) + list_simplify(list(1, 2), simplify = TRUE, ptype = character()) + }) +}) + # argument checking ------------------------------------------------------- -test_that("x must be a list", { +test_that("validates inputs", { expect_snapshot(list_simplify(1:5), error = TRUE) + expect_snapshot(list_simplify(list(), simplify = 1), error = TRUE) + expect_snapshot(list_simplify(list(), simplify = FALSE, ptype = integer()), error = TRUE) }) From 780559119cfd1ebd9d8d40969382acf79a5820d0 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:24:56 -0500 Subject: [PATCH 09/33] Update accumulate tests --- tests/testthat/test-reduce.R | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/tests/testthat/test-reduce.R b/tests/testthat/test-reduce.R index 0f627371..40504599 100644 --- a/tests/testthat/test-reduce.R +++ b/tests/testthat/test-reduce.R @@ -113,22 +113,8 @@ test_that("accumulate() uses vctrs to simplify results", { test_that("accumulate() does not fail when input can't be simplified", { expect_identical(accumulate(list(1L, 2:3), ~ .y), list(1L, 2:3)) expect_identical(accumulate(list(1, "a"), ~ .y), list(1, "a")) - expect_identical(accumulate(1:3, ~ .y), 1:3) - expect_identical(accumulate(list(identity), ~ .y), list(identity)) - expect_identical(accumulate(mtcars, ~ .y), as.list(mtcars)) }) -test_that("accumulate() does not simplify data frame rowwise", { - out <- accumulate( - 1L, - ~ data.frame(new = .y), - .init = data.frame(new = 0L) - ) - exp <- list(data.frame(new = 0L), data.frame(new = 1L)) - expect_identical(out, exp) -}) - - # reduce2 ----------------------------------------------------------------- test_that("basic application works", { From 5d6d87444e7a5bd715f0605471a9935cb527e9f1 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:25:59 -0500 Subject: [PATCH 10/33] Basic docs for list_transpose() --- NAMESPACE | 1 + R/list-transpose.R | 46 +++++++++++++++++++++++------ _pkgdown.yml | 1 + man/list_transpose.Rd | 67 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 106 insertions(+), 9 deletions(-) create mode 100644 man/list_transpose.Rd diff --git a/NAMESPACE b/NAMESPACE index 88c2dbea..ea296123 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -131,6 +131,7 @@ export(lift_vl) export(list_along) export(list_merge) export(list_modify) +export(list_transpose) export(lmap) export(lmap_at) export(lmap_if) diff --git a/R/list-transpose.R b/R/list-transpose.R index 00b58174..1b011acd 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -1,39 +1,67 @@ +#' 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_tranpose() is useful in conjunction with safely() +#' # 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_tranpose() will try to simplify by default: +#' # 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 component names to prevent loss of those that don't -#' # appear in first component +#' # 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(c("x", "y", "z")) +#' 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_assert(x, list()) + 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 `template.") + 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") + cli::cli_abort("{.arg template} must be a character vector.") } simplify <- match_template(simplify, template) @@ -43,7 +71,7 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa out <- rep_named(template, list()) for (nm in template) { res <- map(x, nm, .default = default[[nm]]) - res <- list_simplify(res, simplify = simplify[[nm]], ptype = ptype[[nm]]) + res <- list_simplify(res, simplify = simplify[[nm]] %||% NA, ptype = ptype[[nm]]) out[[nm]] <- res } diff --git a/_pkgdown.yml b/_pkgdown.yml index bb9b8896..368f0344 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -81,6 +81,7 @@ reference: - accumulate - flatten - list_modify + - list_transpose - reduce - transpose diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd new file mode 100644 index 00000000..48dea641 --- /dev/null +++ b/man/list_transpose.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list-transpose.R +\name{list_transpose} +\alias{list_transpose} +\title{Transpose a list} +\usage{ +list_transpose(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) +} +\arguments{ +\item{x}{A list of vectors to transpose.} + +\item{template}{A "template" that specifies the names of output list. +Usually taken from the name of the first element of \code{x}.} + +\item{simplify}{Should the result be simplified? +\itemize{ +\item \code{TRUE}: simplify or die trying. +\item \code{NA}: simplify if possible. +\item \code{FALSE}: never try to simplify, always leaving as a list. +} + +Alternatively, a named list specifying the simplification by output column.} + +\item{ptype}{An optional vector prototype used to control the simplification. +Alternatively, a named list specifying the prototype by output column.} + +\item{default}{A default value to use if a value is absent of \code{NULL}. +Alternatively, a named list specifying the prototype by output column.} +} +\description{ +\code{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 \code{n} where each component had values \code{a} +and \code{b}, \code{list_transpose()} would make a list with elements \code{a} and +\code{b} that contained lists of length n. + +It's called transpose because \code{x[["a"]][["b"]]} is equivalent to +\code{transpose(x)[["b"]][["a"]]}, i.e. transposing a list flips the order of +indices in a similar way to transposing a matrix. +} +\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) +} From d9c76d35318685a82db5cc0403bc58895f907240 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:34:34 -0500 Subject: [PATCH 11/33] Mildly consider simplification errors --- R/list-simplify.R | 13 ++++++++++--- R/list-transpose.R | 6 +++++- R/reduce.R | 4 ++-- tests/testthat/_snaps/list-simplify.md | 8 ++++---- tests/testthat/_snaps/reduce.md | 10 ++++++++++ tests/testthat/test-reduce.R | 4 ++++ 6 files changed, 35 insertions(+), 10 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 524c9b30..a5013aae 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,4 +1,4 @@ -list_simplify <- function(x, simplify = NA, ptype = NULL) { +list_simplify <- function(x, simplify = NA, ptype = NULL, error_arg = "`x`", error_call = caller_env()) { vec_check_list(x) if (length(simplify) > 1 || !is.logical(simplify)) { @@ -21,7 +21,11 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { vec_unchop(x, ptype = ptype), vctrs_error_incompatible_type = function(err) { if (strict || !is.null(ptype)) { - cli::cli_abort("Failed to simplify {.arg x}.", parent = err) + cli::cli_abort( + "Failed to simplify {error_arg}.", + parent = err, + call = error_call + ) } else { x } @@ -29,7 +33,10 @@ list_simplify <- function(x, simplify = NA, ptype = NULL) { ) } else { if (strict) { - cli::cli_abort("Failed to simplify {.arg x}: not all elements vectors of length 1.") + cli::cli_abort( + "Failed to simplify {error_arg}: not all elements vectors of length 1.", + call = error_call + ) } else { x } diff --git a/R/list-transpose.R b/R/list-transpose.R index 1b011acd..fcc6c205 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -71,7 +71,11 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa out <- rep_named(template, list()) for (nm in template) { res <- map(x, nm, .default = default[[nm]]) - res <- list_simplify(res, simplify = simplify[[nm]] %||% NA, ptype = ptype[[nm]]) + res <- list_simplify(res, + simplify = simplify[[nm]] %||% NA, + ptype = ptype[[nm]], + error_arg = paste0("output `", nm, "`") + ) out[[nm]] <- res } diff --git a/R/reduce.R b/R/reduce.R index bdcf1c5f..64e1c0d6 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -464,14 +464,14 @@ accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .sim res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE) names(res) <- accumulate_names(names(.x), .init, .dir) - res <- list_simplify(res, .simplify, .ptype) + res <- list_simplify(res, .simplify, .ptype, error_arg = "accumulated results") res } #' @rdname accumulate #' @export accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) { res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE) - res <- list_simplify(res, .simplify, .ptype) + res <- list_simplify(res, .simplify, .ptype, error_arg = "accumulated results") res } diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 9aedd341..412db373 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -3,7 +3,7 @@ Code list_simplify(list(1, 2), ptype = character()) Condition - Error in `list_simplify()`: + Error: ! Failed to simplify `x`. Caused by error: ! Can't convert to . @@ -13,19 +13,19 @@ Code list_simplify(list(1, "a"), simplify = TRUE) Condition - Error in `list_simplify()`: + Error: ! Failed to simplify `x`. Caused by error: ! Can't combine `..1` and `..2` . Code list_simplify(list(1, 1:2), simplify = TRUE) Condition - Error in `list_simplify()`: + Error: ! Failed to simplify `x`: not all elements vectors of length 1. Code list_simplify(list(1, 2), simplify = TRUE, ptype = character()) Condition - Error in `list_simplify()`: + Error: ! Failed to simplify `x`. Caused by error: ! Can't convert to . diff --git a/tests/testthat/_snaps/reduce.md b/tests/testthat/_snaps/reduce.md index b6990a10..35cfb788 100644 --- a/tests/testthat/_snaps/reduce.md +++ b/tests/testthat/_snaps/reduce.md @@ -1,3 +1,13 @@ +# accumulate() does fail when simpification is required + + Code + accumulate(list(1, "a"), ~.y, .simplify = TRUE) + Condition + Error in `accumulate()`: + ! Failed to simplify accumulated results. + Caused by error: + ! Can't combine `..1` and `..2` . + # right variants are retired Code diff --git a/tests/testthat/test-reduce.R b/tests/testthat/test-reduce.R index 40504599..9125d42b 100644 --- a/tests/testthat/test-reduce.R +++ b/tests/testthat/test-reduce.R @@ -115,6 +115,10 @@ test_that("accumulate() does not fail when input can't be simplified", { expect_identical(accumulate(list(1, "a"), ~ .y), list(1, "a")) }) +test_that("accumulate() does fail when simpification is required", { + expect_snapshot(accumulate(list(1, "a"), ~ .y, .simplify = TRUE), error = TRUE) +}) + # reduce2 ----------------------------------------------------------------- test_that("basic application works", { From 1980e24feed5dab248047441c43f3524521cbf69 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:46:24 -0500 Subject: [PATCH 12/33] Test list_transpose() --- R/list-transpose.R | 2 +- tests/testthat/_snaps/list-transpose.md | 57 ++++++++++++++++++++ tests/testthat/test-list-transpose.R | 72 +++++++++++++++++++++++++ 3 files changed, 130 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/_snaps/list-transpose.md create mode 100644 tests/testthat/test-list-transpose.R diff --git a/R/list-transpose.R b/R/list-transpose.R index fcc6c205..c6acef9e 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -87,7 +87,7 @@ match_template <- function(x, template, error_arg = caller_arg(x), error_call = extra_names <- setdiff(names(x), template) if (length(extra_names)) { cli::cli_abort( - "{.arg {error_arg}} contains unknown names: {.str extra_names}", + "{.arg {error_arg}} contains unknown names: {.str {extra_names}}", call = error_call ) } diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md new file mode 100644 index 00000000..84de4103 --- /dev/null +++ b/tests/testthat/_snaps/list-transpose.md @@ -0,0 +1,57 @@ +# simplification fails silently unless requested + + Code + list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE) + Condition + Error in `list_transpose()`: + ! Failed to simplify output `x`. + Caused by error: + ! Can't combine `..1` and `..2` . + Code + list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE) + Condition + Error in `list_transpose()`: + ! Failed to simplify output `x`: not all elements vectors of length 1. + +# can supply `simplify` globally or individually + + Code + list_transpose(x, simplify = list(c = FALSE)) + Condition + Error in `list_transpose()`: + ! `simplify` contains unknown names: "c" + +# can supply `ptype` globally or individually + + Code + list_transpose(x, ptype = list(c = integer())) + Condition + Error in `list_transpose()`: + ! `ptype` contains unknown names: "c" + +# can supply `default` globally or individually + + Code + list_transpose(x, default = list(c = NA)) + Condition + Error in `list_transpose()`: + ! `default` contains unknown names: "c" + +# validates inputs + + Code + list_transpose(10) + Condition + Error in `list_transpose()`: + ! `x` must be a list, not a number. + Code + list_transpose(list(1)) + Condition + Error in `list_transpose()`: + ! First element of `x` is unnamed, please supply `template`. + Code + list_transpose(list(a = 1), template = 1) + Condition + Error in `list_transpose()`: + ! `template` must be a character vector. + diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R new file mode 100644 index 00000000..2838b652 --- /dev/null +++ b/tests/testthat/test-list-transpose.R @@ -0,0 +1,72 @@ +test_that("can transpose homogenous list", { + x <- list(x = list(a = 1, b = 2), y = list(a = 3, b = 4)) + out <- list_transpose(x) + expect_equal(out, list(a = c(x = 1, y = 3), b = c(x = 2, y = 4))) +}) + +test_that("transposing empty list returns empty list", { + expect_equal(list_transpose(list()), list()) +}) + +test_that("simplification fails silently unless requested", { + expect_equal( + list_transpose(list(list(x = 1), list(x = "b"))), + list(x = list(1, "b")) + ) + expect_equal( + list_transpose(list(list(x = 1), list(x = 2:3))), + list(x = list(1, 2:3)) + ) + + expect_snapshot(error = TRUE, { + list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE) + list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE) + }) +}) + +test_that("can supply `simplify` globally or individually", { + x <- list(list(a = 1, b = 2), list(a = 3, b = 4)) + expect_equal( + list_transpose(x, simplify = FALSE), + list(a = list(1, 3), b = list(2, 4)) + ) + expect_equal( + list_transpose(x, simplify = list(a = FALSE)), + list(a = list(1, 3), b = c(2, 4)) + ) + expect_snapshot(list_transpose(x, simplify = list(c = FALSE)), error = TRUE) +}) + +test_that("can supply `ptype` globally or individually", { + x <- list(list(a = 1, b = 2), list(a = 3, b = 4)) + expect_identical( + list_transpose(x, ptype = integer()), + list(a = c(1L, 3L), b = c(2L, 4L)) + ) + expect_equal( + list_transpose(x, ptype = list(a = integer())), + list(a = c(1L, 3L), b = c(2, 4)) + ) + expect_snapshot(list_transpose(x, ptype = list(c = integer())), error = TRUE) +}) + +test_that("can supply `default` globally or individually", { + x <- list(list(x = 1), list(y = "a")) + expect_equal( + list_transpose(x, c("x", "y"), default = NA), + list(x = c(1, NA), y = c(NA, "a")) + ) + expect_equal( + list_transpose(x, c("x", "y"), default = list(x = NA, y = "")), + list(x = c(1, NA), y = c("", "a")) + ) + expect_snapshot(list_transpose(x, default = list(c = NA)), error = TRUE) +}) + +test_that("validates inputs", { + expect_snapshot(error = TRUE, { + list_transpose(10) + list_transpose(list(1)) + list_transpose(list(a = 1), template = 1) + }) +}) From eb8555956de6f62181c9c3134b77fd0449d007d9 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 7 Sep 2022 16:55:53 -0500 Subject: [PATCH 13/33] Deprecate transpose() --- R/transpose.R | 30 ++++++++++++++++++------ _pkgdown.yml | 1 - man/transpose.Rd | 31 +++++++++++++++++-------- tests/testthat/_snaps/transpose.md | 9 ++++++++ tests/testthat/test-transpose.R | 37 ++++++++++++++++++++++++++++++ 5 files changed, 91 insertions(+), 17 deletions(-) create mode 100644 tests/testthat/_snaps/transpose.md diff --git a/R/transpose.R b/R/transpose.R index 360e000d..8bb890ea 100644 --- a/R/transpose.R +++ b/R/transpose.R @@ -1,5 +1,11 @@ #' Transpose a list. #' +#' @description +#' `r lifecycle::badge("deprecated")` +#' +#' Please use [list_transpose()] instead of `transpose()`. It has a better name, +#' and can now automatically simplify the output, as is commonly needed. +#' #' 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 @@ -17,24 +23,28 @@ #' @param .names For efficiency, `transpose()` bases the return structure on #' the first component of `.l` by default. Specify `.names` to override this. #' @return A list with indexing transposed compared to `.l`. +#' @keywords internal #' @export #' @examples -#' x <- rerun(5, x = runif(1), y = runif(5)) -#' x %>% str() +#' x <- map(1:5, ~ list(x = runif(1), y = runif(5))) +#' # was #' x %>% transpose() %>% str() -#' # Back to where we started -#' x %>% transpose() %>% transpose() %>% str() +#' # now +#' x %>% list_transpose(simplify = FALSE) %>% str() #' #' # transpose() is useful in conjunction with safely() & quietly() #' x <- list("a", 1, 2) #' y <- x %>% map(safely(log)) -#' y %>% str() +#' # was #' y %>% transpose() %>% str() +#' # now: +#' y %>% list_transpose() %>% str() #' -#' # Use simplify_all() to reduce to atomic vectors where possible +#' # Previously, output simplification required a call to another function #' x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6)) -#' x %>% transpose() #' x %>% transpose() %>% simplify_all() +#' # Now can take advantage of automatic simplification +#' x %>% list_transpose() #' #' # Provide explicit component names to prevent loss of those that don't #' # appear in first component @@ -44,7 +54,13 @@ #' ) #' ll %>% transpose() #' nms <- ll %>% map(names) %>% reduce(union) +#' # was #' ll %>% transpose(.names = nms) +#' # now +#' ll %>% list_transpose(template = nms) +#' # and can supply default value +#' ll %>% list_transpose(template = nms, default = NA) transpose <- function(.l, .names = NULL) { + lifecycle::deprecate_warn("0.4.0", "transpose()", "list_transpose()") .Call(transpose_impl, .l, .names) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 368f0344..9a59fcfe 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -83,7 +83,6 @@ reference: - list_modify - list_transpose - reduce - - transpose - title: Adverbs desc: > diff --git a/man/transpose.Rd b/man/transpose.Rd index adc2d5ed..b523a4aa 100644 --- a/man/transpose.Rd +++ b/man/transpose.Rd @@ -18,35 +18,42 @@ the first component of \code{.l} by default. Specify \code{.names} to override t A list with indexing transposed compared to \code{.l}. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +Please use \code{\link[=list_transpose]{list_transpose()}} instead of \code{transpose()}. It has a better name, +and can now automatically simplify the output, as is commonly needed. + 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 \code{a} and \code{b}, \code{transpose()} would make a list with elements \code{a} and \code{b} that contained lists of length n. It's called transpose because \code{x[[1]][[2]]} is equivalent to \code{transpose(x)[[2]][[1]]}. -} -\details{ + Note that \code{transpose()} is its own inverse, much like the transpose operation on a matrix. You can get back the original input by transposing it twice. } \examples{ -x <- rerun(5, x = runif(1), y = runif(5)) -x \%>\% str() +x <- map(1:5, ~ list(x = runif(1), y = runif(5))) +# was x \%>\% transpose() \%>\% str() -# Back to where we started -x \%>\% transpose() \%>\% transpose() \%>\% str() +# now +x \%>\% list_transpose(simplify = FALSE) \%>\% str() # transpose() is useful in conjunction with safely() & quietly() x <- list("a", 1, 2) y <- x \%>\% map(safely(log)) -y \%>\% str() +# was y \%>\% transpose() \%>\% str() +# now: +y \%>\% list_transpose() \%>\% str() -# Use simplify_all() to reduce to atomic vectors where possible +# Previously, output simplification required a call to another function x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6)) -x \%>\% transpose() x \%>\% transpose() \%>\% simplify_all() +# Now can take advantage of automatic simplification +x \%>\% list_transpose() # Provide explicit component names to prevent loss of those that don't # appear in first component @@ -56,5 +63,11 @@ ll <- list( ) ll \%>\% transpose() nms <- ll \%>\% map(names) \%>\% reduce(union) +# was ll \%>\% transpose(.names = nms) +# now +ll \%>\% list_transpose(template = nms) +# and can supply default value +ll \%>\% list_transpose(template = nms, default = NA) } +\keyword{internal} diff --git a/tests/testthat/_snaps/transpose.md b/tests/testthat/_snaps/transpose.md new file mode 100644 index 00000000..6e86dcd2 --- /dev/null +++ b/tests/testthat/_snaps/transpose.md @@ -0,0 +1,9 @@ +# transpose() is deprecated + + Code + . <- transpose(list()) + Condition + Warning: + `transpose()` was deprecated in purrr 0.4.0. + Please use `list_transpose()` instead. + diff --git a/tests/testthat/test-transpose.R b/tests/testthat/test-transpose.R index 4fc2b832..d557b5ef 100644 --- a/tests/testthat/test-transpose.R +++ b/tests/testthat/test-transpose.R @@ -1,48 +1,72 @@ +test_that("transpose() is deprecated", { + expect_snapshot(. <- transpose(list())) +}) + test_that("input must be a list", { + local_options(lifecycle_verbosity = "quiet") + expect_bad_type_error(transpose(1:3), "`.l` must be a list, not an integer vector") }) test_that("elements of input must be atomic vectors", { + local_options(lifecycle_verbosity = "quiet") + expect_bad_element_type_error(transpose(list(environment())), "Element 1 must be a vector, not an environment") expect_bad_element_type_error(transpose(list(list(), environment())), "Element 2 must be a vector, not an environment") }) test_that("empty list returns empty list", { + local_options(lifecycle_verbosity = "quiet") + expect_equal(transpose(list()), list()) }) test_that("transpose switches order of first & second idnex", { + local_options(lifecycle_verbosity = "quiet") + x <- list(list(1, 3), list(2, 4)) expect_equal(transpose(x), list(list(1, 2), list(3, 4))) }) test_that("inside names become outside names", { + local_options(lifecycle_verbosity = "quiet") + x <- list(list(x = 1), list(x = 2)) expect_equal(transpose(x), list(x = list(1, 2))) }) test_that("outside names become inside names", { + local_options(lifecycle_verbosity = "quiet") + x <- list(x = list(1, 3), y = list(2, 4)) expect_equal(transpose(x), list(list(x = 1, y = 2), list(x = 3, y = 4))) }) test_that("warns if element too short", { + local_options(lifecycle_verbosity = "quiet") + x <- list(list(1, 2), list(1)) expect_warning(out <- transpose(x), "Element 2 must be length 2, not 1") expect_equal(out, list(list(1, 1), list(2, NULL))) }) test_that("warns if element too long", { + local_options(lifecycle_verbosity = "quiet") + x <- list(list(1, 2), list(1, 2, 3)) expect_warning(out <- transpose(x), "Element 2 must be length 2, not 3") expect_equal(out, list(list(1, 1), list(2, 2))) }) test_that("can transpose list of lists of atomic vectors", { + local_options(lifecycle_verbosity = "quiet") + x <- list(list(TRUE, 1L, 1, "1")) expect_equal(transpose(x), list(list(TRUE), list(1L), list(1), list("1"))) }) test_that("can transpose lists of atomic vectors", { + local_options(lifecycle_verbosity = "quiet") + expect_equal(transpose(list(TRUE, FALSE)), list(list(TRUE, FALSE))) expect_equal(transpose(list(1L, 2L)), list(list(1L, 2L))) expect_equal(transpose(list(1, 2)), list(list(1, 2))) @@ -50,6 +74,8 @@ test_that("can transpose lists of atomic vectors", { }) test_that("can't transpose expressions", { + local_options(lifecycle_verbosity = "quiet") + expect_bad_type_error( transpose(list(expression(a))), "Transposed element must be a vector, not an expression vector" @@ -59,6 +85,8 @@ test_that("can't transpose expressions", { # Named based matching ---------------------------------------------------- test_that("can override default names", { + local_options(lifecycle_verbosity = "quiet") + x <- list( list(x = 1), list(y = 2, x = 1) @@ -72,6 +100,8 @@ test_that("can override default names", { }) test_that("if present, names are used", { + local_options(lifecycle_verbosity = "quiet") + x <- list( list(x = 1, y = 2), list(y = 2, x = 1) @@ -83,6 +113,8 @@ test_that("if present, names are used", { }) test_that("if missing elements, filled with NULL", { + local_options(lifecycle_verbosity = "quiet") + x <- list( list(x = 1, y = 2), list(x = 1) @@ -94,6 +126,8 @@ test_that("if missing elements, filled with NULL", { # Position based matching ------------------------------------------------- test_that("warning if too short", { + local_options(lifecycle_verbosity = "quiet") + x <- list( list(1, 2), list(1) @@ -103,6 +137,8 @@ test_that("warning if too short", { }) test_that("warning if too long", { + local_options(lifecycle_verbosity = "quiet") + x <- list( list(1), list(1, 2) @@ -110,3 +146,4 @@ test_that("warning if too long", { expect_warning(tx <- transpose(x), "must be length 1, not 2") expect_equal(tx, list(list(1, 1))) }) + From 5940cc2b2fa268e464b049e849d53163a520f1fb Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 9 Sep 2022 08:41:32 -0500 Subject: [PATCH 14/33] Replace accidental use of base pipe --- R/list-transpose.R | 2 +- man/list_transpose.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index c6acef9e..de4ee3e7 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -39,7 +39,7 @@ #' 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() +#' x %>% list_transpose(simplify = FALSE) %>% str() #' #' # Provide explicit template if you know which elements you want to extract #' ll <- list( diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 48dea641..5a8a3122 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -52,7 +52,7 @@ y \%>\% list_transpose(default = list(result = NA)) \%>\% str() 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() +x \%>\% list_transpose(simplify = FALSE) \%>\% str() # Provide explicit template if you know which elements you want to extract ll <- list( From 675a8a852a302a5c85099776596f2dacd1944bf3 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 9 Sep 2022 09:03:00 -0500 Subject: [PATCH 15/33] Implement user facing list_simplify() --- NAMESPACE | 1 + R/list-simplify.R | 53 ++++++++++++++++++++++++-- R/list-transpose.R | 2 +- R/reduce.R | 4 +- _pkgdown.yml | 1 + man/list_simplify.Rd | 35 +++++++++++++++++ tests/testthat/_snaps/list-simplify.md | 38 +++++++++++------- tests/testthat/test-list-simplify.R | 44 +++++++++------------ 8 files changed, 131 insertions(+), 47 deletions(-) create mode 100644 man/list_simplify.Rd diff --git a/NAMESPACE b/NAMESPACE index 3b86e7a3..3fa37cab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -135,6 +135,7 @@ export(list_flatten) export(list_merge) export(list_modify) export(list_rbind) +export(list_simplify) export(list_transpose) export(list_update) export(lmap) diff --git a/R/list-simplify.R b/R/list-simplify.R index a5013aae..9b164a63 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,6 +1,35 @@ -list_simplify <- function(x, simplify = NA, ptype = NULL, error_arg = "`x`", error_call = caller_env()) { - vec_check_list(x) +#' 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)) { abort("`simplify` must be `TRUE`, `FALSE`, or `NA`") } @@ -8,11 +37,27 @@ list_simplify <- function(x, simplify = NA, ptype = NULL, error_arg = "`x`", err abort("Must not specify `ptype` when `simplify = FALSE`") } - # Ensures result is a list if (isFALSE(simplify)) { return(x) } - strict <- !is.na(simplify) + + 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) diff --git a/R/list-transpose.R b/R/list-transpose.R index de4ee3e7..d0f10de3 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -71,7 +71,7 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa out <- rep_named(template, list()) for (nm in template) { res <- map(x, nm, .default = default[[nm]]) - res <- list_simplify(res, + res <- list_simplify_internal(res, simplify = simplify[[nm]] %||% NA, ptype = ptype[[nm]], error_arg = paste0("output `", nm, "`") diff --git a/R/reduce.R b/R/reduce.R index ba8d7b0e..a512c6b9 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -465,14 +465,14 @@ accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .sim res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE) names(res) <- accumulate_names(names(.x), .init, .dir) - res <- list_simplify(res, .simplify, .ptype, error_arg = "accumulated results") + res <- list_simplify_internal(res, .simplify, .ptype, error_arg = "accumulated results") res } #' @rdname accumulate #' @export accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) { res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE) - res <- list_simplify(res, .simplify, .ptype, error_arg = "accumulated results") + res <- list_simplify_internal(res, .simplify, .ptype, error_arg = "accumulated results") res } diff --git a/_pkgdown.yml b/_pkgdown.yml index a4edff7f..5f929e18 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -83,6 +83,7 @@ reference: - list_c - list_flatten - list_modify + - list_simplify - list_transpose - reduce diff --git a/man/list_simplify.Rd b/man/list_simplify.Rd new file mode 100644 index 00000000..a1df162f --- /dev/null +++ b/man/list_simplify.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list-simplify.R +\name{list_simplify} +\alias{list_simplify} +\title{Simplify a list to an atomic or S3 vector} +\usage{ +list_simplify(x, strict = TRUE, ptype = NULL) +} +\arguments{ +\item{x}{A list.} + +\item{strict}{What should happen if simplification fails? If \code{TRUE}, +will error. If \code{FALSE}, will return \code{x} unchanged.} + +\item{ptype}{An optional prototype to ensure that the output type is always +the same.} +} +\value{ +A vector the same length as \code{x}. +} +\description{ +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 \code{x} must contain a vector of +length 1. If you don't want to maintain this correspondence, then you +probably want either \code{\link[=list_c]{list_c()}} or \code{\link[=list_flatten]{list_flatten()}}. +} +\examples{ +list_simplify(list(1, 2, 3)) + +try(list_simplify(list(1, 2, "x"))) +try(list_simplify(list(1, 2, 1:3))) +} diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 412db373..1124728c 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -1,9 +1,19 @@ -# ptype is checked +# ptype is enforced Code list_simplify(list(1, 2), ptype = character()) Condition - Error: + Error in `list_simplify()`: + ! Failed to simplify `x`. + Caused by error: + ! Can't convert to . + +--- + + Code + list_simplify(list(1, 2), ptype = character(), strict = FALSE) + Condition + Error in `list_simplify()`: ! Failed to simplify `x`. Caused by error: ! Can't convert to . @@ -11,21 +21,21 @@ # strict simplification will error Code - list_simplify(list(1, "a"), simplify = TRUE) + list_simplify(list(1, "a")) Condition - Error: + Error in `list_simplify()`: ! Failed to simplify `x`. Caused by error: ! Can't combine `..1` and `..2` . Code - list_simplify(list(1, 1:2), simplify = TRUE) + list_simplify(list(1, 1:2)) Condition - Error: + Error in `list_simplify()`: ! Failed to simplify `x`: not all elements vectors of length 1. Code - list_simplify(list(1, 2), simplify = TRUE, ptype = character()) + list_simplify(list(1, 2), ptype = character()) Condition - Error: + Error in `list_simplify()`: ! Failed to simplify `x`. Caused by error: ! Can't convert to . @@ -33,24 +43,24 @@ # validates inputs Code - list_simplify(1:5) + list_simplify_internal(1:5) Condition - Error in `list_simplify()`: + Error: ! `x` must be a list, not an integer vector. --- Code - list_simplify(list(), simplify = 1) + list_simplify_internal(list(), simplify = 1) Condition - Error in `list_simplify()`: + Error in `list_simplify_internal()`: ! `simplify` must be `TRUE`, `FALSE`, or `NA` --- Code - list_simplify(list(), simplify = FALSE, ptype = integer()) + list_simplify_internal(list(), simplify = FALSE, ptype = integer()) Condition - Error in `list_simplify()`: + Error in `list_simplify_internal()`: ! Must not specify `ptype` when `simplify = FALSE` diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R index 1b27939e..5c19fca8 100644 --- a/tests/testthat/test-list-simplify.R +++ b/tests/testthat/test-list-simplify.R @@ -1,44 +1,36 @@ -test_that("simplification requires vectors", { - expect_equal(list_simplify(list(mean)), list(mean)) -}) - -test_that("simplification requires length 1 inputs", { - expect_equal(list_simplify(list(1, 2:3)), list(1, 2:3)) - expect_equal(list_simplify(list(1, 2, 3)), c(1, 2, 3)) -}) - -test_that("simplification requires common type", { - expect_equal(list_simplify(list(1, 2)), c(1, 2)) - expect_equal(list_simplify(list(1, "a")), list(1, "a")) -}) +test_that("simplifies using vctrs principles", { + expect_identical(list_simplify(list(1, 2L)), c(1, 2)) + expect_equal(list_simplify(list("x", factor("y"))), c("x", "y")) -test_that("can simplify one-row data frames", { x <- list(data.frame(x = 1), data.frame(y = 2)) expect_equal(list_simplify(x), data.frame(x = c(1, NA), y = c(NA, 2))) }) -test_that("ptype is checked", { +test_that("ptype is enforced", { expect_equal(list_simplify(list(1, 2), ptype = double()), c(1, 2)) expect_snapshot(list_simplify(list(1, 2), ptype = character()), error = TRUE) -}) - -test_that("can suppress simplification", { - x <- list(1, 2) - expect_equal(list_simplify(x, simplify = FALSE), x) + # even if `strict = FALSE` + expect_snapshot(list_simplify(list(1, 2), ptype = character(), strict = FALSE), error = TRUE) }) test_that("strict simplification will error", { expect_snapshot(error = TRUE, { - list_simplify(list(1, "a"), simplify = TRUE) - list_simplify(list(1, 1:2), simplify = TRUE) - list_simplify(list(1, 2), simplify = TRUE, ptype = character()) + list_simplify(list(1, "a")) + list_simplify(list(1, 1:2)) + list_simplify(list(1, 2), ptype = character()) }) }) +test_that("simplification requires length-1 vectors with common type", { + expect_equal(list_simplify(list(mean), strict = FALSE), list(mean)) + expect_equal(list_simplify(list(1, 2:3), strict = FALSE), list(1, 2:3)) + expect_equal(list_simplify(list(1, "a"), strict = FALSE), list(1, "a")) +}) + # argument checking ------------------------------------------------------- test_that("validates inputs", { - expect_snapshot(list_simplify(1:5), error = TRUE) - expect_snapshot(list_simplify(list(), simplify = 1), error = TRUE) - expect_snapshot(list_simplify(list(), simplify = FALSE, ptype = integer()), error = TRUE) + expect_snapshot(list_simplify_internal(1:5), error = TRUE) + expect_snapshot(list_simplify_internal(list(), simplify = 1), error = TRUE) + expect_snapshot(list_simplify_internal(list(), simplify = FALSE, ptype = integer()), error = TRUE) }) From 8b32bfa05aa7fdacb158fc53c5e15acfe1a92c1a Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 9 Sep 2022 09:14:13 -0500 Subject: [PATCH 16/33] Deprecate as_vector(), simplify(), simplify_all() --- R/coercion.R | 58 ++++++++++++++++++------------- _pkgdown.yml | 1 - man/as_vector.Rd | 44 ++++++++++------------- man/lift.Rd | 9 ++--- tests/testthat/_snaps/coercion.md | 21 +++++++++++ tests/testthat/test-coercion.R | 13 +++++++ 6 files changed, 91 insertions(+), 55 deletions(-) create mode 100644 tests/testthat/_snaps/coercion.md diff --git a/R/coercion.R b/R/coercion.R index fee9fdd1..6f1b5135 100644 --- a/R/coercion.R +++ b/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) } diff --git a/_pkgdown.yml b/_pkgdown.yml index 5f929e18..c6a1cc87 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -97,7 +97,6 @@ reference: - title: Misc contents: - array_tree - - as_vector - rbernoulli - rate-helpers - rdunif diff --git a/man/as_vector.Rd b/man/as_vector.Rd index 84038d45..c21e807d 100644 --- a/man/as_vector.Rd +++ b/man/as_vector.Rd @@ -15,37 +15,31 @@ simplify_all(.x, .type = NULL) \arguments{ \item{.x}{A list of vectors} -\item{.type}{A vector mold or a string describing the type of the -input vectors. The latter can be any of the types returned by -\code{\link[=typeof]{typeof()}}, or "numeric" as a shorthand for either -"double" or "integer".} -} -\description{ -\code{as_vector()} collapses a list of vectors into one vector. It -checks that the type of each vector is consistent with -\code{.type}. If the list can not be simplified, it throws an error. -\code{simplify} will simplify a vector if possible; \code{simplify_all} -will apply \code{simplify} to every element of a list. -} -\details{ -\code{.type} can be a vector mold specifying both the type and the +\item{.type}{can be a vector mold specifying both the type and the length of the vectors to be concatenated, such as \code{numeric(1)} or \code{integer(4)}. Alternatively, it can be a string describing the type, one of: "logical", "integer", "double", "complex", -"character" or "raw". +"character" or "raw".} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +These functions are deprecated in favour of \code{list_simplify()}: +\itemize{ +\item \code{as_vector(x)} is now \code{list_simplify(x)} +\item \code{simplify(x)} is now \code{list_simplify(strict = FALSE)} +\item \code{simplify_all(x)} is \code{map(x, list_simplify, strict = FALSE)} +} } \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()) } +\keyword{internal} diff --git a/man/lift.Rd b/man/lift.Rd index 584bb649..bec8ed25 100644 --- a/man/lift.Rd +++ b/man/lift.Rd @@ -35,10 +35,11 @@ name the parameters in the lifted function signature. This prevents matching of arguments by name and match by position instead.} -\item{.type}{A vector mold or a string describing the type of the -input vectors. The latter can be any of the types returned by -\code{\link[=typeof]{typeof()}}, or "numeric" as a shorthand for either -"double" or "integer".} +\item{.type}{can be a vector mold specifying both the type and the +length of the vectors to be concatenated, such as \code{numeric(1)} +or \code{integer(4)}. Alternatively, it can be a string describing +the type, one of: "logical", "integer", "double", "complex", +"character" or "raw".} } \value{ A function. diff --git a/tests/testthat/_snaps/coercion.md b/tests/testthat/_snaps/coercion.md new file mode 100644 index 00000000..742c61aa --- /dev/null +++ b/tests/testthat/_snaps/coercion.md @@ -0,0 +1,21 @@ +# old simplification functions are deprecated + + Code + . <- as_vector(list(1, 2)) + Condition + Warning: + `as_vector()` was deprecated in purrr 0.4.0. + Please use `list_simplify()` instead. + Code + . <- simplify(list(1, 2)) + Condition + Warning: + `as_vector()` was deprecated in purrr 0.4.0. + Please use `list_simplify()` instead. + Code + . <- simplify_all(list(1, 2)) + Condition + Warning: + `as_vector()` was deprecated in purrr 0.4.0. + Please use map() + list_simplify() instead. + diff --git a/tests/testthat/test-coercion.R b/tests/testthat/test-coercion.R index ecf9aacb..44d634bc 100644 --- a/tests/testthat/test-coercion.R +++ b/tests/testthat/test-coercion.R @@ -1,8 +1,21 @@ +test_that("old simplification functions are deprecated", { + expect_snapshot({ + . <- as_vector(list(1, 2)) + . <- simplify(list(1, 2)) + . <- simplify_all(list(1, 2)) + }) +}) + + test_that("as_vector can be type-specifc", { + local_options(lifecycle_verbosity = "quiet") + expect_identical(as_vector(as.list(letters), "character"), letters) }) test_that("as_vector cannot coerce lists with zero-length elements", { + local_options(lifecycle_verbosity = "quiet") + x <- list(a = 1, b = c(list(), 3)) expect_error(as_vector(x)) expect_identical(x, simplify(x)) From a4f864dc728969ee26c60eec9f5f097bbd516c26 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 9 Sep 2022 09:18:32 -0500 Subject: [PATCH 17/33] Add news bullets --- NEWS.md | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/NEWS.md b/NEWS.md index 754f08da..49f24fbe 100644 --- a/NEWS.md +++ b/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). From 822d714f6b3be97cd38629a206701fec8f4219df Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 9 Sep 2022 09:22:32 -0500 Subject: [PATCH 18/33] Use cli for tests --- R/list-simplify.R | 4 ++-- tests/testthat/_snaps/list-simplify.md | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 9b164a63..0ddd9f5e 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -31,10 +31,10 @@ list_simplify_internal <- function( error_call = caller_env() ) { if (length(simplify) > 1 || !is.logical(simplify)) { - abort("`simplify` must be `TRUE`, `FALSE`, or `NA`") + cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.") } if (!is.null(ptype) && isFALSE(simplify)) { - abort("Must not specify `ptype` when `simplify = FALSE`") + cli::cli_abort("Must not specify {.arg ptype} when `simplify = FALSE`.") } if (isFALSE(simplify)) { diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 1124728c..92ed585f 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -54,7 +54,7 @@ list_simplify_internal(list(), simplify = 1) Condition Error in `list_simplify_internal()`: - ! `simplify` must be `TRUE`, `FALSE`, or `NA` + ! `simplify` must be `TRUE`, `FALSE`, or `NA`. --- @@ -62,5 +62,5 @@ list_simplify_internal(list(), simplify = FALSE, ptype = integer()) Condition Error in `list_simplify_internal()`: - ! Must not specify `ptype` when `simplify = FALSE` + ! Must not specify `ptype` when `simplify = FALSE`. From 525489680e6c8c8bd02acb7f4afa0bf75ee54d8f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 09:41:18 -0500 Subject: [PATCH 19/33] Apply suggestions from code review Co-authored-by: Lionel Henry --- R/list-simplify.R | 4 ++-- R/list-transpose.R | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 0ddd9f5e..d052bb3a 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -31,7 +31,7 @@ list_simplify_internal <- function( error_call = caller_env() ) { if (length(simplify) > 1 || !is.logical(simplify)) { - cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.") + cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", arg = "simplify") } if (!is.null(ptype) && isFALSE(simplify)) { cli::cli_abort("Must not specify {.arg ptype} when `simplify = FALSE`.") @@ -79,7 +79,7 @@ simplify_impl <- function( } else { if (strict) { cli::cli_abort( - "Failed to simplify {error_arg}: not all elements vectors of length 1.", + "Can't simplify {.arg {error_arg}} because all elements vectors must be length 1.", call = error_call ) } else { diff --git a/R/list-transpose.R b/R/list-transpose.R index d0f10de3..abc59316 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -1,7 +1,7 @@ #' Transpose a list #' #' @description -#' `list_transpose()` turns a list-of-lists "inside-out"; it turns a pair of +#' `list_transpose()` turns a list-of-lists "inside-out". For instance 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 @@ -14,7 +14,7 @@ #' @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? +#' @param simplify Should the result be [simplified][list_simplify]? #' * `TRUE`: simplify or die trying. #' * `NA`: simplify if possible. #' * `FALSE`: never try to simplify, always leaving as a list. @@ -59,7 +59,7 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa template <- template %||% names(x[[1]]) %||% - cli::cli_abort("First element of {.arg x} is unnamed, please supply {.arg template}.") + cli::cli_abort("Must supply either {.arg template} or a named {.arg x}.") if (!is.character(template)) { cli::cli_abort("{.arg template} must be a character vector.") } From e4311beba6955b9f68dbef0da2ef25c89e61ea61 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 09:45:54 -0500 Subject: [PATCH 20/33] Re-document --- man/list_transpose.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 5a8a3122..c6359a6c 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -12,7 +12,7 @@ list_transpose(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) \item{template}{A "template" that specifies the names of output list. Usually taken from the name of the first element of \code{x}.} -\item{simplify}{Should the result be simplified? +\item{simplify}{Should the result be \link[=list_simplify]{simplified}? \itemize{ \item \code{TRUE}: simplify or die trying. \item \code{NA}: simplify if possible. @@ -28,7 +28,7 @@ Alternatively, a named list specifying the prototype by output column.} Alternatively, a named list specifying the prototype by output column.} } \description{ -\code{list_transpose()} turns a list-of-lists "inside-out"; it turns a pair of +\code{list_transpose()} turns a list-of-lists "inside-out". For instance 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 \code{n} where each component had values \code{a} and \code{b}, \code{list_transpose()} would make a list with elements \code{a} and From 80fa90c3e3008ed4f7273909c8d55469f12fcacf Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 09:46:20 -0500 Subject: [PATCH 21/33] Error tweaking --- R/list-simplify.R | 4 ++-- tests/testthat/_snaps/list-simplify.md | 4 ++-- tests/testthat/_snaps/list-transpose.md | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index d052bb3a..1096361c 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -34,7 +34,7 @@ list_simplify_internal <- function( cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", arg = "simplify") } if (!is.null(ptype) && isFALSE(simplify)) { - cli::cli_abort("Must not specify {.arg ptype} when `simplify = FALSE`.") + cli::cli_abort("Can't specify {.arg ptype} when `simplify = FALSE`.") } if (isFALSE(simplify)) { @@ -63,7 +63,7 @@ simplify_impl <- function( if (can_simplify) { tryCatch( - vec_unchop(x, ptype = ptype), + list_unchop(x, ptype = ptype), vctrs_error_incompatible_type = function(err) { if (strict || !is.null(ptype)) { cli::cli_abort( diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 92ed585f..921829ea 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -31,7 +31,7 @@ list_simplify(list(1, 1:2)) Condition Error in `list_simplify()`: - ! Failed to simplify `x`: not all elements vectors of length 1. + ! Can't simplify `` `x` `` because all elements vectors must be length 1. Code list_simplify(list(1, 2), ptype = character()) Condition @@ -62,5 +62,5 @@ list_simplify_internal(list(), simplify = FALSE, ptype = integer()) Condition Error in `list_simplify_internal()`: - ! Must not specify `ptype` when `simplify = FALSE`. + ! Can't specify `ptype` when `simplify = FALSE`. diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 84de4103..3a73d28c 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -11,7 +11,7 @@ list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE) Condition Error in `list_transpose()`: - ! Failed to simplify output `x`: not all elements vectors of length 1. + ! Can't simplify `` output `x` `` because all elements vectors must be length 1. # can supply `simplify` globally or individually @@ -48,7 +48,7 @@ list_transpose(list(1)) Condition Error in `list_transpose()`: - ! First element of `x` is unnamed, please supply `template`. + ! Must supply either `template` or a named `x`. Code list_transpose(list(a = 1), template = 1) Condition From 41b2039eb4394410d853624dfdfedd1c88937a52 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 09:51:45 -0500 Subject: [PATCH 22/33] Simplify simplify errors --- R/list-simplify.R | 15 +++------------ R/list-transpose.R | 3 +-- R/reduce.R | 4 ++-- tests/testthat/_snaps/list-simplify.md | 22 +++++++--------------- tests/testthat/_snaps/list-transpose.md | 6 ++---- tests/testthat/_snaps/reduce.md | 4 +--- 6 files changed, 16 insertions(+), 38 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 1096361c..df498f04 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -27,7 +27,6 @@ list_simplify_internal <- function( x, simplify = NA, ptype = NULL, - error_arg = "x", error_call = caller_env() ) { if (length(simplify) > 1 || !is.logical(simplify)) { @@ -45,7 +44,6 @@ list_simplify_internal <- function( x, strict = !is.na(simplify), ptype = ptype, - error_arg = error_arg, error_call = error_call ) } @@ -54,7 +52,6 @@ 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) @@ -63,14 +60,11 @@ simplify_impl <- function( if (can_simplify) { tryCatch( + # TODO: use `error_call` when available list_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 - ) + cnd_signal(err) } else { x } @@ -78,10 +72,7 @@ simplify_impl <- function( ) } else { if (strict) { - cli::cli_abort( - "Can't simplify {.arg {error_arg}} because all elements vectors must be length 1.", - call = error_call - ) + cli::cli_abort("All elements must be length-1 vectors.", call = error_call) } else { x } diff --git a/R/list-transpose.R b/R/list-transpose.R index abc59316..a4e1f74d 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -73,8 +73,7 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa res <- map(x, nm, .default = default[[nm]]) res <- list_simplify_internal(res, simplify = simplify[[nm]] %||% NA, - ptype = ptype[[nm]], - error_arg = paste0("output `", nm, "`") + ptype = ptype[[nm]] ) out[[nm]] <- res } diff --git a/R/reduce.R b/R/reduce.R index a512c6b9..bc4af30a 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -465,14 +465,14 @@ accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .sim res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE) names(res) <- accumulate_names(names(.x), .init, .dir) - res <- list_simplify_internal(res, .simplify, .ptype, error_arg = "accumulated results") + res <- list_simplify_internal(res, .simplify, .ptype) res } #' @rdname accumulate #' @export 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 <- list_simplify_internal(res, .simplify, .ptype) res } diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 921829ea..0fde016f 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -3,9 +3,7 @@ Code list_simplify(list(1, 2), ptype = character()) Condition - Error in `list_simplify()`: - ! Failed to simplify `x`. - Caused by error: + Error: ! Can't convert to . --- @@ -13,9 +11,7 @@ Code list_simplify(list(1, 2), ptype = character(), strict = FALSE) Condition - Error in `list_simplify()`: - ! Failed to simplify `x`. - Caused by error: + Error: ! Can't convert to . # strict simplification will error @@ -23,21 +19,17 @@ Code list_simplify(list(1, "a")) Condition - Error in `list_simplify()`: - ! Failed to simplify `x`. - Caused by error: + Error: ! Can't combine `..1` and `..2` . Code list_simplify(list(1, 1:2)) Condition Error in `list_simplify()`: - ! Can't simplify `` `x` `` because all elements vectors must be length 1. + ! All elements must be length-1 vectors. Code list_simplify(list(1, 2), ptype = character()) Condition - Error in `list_simplify()`: - ! Failed to simplify `x`. - Caused by error: + Error: ! Can't convert to . # validates inputs @@ -45,8 +37,8 @@ Code list_simplify_internal(1:5) Condition - Error: - ! `x` must be a list, not an integer vector. + Error in `vec_check_list()`: + ! object 'error_arg' not found --- diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 3a73d28c..11342b5f 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -3,15 +3,13 @@ Code list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE) Condition - Error in `list_transpose()`: - ! Failed to simplify output `x`. - Caused by error: + Error: ! Can't combine `..1` and `..2` . Code list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE) Condition Error in `list_transpose()`: - ! Can't simplify `` output `x` `` because all elements vectors must be length 1. + ! All elements must be length-1 vectors. # can supply `simplify` globally or individually diff --git a/tests/testthat/_snaps/reduce.md b/tests/testthat/_snaps/reduce.md index 35cfb788..f178ae9b 100644 --- a/tests/testthat/_snaps/reduce.md +++ b/tests/testthat/_snaps/reduce.md @@ -3,9 +3,7 @@ Code accumulate(list(1, "a"), ~.y, .simplify = TRUE) Condition - Error in `accumulate()`: - ! Failed to simplify accumulated results. - Caused by error: + Error: ! Can't combine `..1` and `..2` . # right variants are retired From a7a41c8547acd79f01e6717afbe1807b75763664 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 09:58:34 -0500 Subject: [PATCH 23/33] More code review feedback --- R/list-transpose.R | 1 + tests/testthat/test-list-transpose.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index a4e1f74d..a2203f57 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -87,6 +87,7 @@ match_template <- function(x, template, error_arg = caller_arg(x), error_call = if (length(extra_names)) { cli::cli_abort( "{.arg {error_arg}} contains unknown names: {.str {extra_names}}", + arg = error_arg, call = error_call ) } diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index 2838b652..4df181a6 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -43,7 +43,7 @@ test_that("can supply `ptype` globally or individually", { list_transpose(x, ptype = integer()), list(a = c(1L, 3L), b = c(2L, 4L)) ) - expect_equal( + expect_identical( list_transpose(x, ptype = list(a = integer())), list(a = c(1L, 3L), b = c(2, 4)) ) From 45774738fe536230ac9cd50ce2c7420d735d0e6f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 13:48:33 -0500 Subject: [PATCH 24/33] Let list_transpose() work with numeric templates --- R/list-transpose.R | 64 +++++++++++++++++-------- R/map-df.R | 2 +- tests/testthat/_snaps/list-transpose.md | 25 +++++++--- tests/testthat/test-list-transpose.R | 64 ++++++++++++++++++++++++- 4 files changed, 124 insertions(+), 31 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index a2203f57..4da27ac4 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -57,42 +57,64 @@ list_transpose <- function(x, template = NULL, simplify = NA, ptype = NULL, defa return(list()) } - template <- template %||% - names(x[[1]]) %||% - cli::cli_abort("Must supply either {.arg template} or a named {.arg x}.") - if (!is.character(template)) { - cli::cli_abort("{.arg template} must be a character vector.") + template <- template %||% vec_index(x[[1]]) + if (!is.character(template) && !is.numeric(template)) { + cli::cli_abort( + "{.arg template} must be a character or numeric vector, not {.obj_type_friendly {template}}.", + arg = template + ) } 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]]) + out <- rep_along(template, list()) + if (is.character(template)) { + names(out) <- template + } + + for (i in seq_along(template)) { + idx <- template[[i]] + res <- map(x, idx, .default = default[[i]]) res <- list_simplify_internal(res, - simplify = simplify[[nm]] %||% NA, - ptype = ptype[[nm]] + simplify = simplify[[i]] %||% NA, + ptype = ptype[[i]] ) - out[[nm]] <- res + out[[i]] <- 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}}", - arg = error_arg, - call = error_call - ) + if (is.character(template)) { + 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}}", + arg = error_arg, + call = error_call + ) + } + + out <- rep_named(template, list(NULL)) + out[names(x)] <- x + out + } else { + rep_named(template, list(x)) + } + } else if (is.numeric(template)) { + if (is_bare_list(x) && length(x) > 0) { + if (length(x) != length(template)) { + cli::cli_abort("List {.arg {error_arg}} must be same length as numeric template") + } + x + } else { + rep_along(template, list(x)) } - x } else { - rep_named(template, list(x)) + abort("Invalid x", .internal = TRUE) } } diff --git a/R/map-df.R b/R/map-df.R index dbefd6b3..db6d0c7a 100644 --- a/R/map-df.R +++ b/R/map-df.R @@ -56,7 +56,7 @@ #' # now #' map2(arg1, arg2, ex_fun) %>% list_cbind() map_dfr <- function(.x, .f, ..., .id = NULL) { - lifecycle::deprecate_warn("0.4.0", "map_dfr()", I("`map()` + `list_rbind()`")) + lifecycle::deprecate_warn("0.4.0", "map_dfr()", I("`map()` + `list_rbind()`"), always = TRUE) check_installed("dplyr", "for `map_dfr()`.") .f <- as_mapper(.f, ...) diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 11342b5f..2d09e8ce 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -1,3 +1,19 @@ +# integer template requires exact length of list() simplify etc + + Code + list_transpose(x, ptype = list()) + Condition + Error: + ! Can't convert to . + +--- + + Code + list_transpose(x, ptype = list(integer())) + Condition + Error in `match_template()`: + ! List `ptype` must be same length as numeric template + # simplification fails silently unless requested Code @@ -43,13 +59,8 @@ Error in `list_transpose()`: ! `x` must be a list, not a number. Code - list_transpose(list(1)) - Condition - Error in `list_transpose()`: - ! Must supply either `template` or a named `x`. - Code - list_transpose(list(a = 1), template = 1) + list_transpose(list(1), template = mean) Condition Error in `list_transpose()`: - ! `template` must be a character vector. + ! `template` must be a character or numeric vector, not a function. diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index 4df181a6..aabd5c3a 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -8,6 +8,67 @@ test_that("transposing empty list returns empty list", { expect_equal(list_transpose(list()), list()) }) +test_that("can use character template", { + x <- list(list(a = 1, b = 2), list(b = 3, c = 4)) + # Default: + expect_equal( + list_transpose(x, default = NA), + list(a = c(1, NA), b = c(2, 3)) + ) + + # Change order + expect_equal( + list_transpose(x, c("b", "a"), default = NA), + list(b = c(2, 3), a = c(1, NA)) + ) + # Remove + expect_equal( + list_transpose(x, "b", default = NA), + list(b = c(2, 3)) + ) + # Add + expect_equal( + list_transpose(x, c("a", "b", "c"), default = NA), + list(a = c(1, NA), b = c(2, 3), c = c(NA, 4)) + ) +}) + +test_that("can use integer template", { + x <- list(list(1, 2, 3), list(4, 5)) + # Default: + expect_equal( + list_transpose(x, default = NA), + list(c(1, 4), c(2, 5), c(3, NA)) + ) + + # Change order + expect_equal( + list_transpose(x, c(3, 2, 1), default = NA), + list(c(3, NA), c(2, 5), c(1, 4)) + ) + # Remove + expect_equal( + list_transpose(x, 2, default = NA), + list(c(2, 5)) + ) + # Add + expect_equal( + list_transpose(x, 1:4, default = NA), + list(c(1, 4), c(2, 5), c(3, NA), c(NA, NA)) + ) +}) + +test_that("integer template requires exact length of list() simplify etc", { + x <- list(list(1, 2), list(3, 4)) + + expect_snapshot(list_transpose(x, ptype = list()), error = TRUE) + expect_snapshot(list_transpose(x, ptype = list(integer())), error = TRUE) + expect_identical( + list_transpose(x, ptype = list(integer(), integer())), + list(c(1L, 3L), c(2L, 4L)) + ) +}) + test_that("simplification fails silently unless requested", { expect_equal( list_transpose(list(list(x = 1), list(x = "b"))), @@ -66,7 +127,6 @@ test_that("can supply `default` globally or individually", { test_that("validates inputs", { expect_snapshot(error = TRUE, { list_transpose(10) - list_transpose(list(1)) - list_transpose(list(a = 1), template = 1) + list_transpose(list(1), template = mean) }) }) From 531994940e9ac8c38ec0ac676e2066126520ae98 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 13:50:32 -0500 Subject: [PATCH 25/33] Add more transpose examples --- R/list-transpose.R | 7 +++++++ man/list_transpose.Rd | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/R/list-transpose.R b/R/list-transpose.R index 4da27ac4..925bd4de 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -38,8 +38,14 @@ #' # 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() +#' # this makes list_tranpose() not completely symmetric +#' x %>% list_transpose() %>% list_transpose() +#' #' # use simplify = FALSE to always return lists: #' x %>% list_transpose(simplify = FALSE) %>% str() +#' x %>% +#' list_transpose(simplify = FALSE) %>% +#' list_transpose(simplify = FALSE) %>% str() #' #' # Provide explicit template if you know which elements you want to extract #' ll <- list( @@ -48,6 +54,7 @@ #' ) #' ll %>% list_transpose() #' ll %>% list_transpose(template = c("x", "y", "z")) +#' ll %>% list_transpose(template = 1) #' #' # And specify default if you want to simplify #' ll %>% list_transpose(c("x", "y", "z"), default = NA) diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index c6359a6c..3a04bdbc 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -51,8 +51,14 @@ 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() +# this makes list_tranpose() not completely symmetric +x \%>\% list_transpose() \%>\% list_transpose() + # use simplify = FALSE to always return lists: x \%>\% list_transpose(simplify = FALSE) \%>\% str() +x \%>\% + list_transpose(simplify = FALSE) \%>\% + list_transpose(simplify = FALSE) \%>\% str() # Provide explicit template if you know which elements you want to extract ll <- list( @@ -61,6 +67,7 @@ ll <- list( ) ll \%>\% list_transpose() ll \%>\% list_transpose(template = c("x", "y", "z")) +ll \%>\% list_transpose(template = 1) # And specify default if you want to simplify ll \%>\% list_transpose(c("x", "y", "z"), default = NA) From fcb92d69ed74c40db7d36159204b31e1fdb7bf39 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 13:51:54 -0500 Subject: [PATCH 26/33] Remove unnused error_arg --- R/list-simplify.R | 2 +- tests/testthat/_snaps/list-simplify.md | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index df498f04..f75875de 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -54,7 +54,7 @@ simplify_impl <- function( ptype = NULL, error_call = caller_env() ) { - vec_check_list(x, arg = error_arg, call = error_call) + vec_check_list(x, call = error_call) can_simplify <- every(x, vec_is, size = 1) diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 0fde016f..2680cc66 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -37,8 +37,8 @@ Code list_simplify_internal(1:5) Condition - Error in `vec_check_list()`: - ! object 'error_arg' not found + Error: + ! `x` must be a list, not an integer vector. --- From 2397f21736e94c68cb0dfef83e2468024807b1a6 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 14:36:11 -0500 Subject: [PATCH 27/33] Avoid offense to the delicate senisbilities of Lionel and Davis --- R/list-simplify.R | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index f75875de..90bc5077 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -23,11 +23,10 @@ list_simplify <- function(x, strict = TRUE, ptype = NULL) { } # Wrapper used by purrr functions that do automatic simplification -list_simplify_internal <- function( - x, - simplify = NA, - ptype = NULL, - error_call = caller_env() +list_simplify_internal <- function(x, + simplify = NA, + ptype = NULL, + error_call = caller_env() ) { if (length(simplify) > 1 || !is.logical(simplify)) { cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", arg = "simplify") @@ -48,12 +47,10 @@ list_simplify_internal <- function( ) } -simplify_impl <- function( - x, - strict = TRUE, - ptype = NULL, - error_call = caller_env() - ) { +simplify_impl <- function(x, + strict = TRUE, + ptype = NULL, + error_call = caller_env()) { vec_check_list(x, call = error_call) can_simplify <- every(x, vec_is, size = 1) From da1f7c9cc9a78063bc351bc7da7c8c4953d13cd8 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 16:58:08 -0500 Subject: [PATCH 28/33] Apply suggestions from code review Co-authored-by: Davis Vaughan --- R/coercion.R | 4 ++-- R/list-simplify.R | 3 +-- R/list-transpose.R | 22 +++++++++++----------- 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/R/coercion.R b/R/coercion.R index 6f1b5135..2b0186a9 100644 --- a/R/coercion.R +++ b/R/coercion.R @@ -6,11 +6,11 @@ #' 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(x)` is now `list_simplify(x, strict = FALSE)` #' * `simplify_all(x)` is `map(x, list_simplify, strict = FALSE)` #' #' @param .x A list of vectors -#' @param .type can be a vector mold specifying both the type and the +#' @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", diff --git a/R/list-simplify.R b/R/list-simplify.R index 90bc5077..9bf3dfb3 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -26,8 +26,7 @@ list_simplify <- function(x, strict = TRUE, ptype = NULL) { list_simplify_internal <- function(x, simplify = NA, ptype = NULL, - error_call = caller_env() - ) { + error_call = caller_env()) { if (length(simplify) > 1 || !is.logical(simplify)) { cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", arg = "simplify") } diff --git a/R/list-transpose.R b/R/list-transpose.R index 925bd4de..db448917 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -2,17 +2,17 @@ #' #' @description #' `list_transpose()` turns a list-of-lists "inside-out". For instance it turns a pair of -#' lists into a list of pairs, or a list of pairs into pair of lists. For +#' lists into a list of pairs, or a list of pairs into a 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. +#' `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 +#' `list_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. +#' @param template A "template" that specifies the names of the output list. #' Usually taken from the name of the first element of `x`. #' @param simplify Should the result be [simplified][list_simplify]? #' * `TRUE`: simplify or die trying. @@ -22,8 +22,8 @@ #' 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. +#' @param default A default value to use if a value is absent or `NULL`. +#' Alternatively, a named list specifying the default by output column. #' @export #' @examples #' # list_transpose() is useful in conjunction with safely() @@ -47,7 +47,7 @@ #' list_transpose(simplify = FALSE) %>% #' list_transpose(simplify = FALSE) %>% str() #' -#' # Provide explicit template if you know which elements you want to extract +#' # Provide an explicit template if you know which elements you want to extract #' ll <- list( #' list(x = 1, y = "one"), #' list(z = "deux", x = 2) @@ -56,7 +56,7 @@ #' ll %>% list_transpose(template = c("x", "y", "z")) #' ll %>% list_transpose(template = 1) #' -#' # And specify default if you want to simplify +#' # And specify a 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) @@ -100,7 +100,7 @@ match_template <- function(x, template, error_arg = caller_arg(x), error_call = extra_names <- setdiff(names(x), template) if (length(extra_names)) { cli::cli_abort( - "{.arg {error_arg}} contains unknown names: {.str {extra_names}}", + "{.arg {error_arg}} contains unknown names: {.str {extra_names}}.", arg = error_arg, call = error_call ) @@ -115,13 +115,13 @@ match_template <- function(x, template, error_arg = caller_arg(x), error_call = } else if (is.numeric(template)) { if (is_bare_list(x) && length(x) > 0) { if (length(x) != length(template)) { - cli::cli_abort("List {.arg {error_arg}} must be same length as numeric template") + cli::cli_abort("List {.arg {error_arg}} must be the same length as the numeric {.arg template}.") } x } else { rep_along(template, list(x)) } } else { - abort("Invalid x", .internal = TRUE) + abort("Invalid `template`", .internal = TRUE) } } From 0590ccffbfd81287cfb8cd9299ade4e8a8e9a811 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 16:58:42 -0500 Subject: [PATCH 29/33] Re-document & update snapshots --- man/as_vector.Rd | 4 ++-- man/lift.Rd | 2 +- man/list_transpose.Rd | 16 ++++++++-------- tests/testthat/_snaps/list-transpose.md | 8 ++++---- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/man/as_vector.Rd b/man/as_vector.Rd index c21e807d..12e6ab5d 100644 --- a/man/as_vector.Rd +++ b/man/as_vector.Rd @@ -15,7 +15,7 @@ simplify_all(.x, .type = NULL) \arguments{ \item{.x}{A list of vectors} -\item{.type}{can be a vector mold specifying both the type and the +\item{.type}{Can be a vector mold specifying both the type and the length of the vectors to be concatenated, such as \code{numeric(1)} or \code{integer(4)}. Alternatively, it can be a string describing the type, one of: "logical", "integer", "double", "complex", @@ -27,7 +27,7 @@ the type, one of: "logical", "integer", "double", "complex", These functions are deprecated in favour of \code{list_simplify()}: \itemize{ \item \code{as_vector(x)} is now \code{list_simplify(x)} -\item \code{simplify(x)} is now \code{list_simplify(strict = FALSE)} +\item \code{simplify(x)} is now \code{list_simplify(x, strict = FALSE)} \item \code{simplify_all(x)} is \code{map(x, list_simplify, strict = FALSE)} } } diff --git a/man/lift.Rd b/man/lift.Rd index bec8ed25..b80e6132 100644 --- a/man/lift.Rd +++ b/man/lift.Rd @@ -35,7 +35,7 @@ name the parameters in the lifted function signature. This prevents matching of arguments by name and match by position instead.} -\item{.type}{can be a vector mold specifying both the type and the +\item{.type}{Can be a vector mold specifying both the type and the length of the vectors to be concatenated, such as \code{numeric(1)} or \code{integer(4)}. Alternatively, it can be a string describing the type, one of: "logical", "integer", "double", "complex", diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 3a04bdbc..22d1fd40 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -9,7 +9,7 @@ list_transpose(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) \arguments{ \item{x}{A list of vectors to transpose.} -\item{template}{A "template" that specifies the names of output list. +\item{template}{A "template" that specifies the names of the output list. Usually taken from the name of the first element of \code{x}.} \item{simplify}{Should the result be \link[=list_simplify]{simplified}? @@ -24,18 +24,18 @@ Alternatively, a named list specifying the simplification by output column.} \item{ptype}{An optional vector prototype used to control the simplification. Alternatively, a named list specifying the prototype by output column.} -\item{default}{A default value to use if a value is absent of \code{NULL}. -Alternatively, a named list specifying the prototype by output column.} +\item{default}{A default value to use if a value is absent or \code{NULL}. +Alternatively, a named list specifying the default by output column.} } \description{ \code{list_transpose()} turns a list-of-lists "inside-out". For instance it turns a pair of -lists into a list of pairs, or a list of pairs into pair of lists. For +lists into a list of pairs, or a list of pairs into a pair of lists. For example, if you had a list of length \code{n} where each component had values \code{a} and \code{b}, \code{list_transpose()} would make a list with elements \code{a} and -\code{b} that contained lists of length n. +\code{b} that contained lists of length \code{n}. It's called transpose because \code{x[["a"]][["b"]]} is equivalent to -\code{transpose(x)[["b"]][["a"]]}, i.e. transposing a list flips the order of +\code{list_transpose(x)[["b"]][["a"]]}, i.e. transposing a list flips the order of indices in a similar way to transposing a matrix. } \examples{ @@ -60,7 +60,7 @@ x \%>\% list_transpose(simplify = FALSE) \%>\% list_transpose(simplify = FALSE) \%>\% str() -# Provide explicit template if you know which elements you want to extract +# Provide an explicit template if you know which elements you want to extract ll <- list( list(x = 1, y = "one"), list(z = "deux", x = 2) @@ -69,6 +69,6 @@ ll \%>\% list_transpose() ll \%>\% list_transpose(template = c("x", "y", "z")) ll \%>\% list_transpose(template = 1) -# And specify default if you want to simplify +# And specify a default if you want to simplify ll \%>\% list_transpose(c("x", "y", "z"), default = NA) } diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 2d09e8ce..f2ccd22e 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -12,7 +12,7 @@ list_transpose(x, ptype = list(integer())) Condition Error in `match_template()`: - ! List `ptype` must be same length as numeric template + ! List `ptype` must be the same length as the numeric `template`. # simplification fails silently unless requested @@ -33,7 +33,7 @@ list_transpose(x, simplify = list(c = FALSE)) Condition Error in `list_transpose()`: - ! `simplify` contains unknown names: "c" + ! `simplify` contains unknown names: "c". # can supply `ptype` globally or individually @@ -41,7 +41,7 @@ list_transpose(x, ptype = list(c = integer())) Condition Error in `list_transpose()`: - ! `ptype` contains unknown names: "c" + ! `ptype` contains unknown names: "c". # can supply `default` globally or individually @@ -49,7 +49,7 @@ list_transpose(x, default = list(c = NA)) Condition Error in `list_transpose()`: - ! `default` contains unknown names: "c" + ! `default` contains unknown names: "c". # validates inputs From 99c925ed0f0b0f372c164b30a5fb84cba7f3b20f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 17:05:29 -0500 Subject: [PATCH 30/33] Improve list_simplify() errors + docs --- R/list-simplify.R | 22 ++++++++++++++++++---- man/list_simplify.Rd | 6 ++---- tests/testthat/_snaps/list-simplify.md | 12 ++++++++++-- tests/testthat/test-list-simplify.R | 2 ++ 4 files changed, 32 insertions(+), 10 deletions(-) diff --git a/R/list-simplify.R b/R/list-simplify.R index 9bf3dfb3..aa98a37e 100644 --- a/R/list-simplify.R +++ b/R/list-simplify.R @@ -1,6 +1,5 @@ #' 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 @@ -8,7 +7,8 @@ #' #' @param x A list. #' @param strict What should happen if simplification fails? If `TRUE`, -#' will error. If `FALSE`, will return `x` unchanged. +#' it will error. If `FALSE` and `ptype` is not supplied, it 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`. @@ -19,6 +19,12 @@ #' try(list_simplify(list(1, 2, "x"))) #' try(list_simplify(list(1, 2, 1:3))) list_simplify <- function(x, strict = TRUE, ptype = NULL) { + if (!is_bool(strict)) { + cli::cli_abort( + "{.arg strict} must be `TRUE` or `FALSE`, not {.obj_type_friendly {strict}}." + ) + } + simplify_impl(x, strict = strict, ptype = ptype) } @@ -28,10 +34,18 @@ list_simplify_internal <- function(x, ptype = NULL, error_call = caller_env()) { if (length(simplify) > 1 || !is.logical(simplify)) { - cli::cli_abort("{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", arg = "simplify") + cli::cli_abort( + "{.arg simplify} must be `TRUE`, `FALSE`, or `NA`.", + arg = "simplify", + call = error_call + ) } if (!is.null(ptype) && isFALSE(simplify)) { - cli::cli_abort("Can't specify {.arg ptype} when `simplify = FALSE`.") + cli::cli_abort( + "Can't specify {.arg ptype} when `simplify = FALSE`.", + arg = "ptype", + call = error_call + ) } if (isFALSE(simplify)) { diff --git a/man/list_simplify.Rd b/man/list_simplify.Rd index a1df162f..a113fb71 100644 --- a/man/list_simplify.Rd +++ b/man/list_simplify.Rd @@ -10,7 +10,8 @@ list_simplify(x, strict = TRUE, ptype = NULL) \item{x}{A list.} \item{strict}{What should happen if simplification fails? If \code{TRUE}, -will error. If \code{FALSE}, will return \code{x} unchanged.} +it will error. If \code{FALSE} and \code{ptype} is not supplied, it will return \code{x} +unchanged.} \item{ptype}{An optional prototype to ensure that the output type is always the same.} @@ -19,9 +20,6 @@ the same.} A vector the same length as \code{x}. } \description{ -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 \code{x} must contain a vector of length 1. If you don't want to maintain this correspondence, then you diff --git a/tests/testthat/_snaps/list-simplify.md b/tests/testthat/_snaps/list-simplify.md index 2680cc66..b4fee48a 100644 --- a/tests/testthat/_snaps/list-simplify.md +++ b/tests/testthat/_snaps/list-simplify.md @@ -45,7 +45,7 @@ Code list_simplify_internal(list(), simplify = 1) Condition - Error in `list_simplify_internal()`: + Error: ! `simplify` must be `TRUE`, `FALSE`, or `NA`. --- @@ -53,6 +53,14 @@ Code list_simplify_internal(list(), simplify = FALSE, ptype = integer()) Condition - Error in `list_simplify_internal()`: + Error: ! Can't specify `ptype` when `simplify = FALSE`. +--- + + Code + list_simplify(list(), strict = NA) + Condition + Error in `list_simplify()`: + ! `strict` must be `TRUE` or `FALSE`, not `NA`. + diff --git a/tests/testthat/test-list-simplify.R b/tests/testthat/test-list-simplify.R index 5c19fca8..801b426e 100644 --- a/tests/testthat/test-list-simplify.R +++ b/tests/testthat/test-list-simplify.R @@ -33,4 +33,6 @@ test_that("validates inputs", { expect_snapshot(list_simplify_internal(1:5), error = TRUE) expect_snapshot(list_simplify_internal(list(), simplify = 1), error = TRUE) expect_snapshot(list_simplify_internal(list(), simplify = FALSE, ptype = integer()), error = TRUE) + + expect_snapshot(list_simplify(list(), strict = NA), error = TRUE) }) From 808568b6633d89eff859ea425e0891d9123e6100 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 17:13:01 -0500 Subject: [PATCH 31/33] list_transpose() improvements --- R/list-transpose.R | 25 +++++++++++++++++-------- man/list_transpose.Rd | 14 +++++++++----- tests/testthat/_snaps/list-transpose.md | 4 ++-- 3 files changed, 28 insertions(+), 15 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index db448917..b2f0cd51 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -12,18 +12,22 @@ #' 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 the output list. -#' Usually taken from the name of the first element of `x`. +#' @param template A "template" that describes the output list. Can either be +#' a character vector (where elements are extracted by name), or an integer +#' vector (where elements are extracted by position). Defaults to the names +#' of the first element of `x`, or if they're not present, the integer +#' indices. #' @param simplify Should the result be [simplified][list_simplify]? #' * `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. +#' Alternatively, a named list specifying the simplification by output +#' element. #' @param ptype An optional vector prototype used to control the simplification. -#' Alternatively, a named list specifying the prototype by output column. +#' Alternatively, a named list specifying the prototype by output element. #' @param default A default value to use if a value is absent or `NULL`. -#' Alternatively, a named list specifying the default by output column. +#' Alternatively, a named list specifying the default by output element. #' @export #' @examples #' # list_transpose() is useful in conjunction with safely() @@ -60,11 +64,13 @@ #' 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 <- integer() + } else { + template <- template %||% vec_index(x[[1]]) } - template <- template %||% vec_index(x[[1]]) if (!is.character(template) && !is.numeric(template)) { cli::cli_abort( "{.arg template} must be a character or numeric vector, not {.obj_type_friendly {template}}.", @@ -115,7 +121,10 @@ match_template <- function(x, template, error_arg = caller_arg(x), error_call = } else if (is.numeric(template)) { if (is_bare_list(x) && length(x) > 0) { if (length(x) != length(template)) { - cli::cli_abort("List {.arg {error_arg}} must be the same length as the numeric {.arg template}.") + cli::cli_abort( + "Length of {.arg {error_arg}} ({length(x)}) and {.arg template} ({length(template)}) must be the same when transposing by position.", + call = error_call + ) } x } else { diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 22d1fd40..ee0a5e11 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -9,8 +9,11 @@ list_transpose(x, template = NULL, simplify = NA, ptype = NULL, default = NULL) \arguments{ \item{x}{A list of vectors to transpose.} -\item{template}{A "template" that specifies the names of the output list. -Usually taken from the name of the first element of \code{x}.} +\item{template}{A "template" that describes the output list. Can either be +a character vector (where elements are extracted by name), or an integer +vector (where elements are extracted by position). Defaults to the names +of the first element of \code{x}, or if they're not present, the integer +indices.} \item{simplify}{Should the result be \link[=list_simplify]{simplified}? \itemize{ @@ -19,13 +22,14 @@ Usually taken from the name of the first element of \code{x}.} \item \code{FALSE}: never try to simplify, always leaving as a list. } -Alternatively, a named list specifying the simplification by output column.} +Alternatively, a named list specifying the simplification by output +element.} \item{ptype}{An optional vector prototype used to control the simplification. -Alternatively, a named list specifying the prototype by output column.} +Alternatively, a named list specifying the prototype by output element.} \item{default}{A default value to use if a value is absent or \code{NULL}. -Alternatively, a named list specifying the default by output column.} +Alternatively, a named list specifying the default by output element.} } \description{ \code{list_transpose()} turns a list-of-lists "inside-out". For instance it turns a pair of diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index f2ccd22e..aa8b5ebf 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -11,8 +11,8 @@ Code list_transpose(x, ptype = list(integer())) Condition - Error in `match_template()`: - ! List `ptype` must be the same length as the numeric `template`. + Error in `list_transpose()`: + ! Length of `ptype` (1) and `template` (2) must be the same when transposing by position. # simplification fails silently unless requested From 2c5866ace597cbc9856c9776f04b4acf0e75efcf Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 17:13:06 -0500 Subject: [PATCH 32/33] Tweak docs --- R/reduce.R | 4 ++-- man/accumulate.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/reduce.R b/R/reduce.R index bc4af30a..8f2b912a 100644 --- a/R/reduce.R +++ b/R/reduce.R @@ -349,8 +349,8 @@ seq_len2 <- function(start, end) { #' 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. +#' @param .ptype If `simplify` is `NA` or `TRUE`, optionally supply a vector +#' prototype to enforce the output type. #' @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 diff --git a/man/accumulate.Rd b/man/accumulate.Rd index 63a59d69..9d0bed43 100644 --- a/man/accumulate.Rd +++ b/man/accumulate.Rd @@ -51,8 +51,8 @@ results is simplified to an atomic vector if possible. If \code{TRUE}, the result is simplified, erroring if not possible. If \code{FALSE}, the result is not simplified, always returning a list.} -\item{.ptype}{If \code{simplify} is \code{TRUE}, optionally supply a vector prototype -to enforce the output types.} +\item{.ptype}{If \code{simplify} is \code{NA} or \code{TRUE}, optionally supply a vector +prototype to enforce the output type.} \item{.y}{For \code{accumulate2()} \code{.y} is the second argument of the pair. It needs to be 1 element shorter than the vector to be accumulated (\code{.x}). From 78938f73e1323f40bbf1290bd820d64a5ea74ae9 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 12 Sep 2022 17:13:30 -0500 Subject: [PATCH 33/33] Move accidental change --- R/map-df.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/map-df.R b/R/map-df.R index db6d0c7a..dbefd6b3 100644 --- a/R/map-df.R +++ b/R/map-df.R @@ -56,7 +56,7 @@ #' # now #' map2(arg1, arg2, ex_fun) %>% list_cbind() map_dfr <- function(.x, .f, ..., .id = NULL) { - lifecycle::deprecate_warn("0.4.0", "map_dfr()", I("`map()` + `list_rbind()`"), always = TRUE) + lifecycle::deprecate_warn("0.4.0", "map_dfr()", I("`map()` + `list_rbind()`")) check_installed("dplyr", "for `map_dfr()`.") .f <- as_mapper(.f, ...)