From 9a82a564f638ee79d8c2e6942228868f5f879898 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Sat, 27 Aug 2022 13:54:08 -0500 Subject: [PATCH 01/23] Implement map_vec() Fixes #435 --- NAMESPACE | 4 ++++ R/map.R | 24 ++++++++++++++++++++++++ man/map.Rd | 9 +++++++++ tests/testthat/_snaps/map.md | 24 ++++++++++++++++++++++++ tests/testthat/test-map.R | 29 +++++++++++++++++++++++++++++ 5 files changed, 90 insertions(+) create mode 100644 tests/testthat/_snaps/map.md diff --git a/NAMESPACE b/NAMESPACE index beb426f2..bc58c2f7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -160,6 +160,7 @@ export(map_if) export(map_int) export(map_lgl) export(map_raw) +export(map_vec) export(modify) export(modify2) export(modify_at) @@ -213,4 +214,7 @@ export(zap) import(rlang) import(vctrs) importFrom(magrittr,"%>%") +importFrom(vctrs,vec_c) +importFrom(vctrs,vec_ptype_common) +importFrom(vctrs,vec_size) useDynLib(purrr, .registration = TRUE) diff --git a/R/map.R b/R/map.R index 849289d5..fde35569 100644 --- a/R/map.R +++ b/R/map.R @@ -11,6 +11,9 @@ #' * `map_lgl()`, `map_int()`, `map_dbl()` and `map_chr()` return an #' atomic vector of the indicated type (or die trying). #' +#' * `map_vec()` simplifies to the common type of the output. It works with +#' most types of simple vectors like Date, POSIXct, factors, etc. +#' #' * `map_dfr()` and `map_dfc()` return a data frame created by #' row-binding and column-binding respectively. They require dplyr #' to be installed. `map_df()` is an alias for `map_dfr()`. @@ -218,6 +221,27 @@ map_raw <- function(.x, .f, ...) { .Call(map_impl, environment(), ".x", ".f", "raw") } + +#' @rdname map +#' @param .ptype If `NULL`, the default, the output type is the common type +#' of the elements of the result. Otherwise, supply a "prototype" giving +#' the desired type of output. +#' @importFrom vctrs vec_c vec_size vec_ptype_common +#' @export +map_vec <- function(.x, .f, ..., .ptype = NULL) { + out <- map(.x, .f, ...) + + .ptype <- vec_ptype_common(!!!out, .ptype = .ptype) + for (i in seq_along(out)) { + if (vec_size(out[[i]]) != 1L) { + stop_bad_element_vector(out[[i]], i, .ptype, 1L, what = "Result") + } + } + + vec_c(!!!out, .ptype = .ptype) +} + + #' @rdname map #' @param .id Either a string or `NULL`. If a string, the output will contain #' a variable with that name, storing either the name (if `.x` is named) or diff --git a/man/map.Rd b/man/map.Rd index d471740d..b46ced66 100644 --- a/man/map.Rd +++ b/man/map.Rd @@ -7,6 +7,7 @@ \alias{map_int} \alias{map_dbl} \alias{map_raw} +\alias{map_vec} \alias{map_dfr} \alias{map_df} \alias{map_dfc} @@ -25,6 +26,8 @@ map_dbl(.x, .f, ...) map_raw(.x, .f, ...) +map_vec(.x, .f, ..., .ptype = NULL) + map_dfr(.x, .f, ..., .id = NULL) map_dfc(.x, .f, ...) @@ -59,6 +62,10 @@ present, the value of \code{.default} will be returned.} \item{...}{Additional arguments passed on to the mapped function.} +\item{.ptype}{If \code{NULL}, the default, the output type is the common type +of the elements of the result. Otherwise, supply a "prototype" giving +the desired type of output.} + \item{.id}{Either a string or \code{NULL}. If a string, the output will contain a variable with that name, storing either the name (if \code{.x} is named) or the index (if \code{.x} is unnamed) of the input. If \code{NULL}, the default, no @@ -91,6 +98,8 @@ each element of a list or atomic vector and returning an object of the same leng versions that return an object of the same type as the input. \item \code{map_lgl()}, \code{map_int()}, \code{map_dbl()} and \code{map_chr()} return an atomic vector of the indicated type (or die trying). +\item \code{map_vec()} simplifies to the common type of the output. It works with +most types of simple vectors like Date, POSIXct, factors, etc. \item \code{map_dfr()} and \code{map_dfc()} return a data frame created by row-binding and column-binding respectively. They require dplyr to be installed. \code{map_df()} is an alias for \code{map_dfr()}. diff --git a/tests/testthat/_snaps/map.md b/tests/testthat/_snaps/map.md new file mode 100644 index 00000000..303b290c --- /dev/null +++ b/tests/testthat/_snaps/map.md @@ -0,0 +1,24 @@ +# requires output be length 1 + + Code + map_vec(1:2, ~ rep(1, .x)) + Condition + Error in `stop_bad_type()`: + ! Result 2 must be a single double, not a double vector of length 2 + +# requires common type of output + + Code + map_vec(1:2, ~ if (.x == 1) factor("x") else 1) + Condition + Error in `map_vec()`: + ! Can't combine `..1` > and `..2` . + +# can enforce .ptype + + Code + map_vec(1:2, ~ factor("x"), .ptype = integer()) + Condition + Error: + ! Can't convert > to . + diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index d832fcda..b2e8c814 100644 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -170,3 +170,32 @@ test_that("map() with empty input copies names", { expect_identical(map_chr(named_list, identity), named(chr())) expect_identical(map_raw(named_list, identity), named(raw())) }) + + +# map_vec ----------------------------------------------------------------- + +test_that("still iterates using [[", { + df <- data.frame(x = 1, y = 2, z = 3) + expect_equal(map_vec(df, length), c(x = 1, y = 1, z = 1)) +}) + +test_that("requires output be length 1", { + expect_snapshot(error = TRUE, { + map_vec(1:2, ~ rep(1, .x)) + }) +}) + +test_that("requires common type of output", { + out <- map_vec(1:2, ~ factor("x")) + expect_equal(out, factor(c("x", "x"))) + + expect_snapshot(error = TRUE, { + map_vec(1:2, ~ if (.x == 1) factor("x") else 1) + }) +}) + +test_that("can enforce .ptype", { + expect_snapshot(error = TRUE, { + map_vec(1:2, ~ factor("x"), .ptype = integer()) + }) +}) From 194828f6853db2e2d1c56a1b6d75768f8067728d Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 29 Aug 2022 16:06:24 -0500 Subject: [PATCH 02/23] Implementation feedback --- R/map.R | 12 +++++++----- tests/testthat/test-map.R | 6 ++++++ 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/map.R b/R/map.R index fde35569..8c45a85d 100644 --- a/R/map.R +++ b/R/map.R @@ -232,13 +232,15 @@ map_vec <- function(.x, .f, ..., .ptype = NULL) { out <- map(.x, .f, ...) .ptype <- vec_ptype_common(!!!out, .ptype = .ptype) - for (i in seq_along(out)) { - if (vec_size(out[[i]]) != 1L) { - stop_bad_element_vector(out[[i]], i, .ptype, 1L, what = "Result") - } + bad_sizes <- which(list_sizes(out) != 1L) + if (length(bad_sizes) >= 1) { + i <- bad_sizes[[1L]] + stop_bad_element_vector(out[[i]], i, .ptype, 1L, what = "Result") } - vec_c(!!!out, .ptype = .ptype) + out <- vec_set_names(out, NULL) + out <- vec_unchop(out, ptype = .ptype) + vec_set_names(out, names(.x)) } diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index b2e8c814..067a4b24 100644 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -199,3 +199,9 @@ test_that("can enforce .ptype", { map_vec(1:2, ~ factor("x"), .ptype = integer()) }) }) + +test_that("preserves names of input", { + x <- c(x = 1, y = 2) + out <- map_vec(x, ~ set_names(1, letters[.x])) + expect_named(out, c("x", "y")) +}) From 7733dc1176b68c4e296ad18616b9d040346e75c1 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 29 Aug 2022 16:08:45 -0500 Subject: [PATCH 03/23] Add tests to clarify behaviour --- tests/testthat/test-map.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index 067a4b24..438b57f6 100644 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -185,6 +185,16 @@ test_that("requires output be length 1", { }) }) +test_that("row-binds data frame output", { + out <- map_vec(1:2, ~ data.frame(x = .x)) + expect_equal(out, data.frame(x = 1:2)) +}) + +test_that("concatenates list output", { + out <- map_vec(1:2, ~ list(.x)) + expect_equal(out, list(1, 2)) +}) + test_that("requires common type of output", { out <- map_vec(1:2, ~ factor("x")) expect_equal(out, factor(c("x", "x"))) From 63119fd78ec609d2ff444cf4c945d616cbd06bd7 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 14 Sep 2022 15:48:37 -0500 Subject: [PATCH 04/23] Use new simplify tooling --- R/map.R | 12 +----------- tests/testthat/_snaps/map.md | 9 +++------ 2 files changed, 4 insertions(+), 17 deletions(-) diff --git a/R/map.R b/R/map.R index d4d79900..5de27373 100644 --- a/R/map.R +++ b/R/map.R @@ -144,17 +144,7 @@ map_int <- function(.x, .f, ..., .progress = FALSE) { #' @export map_vec <- function(.x, .f, ..., .ptype = NULL) { out <- map(.x, .f, ...) - - .ptype <- vec_ptype_common(!!!out, .ptype = .ptype) - bad_sizes <- which(list_sizes(out) != 1L) - if (length(bad_sizes) >= 1) { - i <- bad_sizes[[1L]] - stop_bad_element_vector(out[[i]], i, .ptype, 1L, what = "Result") - } - - out <- vec_set_names(out, NULL) - out <- vec_unchop(out, ptype = .ptype) - vec_set_names(out, names(.x)) + simplify_impl(out, ptype = .ptype) } diff --git a/tests/testthat/_snaps/map.md b/tests/testthat/_snaps/map.md index 503022f6..1037a4b7 100644 --- a/tests/testthat/_snaps/map.md +++ b/tests/testthat/_snaps/map.md @@ -27,15 +27,15 @@ Code map_vec(1:2, ~ rep(1, .x)) Condition - Error in `stop_bad_element_vector()`: - ! could not find function "stop_bad_element_vector" + Error in `map_vec()`: + ! All elements must be length-1 vectors. # requires common type of output Code map_vec(1:2, ~ if (.x == 1) factor("x") else 1) Condition - Error in `map_vec()`: + Error: ! Can't combine `..1` > and `..2` . # can enforce .ptype @@ -43,9 +43,6 @@ Code map_vec(1:2, ~ factor("x"), .ptype = integer()) Condition - Warning: - `vec_unchop()` was deprecated in vctrs 0.5.0. - Please use `list_unchop()` instead. Error: ! Can't convert > to . From 0aff22d36c44bcd7bb3808995096a2de1e98fec4 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 14 Sep 2022 15:48:52 -0500 Subject: [PATCH 05/23] Remove unneeded import --- NAMESPACE | 3 --- R/map.R | 1 - 2 files changed, 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 365472d1..850ceffa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -221,7 +221,4 @@ import(vctrs) importFrom(cli,cli_progress_bar) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") -importFrom(vctrs,vec_c) -importFrom(vctrs,vec_ptype_common) -importFrom(vctrs,vec_size) useDynLib(purrr, .registration = TRUE) diff --git a/R/map.R b/R/map.R index 5de27373..f6addfa0 100644 --- a/R/map.R +++ b/R/map.R @@ -140,7 +140,6 @@ map_int <- function(.x, .f, ..., .progress = FALSE) { #' @param .ptype If `NULL`, the default, the output type is the common type #' of the elements of the result. Otherwise, supply a "prototype" giving #' the desired type of output. -#' @importFrom vctrs vec_c vec_size vec_ptype_common #' @export map_vec <- function(.x, .f, ..., .ptype = NULL) { out <- map(.x, .f, ...) From 5671d9d4867fd5fb962bd10fd1e5328008d1edfb Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 10:10:18 -0500 Subject: [PATCH 06/23] Update snapshot --- tests/testthat/_snaps/map.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/map.md b/tests/testthat/_snaps/map.md index 1037a4b7..1e11567b 100644 --- a/tests/testthat/_snaps/map.md +++ b/tests/testthat/_snaps/map.md @@ -28,7 +28,8 @@ map_vec(1:2, ~ rep(1, .x)) Condition Error in `map_vec()`: - ! All elements must be length-1 vectors. + ! All elements must be size 1. + i `out[[2]]` is size 2. # requires common type of output From 4d5b102afad2d6d034027355164fbaf2117d5b8f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 11:44:06 -0500 Subject: [PATCH 07/23] Update modify and modify_at --- NAMESPACE | 9 ---- NEWS.md | 2 + R/modify.R | 84 +++++++++++---------------------- tests/testthat/_snaps/modify.md | 23 +++++++++ tests/testthat/test-modify.R | 18 +++---- 5 files changed, 59 insertions(+), 77 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 850ceffa..911f6f9d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,22 +4,13 @@ S3method(as_mapper,character) S3method(as_mapper,default) S3method(as_mapper,list) S3method(as_mapper,numeric) -S3method(modify,character) S3method(modify,default) -S3method(modify,double) -S3method(modify,integer) -S3method(modify,logical) -S3method(modify,pairlist) S3method(modify2,character) S3method(modify2,default) S3method(modify2,double) S3method(modify2,integer) S3method(modify2,logical) -S3method(modify_at,character) S3method(modify_at,default) -S3method(modify_at,double) -S3method(modify_at,integer) -S3method(modify_at,logical) S3method(modify_if,character) S3method(modify_if,default) S3method(modify_if,double) diff --git a/NEWS.md b/NEWS.md index 2d8d4b47..cbffd9da 100644 --- a/NEWS.md +++ b/NEWS.md @@ -155,6 +155,8 @@ ## Minor improvements and bug fixes +* `modify()` no longer supports modifying calls or pairlists. + * `modify_depth()` is no longer a generic. This makes it more consistent with `map_depth()`. diff --git a/R/modify.R b/R/modify.R index 981f3ed7..d5a85456 100644 --- a/R/modify.R +++ b/R/modify.R @@ -93,39 +93,20 @@ modify <- function(.x, .f, ...) { modify.default <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) - for (i in seq_along(.x)) { - list_slice2(.x, i) <- .f(.x[[i]], ...) + if (is.null(.x)) { + NULL + } else if (vec_is_list(.x) || is.data.frame(.x)) { + out <- map(vec_proxy(.x), .f, ...) + vec_restore(out, .x) + } else if (vec_is(.x)) { + map_vec(.x, .f, ..., .ptype = .x) + } else if (is.list(x)) { + .x[] <- map(.x, .f, ...) + .x + } else { + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") } - - .x -} -# TODO: Replace all the following methods with a generic strategy that -# implements sane coercion rules for base vectors -#' @export -modify.integer <- function (.x, .f, ...) { - .x[] <- map_int(.x, .f, ...) - .x -} -#' @export -modify.double <- function (.x, .f, ...) { - .x[] <- map_dbl(.x, .f, ...) - .x } -#' @export -modify.character <- function (.x, .f, ...) { - .x[] <- map_chr(.x, .f, ...) - .x -} -#' @export -modify.logical <- function (.x, .f, ...) { - .x[] <- map_lgl(.x, .f, ...) - .x -} -#' @export -modify.pairlist <- function(.x, .f, ...) { - as.pairlist(map(.x, .f, ...)) -} - # modify_if --------------------------------------------------------------- @@ -195,31 +176,22 @@ modify_at <- function(.x, .at, .f, ...) { #' @export modify_at.default <- function(.x, .at, .f, ...) { where <- where_at(.x, .at) - modify_if(.x, where, .f, ...) -} -#' @export -modify_at.integer <- function(.x, .at, .f, ...) { - where <- where_at(.x, .at) - .x[where] <- map_int(.x[where], .f, ...) - .x -} -#' @export -modify_at.double <- function(.x, .at, .f, ...) { - where <- where_at(.x, .at) - .x[where] <- map_dbl(.x[where], .f, ...) - .x -} -#' @export -modify_at.character <- function(.x, .at, .f, ...) { - where <- where_at(.x, .at) - .x[where] <- map_chr(.x[where], .f, ...) - .x -} -#' @export -modify_at.logical <- function(.x, .at, .f, ...) { - where <- where_at(.x, .at) - .x[where] <- map_lgl(.x[where], .f, ...) - .x + + if (is.null(.x)) { + NULL + } else if (vec_is_list(.x) || is.data.frame(.x)) { + out <- vec_proxy(.x) + out[where] <- map(out[where], .f, ...) + vec_restore(out, .x) + } else if (vec_is(.x)) { + .x[where] <- map_vec(.x[where], .f, ..., .ptype = .x) + .x + } else if (is.list(x)) { + .x[where] <- map(.x[where], .f, ...) + .x + } else { + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") + } } # modify2 ----------------------------------------------------------------- diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index 8d6606ff..71bf3e86 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -1,3 +1,26 @@ +# modify() and variants implement sane coercion rules for base vectors + + Code + modify(1:3, ~"foo") + Condition + Error: + ! Can't convert to . + Code + modify_at(1:3, 1, ~"foo") + Condition + Error: + ! Can't convert to . + Code + modify_if(1:3, is_integer, ~"foo") + Condition + Error: + ! Can't coerce element 1 from a character to a integer + Code + modify2(1:3, "foo", ~.y) + Condition + Error: + ! Can't coerce element 1 from a character to a integer + # modify_if() requires predicate functions Code diff --git a/tests/testthat/test-modify.R b/tests/testthat/test-modify.R index af6a4bde..9410ba6a 100644 --- a/tests/testthat/test-modify.R +++ b/tests/testthat/test-modify.R @@ -25,14 +25,6 @@ test_that("negative .at omits locations", { expect_equal(out, list(1, 4, 6)) }) -test_that("modify works with calls and pairlists", { - out <- modify(quote(f(x)), ~ quote(z)) - expect_equal(out, quote(z(z))) - - out <- modify(pairlist(1, 2), ~ . + 1) - expect_equal(out, pairlist(2, 3)) -}) - test_that("modify{,_at,_if} preserves atomic vector classes", { expect_type(modify("a", identity), "character") expect_type(modify(1L, identity), "integer") @@ -51,10 +43,12 @@ test_that("modify{,_at,_if} preserves atomic vector classes", { }) test_that("modify() and variants implement sane coercion rules for base vectors", { - expect_error(modify(1:3, ~ "foo"), "Can't coerce") - expect_error(modify_at(1:3, 1, ~ "foo"), "Can't coerce") - expect_error(modify_if(1:3, is_integer, ~ "foo"), "Can't coerce") - expect_error(modify2(1:3, "foo", ~ .y), "Can't coerce") + expect_snapshot(error = TRUE, { + modify(1:3, ~ "foo") + modify_at(1:3, 1, ~ "foo") + modify_if(1:3, is_integer, ~ "foo") + modify2(1:3, "foo", ~ .y) + }) }) test_that("modify2() and imodify() preserve type of first input", { From ed04346b0579e770e012df62e4d4e5c095923352 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 11:51:16 -0500 Subject: [PATCH 08/23] Add map2_vec() and pmap_vec() And add missing .progress argument to map_vec(). And move map_vec() to correct location. --- NAMESPACE | 2 ++ R/map.R | 23 ++++++++++++----------- R/map2.R | 7 ++++++- R/pmap.R | 10 ++++++++++ man/map.Rd | 10 ++++++---- man/map2.Rd | 11 ++++++++++- man/pmap.Rd | 7 ++++++- 7 files changed, 52 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 911f6f9d..ec784ec3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,6 +143,7 @@ export(map2_dfr) export(map2_int) export(map2_lgl) export(map2_raw) +export(map2_vec) export(map_at) export(map_chr) export(map_dbl) @@ -176,6 +177,7 @@ export(pmap_dfr) export(pmap_int) export(pmap_lgl) export(pmap_raw) +export(pmap_vec) export(possibly) export(prepend) export(pwalk) diff --git a/R/map.R b/R/map.R index f6addfa0..88a672fd 100644 --- a/R/map.R +++ b/R/map.R @@ -43,9 +43,12 @@ #' #' * No suffix: a list. #' -#' * `_lgl`, `_int`, `_dbl`, `_chr` return a logical, integer, double, +#' * `_lgl()`, `_int()`, `_dbl()`, `_chr()` return a logical, integer, double, #' or character vector respectively. It will be named if the input was named. #' +#' * `_vec()` return an atomic or S3 vector, that is guaranteed to be +#' simpler than list. +#' #' * `walk()` returns the input `.x` (invisibly). This makes it easy to #' use in a pipe. #' @export @@ -135,25 +138,23 @@ map_int <- function(.x, .f, ..., .progress = FALSE) { .Call(map_impl, environment(), ".x", ".f", "integer", .progress) } +#' @rdname map +#' @export +map_dbl <- function(.x, .f, ..., .progress = FALSE) { + .f <- as_mapper(.f, ...) + .Call(map_impl, environment(), ".x", ".f", "double", .progress) +} #' @rdname map #' @param .ptype If `NULL`, the default, the output type is the common type #' of the elements of the result. Otherwise, supply a "prototype" giving #' the desired type of output. #' @export -map_vec <- function(.x, .f, ..., .ptype = NULL) { - out <- map(.x, .f, ...) +map_vec <- function(.x, .f, ..., .ptype = NULL, .progress = FALSE) { + out <- map(.x, .f, ..., .progress = .progress) simplify_impl(out, ptype = .ptype) } - -#' @rdname map -#' @export -map_dbl <- function(.x, .f, ..., .progress = FALSE) { - .f <- as_mapper(.f, ...) - .Call(map_impl, environment(), ".x", ".f", "double", .progress) -} - #' @rdname map #' @export walk <- function(.x, .f, ...) { diff --git a/R/map2.R b/R/map2.R index 39717a91..7ece77fe 100644 --- a/R/map2.R +++ b/R/map2.R @@ -64,6 +64,12 @@ map2_chr <- function(.x, .y, .f, ..., .progress = NULL) { .Call(map2_impl, environment(), ".x", ".y", ".f", "character", .progress) } +#' @rdname map2 +#' @export +map2_vec <- function(.x, .y, .f, ..., .ptype = NULL, .progress = NULL) { + out <- map2(.x, .y, .f, ..., .progress = .progress) + simplify_impl(out, ptype = .ptype) +} #' @export #' @rdname map2 @@ -71,4 +77,3 @@ walk2 <- function(.x, .y, .f, ...) { map2(.x, .y, .f, ...) invisible(.x) } - diff --git a/R/pmap.R b/R/pmap.R index 4eed3634..cb0b3b9b 100644 --- a/R/pmap.R +++ b/R/pmap.R @@ -129,6 +129,16 @@ pmap_chr <- function(.l, .f, ..., .progress = NULL) { .Call(pmap_impl, environment(), ".l", ".f", "character", .progress) } +#' @export +#' @rdname pmap +pmap_vec <- function(.l, .f, ..., .progress = NULL) { + .f <- as_mapper(.f, ...) + + out <- pmap(.l, .f, ..., .progress = .progress) + simplify_impl(out) +} + + #' @export #' @rdname pmap pwalk <- function(.l, .f, ...) { diff --git a/man/map.Rd b/man/map.Rd index 82bf8ed6..8d2a7648 100644 --- a/man/map.Rd +++ b/man/map.Rd @@ -5,8 +5,8 @@ \alias{map_lgl} \alias{map_chr} \alias{map_int} -\alias{map_vec} \alias{map_dbl} +\alias{map_vec} \alias{walk} \title{Apply a function to each element of a vector} \usage{ @@ -18,10 +18,10 @@ map_chr(.x, .f, ..., .progress = FALSE) map_int(.x, .f, ..., .progress = FALSE) -map_vec(.x, .f, ..., .ptype = NULL) - map_dbl(.x, .f, ..., .progress = FALSE) +map_vec(.x, .f, ..., .ptype = NULL, .progress = FALSE) + walk(.x, .f, ...) } \arguments{ @@ -57,8 +57,10 @@ The output length is determined by the length of the input. The output type is determined by the suffix: \itemize{ \item No suffix: a list. -\item \verb{_lgl}, \verb{_int}, \verb{_dbl}, \verb{_chr} return a logical, integer, double, +\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, or character vector respectively. It will be named if the input was named. +\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be +simpler than list. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to use in a pipe. } diff --git a/man/map2.Rd b/man/map2.Rd index 2ec102c8..5aa4af25 100644 --- a/man/map2.Rd +++ b/man/map2.Rd @@ -6,6 +6,7 @@ \alias{map2_int} \alias{map2_dbl} \alias{map2_chr} +\alias{map2_vec} \alias{walk2} \title{Map over two inputs} \usage{ @@ -19,6 +20,8 @@ map2_dbl(.x, .y, .f, ..., .progress = NULL) map2_chr(.x, .y, .f, ..., .progress = NULL) +map2_vec(.x, .y, .f, ..., .ptype = NULL, .progress = NULL) + walk2(.x, .y, .f, ...) } \arguments{ @@ -42,14 +45,20 @@ and the arguments that are the same come after \code{.f}.} \item{.progress}{Whether to show a progress bar. See \link{progress_bars} for details.} + +\item{.ptype}{If \code{NULL}, the default, the output type is the common type +of the elements of the result. Otherwise, supply a "prototype" giving +the desired type of output.} } \value{ The output length is determined by the length of the input. The output type is determined by the suffix: \itemize{ \item No suffix: a list. -\item \verb{_lgl}, \verb{_int}, \verb{_dbl}, \verb{_chr} return a logical, integer, double, +\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, or character vector respectively. It will be named if the input was named. +\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be +simpler than list. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to use in a pipe. } diff --git a/man/pmap.Rd b/man/pmap.Rd index 2d6ff389..3de6aab4 100644 --- a/man/pmap.Rd +++ b/man/pmap.Rd @@ -6,6 +6,7 @@ \alias{pmap_int} \alias{pmap_dbl} \alias{pmap_chr} +\alias{pmap_vec} \alias{pwalk} \title{Map over multiple input simultaneously (in "parallel")} \usage{ @@ -19,6 +20,8 @@ pmap_dbl(.l, .f, ..., .progress = NULL) pmap_chr(.l, .f, ..., .progress = NULL) +pmap_vec(.l, .f, ..., .progress = NULL) + pwalk(.l, .f, ...) } \arguments{ @@ -54,8 +57,10 @@ The output length is determined by the length of the input. The output type is determined by the suffix: \itemize{ \item No suffix: a list. -\item \verb{_lgl}, \verb{_int}, \verb{_dbl}, \verb{_chr} return a logical, integer, double, +\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, or character vector respectively. It will be named if the input was named. +\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be +simpler than list. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to use in a pipe. } From e09362193093255a23d489ee6130027029e70677 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 11:51:45 -0500 Subject: [PATCH 09/23] Move map_chr to correct position --- R/map.R | 12 ++++++------ man/map.Rd | 6 +++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/map.R b/R/map.R index 88a672fd..dae6a88f 100644 --- a/R/map.R +++ b/R/map.R @@ -126,23 +126,23 @@ map_lgl <- function(.x, .f, ..., .progress = FALSE) { #' @rdname map #' @export -map_chr <- function(.x, .f, ..., .progress = FALSE) { +map_int <- function(.x, .f, ..., .progress = FALSE) { .f <- as_mapper(.f, ...) - .Call(map_impl, environment(), ".x", ".f", "character", .progress) + .Call(map_impl, environment(), ".x", ".f", "integer", .progress) } #' @rdname map #' @export -map_int <- function(.x, .f, ..., .progress = FALSE) { +map_dbl <- function(.x, .f, ..., .progress = FALSE) { .f <- as_mapper(.f, ...) - .Call(map_impl, environment(), ".x", ".f", "integer", .progress) + .Call(map_impl, environment(), ".x", ".f", "double", .progress) } #' @rdname map #' @export -map_dbl <- function(.x, .f, ..., .progress = FALSE) { +map_chr <- function(.x, .f, ..., .progress = FALSE) { .f <- as_mapper(.f, ...) - .Call(map_impl, environment(), ".x", ".f", "double", .progress) + .Call(map_impl, environment(), ".x", ".f", "character", .progress) } #' @rdname map diff --git a/man/map.Rd b/man/map.Rd index 8d2a7648..0a2749d0 100644 --- a/man/map.Rd +++ b/man/map.Rd @@ -3,9 +3,9 @@ \name{map} \alias{map} \alias{map_lgl} -\alias{map_chr} \alias{map_int} \alias{map_dbl} +\alias{map_chr} \alias{map_vec} \alias{walk} \title{Apply a function to each element of a vector} @@ -14,12 +14,12 @@ map(.x, .f, ..., .progress = FALSE) map_lgl(.x, .f, ..., .progress = FALSE) -map_chr(.x, .f, ..., .progress = FALSE) - map_int(.x, .f, ..., .progress = FALSE) map_dbl(.x, .f, ..., .progress = FALSE) +map_chr(.x, .f, ..., .progress = FALSE) + map_vec(.x, .f, ..., .ptype = NULL, .progress = FALSE) walk(.x, .f, ...) From 5167acc409f63405d551fc0debd1291deb68a683 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 11:53:51 -0500 Subject: [PATCH 10/23] Update modify2 --- NAMESPACE | 4 --- R/modify.R | 53 +++++++++++---------------------- tests/testthat/_snaps/modify.md | 2 +- 3 files changed, 19 insertions(+), 40 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ec784ec3..8123c9c1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,11 +5,7 @@ S3method(as_mapper,default) S3method(as_mapper,list) S3method(as_mapper,numeric) S3method(modify,default) -S3method(modify2,character) S3method(modify2,default) -S3method(modify2,double) -S3method(modify2,integer) -S3method(modify2,logical) S3method(modify_at,default) S3method(modify_if,character) S3method(modify_if,default) diff --git a/R/modify.R b/R/modify.R index d5a85456..50cb3b8f 100644 --- a/R/modify.R +++ b/R/modify.R @@ -93,14 +93,12 @@ modify <- function(.x, .f, ...) { modify.default <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) - if (is.null(.x)) { - NULL - } else if (vec_is_list(.x) || is.data.frame(.x)) { + if (vec_is_list(.x) || is.data.frame(.x)) { out <- map(vec_proxy(.x), .f, ...) vec_restore(out, .x) } else if (vec_is(.x)) { map_vec(.x, .f, ..., .ptype = .x) - } else if (is.list(x)) { + } else if (is.null(.x) || is.list(.x)) { .x[] <- map(.x, .f, ...) .x } else { @@ -177,16 +175,14 @@ modify_at <- function(.x, .at, .f, ...) { modify_at.default <- function(.x, .at, .f, ...) { where <- where_at(.x, .at) - if (is.null(.x)) { - NULL - } else if (vec_is_list(.x) || is.data.frame(.x)) { + if (vec_is_list(.x) || is.data.frame(.x)) { out <- vec_proxy(.x) out[where] <- map(out[where], .f, ...) vec_restore(out, .x) } else if (vec_is(.x)) { .x[where] <- map_vec(.x[where], .f, ..., .ptype = .x) .x - } else if (is.list(x)) { + } else if (is.null(.x) || is.list(.x)) { .x[where] <- map(.x[where], .f, ...) .x } else { @@ -203,36 +199,23 @@ modify2 <- function(.x, .y, .f, ...) { } #' @export modify2.default <- function(.x, .y, .f, ...) { - modify2_base(map2, .x, .y, .f, ...) -} -# TODO: Improve genericity (see above) -#' @export -modify2.integer <- function(.x, .y, .f, ...) { - modify2_base(map2_int, .x, .y, .f, ...) -} -#' @export -modify2.double <- function(.x, .y, .f, ...) { - modify2_base(map2_dbl, .x, .y, .f, ...) -} -#' @export -modify2.character <- function(.x, .y, .f, ...) { - modify2_base(map2_chr, .x, .y, .f, ...) -} -#' @export -modify2.logical <- function(.x, .y, .f, ...) { - modify2_base(map2_lgl, .x, .y, .f, ...) -} - -modify2_base <- function(mapper, .x, .y, .f, ...) { .f <- as_mapper(.f, ...) - out <- mapper(.x, .y, .f, ...) - # if .x got recycled by map2 - if (length(out) > length(.x)) { - .x <- .x[rep(1L, length(out))] + if (vec_is_list(.x) || is.data.frame(.x)) { + out <- map2(vec_proxy(.x), .y, .f, ...) + vec_restore(out, .x) + } else if (vec_is(.x)) { + map2_vec(.x, .y, .f, ..., .ptype = .x) + } else if (is.null(.x) || is.list(.x)) { + out <- map(.x, .y, .f, ...) + if (length(out) > length(.x)) { + .x <- .x[rep(1L, length(out))] + } + .x[] <- out + .x + } else { + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") } - .x[] <- out - .x } #' @rdname modify diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index 71bf3e86..e7b2b0f6 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -19,7 +19,7 @@ modify2(1:3, "foo", ~.y) Condition Error: - ! Can't coerce element 1 from a character to a integer + ! Can't convert to . # modify_if() requires predicate functions From 08fe6e6eacb4bff3579b09998b159de15ca8e319 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 12:03:19 -0500 Subject: [PATCH 11/23] And modify_if And extract out modify_where --- NAMESPACE | 4 -- R/modify.R | 80 ++++++++++----------------------- tests/testthat/_snaps/modify.md | 2 +- 3 files changed, 24 insertions(+), 62 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8123c9c1..921d135d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,11 +7,7 @@ S3method(as_mapper,numeric) S3method(modify,default) S3method(modify2,default) S3method(modify_at,default) -S3method(modify_if,character) S3method(modify_if,default) -S3method(modify_if,double) -S3method(modify_if,integer) -S3method(modify_if,logical) S3method(print,purrr_function_compose) S3method(print,purrr_function_partial) S3method(print,purrr_rate_backoff) diff --git a/R/modify.R b/R/modify.R index 50cb3b8f..9d22c44e 100644 --- a/R/modify.R +++ b/R/modify.R @@ -106,8 +106,6 @@ modify.default <- function(.x, .f, ...) { } } -# modify_if --------------------------------------------------------------- - #' @rdname modify #' @inheritParams map_if #' @export @@ -118,51 +116,15 @@ modify_if <- function(.x, .p, .f, ..., .else = NULL) { #' @export modify_if.default <- function(.x, .p, .f, ..., .else = NULL) { where <- where_if(.x, .p) - index <- seq_along(.x) - - .f <- as_mapper(.f, ...) - for (i in index[where]) { - list_slice2(.x, i) <- .f(.x[[i]], ...) - } + .x <- modify_where(.x, where, .f, ...) - if (!is_null(.else)) { + if (!is.null(.else)) { .else <- as_mapper(.else, ...) - for (i in index[!where]) { - list_slice2(.x, i) <- .else(.x[[i]], ...) - } + .x <- modify_where(.x, !where, .else, ...) } .x } -#' @export -modify_if.integer <- function(.x, .p, .f, ..., .else = NULL) { - modify_if_base(map_int, .x, .p, .true = .f, .false = .else, ...) -} -#' @export -modify_if.double <- function(.x, .p, .f, ..., .else = NULL) { - modify_if_base(map_dbl, .x, .p, .true = .f, .false = .else, ...) -} -#' @export -modify_if.character <- function(.x, .p, .f, ..., .else = NULL) { - modify_if_base(map_chr, .x, .p, .true = .f, .false = .else, ...) -} -#' @export -modify_if.logical <- function(.x, .p, .f, ..., .else = NULL) { - modify_if_base(map_lgl, .x, .p, .true = .f, .false = .else, ...) -} - -modify_if_base <- function(.fmap, .x, .p, .true, .false = NULL, ..., .error_call = caller_env()) { - where <- where_if(.x, .p, .error_call = .error_call) - .x[where] <- .fmap(.x[where], .true, ...) - - if (!is.null(.false)) { - .x[!where] <- .fmap(.x[!where], .false, ...) - } - - .x -} - -# modify_at --------------------------------------------------------------- #' @rdname modify #' @inheritParams map_at @@ -174,24 +136,9 @@ modify_at <- function(.x, .at, .f, ...) { #' @export modify_at.default <- function(.x, .at, .f, ...) { where <- where_at(.x, .at) - - if (vec_is_list(.x) || is.data.frame(.x)) { - out <- vec_proxy(.x) - out[where] <- map(out[where], .f, ...) - vec_restore(out, .x) - } else if (vec_is(.x)) { - .x[where] <- map_vec(.x[where], .f, ..., .ptype = .x) - .x - } else if (is.null(.x) || is.list(.x)) { - .x[where] <- map(.x[where], .f, ...) - .x - } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") - } + modify_where(.x, where, .f, ...) } -# modify2 ----------------------------------------------------------------- - #' @rdname modify #' @export modify2 <- function(.x, .y, .f, ...) { @@ -223,3 +170,22 @@ modify2.default <- function(.x, .y, .f, ...) { imodify <- function(.x, .f, ...) { modify2(.x, vec_index(.x), .f, ...) } + + +# helpers ----------------------------------------------------------------- + +modify_where <- function(.x, .where, .f, ...) { + if (vec_is_list(.x) || is.data.frame(.x)) { + out <- vec_proxy(.x) + out[.where] <- map(out[.where], .f, ...) + vec_restore(out, .x) + } else if (vec_is(.x)) { + .x[.where] <- map_vec(.x[.where], .f, ..., .ptype = .x) + .x + } else if (is.null(.x) || is.list(.x)) { + .x[.where] <- map(.x[.where], .f, ...) + .x + } else { + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") + } +} diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index e7b2b0f6..5f077a0e 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -14,7 +14,7 @@ modify_if(1:3, is_integer, ~"foo") Condition Error: - ! Can't coerce element 1 from a character to a integer + ! Can't convert to . Code modify2(1:3, "foo", ~.y) Condition From b2c09b3c71fbc8081e29c50e52416460f8f62b53 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:00:51 -0500 Subject: [PATCH 12/23] Add news bullets --- NEWS.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/NEWS.md b/NEWS.md index cbffd9da..b701c52f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -70,6 +70,10 @@ * `*_at()` can now take a function (or formula) that's passed the vector of element names and returns the elements to select. +* New `map_vec()`, `map2_vec()`, and `pmap_vec()` work on all types of vectors, + extending `map_lgl()`, `map_int()`, and friends so that you can easily work + with dates, factors, date-times and more (#435). + * New `keep_at()` and `discard_at()` that work like `keep()` and `discard()` but operation on element names rather than element contents (#817). @@ -117,6 +121,10 @@ * `map2()` and `pmap()` now recycle names of their first input if needed (#783). +* `modify()`, `modify_if()`, and `modify_at()` have been reimplemented using + vctrs principles. This shouldn't have an user facing impact, but it does + make the implementation much simpler. + ### Plucking * `vec_depth()` is now `pluck_depth()` and works with more types of input From 903bdd37a0078f6a92521f0e4ee8298dae18bc38 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:05:52 -0500 Subject: [PATCH 13/23] Minimise map_vec() tests given implementation --- tests/testthat/_snaps/map.md | 5 +---- tests/testthat/test-map.R | 18 ++---------------- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/tests/testthat/_snaps/map.md b/tests/testthat/_snaps/map.md index 1e11567b..44eea4cf 100644 --- a/tests/testthat/_snaps/map.md +++ b/tests/testthat/_snaps/map.md @@ -22,7 +22,7 @@ Error in `purrr::map_int()`: ! Result 2 must have length 1, not 2. -# requires output be length 1 +# requires output be length 1 and have common type Code map_vec(1:2, ~ rep(1, .x)) @@ -30,9 +30,6 @@ Error in `map_vec()`: ! All elements must be size 1. i `out[[2]]` is size 2. - -# requires common type of output - Code map_vec(1:2, ~ if (.x == 1) factor("x") else 1) Condition diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index a4cffe5e..86ada6f3 100644 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -95,9 +95,10 @@ test_that("still iterates using [[", { expect_equal(map_vec(df, length), c(x = 1, y = 1, z = 1)) }) -test_that("requires output be length 1", { +test_that("requires output be length 1 and have common type", { expect_snapshot(error = TRUE, { map_vec(1:2, ~ rep(1, .x)) + map_vec(1:2, ~ if (.x == 1) factor("x") else 1) }) }) @@ -111,23 +112,8 @@ test_that("concatenates list output", { expect_equal(out, list(1, 2)) }) -test_that("requires common type of output", { - out <- map_vec(1:2, ~ factor("x")) - expect_equal(out, factor(c("x", "x"))) - - expect_snapshot(error = TRUE, { - map_vec(1:2, ~ if (.x == 1) factor("x") else 1) - }) -}) - test_that("can enforce .ptype", { expect_snapshot(error = TRUE, { map_vec(1:2, ~ factor("x"), .ptype = integer()) }) }) - -test_that("preserves names of input", { - x <- c(x = 1, y = 2) - out <- map_vec(x, ~ set_names(1, letters[.x])) - expect_named(out, c("x", "y")) -}) From e203d7ee915cf93e164c9cc517335c40ca0199b6 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:15:44 -0500 Subject: [PATCH 14/23] Update map2 tests --- tests/testthat/_snaps/map2.md | 18 +++++----- tests/testthat/test-map2.R | 64 ++++++++++++++++++----------------- 2 files changed, 43 insertions(+), 39 deletions(-) diff --git a/tests/testthat/_snaps/map2.md b/tests/testthat/_snaps/map2.md index 8f96fc4b..b3ad616b 100644 --- a/tests/testthat/_snaps/map2.md +++ b/tests/testthat/_snaps/map2.md @@ -1,28 +1,30 @@ -# map2 can't simplify if elements longer than length 1 +# verifies result types and length Code - map2_int(1:4, 5:8, range) + map2_int(1, 1, ~"x") + Condition + Error: + ! Can't coerce element 1 from a character to a integer + Code + map2_int(1, 1, ~ 1:2) Condition Error in `map2_int()`: ! Result 1 must have length 1, not 2. -# fails on non-vectors +# requires vector inputs Code map2(environment(), "a", identity) Condition Error in `map2()`: ! `.x` must be a vector, not an environment. - ---- - Code - map2("a", environment(), identity) + map2("a", environment(), "a", identity) Condition Error in `map2()`: ! `.y` must be a vector, not an environment. -# map2 recycles inputs +# recycles inputs Code map2(1:2, 1:3, `+`) diff --git a/tests/testthat/test-map2.R b/tests/testthat/test-map2.R index 109e5c69..172af8e2 100644 --- a/tests/testthat/test-map2.R +++ b/tests/testthat/test-map2.R @@ -1,15 +1,31 @@ -test_that("map2 can't simplify if elements longer than length 1", { - expect_snapshot(map2_int(1:4, 5:8, range), error = TRUE) +test_that("variants return expected types", { + x <- list(1, 2, 3) + expect_true(is_bare_list(map2(x, 0, ~ 1))) + expect_true(is_bare_logical(map2_lgl(x, 0, ~ TRUE))) + expect_true(is_bare_integer(map2_int(x, 0, ~ 1))) + expect_true(is_bare_double(map2_dbl(x, 0, ~ 1.5))) + expect_true(is_bare_character(map2_chr(x, 0, ~ "x"))) + expect_equal(walk2(x, 0, ~ "x"), x) + + x <- list(FALSE, 1L, 1) + expect_true(is_bare_double(map2_vec(x, 0, ~ .x))) }) -test_that("fails on non-vectors", { - expect_snapshot(map2(environment(), "a", identity), error = TRUE) - expect_snapshot(map2("a", environment(), identity), error = TRUE) +test_that("verifies result types and length", { + expect_snapshot(error = TRUE, { + map2_int(1, 1, ~ "x") + map2_int(1, 1, ~ 1:2) + }) }) -test_that("map2 recycles inputs", { - expect_equal(map2(1, 1, `+`), list(2)) +test_that("requires vector inputs", { + expect_snapshot(error = TRUE, { + map2(environment(), "a", identity) + map2("a", environment(), "a", identity) + }) +}) +test_that("recycles inputs", { expect_equal(map2(1:2, 1, `+`), list(2, 3)) expect_equal(map2(integer(), 1, `+`), list()) expect_equal(map2(NULL, 1, `+`), list()) @@ -17,30 +33,16 @@ test_that("map2 recycles inputs", { expect_snapshot(map2(1:2, 1:3, `+`), error = TRUE) }) -test_that("map2 takes only names from x", { - x1 <- 1:3 - x2 <- set_names(x1) - - expect_equal(names(map2(x1, x2, `+`)), NULL) - expect_equal(names(map2(x2, x1, `+`)), names(x2)) -}) - -test_that("map2 always returns a list", { - expect_bare(map2(mtcars, 0, ~mtcars), "list") -}) +test_that("takes only names from x", { + x1 <- 1:2 + x2 <- set_names(x1, letters[1:2]) + x3 <- set_names(x1, "") -test_that("map2() with empty input copies names", { - named_list <- named(list()) - expect_identical( map2(named_list, list(), identity), named(list())) - expect_identical(map2_lgl(named_list, list(), identity), named(lgl())) - expect_identical(map2_int(named_list, list(), identity), named(int())) - expect_identical(map2_dbl(named_list, list(), identity), named(dbl())) - expect_identical(map2_chr(named_list, list(), identity), named(chr())) -}) + expect_named(map2(x1, 1, `+`), NULL) + expect_named(map2(x2, 1, `+`), c("a", "b")) + expect_named(map2(x3, 1, `+`), c("", "")) -test_that("map2() recycle names (#779)", { - expect_identical( - map2(c(a = 1), 1:2, ~ .x), - list(a = 1, a = 1) - ) + # recycling them if needed (#779) + x4 <- c(a = 1) + expect_named(map2(x4, 1:2, `+`), c("a", "a")) }) From 3da5be6a1d61bfb464877a959640b2ae17a1a156 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:44:00 -0500 Subject: [PATCH 15/23] Update pmap tests --- tests/testthat/_snaps/map2.md | 7 ++ tests/testthat/_snaps/pmap.md | 27 +++++--- tests/testthat/test-map2.R | 17 ++++- tests/testthat/test-pmap.R | 123 ++++++++++++++++++---------------- 4 files changed, 105 insertions(+), 69 deletions(-) diff --git a/tests/testthat/_snaps/map2.md b/tests/testthat/_snaps/map2.md index b3ad616b..eabadca6 100644 --- a/tests/testthat/_snaps/map2.md +++ b/tests/testthat/_snaps/map2.md @@ -33,4 +33,11 @@ ! Mapped vectors must have consistent lengths: * `.x` has length 2 * `.y` has length 3 + Code + map2(1:2, integer(), `+`) + Condition + Error in `map2()`: + ! Mapped vectors must have consistent lengths: + * `.x` has length 2 + * `.y` has length 0 diff --git a/tests/testthat/_snaps/pmap.md b/tests/testthat/_snaps/pmap.md index 63000e4d..a6f04d4b 100644 --- a/tests/testthat/_snaps/pmap.md +++ b/tests/testthat/_snaps/pmap.md @@ -1,31 +1,38 @@ -# input must be a list of vectors +# verifies result types and length + + Code + pmap_int(list(1), ~"x") + Condition + Error: + ! Can't coerce element 1 from a character to a integer + Code + pmap_int(list(1), ~ 1:2) + Condition + Error in `pmap_int()`: + ! Result 1 must have length 1, not 2. + +# requires list of vectors Code pmap(environment(), identity) Condition Error in `pmap()`: ! `.l` must be a list, not an environment. - ---- - Code pmap(list(environment()), identity) Condition Error in `pmap()`: ! `.l[[1]]` must be a vector, not an environment. -# inputs are recycled +# recycles inputs Code - pmap(list(1:2, 1:3), identity) + pmap(list(1:2, 1:3), `+`) Condition Error in `pmap()`: ! `.l[[2]]` must have length 1 or 2, not 3. - ---- - Code - pmap(list(1:2, integer()), identity) + pmap(list(1:2, integer()), `+`) Condition Error in `pmap()`: ! `.l[[2]]` must have length 1 or 2, not 0. diff --git a/tests/testthat/test-map2.R b/tests/testthat/test-map2.R index 172af8e2..e9581518 100644 --- a/tests/testthat/test-map2.R +++ b/tests/testthat/test-map2.R @@ -1,3 +1,8 @@ +test_that("x and y mapped to first and second argument", { + expect_equal(map2(1, 2, function(x, y) x), list(1)) + expect_equal(map2(1, 2, function(x, y) y), list(2)) +}) + test_that("variants return expected types", { x <- list(1, 2, 3) expect_true(is_bare_list(map2(x, 0, ~ 1))) @@ -30,10 +35,13 @@ test_that("recycles inputs", { expect_equal(map2(integer(), 1, `+`), list()) expect_equal(map2(NULL, 1, `+`), list()) - expect_snapshot(map2(1:2, 1:3, `+`), error = TRUE) + expect_snapshot(error = TRUE, { + map2(1:2, 1:3, `+`) + map2(1:2, integer(), `+`) + }) }) -test_that("takes only names from x", { +test_that("only takes names from x", { x1 <- 1:2 x2 <- set_names(x1, letters[1:2]) x3 <- set_names(x1, "") @@ -46,3 +54,8 @@ test_that("takes only names from x", { x4 <- c(a = 1) expect_named(map2(x4, 1:2, `+`), c("a", "a")) }) + +test_that("don't evaluate symbolic objects (#428)", { + map2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2))) + walk2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2))) +}) diff --git a/tests/testthat/test-pmap.R b/tests/testthat/test-pmap.R index 8c0ceede..d0db5cf6 100644 --- a/tests/testthat/test-pmap.R +++ b/tests/testthat/test-pmap.R @@ -1,59 +1,82 @@ -test_that("input must be a list of vectors", { - expect_snapshot(pmap(environment(), identity), error = TRUE) - expect_snapshot(pmap(list(environment()), identity), error = TRUE) +test_that(".f called with named arguments", { + x <- list(x = 1, 2, y = 3) + expect_equal(pmap(x, list), list(x)) }) -test_that("inputs are recycled", { - expect_equal(pmap(list(1, 1), c), list(c(1, 1))) - expect_equal(pmap(list(1:2, 1), c), list(c(1, 1), c(2, 1))) +test_that("... are passed after varying argumetns", { + out <- pmap(list(x = 1:2), list, n = 1:2) + expect_equal(out, list( + list(x = 1, n = 1:2), + list(x = 2, n = 1:2) + )) +}) - expect_equal(pmap(list(list(), 1), ~ 1), list()) - expect_equal(pmap(list(NULL, 1), ~ 1), list()) +test_that("variants return expected types", { + l <- list(list(1, 2, 3)) + expect_true(is_bare_list(pmap(l, ~ 1))) + expect_true(is_bare_logical(pmap_lgl(l, ~ TRUE))) + expect_true(is_bare_integer(pmap_int(l, ~ 1))) + expect_true(is_bare_double(pmap_dbl(l, ~ 1.5))) + expect_true(is_bare_character(pmap_chr(l, ~ "x"))) + expect_equal(pwalk(l, ~ "x"), l) - expect_snapshot(pmap(list(1:2, 1:3), identity), error = TRUE) - expect_snapshot(pmap(list(1:2, integer()), identity), error = TRUE) + l <- list(list(FALSE, 1L, 1)) + expect_true(is_bare_double(pmap_vec(l, ~ .x))) }) -test_that(".f called with named arguments", { - out <- pmap(list(x = 1, 2, y = 3), list)[[1]] - expect_equal(names(out), c("x", "", "y")) +test_that("verifies result types and length", { + expect_snapshot(error = TRUE, { + pmap_int(list(1), ~ "x") + pmap_int(list(1), ~ 1:2) + }) }) -test_that("names are preserved", { - out <- pmap(list(c(x = 1, y = 2), 3:4), list) - expect_equal(names(out), c("x", "y")) +test_that("requires list of vectors", { + expect_snapshot(error = TRUE, { + pmap(environment(), identity) + pmap(list(environment()), identity) + }) }) -test_that("pmap() recycles names (#779)", { - expect_identical( - pmap(list(c(a = 1), 1:2), ~ .x), - list(a = 1, a = 1) - ) -}) +test_that("recycles inputs", { + expect_equal(pmap(list(1:2, 1), `+`), list(2, 3)) + expect_equal(pmap(list(integer(), 1), `+`), list()) + expect_equal(pmap(list(NULL, 1), `+`), list()) -test_that("... are passed on", { - out <- pmap(list(x = 1:2), list, n = 1) - expect_equal(out, list( - list(x = 1, n = 1), - list(x = 2, n = 1) - )) + expect_snapshot(error = TRUE, { + pmap(list(1:2, 1:3), `+`) + pmap(list(1:2, integer()), `+`) + }) }) -test_that("outputs are suffixes have correct type", { - x <- 1:3 - expect_bare(pmap_lgl(list(x), is.numeric), "logical") - expect_bare(pmap_int(list(x), length), "integer") - expect_bare(pmap_dbl(list(x), mean), "double") - expect_bare(pmap_chr(list(x), paste), "character") +test_that("only takes names from x", { + x1 <- 1:2 + x2 <- set_names(x1, letters[1:2]) + x3 <- set_names(x1, "") + + expect_named(pmap(list(x1, x2), `+`), NULL) + expect_named(pmap(list(x2, x2), `+`), c("a", "b")) + expect_named(pmap(list(x3, x2), `+`), c("", "")) + + # recycling them if needed (#779) + x4 <- c(a = 1) + expect_named(pmap(list(x4, 1:2), `+`), c("a", "a")) }) -test_that("pmap on data frames performs rowwise operations", { - mtcars2 <- mtcars[c("mpg", "cyl")] - expect_length(pmap(mtcars2, paste), nrow(mtcars)) - expect_bare(pmap_lgl(mtcars2, function(mpg, cyl) mpg > cyl), "logical") - expect_bare(pmap_int(mtcars2, function(mpg, cyl) as.integer(cyl)), "integer") - expect_bare(pmap_dbl(mtcars2, function(mpg, cyl) mpg + cyl), "double") - expect_bare(pmap_chr(mtcars2, paste), "character") +test_that("avoid expensive [[ method on data frames", { + local_bindings( + `[[.mydf` = function(x, ...) stop("Not allowed!"), + .env = global_env() + ) + + df <- data.frame(x = 1:2, y = 2:1) + class(df) <- c("mydf", "data.frame") + + expect_equal(pmap(df, list), list(list(x = 1, y = 2), list(x = 2, y = 1))) + expect_equal(pmap_lgl(df, ~ TRUE), c(TRUE, TRUE)) + expect_equal(pmap_int(df, ~ 2), c(2, 2)) + expect_equal(pmap_dbl(df, ~ 3.5), c(3.5, 3.5)) + expect_equal(pmap_chr(df, ~ "x"), c("x", "x")) }) test_that("pmap works with empty lists", { @@ -66,21 +89,7 @@ test_that("preserves S3 class of input vectors (#358)", { expect_output(pwalk(list(date), print), format(date)) }) -test_that("walk2() and pwalk() don't evaluate symbolic objects", { - walk2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2))) - pwalk(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2))) -}) - -test_that("map2() and pmap() don't evaluate symbolic objects", { - map2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2))) +test_that("don't evaluate symbolic objects (#428)", { pmap(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2))) -}) - -test_that("pmap() with empty input copies names", { - named_list <- list(named(list())) - expect_identical( pmap(named_list, identity), named(list())) - expect_identical(pmap_lgl(named_list, identity), named(lgl())) - expect_identical(pmap_int(named_list, identity), named(int())) - expect_identical(pmap_dbl(named_list, identity), named(dbl())) - expect_identical(pmap_chr(named_list, identity), named(chr())) + pwalk(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2))) }) From 8f82675f1d2a5538fdf4ea3b2165e7d28d2fbf69 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:55:16 -0500 Subject: [PATCH 16/23] At test for non-vector lists And fix bugs thus revealed --- R/modify.R | 2 +- tests/testthat/test-modify.R | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/R/modify.R b/R/modify.R index 9d22c44e..5e7e015d 100644 --- a/R/modify.R +++ b/R/modify.R @@ -154,7 +154,7 @@ modify2.default <- function(.x, .y, .f, ...) { } else if (vec_is(.x)) { map2_vec(.x, .y, .f, ..., .ptype = .x) } else if (is.null(.x) || is.list(.x)) { - out <- map(.x, .y, .f, ...) + out <- map2(.x, .y, .f, ...) if (length(out) > length(.x)) { .x <- .x[rep(1L, length(out))] } diff --git a/tests/testthat/test-modify.R b/tests/testthat/test-modify.R index 9410ba6a..d5e3a6f1 100644 --- a/tests/testthat/test-modify.R +++ b/tests/testthat/test-modify.R @@ -109,3 +109,19 @@ test_that("modify_at() can use tidyselect", { two <- modify_at(mtcars, vars(tidyselect::contains("cyl")), as.character) expect_bare(two$cyl, "character") }) + +test_that("can still modify non-vector lists", { + notlist <- function(...) structure(list(...), class = "notlist") + x <- notlist(x = 1, y = "a") + + expect_equal(modify(x, ~ 2), notlist(x = 2, y = 2)) + expect_equal(modify_if(x, is.character, ~ 2), notlist(x = 1, y = 2)) + expect_equal(modify_at(x, "y", ~ 2), notlist(x = 1, y = 2)) + + local_bindings( + "[.notlist" = function(...) structure(NextMethod(), class = "notlist"), + .env = globalenv() + ) + expect_equal(modify2(x, list(3, 4), ~ .y), notlist(x = 3, y = 4)) + expect_equal(modify2(notlist(1), list(3, 4), ~ .y), notlist(3, 4)) +}) From 4983571bdaf4c7163fef3c4dbdb7fe2823c442df Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 15 Sep 2022 16:58:39 -0500 Subject: [PATCH 17/23] Test fallbacks --- R/modify.R | 11 +++++++---- tests/testthat/_snaps/modify.md | 23 +++++++++++++++++++++++ tests/testthat/test-modify.R | 9 +++++++++ 3 files changed, 39 insertions(+), 4 deletions(-) diff --git a/R/modify.R b/R/modify.R index 5e7e015d..b260a2cc 100644 --- a/R/modify.R +++ b/R/modify.R @@ -102,7 +102,7 @@ modify.default <- function(.x, .f, ...) { .x[] <- map(.x, .f, ...) .x } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}.") } } @@ -161,7 +161,7 @@ modify2.default <- function(.x, .y, .f, ...) { .x[] <- out .x } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") + cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}.") } } @@ -174,7 +174,7 @@ imodify <- function(.x, .f, ...) { # helpers ----------------------------------------------------------------- -modify_where <- function(.x, .where, .f, ...) { +modify_where <- function(.x, .where, .f, ..., .error_call = caller_env()) { if (vec_is_list(.x) || is.data.frame(.x)) { out <- vec_proxy(.x) out[.where] <- map(out[.where], .f, ...) @@ -186,6 +186,9 @@ modify_where <- function(.x, .where, .f, ...) { .x[.where] <- map(.x[.where], .f, ...) .x } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}") + cli::cli_abort( + "Don't know how to modify {.obj_type_friendly {.x}}.", + call = .error_call + ) } } diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index 5f077a0e..68e3ecea 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -37,3 +37,26 @@ Error in `modify_if()`: ! `.p()` must return a single `TRUE` or `FALSE`, not a logical vector. +# user friendly error for non-supported cases + + Code + modify(mean, identity) + Condition + Error in `modify()`: + ! Don't know how to modify a function. + Code + modify_if(mean, TRUE, identity) + Condition + Error in `modify_if()`: + ! Don't know how to modify a function. + Code + modify_at(mean, "x", identity) + Condition + Error in `modify_at()`: + ! Don't know how to modify a function. + Code + modify2(mean, 1, identity) + Condition + Error in `modify2()`: + ! Don't know how to modify a function. + diff --git a/tests/testthat/test-modify.R b/tests/testthat/test-modify.R index d5e3a6f1..a680861a 100644 --- a/tests/testthat/test-modify.R +++ b/tests/testthat/test-modify.R @@ -125,3 +125,12 @@ test_that("can still modify non-vector lists", { expect_equal(modify2(x, list(3, 4), ~ .y), notlist(x = 3, y = 4)) expect_equal(modify2(notlist(1), list(3, 4), ~ .y), notlist(3, 4)) }) + +test_that("user friendly error for non-supported cases", { + expect_snapshot(error = TRUE, { + modify(mean, identity) + modify_if(mean, TRUE, identity) + modify_at(mean, "x", identity) + modify2(mean, 1, identity) + }) +}) From 961eeead97b7252fb4cfd2c4a06f711f9a069f0b Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 09:55:45 -0500 Subject: [PATCH 18/23] Tweak modify's handling of data frames --- R/modify.R | 13 +++++++++++-- tests/testthat/_snaps/modify.md | 13 +++++++++++++ tests/testthat/test-modify.R | 17 +++++++++++++++++ 3 files changed, 41 insertions(+), 2 deletions(-) diff --git a/R/modify.R b/R/modify.R index b260a2cc..ca2cb4f5 100644 --- a/R/modify.R +++ b/R/modify.R @@ -93,12 +93,21 @@ modify <- function(.x, .f, ...) { modify.default <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) - if (vec_is_list(.x) || is.data.frame(.x)) { + if (is.null(.x)) { + NULL + } else if (vec_is_list(.x)) { out <- map(vec_proxy(.x), .f, ...) vec_restore(out, .x) + } else if (is.data.frame(.x)) { + size <- vec_size(.x) + out <- vec_proxy(.x) + out <- map(out, .f, ...) + out <- vec_recycle_common(!!!out, .size = size, .arg = "out") + out <- new_data_frame(out, n = size) + vec_restore(out, .x) } else if (vec_is(.x)) { map_vec(.x, .f, ..., .ptype = .x) - } else if (is.null(.x) || is.list(.x)) { + } else if (is.list(.x)) { .x[] <- map(.x, .f, ...) .x } else { diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index 68e3ecea..728c3b60 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -1,3 +1,16 @@ +# preserves size of data frame + + Code + modify(df1, ~ integer()) + Condition + Error in `modify()`: + ! Can't recycle `out$x` (size 0) to size 3. + Code + modify(df1, ~ 1:4) + Condition + Error in `modify()`: + ! Can't recycle `out$x` (size 4) to size 3. + # modify() and variants implement sane coercion rules for base vectors Code diff --git a/tests/testthat/test-modify.R b/tests/testthat/test-modify.R index a680861a..72ac2c49 100644 --- a/tests/testthat/test-modify.R +++ b/tests/testthat/test-modify.R @@ -1,3 +1,7 @@ +test_that("modifying NULL returns NULL",{ + expect_null(modify(NULL, identity)) +}) + test_that("modify returns same type as input", { df1 <- data.frame(x = 1:3, y = 4:6) df2 <- data.frame(x = 2:4, y = 5:7) @@ -8,6 +12,19 @@ test_that("modify returns same type as input", { expect_equal(modify(x1, ~ .x + 1), x2) }) +test_that("preserves size of data frame", { + df1 <- data.frame(x = 1:3, y = 4:6) + expect_equal(modify(df1, ~ 1), data.frame(x = rep(1, 3), y = rep(1, 3))) + + df2 <- new_data_frame(n = 5L) + expect_equal(modify(df2, ~ 1), df2) + + expect_snapshot(error = TRUE, { + modify(df1, ~ integer()) + modify(df1, ~ 1:4) + }) +}) + test_that("modify_if/modify_at return same type as input", { df1 <- data.frame(x = "a", y = 2, stringsAsFactors = FALSE) exp <- data.frame(x = "A", y = 2, stringsAsFactors = FALSE) From 2e7af8c23350b72fbc612fe1506b5e0a818bf64e Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 15:27:57 -0500 Subject: [PATCH 19/23] modify functions are no longer generics --- NAMESPACE | 4 ---- NEWS.md | 5 +++++ R/modify.R | 19 ------------------- man/modify.Rd | 9 --------- 4 files changed, 5 insertions(+), 32 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 921d135d..d4b725bf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,10 +4,6 @@ S3method(as_mapper,character) S3method(as_mapper,default) S3method(as_mapper,list) S3method(as_mapper,numeric) -S3method(modify,default) -S3method(modify2,default) -S3method(modify_at,default) -S3method(modify_if,default) S3method(print,purrr_function_compose) S3method(print,purrr_function_partial) S3method(print,purrr_rate_backoff) diff --git a/NEWS.md b/NEWS.md index b701c52f..e7deb41c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -82,6 +82,11 @@ * purrr is now licensed as MIT (#805). +* `modify()`, `modify_if()`, `modify_at()`, and `modify2()` are no longer + generics. We have discovered a simple implementation that no longer requires + genericity and methods were only provided by a very small number of packages + (#894). + ### Flattening and simplification * New `list_c()`, `list_rbind()`, and `list_cbind()` make it easy to diff --git a/R/modify.R b/R/modify.R index ca2cb4f5..329124c9 100644 --- a/R/modify.R +++ b/R/modify.R @@ -86,11 +86,6 @@ #' #' @export modify <- function(.x, .f, ...) { - UseMethod("modify") -} -#' @rdname modify -#' @export -modify.default <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) if (is.null(.x)) { @@ -119,11 +114,6 @@ modify.default <- function(.x, .f, ...) { #' @inheritParams map_if #' @export modify_if <- function(.x, .p, .f, ..., .else = NULL) { - UseMethod("modify_if") -} -#' @rdname modify -#' @export -modify_if.default <- function(.x, .p, .f, ..., .else = NULL) { where <- where_if(.x, .p) .x <- modify_where(.x, where, .f, ...) @@ -139,11 +129,6 @@ modify_if.default <- function(.x, .p, .f, ..., .else = NULL) { #' @inheritParams map_at #' @export modify_at <- function(.x, .at, .f, ...) { - UseMethod("modify_at") -} -#' @rdname modify -#' @export -modify_at.default <- function(.x, .at, .f, ...) { where <- where_at(.x, .at) modify_where(.x, where, .f, ...) } @@ -151,10 +136,6 @@ modify_at.default <- function(.x, .at, .f, ...) { #' @rdname modify #' @export modify2 <- function(.x, .y, .f, ...) { - UseMethod("modify2") -} -#' @export -modify2.default <- function(.x, .y, .f, ...) { .f <- as_mapper(.f, ...) if (vec_is_list(.x) || is.data.frame(.x)) { diff --git a/man/modify.Rd b/man/modify.Rd index cddf05a2..507e63b7 100644 --- a/man/modify.Rd +++ b/man/modify.Rd @@ -2,27 +2,18 @@ % Please edit documentation in R/modify.R \name{modify} \alias{modify} -\alias{modify.default} \alias{modify_if} -\alias{modify_if.default} \alias{modify_at} -\alias{modify_at.default} \alias{modify2} \alias{imodify} \title{Modify elements selectively} \usage{ modify(.x, .f, ...) -\method{modify}{default}(.x, .f, ...) - modify_if(.x, .p, .f, ..., .else = NULL) -\method{modify_if}{default}(.x, .p, .f, ..., .else = NULL) - modify_at(.x, .at, .f, ...) -\method{modify_at}{default}(.x, .at, .f, ...) - modify2(.x, .y, .f, ...) imodify(.x, .f, ...) From 0b7ce2e2f5bbfbd5dce6ac68e17fee9951e8285f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 16:00:49 -0500 Subject: [PATCH 20/23] Polish modify tests --- R/modify.R | 25 +++-- tests/testthat/_snaps/modify.md | 41 ++++++--- tests/testthat/test-modify.R | 158 ++++++++++++++------------------ 3 files changed, 117 insertions(+), 107 deletions(-) diff --git a/R/modify.R b/R/modify.R index 329124c9..d286b31f 100644 --- a/R/modify.R +++ b/R/modify.R @@ -88,9 +88,7 @@ modify <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) - if (is.null(.x)) { - NULL - } else if (vec_is_list(.x)) { + if (vec_is_list(.x)) { out <- map(vec_proxy(.x), .f, ...) vec_restore(out, .x) } else if (is.data.frame(.x)) { @@ -102,7 +100,7 @@ modify <- function(.x, .f, ...) { vec_restore(out, .x) } else if (vec_is(.x)) { map_vec(.x, .f, ..., .ptype = .x) - } else if (is.list(.x)) { + } else if (is.list(.x) || is.null(.x)) { .x[] <- map(.x, .f, ...) .x } else { @@ -138,9 +136,16 @@ modify_at <- function(.x, .at, .f, ...) { modify2 <- function(.x, .y, .f, ...) { .f <- as_mapper(.f, ...) - if (vec_is_list(.x) || is.data.frame(.x)) { + if (vec_is_list(.x)) { out <- map2(vec_proxy(.x), .y, .f, ...) vec_restore(out, .x) + } else if (is.data.frame(.x)) { + size <- vec_size(.x) + out <- vec_proxy(.x) + out <- map2(out, .y, .f, ...) + out <- vec_recycle_common(!!!out, .size = size, .arg = "out") + out <- new_data_frame(out, n = size) + vec_restore(out, .x) } else if (vec_is(.x)) { map2_vec(.x, .y, .f, ..., .ptype = .x) } else if (is.null(.x) || is.list(.x)) { @@ -161,14 +166,20 @@ imodify <- function(.x, .f, ...) { modify2(.x, vec_index(.x), .f, ...) } - # helpers ----------------------------------------------------------------- modify_where <- function(.x, .where, .f, ..., .error_call = caller_env()) { - if (vec_is_list(.x) || is.data.frame(.x)) { + if (vec_is_list(.x)) { out <- vec_proxy(.x) out[.where] <- map(out[.where], .f, ...) vec_restore(out, .x) + } else if (is.data.frame(.x)) { + size <- vec_size(.x) + out <- vec_proxy(.x) + new <- map(out[.where], .f, ...) + out[.where] <- vec_recycle_common(!!!new, .size = size, .arg = "out") + out <- new_data_frame(out, n = size) + vec_restore(out, .x) } else if (vec_is(.x)) { .x[.where] <- map_vec(.x[.where], .f, ..., .ptype = .x) .x diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index 728c3b60..d0925f19 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -1,17 +1,27 @@ -# preserves size of data frame +# modfiying data.frame preserves type and size Code modify(df1, ~ integer()) Condition Error in `modify()`: - ! Can't recycle `out$x` (size 0) to size 3. + ! Can't recycle `out$x` (size 0) to size 2. Code modify(df1, ~ 1:4) Condition Error in `modify()`: - ! Can't recycle `out$x` (size 4) to size 3. + ! Can't recycle `out$x` (size 4) to size 2. + Code + modify_at(df1, 2, ~ integer()) + Condition + Error in `modify_where()`: + ! Can't recycle `out$y` (size 0) to size 2. + Code + modify2(df1, list(1, 1:3), ~.y) + Condition + Error in `modify2()`: + ! Can't recycle `out$y` (size 3) to size 2. -# modify() and variants implement sane coercion rules for base vectors +# bad type has useful error Code modify(1:3, ~"foo") @@ -34,21 +44,30 @@ Error: ! Can't convert to . -# modify_if() requires predicate functions +# modify2() recycles arguments Code - modify_if(list(1, 2), ~NA, ~"foo") + modify2(1:3, integer(), `+`) Condition - Error in `modify_if()`: - ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. + Error in `map2()`: + ! Mapped vectors must have consistent lengths: + * `.x` has length 3 + * `.y` has length 0 + Code + modify2(1:3, 1:4, `+`) + Condition + Error in `map2()`: + ! Mapped vectors must have consistent lengths: + * `.x` has length 3 + * `.y` has length 4 ---- +# modify_if() requires predicate functions Code - modify_if(1:2, ~ c(TRUE, FALSE), ~"foo") + modify_if(list(1, 2), ~NA, ~"foo") Condition Error in `modify_if()`: - ! `.p()` must return a single `TRUE` or `FALSE`, not a logical vector. + ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. # user friendly error for non-supported cases diff --git a/tests/testthat/test-modify.R b/tests/testthat/test-modify.R index 72ac2c49..bd257e97 100644 --- a/tests/testthat/test-modify.R +++ b/tests/testthat/test-modify.R @@ -1,20 +1,16 @@ -test_that("modifying NULL returns NULL",{ - expect_null(modify(NULL, identity)) -}) - -test_that("modify returns same type as input", { - df1 <- data.frame(x = 1:3, y = 4:6) - df2 <- data.frame(x = 2:4, y = 5:7) - expect_equal(modify(df1, ~ .x + 1), df2) +# Input types, ordered by apperance +test_that("modifying vectors list preserves type", { x1 <- vctrs::list_of(c(1, 2), c(3, 6, 9)) x2 <- vctrs::list_of(c(2, 3), c(4, 7, 10)) expect_equal(modify(x1, ~ .x + 1), x2) }) -test_that("preserves size of data frame", { - df1 <- data.frame(x = 1:3, y = 4:6) - expect_equal(modify(df1, ~ 1), data.frame(x = rep(1, 3), y = rep(1, 3))) +test_that("modfiying data.frame preserves type and size", { + df1 <- data.frame(x = 1:2, y = 2:1) + expect_equal(modify(df1, ~ 1), data.frame(x = c(1, 1), y = c(1, 1))) + expect_equal(modify_at(df1, 1, ~ 1), data.frame(x = c(1, 1), y = 2:1)) + expect_equal(modify2(df1, df1, ~ .x + .y), data.frame(x = c(2, 4), y = c(4, 2))) df2 <- new_data_frame(n = 5L) expect_equal(modify(df2, ~ 1), df2) @@ -22,44 +18,30 @@ test_that("preserves size of data frame", { expect_snapshot(error = TRUE, { modify(df1, ~ integer()) modify(df1, ~ 1:4) + + modify_at(df1, 2, ~ integer()) + modify2(df1, list(1, 1:3), ~ .y) }) }) -test_that("modify_if/modify_at return same type as input", { - df1 <- data.frame(x = "a", y = 2, stringsAsFactors = FALSE) - exp <- data.frame(x = "A", y = 2, stringsAsFactors = FALSE) - - df2a <- modify_if(df1, is.character, toupper) - expect_equal(df2a, exp) +test_that("data.frames are modified by column, not row", { + df1 <- data.frame(x = 1:3, y = letters[1:3]) + df2 <- data.frame(x = 2:4, y = letters[1:3]) - df2b <- modify_at(df1, "x", toupper) - expect_equal(df2b, exp) + expect_equal(modify(df1, ~ if (is.numeric(.x)) .x + 1 else .x), df2) + expect_equal(modify_at(df1, "x", ~ .x + 1), df2) }) -test_that("negative .at omits locations", { - x <- list(1, 2, 3) - out <- modify_at(x, -1, ~ .x * 2) - expect_equal(out, list(1, 4, 6)) -}) +test_that("modifying vectors preserves type", { + expect_identical(modify(1:3, ~ .x + 1), 2:4) + expect_equal(modify("a", ~ factor("b")), "b") -test_that("modify{,_at,_if} preserves atomic vector classes", { - expect_type(modify("a", identity), "character") - expect_type(modify(1L, identity), "integer") - expect_type(modify(1, identity), "double") - expect_type(modify(TRUE, identity), "logical") - - expect_type(modify_at("a", 1L, identity), "character") - expect_type(modify_at(1L, 1L, identity), "integer") - expect_type(modify_at(1, 1L, identity), "double") - expect_type(modify_at(TRUE, 1L, identity), "logical") - - expect_type(modify_if("a", TRUE, identity), "character") - expect_type(modify_if(1L, TRUE, identity), "integer") - expect_type(modify_if(1, TRUE, identity), "double") - expect_type(modify_if(TRUE, TRUE, identity), "logical") + expect_identical(modify_if(1:2, ~ .x %% 2 == 0, ~ 3), c(1L, 3L)) + expect_identical(modify_at(1:2, 2, ~ 3), c(1L, 3L)) + expect_identical(modify2(1:2, c(0, 1), `+`), c(1L, 3L)) }) -test_that("modify() and variants implement sane coercion rules for base vectors", { +test_that("bad type has useful error", { expect_snapshot(error = TRUE, { modify(1:3, ~ "foo") modify_at(1:3, 1, ~ "foo") @@ -68,28 +50,35 @@ test_that("modify() and variants implement sane coercion rules for base vectors" }) }) -test_that("modify2() and imodify() preserve type of first input", { - x <- c(foo = 1L, bar = 2L) - y <- c(TRUE, FALSE) - expect_identical(modify2(x, y, ~ if (.y) .x else 0L), c(foo = 1L, bar = 0L)) - - out <- imodify(mtcars, paste) - expect_s3_class(out, "data.frame") - expect_identical(out$vs, paste(mtcars$vs, "vs")) +test_that("modifying lists preserves NULLs", { + l <- list(a = 1, b = NULL, c = 3) + expect_equal(modify(l, identity), l) + expect_equal(modify_at(l, "b", identity), l) + expect_equal(modify_if(l, is.null, identity), l) + expect_equal( + modify2(l, list(NULL, 1, NULL), ~ .y), + list(a = NULL, b = 1, c = NULL) + ) }) -test_that("modify2() recycles arguments", { - expect_identical(modify2(1:3, 1L, `+`), int(2, 3, 4)) - expect_identical(modify2(1, 1:3, `+`), dbl(2, 3, 4)) - expect_identical(modify2(mtcars, seq_along(mtcars), `+`)$carb, mtcars$carb + ncol(mtcars)) - expect_identical(modify2(mtcars, 1, `+`)$carb, mtcars$carb + 1L) -}) +test_that("can modify non-vector lists", { + notlist <- function(...) structure(list(...), class = "notlist") + x <- notlist(x = 1, y = "a") -test_that("modify_if() requires predicate functions", { - expect_snapshot(modify_if(list(1, 2), ~ NA, ~ "foo"), error = TRUE) - expect_snapshot(modify_if(1:2, ~ c(TRUE, FALSE), ~ "foo"), error = TRUE) + expect_equal(modify(x, ~ 2), notlist(x = 2, y = 2)) + expect_equal(modify_if(x, is.character, ~ 2), notlist(x = 1, y = 2)) + expect_equal(modify_at(x, "y", ~ 2), notlist(x = 1, y = 2)) + + local_bindings( + "[.notlist" = function(...) structure(NextMethod(), class = "notlist"), + .env = globalenv() + ) + expect_equal(modify2(x, list(3, 4), ~ .y), notlist(x = 3, y = 4)) + expect_equal(modify2(notlist(1), list(3, 4), ~ .y), notlist(3, 4)) }) +# other properties -------------------------------------------------------- + test_that("`.else` modifies false elements", { exp <- modify_if(iris, negate(is.factor), as.integer) exp <- modify_if(exp, is.factor, as.character) @@ -101,46 +90,37 @@ test_that("`.else` modifies false elements", { expect_equal(modify_if(c("a", "b"), ~ .x == "a", ~ "A", .else = ~ "B"), c("A", "B")) }) -test_that("modify family preserves NULLs", { - l <- list(a = 1, b = NULL, c = 3) - expect_equal(modify(l, identity), l) - expect_equal(modify_at(l, "b", identity), l) - expect_equal(modify_if(l, is.null, identity), l) - expect_equal( - modify(l, ~ if (!is.null(.x)) .x + .y, 10), - list(a = 11, b = NULL, c = 13) - ) +test_that("modify_at() can use tidyselect", { + local_options(lifecycle_verbosity = "quiet") + + df <- data.frame(x = 1, y = 3) expect_equal( - modify_if(list(1, 2), ~ .x == 2, ~NULL), - list(1, NULL) + modify_at(df, vars(x), ~ 2), + data.frame(x = 2, y = 3) ) }) -test_that("modify_at() can use tidyselect", { - skip_if_not_installed("tidyselect") - local_options(lifecycle_verbosity = "quiet") - - one <- modify_at(mtcars, vars(cyl, am), as.character) - expect_bare(one$cyl, "character") - expect_bare(one$am, "character") - two <- modify_at(mtcars, vars(tidyselect::contains("cyl")), as.character) - expect_bare(two$cyl, "character") +test_that("imodify uses index", { + expect_equal(imodify(list(2), ~ .y), list(1)) + expect_equal(imodify(list(a = 2), ~ .y), list(a = "a")) }) -test_that("can still modify non-vector lists", { - notlist <- function(...) structure(list(...), class = "notlist") - x <- notlist(x = 1, y = "a") +# input validation -------------------------------------------------------- - expect_equal(modify(x, ~ 2), notlist(x = 2, y = 2)) - expect_equal(modify_if(x, is.character, ~ 2), notlist(x = 1, y = 2)) - expect_equal(modify_at(x, "y", ~ 2), notlist(x = 1, y = 2)) +test_that("modify2() recycles arguments", { + expect_equal(modify2(1:3, 1L, `+`), c(2, 3, 4)) + expect_equal(modify2(1, 1:3, `+`), c(2, 3, 4)) - local_bindings( - "[.notlist" = function(...) structure(NextMethod(), class = "notlist"), - .env = globalenv() - ) - expect_equal(modify2(x, list(3, 4), ~ .y), notlist(x = 3, y = 4)) - expect_equal(modify2(notlist(1), list(3, 4), ~ .y), notlist(3, 4)) + expect_snapshot(error = TRUE, { + modify2(1:3, integer(), `+`) + modify2(1:3, 1:4, `+`) + }) +}) + +test_that("modify_if() requires predicate functions", { + expect_snapshot(error = TRUE, { + modify_if(list(1, 2), ~ NA, ~ "foo") + }) }) test_that("user friendly error for non-supported cases", { From ecae80332753bf5ca4702a22b195604b920faa14 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 16:01:58 -0500 Subject: [PATCH 21/23] Tweak error message --- R/modify.R | 10 +++++++--- tests/testthat/_snaps/modify.md | 8 ++++---- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/R/modify.R b/R/modify.R index d286b31f..53e86fd0 100644 --- a/R/modify.R +++ b/R/modify.R @@ -104,7 +104,9 @@ modify <- function(.x, .f, ...) { .x[] <- map(.x, .f, ...) .x } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}.") + cli::cli_abort( + "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}." + ) } } @@ -156,7 +158,9 @@ modify2 <- function(.x, .y, .f, ...) { .x[] <- out .x } else { - cli::cli_abort("Don't know how to modify {.obj_type_friendly {.x}}.") + cli::cli_abort( + "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}." + ) } } @@ -188,7 +192,7 @@ modify_where <- function(.x, .where, .f, ..., .error_call = caller_env()) { .x } else { cli::cli_abort( - "Don't know how to modify {.obj_type_friendly {.x}}.", + "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}.", call = .error_call ) } diff --git a/tests/testthat/_snaps/modify.md b/tests/testthat/_snaps/modify.md index d0925f19..94633130 100644 --- a/tests/testthat/_snaps/modify.md +++ b/tests/testthat/_snaps/modify.md @@ -75,20 +75,20 @@ modify(mean, identity) Condition Error in `modify()`: - ! Don't know how to modify a function. + ! `.x` must be a vector, list, or data frame, not a function. Code modify_if(mean, TRUE, identity) Condition Error in `modify_if()`: - ! Don't know how to modify a function. + ! `.x` must be a vector, list, or data frame, not a function. Code modify_at(mean, "x", identity) Condition Error in `modify_at()`: - ! Don't know how to modify a function. + ! `.x` must be a vector, list, or data frame, not a function. Code modify2(mean, 1, identity) Condition Error in `modify2()`: - ! Don't know how to modify a function. + ! `.x` must be a vector, list, or data frame, not a function. From 524e484f2c6c646aa0b7b502e660a4dd52ccb4a6 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 16:29:44 -0500 Subject: [PATCH 22/23] Add test for ptype And fix bug thus revealed --- R/pmap.R | 4 ++-- tests/testthat/_snaps/map2.md | 5 +++++ tests/testthat/_snaps/pmap.md | 5 +++++ tests/testthat/test-map2.R | 1 + tests/testthat/test-pmap.R | 1 + 5 files changed, 14 insertions(+), 2 deletions(-) diff --git a/R/pmap.R b/R/pmap.R index cb0b3b9b..2e9d15cf 100644 --- a/R/pmap.R +++ b/R/pmap.R @@ -131,11 +131,11 @@ pmap_chr <- function(.l, .f, ..., .progress = NULL) { #' @export #' @rdname pmap -pmap_vec <- function(.l, .f, ..., .progress = NULL) { +pmap_vec <- function(.l, .f, ..., .ptype = NULL, .progress = NULL) { .f <- as_mapper(.f, ...) out <- pmap(.l, .f, ..., .progress = .progress) - simplify_impl(out) + simplify_impl(out, ptype = .ptype) } diff --git a/tests/testthat/_snaps/map2.md b/tests/testthat/_snaps/map2.md index eabadca6..98adc018 100644 --- a/tests/testthat/_snaps/map2.md +++ b/tests/testthat/_snaps/map2.md @@ -10,6 +10,11 @@ Condition Error in `map2_int()`: ! Result 1 must have length 1, not 2. + Code + map2_vec(1, 1, ~1, .ptype = character()) + Condition + Error: + ! Can't convert to . # requires vector inputs diff --git a/tests/testthat/_snaps/pmap.md b/tests/testthat/_snaps/pmap.md index a6f04d4b..888486ca 100644 --- a/tests/testthat/_snaps/pmap.md +++ b/tests/testthat/_snaps/pmap.md @@ -10,6 +10,11 @@ Condition Error in `pmap_int()`: ! Result 1 must have length 1, not 2. + Code + pmap_vec(list(1), ~1, .ptype = character()) + Condition + Error: + ! Can't convert to . # requires list of vectors diff --git a/tests/testthat/test-map2.R b/tests/testthat/test-map2.R index e9581518..55ebfbc4 100644 --- a/tests/testthat/test-map2.R +++ b/tests/testthat/test-map2.R @@ -20,6 +20,7 @@ test_that("verifies result types and length", { expect_snapshot(error = TRUE, { map2_int(1, 1, ~ "x") map2_int(1, 1, ~ 1:2) + map2_vec(1, 1, ~ 1, .ptype = character()) }) }) diff --git a/tests/testthat/test-pmap.R b/tests/testthat/test-pmap.R index d0db5cf6..1a66b611 100644 --- a/tests/testthat/test-pmap.R +++ b/tests/testthat/test-pmap.R @@ -28,6 +28,7 @@ test_that("verifies result types and length", { expect_snapshot(error = TRUE, { pmap_int(list(1), ~ "x") pmap_int(list(1), ~ 1:2) + pmap_vec(list(1), ~ 1, .ptype = character()) }) }) From 9d455215b11b6752a1ecce2f5a5f428b4a618c50 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 16 Sep 2022 16:32:32 -0500 Subject: [PATCH 23/23] Tweak return type description some more --- R/map.R | 12 +++++++----- man/map.Rd | 12 +++++++----- man/map2.Rd | 12 +++++++----- man/pmap.Rd | 18 ++++++++++++------ 4 files changed, 33 insertions(+), 21 deletions(-) diff --git a/R/map.R b/R/map.R index dae6a88f..4a987c97 100644 --- a/R/map.R +++ b/R/map.R @@ -39,18 +39,20 @@ #' for details. #' @returns #' The output length is determined by the length of the input. +#' The output names are determined by the input names. #' The output type is determined by the suffix: #' -#' * No suffix: a list. +#' * No suffix: a list; `.f()` can return anything. #' #' * `_lgl()`, `_int()`, `_dbl()`, `_chr()` return a logical, integer, double, -#' or character vector respectively. It will be named if the input was named. +#' or character vector respectively; `.f()` must return a compatible atomic +#' vector of length 1. #' -#' * `_vec()` return an atomic or S3 vector, that is guaranteed to be -#' simpler than list. +#' * `_vec()` return an atomic or S3 vector, the same type that `.f` returns. +#' `.f` can return pretty much any type of vector, as long as its length 1. #' #' * `walk()` returns the input `.x` (invisibly). This makes it easy to -#' use in a pipe. +#' use in a pipe. The return value of `.f()` is ignored. #' @export #' @family map variants #' @seealso [map_if()] for applying a function to only those elements diff --git a/man/map.Rd b/man/map.Rd index 0a2749d0..06966885 100644 --- a/man/map.Rd +++ b/man/map.Rd @@ -54,15 +54,17 @@ the desired type of output.} } \value{ The output length is determined by the length of the input. +The output names are determined by the input names. The output type is determined by the suffix: \itemize{ -\item No suffix: a list. +\item No suffix: a list; \code{.f()} can return anything. \item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, -or character vector respectively. It will be named if the input was named. -\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be -simpler than list. +or character vector respectively; \code{.f()} must return a compatible atomic +vector of length 1. +\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns. +\code{.f} can return pretty much any type of vector, as long as its length 1. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to -use in a pipe. +use in a pipe. The return value of \code{.f()} is ignored. } } \description{ diff --git a/man/map2.Rd b/man/map2.Rd index 5aa4af25..f237f18d 100644 --- a/man/map2.Rd +++ b/man/map2.Rd @@ -52,15 +52,17 @@ the desired type of output.} } \value{ The output length is determined by the length of the input. +The output names are determined by the input names. The output type is determined by the suffix: \itemize{ -\item No suffix: a list. +\item No suffix: a list; \code{.f()} can return anything. \item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, -or character vector respectively. It will be named if the input was named. -\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be -simpler than list. +or character vector respectively; \code{.f()} must return a compatible atomic +vector of length 1. +\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns. +\code{.f} can return pretty much any type of vector, as long as its length 1. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to -use in a pipe. +use in a pipe. The return value of \code{.f()} is ignored. } } \description{ diff --git a/man/pmap.Rd b/man/pmap.Rd index 3de6aab4..409bd0a0 100644 --- a/man/pmap.Rd +++ b/man/pmap.Rd @@ -20,7 +20,7 @@ pmap_dbl(.l, .f, ..., .progress = NULL) pmap_chr(.l, .f, ..., .progress = NULL) -pmap_vec(.l, .f, ..., .progress = NULL) +pmap_vec(.l, .f, ..., .ptype = NULL, .progress = NULL) pwalk(.l, .f, ...) } @@ -51,18 +51,24 @@ and the arguments that are the same come after \code{.f}.} \item{.progress}{Whether to show a progress bar. See \link{progress_bars} for details.} + +\item{.ptype}{If \code{NULL}, the default, the output type is the common type +of the elements of the result. Otherwise, supply a "prototype" giving +the desired type of output.} } \value{ The output length is determined by the length of the input. +The output names are determined by the input names. The output type is determined by the suffix: \itemize{ -\item No suffix: a list. +\item No suffix: a list; \code{.f()} can return anything. \item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, -or character vector respectively. It will be named if the input was named. -\item \verb{_vec()} return an atomic or S3 vector, that is guaranteed to be -simpler than list. +or character vector respectively; \code{.f()} must return a compatible atomic +vector of length 1. +\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns. +\code{.f} can return pretty much any type of vector, as long as its length 1. \item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to -use in a pipe. +use in a pipe. The return value of \code{.f()} is ignored. } } \description{