purrr/0000755000176200001440000000000015166226231011430 5ustar liggesuserspurrr/tests/0000755000176200001440000000000015166146732012601 5ustar liggesuserspurrr/tests/testthat/0000755000176200001440000000000015166226231014432 5ustar liggesuserspurrr/tests/testthat/test-keep.R0000644000176200001440000000205015063325731016454 0ustar liggesuserstest_that("can keep/discard with logical vector", { expect_equal(keep(1:3, c(TRUE, FALSE, TRUE)), c(1, 3)) expect_equal(discard(1:3, c(TRUE, FALSE, TRUE)), 2) }) test_that("can keep/discard with predicate", { expect_equal(keep(1:3, ~ .x != 2), c(1, 3)) expect_equal(discard(1:3, ~ .x != 2), c(2)) }) test_that("keep() and discard() require predicate functions", { expect_snapshot(error = TRUE, { keep(1:3, ~NA) discard(1:3, ~NA) }) }) # keep_at / discard_at ---------------------------------------------------- test_that("can keep_at/discard_at with character vector", { x <- list(a = 1, b = 1, c = 1) expect_equal(keep_at(x, "b"), list(b = 1)) expect_equal(discard_at(x, "b"), list(a = 1, c = 1)) }) test_that("can keep_at/discard_at with function", { x <- list(a = 1, b = 1, c = 1) expect_equal(keep_at(x, ~ . == "b"), list(b = 1)) expect_equal(discard_at(x, ~ . == "b"), list(a = 1, c = 1)) }) test_that("discard_at works when nothing discarded", { x <- list(a = 1, b = 1, c = 1) expect_equal(discard_at(x, "d"), x) }) purrr/tests/testthat/test-modify-tree.R0000644000176200001440000000201115063325731017751 0ustar liggesuserstest_that("can modify leaves", { expect_equal( modify_tree(c(1, 1, 1), leaf = ~ .x + 9), c(10, 10, 10) ) expect_equal( modify_tree(list(1, list(1, list(1))), leaf = ~ .x + 9), list(10, list(10, list(10))) ) }) test_that("can modify nodes", { expect_equal( modify_tree(list(1, list(2, list(3))), post = list_flatten), list(1, 2, 3) ) }) test_that("default doesn't recurse into data frames, but can customise", { local_options(stringsAsFactors = FALSE) x <- list(data.frame(x = 1), data.frame(y = 2)) expect_equal( modify_tree(x, leaf = class), list("data.frame", "data.frame") ) expect_equal( modify_tree(x, leaf = class, is_node = is.list), list(data.frame(x = "numeric"), data.frame(y = "numeric")) ) }) test_that("leaf() is applied to non-node input", { expect_equal(modify_tree(1:3, leaf = identity), 1:3) }) test_that("validates inputs", { expect_snapshot(error = TRUE, { modify_tree(list(), is_node = ~1) modify_tree(list(), is_node = 1) }) }) purrr/tests/testthat/test-utils.R0000644000176200001440000000727115163460322016677 0ustar liggesusers# where_at ------------------------------------------------------------ test_that("allows valid logical, numeric, and character vectors", { x <- list(a = 1, b = 1, c = 1) expect_equal(where_at(x, TRUE), c(TRUE, TRUE, TRUE)) expect_equal(where_at(x, 1), c(TRUE, FALSE, FALSE)) expect_equal(where_at(x, -2), c(TRUE, FALSE, TRUE)) expect_equal(where_at(x, "b"), c(FALSE, TRUE, FALSE)) }) test_that("errors on invalid subsetting vectors", { x <- list(a = 1, b = 1, c = 1) expect_snapshot(error = TRUE, { where_at(x, c(FALSE, TRUE)) where_at(x, NA_real_) where_at(x, 4) }) }) test_that("function at is passed names", { x <- list(a = 1, B = 1, c = 1) expect_equal(where_at(x, ~ .x %in% LETTERS), c(FALSE, TRUE, FALSE)) expect_equal(where_at(x, ~ intersect(.x, LETTERS)), c(FALSE, TRUE, FALSE)) }) test_that("where_at works with unnamed input", { x <- list(1, 1, 1) expect_equal(where_at(x, letters), rep(FALSE, 3)) expect_equal(where_at(x, ~ intersect(.x, LETTERS)), rep(FALSE, 3)) }) test_that("validates its inputs", { x <- list(a = 1, b = 1, c = 1) expect_snapshot(where_at(x, list()), error = TRUE) }) test_that("tidyselect `at` is deprecated", { skip_if_not_installed("tidyselect") expect_snapshot({ . <- where_at(data.frame(x = 1), vars("x"), user_env = globalenv()) }) }) # vctrs compat ------------------------------------------------------------ test_that("arrays become vectors (#970)", { x <- matrix(1:4, nrow = 2) expect_equal(vctrs_vec_compat(x, globalenv()), 1:4) f <- factor(letters[1:4]) dim(f) <- c(2, 2, 1) expect_equal(vctrs_vec_compat(f, globalenv()), factor(letters[1:4])) }) test_that("pairlists, expressions, and calls are deprecated", { local_options(lifecycle_verbosity = "warning") expect_snapshot(x <- vctrs_vec_compat(expression(1, 2), globalenv())) expect_equal(x, list(1, 2)) expect_snapshot(x <- vctrs_vec_compat(pairlist(1, 2), globalenv())) expect_equal(x, list(1, 2)) expect_snapshot(x <- vctrs_vec_compat(quote(f(a, b = 1)), globalenv())) expect_equal(x, list(quote(f), quote(a), b = 1)) }) test_that("can work with S4 vector objects", { foo <- methods::setClass("foo1", contains = "list", where = current_env()) on.exit(methods::removeClass("foo1", where = current_env()), add = TRUE) x1 <- foo(list(1, 2, 3)) expect_equal(map(x1, identity), list(1, 2, 3)) x2 <- foo(list(x = 1, y = 2, z = 3)) expect_equal(map(x2, identity), list(x = 1, y = 2, z = 3)) }) test_that("preserves names of 1d arrays", { v <- array(list(1, 2), dim = 2, dimnames = list(c("a", "b"))) expect_equal(map_dbl(v, identity), c(a = 1, b = 2)) }) test_that("can work with output of by", { df <- data.frame(x = 1:2) # 1d keeps names x <- by(df, c("a", "b"), function(df) df$x) expect_equal(map_dbl(x, identity), c(a = 1, b = 2)) x <- by(df, c("a", "b"), function(df) df$x, simplify = FALSE) expect_equal(map_dbl(x, identity), c(a = 1, b = 2)) # 2d loses names x <- by(df, list(c("a", "b"), c("a", "b")), function(df) df$x) expect_equal(map_dbl(x, identity), c(1, NA, NA, 2)) x <- by( df, list(c("a", "b"), c("a", "b")), function(df) df$x, simplify = FALSE ) expect_equal(map(x, identity), list(1, NULL, NULL, 2)) }) test_that("can work with lubridate periods", { skip_if_not_installed("lubridate") days <- lubridate::days(1:2) expect_equal( map(days, identity), list(lubridate::days(1), lubridate::days(2)) ) }) test_that("can't work with regular S4 objects", { foo <- methods::setClass( "foo", slots = list(a = "integer"), where = global_env() ) on.exit(methods::removeClass("foo", where = global_env()), add = TRUE) expect_snapshot(map(foo(), identity), error = TRUE) }) purrr/tests/testthat/test-list-combine.R0000644000176200001440000000532515063325731020125 0ustar liggesuserstest_that("list_c() concatenates vctrs of compatible types", { expect_identical(list_c(list(1L, 2:3)), c(1L, 2L, 3L)) expect_identical(list_c(list(1, 2:3)), c(1, 2, 3)) expect_snapshot(error = TRUE, list_c(list("a", 1))) }) test_that("list_c() can enforce ptype", { expect_snapshot(error = TRUE, list_c(list("a"), ptype = integer())) }) test_that("list_c() strips outer names and preserves inner names (#997)", { expect_equal(list_c(list(x = 1:2, y = 3:4)), 1:4) expect_equal(list_c(list(c(a = 1), c(b = 2))), c(a = 1, b = 2)) }) test_that("list_cbind() column-binds compatible data frames", { df1 <- data.frame(x = 1:2) df2 <- data.frame(y = 1:2) df3 <- data.frame(z = 1:3) expect_equal(list_cbind(list(df1, df2)), data.frame(x = 1:2, y = 1:2)) expect_snapshot(error = TRUE, { list_cbind(list(df1, df3)) }) }) test_that("list_cbind() can enforce size", { df1 <- data.frame(x = 1:2) expect_snapshot(error = TRUE, { list_cbind(list(df1), size = 3) }) }) test_that("list_rbind() row-binds compatible data.frames", { df1 <- data.frame(x = 1) df2 <- data.frame(x = 2, y = 1) df3 <- data.frame(x = "a", stringsAsFactors = FALSE) expect_equal(list_rbind(list(df1, df2)), data.frame(x = 1:2, y = c(NA, 1))) # and names don't make a difference unless `names_to` is set out <- list_rbind(list(a = df1, b = df2)) expect_equal(out, data.frame(x = c(1, 2), y = c(NA, 1))) expect_snapshot(error = TRUE, { list_rbind(list(df1, df3)) }) }) test_that("list_rbind() can enforce ptype", { df1 <- data.frame(x = 1) expect_snapshot(error = TRUE, { ptype <- data.frame(x = character(), stringsAsFactors = FALSE) list_rbind(list(df1), ptype = ptype) }) }) test_that("NULLs are ignored", { df1 <- data.frame(x = 1) df2 <- data.frame(y = 1) expect_equal(list_c(list(1, NULL, 2)), c(1, 2)) expect_equal(list_rbind(list(df1, NULL, df1)), vec_rbind(df1, df1)) expect_equal(list_cbind(list(df1, NULL, df2)), vec_cbind(df1, df2)) }) test_that("empty inputs return expected output", { expect_equal(list_c(list()), NULL) expect_equal(list_c(list(NULL)), NULL) expect_equal(list_rbind(list()), data.frame()) expect_equal(list_rbind(list(NULL)), data.frame()) expect_equal(list_cbind(list()), data.frame()) expect_equal(list_cbind(list(NULL)), data.frame()) }) test_that("assert input is a list", { expect_snapshot(error = TRUE, { list_c(1) list_rbind(1) list_cbind(1) }) # and not just built on a list expect_snapshot(error = TRUE, { list_c(mtcars) list_rbind(mtcars) list_cbind(mtcars) }) }) test_that("assert input is list of data frames", { expect_snapshot(error = TRUE, { list_rbind(list(1, mtcars, 3)) list_cbind(list(1, mtcars, 3)) }) }) purrr/tests/testthat/test-deprec-utils.R0000644000176200001440000000205215063325731020132 0ustar liggesuserstest_that("rdunif and rbernoulli are deprecated", { expect_snapshot({ . <- rdunif(10, 1) . <- rbernoulli(10) }) }) test_that("rbernoulli is a special case of rbinom", { local_options(lifecycle_verbosity = "quiet") set.seed(1) x <- rbernoulli(10) set.seed(1) y <- ifelse(rbinom(10, 1, 0.5) == 1, TRUE, FALSE) expect_equal(x, y) }) test_that("rdunif works", { local_options(lifecycle_verbosity = "quiet") expect_length(rdunif(100, 10), 100) }) test_that("rdunif fails if a and b are not unit length numbers", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(rdunif(1000, 1, "a"), error = TRUE) expect_snapshot(rdunif(1000, 1, c(0.5, 0.2)), error = TRUE) expect_snapshot(rdunif(1000, FALSE, 2), error = TRUE) expect_snapshot(rdunif(1000, c(2, 3), 2), error = TRUE) }) # Lifecycle --------------------------------------------------------------- test_that("%@% is an infix attribute accessor", { local_options(lifecycle_verbosity = "quiet") expect_identical(mtcars %@% "names", attr(mtcars, "names")) }) purrr/tests/testthat/test-deprec-splice.R0000644000176200001440000000116715063325731020257 0ustar liggesuserstest_that("predicate controls which elements get spliced", { x <- list(1, 2, list(3, 4)) expect_equal(splice_if(x, ~FALSE), x) expect_equal(splice_if(x, is.list), list(1, 2, 3, 4)) }) test_that("splice() produces correctly named lists", { local_options(lifecycle_verbosity = "quiet") inputs <- list(arg1 = "a", arg2 = "b") out1 <- splice(inputs, arg3 = c("c1", "c2")) expect_named(out1, c("arg1", "arg2", "arg3")) out2 <- splice(inputs, arg = list(arg3 = 1, arg4 = 2)) expect_named(out2, c("arg1", "arg2", "arg3", "arg4")) }) test_that("splice is deprecated", { expect_snapshot({ . <- splice() }) }) purrr/tests/testthat/test-deprec-lift.R0000644000176200001440000000237715063325731017742 0ustar liggesuserstest_that("lift_dl and lift_ld are inverses of each other", { options(lifecycle_verbosity = "quiet") expect_identical( sum |> lift_dl(.unnamed = TRUE) |> do.call(list(3, NA, 4, na.rm = TRUE)), sum |> lift_dl() |> lift_ld() |> exec(3, NA, 4, na.rm = TRUE) ) }) test_that("lift_dv is from ... to c(...)", { options(lifecycle_verbosity = "quiet") expect_equal(lift_dv(range, .unnamed = TRUE)(1:10), c(1, 10)) }) test_that("lift_vd is from c(...) to ...", { options(lifecycle_verbosity = "quiet") expect_equal(lift_vd(mean)(1, 2), 1.5) }) test_that("lift_vl is from c(...) to list(...)", { options(lifecycle_verbosity = "quiet") expect_equal(lift_vl(mean)(list(1, 2)), 1.5) }) test_that("lift_lv is from list(...) to c(...)", { options(lifecycle_verbosity = "quiet") glue <- function(l) { if (!is.list(l)) { stop("not a list") } do.call(paste, l) } expect_identical(lift_lv(glue)(letters), paste(letters, collapse = " ")) }) test_that("lift functions are deprecated", { expect_snapshot({ . <- lift_dl(function() {}) . <- lift_dv(function() {}) . <- lift_vl(function() {}) . <- lift_vd(function() {}) . <- lift_ld(function() {}) . <- lift_lv(function() {}) }) }) purrr/tests/testthat/helper-map.R0000644000176200001440000000016414326706774016624 0ustar liggesusersnamed <- function(x) set_names(x, chr()) # Until we can reexport from rlang vars <- function(...) rlang::quos(...) purrr/tests/testthat/test-superseded-map-df.R0000644000176200001440000000150615063325731021042 0ustar liggesuserstest_that("row and column binding work", { skip_if_not_installed("dplyr") local_name_repair_quiet() mtcar_mod <- mtcars |> split(mtcars$cyl) |> map(~ lm(mpg ~ wt, data = .x)) f_coef <- function(x) as.data.frame(t(as.matrix(coef(x)))) expect_length(mtcar_mod |> map_dfr(f_coef), 2) expect_length(mtcar_mod |> map_dfc(f_coef), 6) }) test_that("data frame imap works", { skip_if_not_installed("dplyr") x <- set_names(1:3) expect_identical(imap_dfc(x, paste), imap_dfr(x, paste)) }) test_that("outputs are suffixes have correct type for data frames", { skip_if_not_installed("dplyr") local_name_repair_quiet() local_options(rlang_message_verbosity = "quiet") x <- 1:3 expect_s3_class(pmap_dfr(list(x), as.data.frame), "data.frame") expect_s3_class(pmap_dfc(list(x), as.data.frame), "data.frame") }) purrr/tests/testthat/test-deprec-along.R0000644000176200001440000000064314326706774020111 0ustar liggesuserstest_that("list-along is deprecated", { expect_snapshot({ . <- list_along(1:4) }) }) test_that("list_along works", { local_options(lifecycle_verbosity = "quiet") x <- 1:5 expect_identical(list_along(x), vector("list", 5)) }) test_that("rep_along works", { local_options(lifecycle_verbosity = "quiet") expect_equal( rep_along(c("c", "b", "a"), 1:3), rep_along(c("d", "f", "e"), 1:3) ) }) purrr/tests/testthat/test-adverb-auto-browse.R0000644000176200001440000000025415063325731021244 0ustar liggesuserstest_that("auto_browse() not intended for primitive functions", { expect_snapshot(auto_browse(log)(NULL), error = TRUE) expect_no_error(auto_browse(identity)(NULL)) }) purrr/tests/testthat/test-pluck-assign.R0000644000176200001440000000455115063325731020140 0ustar liggesusers# assign_in() ---------------------------------------------------------- test_that("assign_in() doesn't assign in the caller environment", { x <- list(list(bar = 1, foo = 2)) assign_in(x, list(1, "foo"), value = 20) expect_identical(x, list(list(bar = 1, foo = 2))) }) test_that("assign_in() assigns", { x <- list(list(bar = 1, foo = 2)) out <- assign_in(x, list(1, "foo"), value = 20) expect_identical(out, list(list(bar = 1, foo = 20))) }) test_that("can assign NULL (#636)", { expect_equal( assign_in(list(x = 1, y = 2), 1, value = NULL), list(x = NULL, y = 2) ) expect_equal( assign_in(list(x = 1, y = 2), "y", value = NULL), list(x = 1, y = NULL) ) }) test_that("can remove elements with zap()", { expect_equal( assign_in(list(x = 1, y = 2), 1, value = zap()), list(y = 2) ) expect_equal( assign_in(list(x = 1, y = 2), "y", value = zap()), list(x = 1) ) # And deep indexing leaves unchanged expect_equal( assign_in(list(x = 1, y = 2), c(3, 4, 5), value = zap()), list(x = 1, y = 2) ) expect_equal( assign_in(list(x = 1, y = 2), c("a", "b", "c"), value = zap()), list(x = 1, y = 2) ) }) test_that("assign_in() requires at least one location", { x <- list("foo") expect_snapshot(error = TRUE, { assign_in(x, NULL, value = "foo") }) }) test_that("can modify non-existing locations", { expect_equal(assign_in(list(), "x", 1), list(x = 1)) expect_equal(assign_in(list(), 2, 1), list(NULL, 1)) expect_equal(assign_in(list(), c("x", "y"), 1), list(x = list(y = 1))) expect_equal(assign_in(list(), c(2, 1), 1), list(NULL, list(1))) expect_equal(assign_in(list(), list("x", 2), 1), list(x = list(NULL, 1))) expect_equal(assign_in(list(), list(1, "y"), 1), list(list(y = 1))) }) # modify_in() ---------------------------------------------------------- test_that("modify_in() modifies in pluck location", { x <- list(list(bar = 1, foo = 2)) out <- modify_in(x, list(1, "foo"), `+`, 100) expect_identical(out, list(list(bar = 1, foo = 102))) out <- modify_in(x, c(1, 1), `+`, 10) expect_identical(out, list(list(bar = 11, foo = 2))) }) test_that("modify_in() doesn't require existing", { x <- list(list(x = 1, y = 2)) expect_equal(modify_in(x, 2, ~10), list(list(x = 1, y = 2), 10)) expect_equal( modify_in(x, list(1, "z"), ~10), list(list(x = 1, y = 2, z = 10)) ) }) purrr/tests/testthat/test-adverb-quietly.R0000644000176200001440000000060015063325731020464 0ustar liggesuserstest_that("quietly captures output", { f <- function() { cat(1) message(2, appendLF = FALSE) warning(3) 4 } expect_output(quietly(f)(), NA) expect_message(quietly(f)(), NA) expect_warning(quietly(f)(), NA) out <- quietly(f)() expect_equal( out, list( result = 4, output = "1", warnings = "3", messages = "2" ) ) }) purrr/tests/testthat/test-map-mapper.R0000644000176200001440000000404315163460322017570 0ustar liggesusers# formulas ---------------------------------------------------------------- test_that("can refer to first argument in three ways", { expect_equal(map_dbl(1, ~ . + 1), 2) expect_equal(map_dbl(1, ~ .x + 1), 2) expect_equal(map_dbl(1, ~ ..1 + 1), 2) }) test_that("can refer to second arg in two ways", { expect_equal(map2_dbl(1, 2, ~ .x + .y + 1), 4) expect_equal(map2_dbl(1, 2, ~ ..1 + ..2 + 1), 4) }) # vectors -------------------------------------------------------------- # test_that(".null generates warning", { # expect_warning(map(1, 2, .null = NA), "`.null` is deprecated") # }) test_that(".default replaces absent values", { x <- list( list(a = 1, b = 2, c = 3), list(a = 1, c = 2), NULL ) expect_equal(map_dbl(x, 3, .default = NA), c(3, NA, NA)) expect_equal(map_dbl(x, "b", .default = NA), c(2, NA, NA)) }) test_that(".default only replaces NULL elements", { x <- list( list(a = 1), list(a = numeric()), list(a = NULL), list() ) expect_equal(map(x, "a", .default = NA), list(1, numeric(), NA, NA)) }) test_that("Additional arguments are ignored", { expect_equal(as_mapper(function() NULL, foo = "bar", foobar), function() NULL) }) test_that("can supply length > 1 vectors", { expect_identical(as_mapper(1:2)(list(list("a", "b"))), "b") expect_identical(as_mapper(c("a", "b"))(list(a = list("a", b = "b"))), "b") }) # primitive functions -------------------------------------------------- test_that("primitive functions are wrapped", { expect_identical(as_mapper(`-`)(.y = 10, .x = 5), 5) # positional matching, not by name expect_identical(as_mapper(`c`)(1, 3, 5), c(1, 3, 5)) }) test_that("syntactic primitives are wrapped", { expect_identical(as_mapper(`[[`)(mtcars, "cyl"), mtcars$cyl) expect_identical(as_mapper(`$`)(mtcars, cyl), mtcars$cyl) }) # lists ------------------------------------------------------------------ test_that("lists are wrapped", { mapper_list <- as_mapper(list("mpg", 5))(mtcars) base_list <- mtcars[["mpg"]][[5]] expect_identical(mapper_list, base_list) }) purrr/tests/testthat/test-deprec-rerun.R0000644000176200001440000000140015063325731020121 0ustar liggesuserstest_that("is deprecated", { expect_snapshot({ . <- rerun(5, rnorm(1)) . <- rerun(5, rnorm(1), rnorm(2)) }) }) test_that("single unnamed arg doesn't get extra list", { local_options(lifecycle_verbosity = "quiet") expect_equal(rerun(2, 1), list(1, 1)) }) test_that("single named arg gets extra list", { local_options(lifecycle_verbosity = "quiet") expect_equal(rerun(2, a = 1), list(list(a = 1), list(a = 1))) }) test_that("every run is different", { local_options(lifecycle_verbosity = "quiet") x <- rerun(2, runif(1)) expect_true(x[[1]] != x[[2]]) }) test_that("rerun uses scope of expression", { local_options(lifecycle_verbosity = "quiet") f <- function(n) { rerun(1, x = seq_len(n)) } expect_equal(f(10)[[1]]$x, 1:10) }) purrr/tests/testthat/test-head-tail.R0000644000176200001440000000111315063325731017357 0ustar liggesusersy <- 1:100 test_that("head_while works", { expect_length(head_while(y, function(x) x <= 15), 15) }) test_that("tail_while works", { expect_length(tail_while(y, function(x) x >= 86), 15) }) test_that("original vector returned if predicate satisfied by all elements", { expect_identical(head_while(y, function(x) x <= 100), y) expect_identical(tail_while(y, function(x) x >= 0), y) }) test_that("head_while and tail_while require predicate function", { expect_snapshot(head_while(1:3, ~NA), error = TRUE) expect_snapshot(tail_while(1:3, ~ c(TRUE, FALSE)), error = TRUE) }) purrr/tests/testthat/test-adverb-possibly.R0000644000176200001440000000050515063325731020640 0ustar liggesuserstest_that("possibly returns default value on failure", { expect_identical(possibly(log, NA_real_)("a"), NA_real_) }) test_that("possibly emits a message on failure if quiet = FALSE", { f <- function(...) stop("tilt") expect_message( { possibly(f, NA_real_, quiet = FALSE)() }, regexp = "tilt" ) }) purrr/tests/testthat/test-superseded-simplify.R0000644000176200001440000000171014334365317021533 0ustar liggesuserstest_that("can_simplify() understands vector molds", { x <- as.list(1:3) x2 <- c(x, list(1:3)) expect_true(can_simplify(x, integer(1))) expect_false(can_simplify(x, character(1))) expect_false(can_simplify(x2, integer(1))) x3 <- list(1:2, 3:4, 5:6) expect_true(can_simplify(x3, integer(2))) expect_false(can_simplify(x, integer(2))) }) test_that("can_simplify() understands types as strings", { x <- as.list(1:3) expect_true(can_simplify(x, "integer")) expect_false(can_simplify(x, "character")) }) test_that("integer is coercible to double", { x <- list(1L, 2L) expect_true(can_simplify(x, "numeric")) expect_true(can_simplify(x, numeric(1))) expect_true(can_simplify(x, "double")) expect_true(can_simplify(x, double(1))) }) test_that("numeric is an alias for double", { expect_true(can_simplify(list(1, 2), "numeric")) }) test_that("double is not coercible to integer", { expect_false(can_simplify(list(1, 2), "integer")) }) purrr/tests/testthat/test-conditions.R0000644000176200001440000000242715063325731017711 0ustar liggesuserstest_that("stop_bad_type() constructs default `what`", { expect_snapshot(stop_bad_type(NA, "`NULL`"), error = TRUE) expect_snapshot(stop_bad_type(NA, "`NULL`", arg = ".foo"), error = TRUE) expect_snapshot(stop_bad_type(NA, "`NULL`", arg = quote(.foo)), error = TRUE) }) test_that("stop_bad_element_type() constructs type errors", { expect_snapshot(stop_bad_element_type(1:3, 3, "a foobaz"), error = TRUE) expect_snapshot( stop_bad_element_type(1:3, 3, "a foobaz", actual = "a quux"), error = TRUE ) expect_snapshot( stop_bad_element_type(1:3, 3, "a foobaz", arg = "..arg"), error = TRUE ) }) test_that("stop_bad_element_type() accepts `what`", { expect_snapshot( stop_bad_element_type(1:3, 3, "a foobaz", what = "Result"), error = TRUE ) }) test_that("stop_bad_element_length() constructs error message", { expect_snapshot(stop_bad_element_length(1:3, 8, 10), error = TRUE) expect_snapshot( stop_bad_element_length(1:3, 8, 10, arg = ".foo"), error = TRUE ) expect_snapshot( stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result"), error = TRUE ) expect_snapshot( stop_bad_element_length( 1:3, 8, 10, arg = ".foo", what = "Result", recycle = TRUE ), error = TRUE ) }) purrr/tests/testthat/test-map-raw.R0000644000176200001440000000142215063325731017076 0ustar liggesuserstest_that("_raw funtions are deprecated", { expect_snapshot({ . <- map_raw(list(), ~.x) . <- map2_raw(list(), list(), ~.x) . <- imap_raw(list(), ~.x) . <- pmap_raw(list(), ~.x) . <- flatten_raw(list()) }) }) test_that("_raw functions still work", { local_options(lifecycle_verbosity = "quiet") expect_equal(map_raw("a", charToRaw), charToRaw("a")) expect_identical(map_raw(set_names(list()), identity), named(raw())) expect_identical(map2_raw(set_names(list()), list(), identity), named(raw())) expect_equal(imap_raw(as.raw(12), rawShift), rawShift(as.raw(12), 1)) expect_bare(pmap_raw(list(1:3), as.raw), "raw") expect_identical(pmap_raw(list(named(list())), identity), named(raw())) expect_equal(flatten_raw(list(as.raw(1))), as.raw(1)) }) purrr/tests/testthat/test-arrays.R0000644000176200001440000000210614326706774017046 0ustar liggesusersx <- array(1:12, c(2, 2, 3), dimnames = list(letters[1:2], LETTERS[1:2], NULL)) test_that("array_branch creates a flat list when no margin specified", { expect_length(array_branch(x), 12) }) test_that("array_branch wraps array in list when margin has length 0", { expect_identical(array_branch(x, numeric(0)), list(x)) }) test_that("array_branch works on vectors", { expect_identical(array_branch(1:3), list(1L, 2L, 3L)) expect_identical(array_branch(1:3, 1), list(1L, 2L, 3L)) }) test_that("array_branch throws an error for wrong margins on a vector", { expect_snapshot(array_branch(1:3, 2), error = TRUE) }) test_that("length depends on whether list is flattened or not", { m1 <- c(3, 1) m2 <- 3 expect_length(array_branch(x, m1), prod(dim(x)[m1])) expect_length(array_tree(x, m1), prod(dim(x)[m2])) }) test_that("array_branch retains dimnames when going over one dimension", { expect_identical(names(array_branch(x, 1)), letters[1:2]) expect_identical(names(array_branch(x, 2)), LETTERS[1:2]) expect_identical(names(array_branch(x, 2:3)[[1]]), letters[1:2]) }) purrr/tests/testthat/helper.R0000644000176200001440000000127014326706774016050 0ustar liggesusersexpect_bare <- function(x, type) { predicate <- switch( type, logical = is_bare_logical, integer = is_bare_integer, double = is_bare_double, complex = is_bare_complex, character = is_bare_character, raw = is_bare_raw, list = is_bare_list, ) expect_true(predicate(x)) } local_name_repair_quiet <- function(frame = caller_env()) { local_options(rlib_name_repair_verbosity = "quiet", .frame = frame) } local_name_repair_verbose <- function(frame = caller_env()) { local_options(rlib_name_repair_verbosity = "verbose", .frame = frame) } local_methods <- function(..., .frame = caller_env()) { local_bindings(..., .env = global_env(), .frame = .frame) } purrr/tests/testthat/test-adverb-insistently.R0000644000176200001440000000052614326706774021377 0ustar liggesuserstest_that("insistently() resets rate state", { fn <- insistently(compose(), rate_delay(1, max_times = 0)) expect_snapshot_error(fn(), class = "purrr_error_rate_excess") expect_snapshot_error(fn(), class = "purrr_error_rate_excess") }) test_that("validates inputs", { expect_snapshot(error = TRUE, { insistently(mean, 10) }) }) purrr/tests/testthat/test-map-depth.R0000644000176200001440000000600015063325731017406 0ustar liggesusers# map_depth ------------------------------------------------------------ test_that("map_depth modifies values at specified depth", { x1 <- list(list(list(1:3, 4:6))) expect_equal(map_depth(x1, 0, length), 1) expect_equal(map_depth(x1, 1, length), list(1)) expect_equal(map_depth(x1, 2, length), list(list(2))) expect_equal(map_depth(x1, 3, length), list(list(list(3, 3)))) expect_equal(map_depth(x1, -1, length), list(list(list(3, 3)))) expect_snapshot(map_depth(x1, 6, length), error = TRUE) expect_snapshot(map_depth(x1, -5, length), error = TRUE) }) test_that("default doesn't recurse into data frames, but can customise", { x <- list(data.frame(x = 1), data.frame(y = 2)) expect_snapshot(map_depth(x, 2, class), error = TRUE) x <- list(data.frame(x = 1), data.frame(y = 1)) expect_equal( map_depth(x, 2, class, .is_node = is.list), list(list(x = "numeric"), list(y = "numeric")) ) }) test_that("map_depth() with .ragged = TRUE operates on leaves", { x1 <- list( list(1), list(list(2)) ) exp <- list( list(list(2)), list(list(3)) ) expect_equal(map_depth(x1, 3, ~ . + 1, .ragged = TRUE), exp) expect_equal(map_depth(x1, -1, ~ . + 1, .ragged = TRUE), exp) # .ragged should be TRUE is .depth < 0 expect_equal(map_depth(x1, -1, ~ . + 1), exp) }) # modify_depth ------------------------------------------------------------ test_that("modify_depth modifies values at specified depth", { x1 <- list(list(list(1:3, 4:6))) expect_equal(modify_depth(x1, 0, length), list(1)) expect_equal(modify_depth(x1, 1, length), list(1)) expect_equal(modify_depth(x1, 2, length), list(list(2))) expect_equal(modify_depth(x1, 3, length), list(list(list(3, 3)))) expect_equal(modify_depth(x1, -1, length), list(list(list(3, 3)))) expect_snapshot(modify_depth(x1, 5, length), error = TRUE) expect_snapshot(modify_depth(x1, -5, length), error = TRUE) }) test_that(".ragged = TRUE operates on leaves", { x1 <- list( list(1), list(list(2)) ) x2 <- list( list(2), list(list(3)) ) expect_equal(modify_depth(x1, 3, ~ . + 1, .ragged = TRUE), x2) expect_equal(modify_depth(x1, -1, ~ . + 1, .ragged = TRUE), x2) # .ragged should be TRUE is .depth < 0 expect_equal(modify_depth(x1, -1, ~ . + 1), x2) }) test_that("vectorised operations on the recursive and atomic levels yield same results", { x <- list(list(list(1:3, 4:6))) exp <- list(list(list(11:13, 14:16))) expect_identical(modify_depth(x, 3, `+`, 10L), exp) expect_snapshot(modify_depth(x, 5, `+`, 10L), error = TRUE) }) test_that("modify_depth() treats NULLs correctly", { ll <- list(a = NULL, b = list(b1 = NULL, b2 = "hello")) expect_equal(modify_depth(ll, .depth = 2, identity, .ragged = TRUE), ll) expect_equal( modify_depth(ll, .depth = 2, is.character, .ragged = TRUE), list(a = NULL, b = list(b1 = FALSE, b2 = TRUE)) ) }) # check_depth ------------------------------------------------------------- test_that("validates depth", { expect_snapshot(check_depth(mean), error = TRUE) }) purrr/tests/testthat/test-adverb-negate.R0000644000176200001440000000111114326706774020244 0ustar liggesuserstest_that("negate works with both functions and vectors", { true <- function(...) TRUE expect_equal(negate(true)(), FALSE) expect_equal(negate("x")(list(x = TRUE)), FALSE) expect_equal(negate(is.null)(TRUE), TRUE) expect_equal(negate(is.null)(NULL), FALSE) }) test_that("negate() works with early returns", { expect_false(negate(~ return(TRUE))()) }) test_that("negate() works with generic functions and local methods", { is_foobar <- function(x) UseMethod("is_foobar") local({ is_foobar.default <- function(x) TRUE expect_false(negate(is_foobar)()) }) }) purrr/tests/testthat/test-pmap.R0000644000176200001440000000637115063325731016477 0ustar liggesuserstest_that(".f called with named arguments", { x <- list(x = 1, 2, y = 3) expect_equal(pmap(x, list), list(x)) }) 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) ) ) }) 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) l <- list(list(FALSE, 1L, 1)) expect_true(is_bare_double(pmap_vec(l, ~.x))) }) 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()) }) }) test_that("0 length input gives 0 length output", { expect_equal(pmap(list(list(), list()), identity), list()) expect_equal(pmap(list(NULL, NULL), identity), list()) expect_equal(pmap(list(), identity), list()) expect_equal(pmap(NULL, identity), list()) expect_equal(pmap_lgl(NULL, identity), logical()) }) test_that("requires list of vectors", { expect_snapshot(error = TRUE, { pmap(environment(), identity) pmap(list(environment()), identity) }) }) 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()) expect_snapshot(error = TRUE, { pmap(list(1:2, 1:3), `+`) pmap(list(1:2, integer()), `+`) }) }) 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("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", { expect_identical(pmap(list(), ~1), list()) }) test_that("preserves S3 class of input vectors (#358)", { date <- as.Date("2018-09-27") expect_equal(pmap(list(date), identity), list(date)) expect_output(pwalk(list(date), print), format(date)) }) test_that("works with vctrs records (#963)", { x <- new_rcrd(list(x = c(1, 2), y = c("a", "b"))) out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b"))) expect_identical(pmap(list(x, 1, 1:2), ~.x), out) }) test_that("don't evaluate symbolic objects (#428)", { pmap(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2))) pwalk(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2))) }) purrr/tests/testthat/test-pluck-depth.R0000644000176200001440000000115114326706774017764 0ustar liggesuserstest_that("depth of non-vectors is 0", { expect_equal(pluck_depth(NULL), 0L) expect_equal(pluck_depth(mean), 0L) }) test_that("depth of atomic vector is 1", { expect_equal(pluck_depth(1:10), 1) expect_equal(pluck_depth(letters), 1) expect_equal(pluck_depth(c(TRUE, FALSE)), 1) }) test_that("depth of nested is depth of deepest element + 1", { x <- list( NULL, list(), list(list()) ) depths <- map_int(x, pluck_depth) expect_equal(depths, c(0, 1, 2)) expect_equal(pluck_depth(x), 3) }) test_that("vec_depth() is deprecated", { expect_snapshot({ . <- vec_depth(list()) }) }) purrr/tests/testthat/test-adverb-compose.R0000644000176200001440000001003115063325731020434 0ustar liggesuserstest_that("composed functions are applied right to left by default", { expect_identical(!is.null(4), compose(`!`, is.null)(4)) set.seed(1) x <- sample(1:4, 100, replace = TRUE) expect_identical(unname(sort(table(x))), compose(unname, sort, table)(x)) }) test_that("composed functions are applied in reverse order if .dir is supplied", { expect_identical(compose(~ .x + 100, ~ .x * 2, .dir = "forward")(2), 204) }) test_that("compose supports formulas", { round_mean <- compose(~ .x * 100, ~ round(.x, 2), ~ mean(.x, na.rm = TRUE)) expect_s3_class(round_mean, "purrr_function_compose") expect_identical(round_mean(1:100), round(mean(1:100, na.rm = TRUE), 2) * 100) }) test_that("compose() supports character vectors", { fn <- local({ foobar <- function(x) paste(x, "baz") compose("foobar", "foobar") }) expect_identical(fn("quux"), "quux baz baz") }) test_that("can splice lists of functions", { fns <- list( ~ paste(.x, "a"), ~ paste(.x, "b") ) fn <- compose(!!!fns) expect_identical(fn("c"), "c b a") }) test_that("composed function has formals of first function called", { fn <- function(x, y = 1) NULL expect_identical(formals(compose(identity, fn)), formals(fn)) }) test_that("can compose primitive functions", { expect_identical(compose(is.character, as.character)(3), TRUE) expect_identical(compose(`-`, `/`)(4, 2), -2) }) test_that("composed function prints informatively", { fn1 <- set_env(function(x) x + 1, global_env()) fn2 <- set_env(function(x) x / 1, global_env()) expect_snapshot({ "Single input" compose(fn1) "Multiple inputs" compose(fn1, fn2) }) }) test_that("compose() with 0 inputs returns the identity", { expect_identical(compose()(mtcars), mtcars) }) test_that("compose() with 1 input is a noop", { expect_identical(compose(toupper)(letters), toupper(letters)) }) test_that("compose() works with generic functions (#629)", { purrr__gen <- function(x) UseMethod("purrr__gen") local({ purrr__gen.default <- function(x) x + 1 expect_identical(compose(~ purrr__gen(.x))(0), 1) expect_identical(compose(~ purrr__gen(.x), ~ purrr__gen(.x))(0), 2) expect_identical(compose(purrr__gen)(0), 1) expect_identical(compose(purrr__gen, purrr__gen)(0), 2) }) }) test_that("compose() works with generic functions (#639)", { n_unique <- purrr::compose(length, unique) expect_identical(n_unique(iris$Species), 3L) }) test_that("compose() works with argument matching functions", { # They inspect their dynamic context via sys.function() fn <- function(x = c("foo", "bar")) match.arg(x) expect_identical(compose(fn)("f"), "foo") expect_identical(compose(fn, fn)("f"), "foo") }) test_that("compose() works with non-local exits", { fn <- function(x) return(x) expect_identical(compose(fn)("foo"), "foo") expect_identical(compose(fn, fn)("foo"), "foo") expect_identical( compose(~ return(paste(.x, "foo")), ~ return("bar"))(), "bar foo" ) }) test_that("compose() preserves lexical environment", { fn <- local({ `_foo` <- "foo" function(...) `_foo` }) expect_identical(compose(fn)(), "foo") expect_identical(compose(fn, fn)(), "foo") }) test_that("compose() can take dots from multiple environments", { f <- function(...) { `_foo` <- "foo" g(`_foo`, ...) } g <- function(...) { `_bar` <- "bar" h(`_bar`, ...) } h <- function(...) { `_baz` <- "baz" fn(`_baz`, ...) } `_quux` <- "quux" # By value fn <- compose(function(...) c(...)) expect_identical(f(`_quux`), c("baz", "bar", "foo", "quux")) # By expression (base) fn <- compose(function(...) substitute(...())) expect_identical( f(`_quux`), as.pairlist(exprs(`_baz`, `_bar`, `_foo`, `_quux`)) ) # By expression (rlang) fn <- compose(function(...) enquos(...)) quos <- f(`_quux`) frame <- current_env() expect_true(is_reference(quo_get_env(quos[[4]]), frame)) expect_false(is_reference(quo_get_env(quos[[3]]), frame)) expect_identical( unname(map_chr(quos, as_name)), c("_baz", "_bar", "_foo", "_quux") ) }) purrr/tests/testthat/test-progress-bars.R0000644000176200001440000000025115163460322020317 0ustar liggesuserstest_that("useful for bad progress spec", { # Test map() to make sure we're passing the caller env correctly expect_snapshot(map(1, .progress = 1), error = TRUE) }) purrr/tests/testthat/test-deprec-cross.R0000644000176200001440000000212215063325731020121 0ustar liggesuserstest_that("long format corresponds to expand.grid output", { skip_if_not_installed("tibble") local_options(lifecycle_verbosity = "quiet") x <- list(a = 1:3, b = 4:9) out1 <- cross_df(x) out2 <- expand.grid(x, KEEP.OUT.ATTRS = FALSE) |> tibble::as_tibble() expect_equal(out1, out2) }) test_that("filtering works", { local_options(lifecycle_verbosity = "quiet") filter <- function(x, y) x >= y out <- cross2(1:3, 1:3, .filter = filter) expect_equal(out, list(list(1, 2), list(1, 3), list(2, 3))) }) test_that("filtering requires a predicate function", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(cross2(1:3, 1:3, .filter = ~ c(TRUE, TRUE)), error = TRUE) }) test_that("filtering fails when filter function doesn't return a logical", { local_options(lifecycle_verbosity = "quiet") filter <- function(x, y, z) x + y + z expect_snapshot(cross3(1:3, 1:3, 1:3, .filter = filter), error = TRUE) }) test_that("works with empty input", { local_options(lifecycle_verbosity = "quiet") expect_equal(cross(list()), list()) expect_equal(cross(NULL), NULL) }) purrr/tests/testthat/test-adverb-slowly.R0000644000176200001440000000013714326706774020341 0ustar liggesuserstest_that("validates inputs", { expect_snapshot(error = TRUE, { slowly(mean, 10) }) }) purrr/tests/testthat/test-superseded-transpose.R0000644000176200001440000000567015063325731021722 0ustar liggesuserstest_that("input must be a list", { expect_snapshot(transpose(1:3), error = TRUE) }) test_that("elements of input must be atomic vectors", { expect_snapshot(transpose(list(environment())), error = TRUE) expect_snapshot(transpose(list(list(), environment())), error = TRUE) }) test_that("empty list returns empty list", { expect_equal(transpose(list()), list()) }) test_that("transpose switches order of first & second idnex", { 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", { x <- list(list(x = 1), list(x = 2)) expect_equal(transpose(x), list(x = list(1, 2))) }) test_that("outside names become inside names", { 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", { 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", { 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", { 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", { 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))) expect_equal(transpose(list("a", "b")), list(list("a", "b"))) }) test_that("can't transpose expressions", { expect_snapshot(transpose(list(expression(a))), error = TRUE) }) # Named based matching ---------------------------------------------------- test_that("can override default names", { x <- list( list(x = 1), list(y = 2, x = 1) ) tx <- transpose(x, c("x", "y")) expect_equal( tx, list( x = list(1, 1), y = list(NULL, 2) ) ) }) test_that("if present, names are used", { x <- list( list(x = 1, y = 2), list(y = 2, x = 1) ) tx <- transpose(x) expect_equal(tx$x, list(1, 1)) expect_equal(tx$y, list(2, 2)) }) test_that("if missing elements, filled with NULL", { x <- list( list(x = 1, y = 2), list(x = 1) ) tx <- transpose(x) expect_equal(tx$y, list(2, NULL)) }) # Position based matching ------------------------------------------------- test_that("warning if too short", { x <- list( list(1, 2), list(1) ) expect_warning(tx <- transpose(x), "must be length 2, not 1") expect_equal(tx, list(list(1, 1), list(2, NULL))) }) test_that("warning if too long", { x <- list( list(1), list(1, 2) ) expect_warning(tx <- transpose(x), "must be length 1, not 2") expect_equal(tx, list(list(1, 1))) }) purrr/tests/testthat/test-lmap.R0000644000176200001440000000333115063325731016464 0ustar liggesuserstest_that("lmap output is list if input is list", { x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10]) maybe_rep <- function(x) { n <- rpois(1, 2) out <- rep_len(x, n) if (length(out) > 0) { names(out) <- paste0(names(x), seq_len(n)) } out } expect_bare(lmap_at(x, "a", maybe_rep), "list") }) test_that("lmap() returns a data frame if input is a data frame", { df <- data.frame(x = 1, y = 2) # as.data.frame() handles repeated names out <- lmap(df, function(x) as.data.frame(rep(x, 2))) expect_equal(out, data.frame(x = 1, x.1 = 1, y = 2, y.1 = 2)) # even if we return bare lists out <- lmap(df, function(x) as.list(rep(x, 2))) expect_equal(out, data.frame(x = 1, x.1 = 1, y = 2, y.1 = 2)) }) test_that("lmap() can increase and decrease elements", { out <- lmap(list(0, 1, 2), ~ as.list(rep(.x, .x))) expect_equal(out, list(1, 2, 2)) }) test_that("lmap_at() only affects selected elements", { out <- lmap_at(list(0, 1, 2), c(1, 3), ~ as.list(rep(.x, .x))) expect_equal(out, list(1, 2, 2)) out <- lmap_at(list(0, 1, 2), c(2, 3), ~ as.list(rep(.x, .x))) expect_equal(out, list(0, 1, 2, 2)) }) test_that("lmap_at can use tidyselect", { skip_if_not_installed("tidyselect") local_options(lifecycle_verbosity = "quiet") x <- lmap_at(mtcars, vars(tidyselect::contains("vs")), ~ .x + 10) expect_equal(x$vs[1], 10) }) test_that("`.else` preserves false elements", { x <- list("a", 99) out <- lmap_if(x, is.character, ~ list(1, 2), .else = ~ list(3, 4)) expect_equal(out, list(1, 2, 3, 4)) }) test_that("validates inputs", { expect_snapshot(error = TRUE, { lmap(list(1), ~1) lmap(list(1), environment()) lmap(list(1), ~1, .else = environment()) }) }) purrr/tests/testthat/test-parallel.R0000644000176200001440000003355415063325731017341 0ustar liggesusersskip_if_not_installed("mirai") test_that("All parallel map variants fall back to sequential with no daemons set", { expect_identical( map(list(x = 1, y = 2), in_parallel(\(x) list(x))), map(list(x = 1, y = 2), \(x) list(x)) ) expect_equal(map2(1, 2, in_parallel(\(x, y) x)), list(1)) expect_identical(pmap(list(), in_parallel(~ 1)), list()) }) # set up daemons mirai::daemons(1, dispatcher = FALSE) # ensures only 1 additional process on CRAN on.exit(mirai::daemons(0), add = TRUE) test_that("Can't use `...` in a parallel map", { expect_snapshot(error = TRUE, { map(list(x = 1, y = 2), in_parallel(\(x) list(x)), a = "wrong") }) }) test_that("Crated function environment is attached to search path", { # Use of `median()` without the `stats::` namespace expect_equal(map_dbl(1:2, in_parallel(\(x) median(c(1, 1, x)))), c(1, 1)) }) # map ----------------------------------------------------------------------- test_that("preserves names", { out <- map(list(x = 1, y = 2), in_parallel(\(x) identity(x))) expect_equal(names(out), c("x", "y")) }) test_that("works with matrices/arrays (#970)", { expect_identical( map_int(matrix(1:4, nrow = 2), in_parallel(\(x) identity(x))), 1:4 ) }) test_that("all inform about location of problem", { skip_if_not_installed("carrier") expect_snapshot(error = TRUE, { map_int(1:3, in_parallel(\(x, bad = 2:1) if (x == 3) bad else x)) map_int(1:3, in_parallel(\(x, bad = "x") if (x == 3) bad else x)) map( 1:3, in_parallel(\(x, bad = stop("Doesn't work")) if (x == 3) bad else x) ) }) cnd <- catch_cnd(map( 1:3, in_parallel(\(x, bad = stop("Doesn't work")) if (x == 3) bad else x) )) expect_s3_class(cnd, "purrr_error_indexed") expect_equal(cnd$location, 3) expect_equal(cnd$name, NULL) }) test_that("error location uses name if present", { skip_if_not_installed("carrier") expect_snapshot(error = TRUE, { map_int( c(a = 1, b = 2, c = 3), in_parallel(\(x, bad = stop("Doesn't work")) if (x == 3) bad else x) ) map_int( c(a = 1, b = 2, 3), in_parallel(\(x, bad = stop("Doesn't work")) if (x == 3) bad else x) ) }) cnd <- catch_cnd(map( c(1, 2, c = 3), in_parallel(\(x, bad = stop("Doesn't work")) if (x == 3) bad else x) )) expect_s3_class(cnd, "purrr_error_indexed") expect_equal(cnd$location, 3) expect_equal(cnd$name, "c") }) test_that("0 length input gives 0 length output", { expect_equal(map(list(), in_parallel(\(x) identity(x))), list()) expect_equal(map(NULL, in_parallel(\(x) identity(x))), list()) expect_equal(map_lgl(NULL, in_parallel(\(x) identity(x))), logical()) }) test_that("map() always returns a list", { expect_bare(map(mtcars, in_parallel(\(x) mean(x))), "list") }) test_that("types automatically coerced correctly", { expect_identical( map_lgl(c(NA, 0, 1), in_parallel(\(x) identity(x))), c(NA, FALSE, TRUE) ) expect_identical( map_int(c(NA, FALSE, TRUE), in_parallel(\(x) identity(x))), c(NA, 0L, 1L) ) expect_identical( map_int(c(NA, 1, 2), in_parallel(\(x) identity(x))), c(NA, 1L, 2L) ) expect_identical( map_dbl(c(NA, FALSE, TRUE), in_parallel(\(x) identity(x))), c(NA, 0, 1) ) expect_identical( map_dbl(c(NA, 1L, 2L), in_parallel(\(x) identity(x))), c(NA, 1, 2) ) expect_identical(map_chr(NA, in_parallel(\(x) identity(x))), NA_character_) }) test_that("logical and integer NA become correct double NA", { expect_identical( map_dbl(list(NA, NA_integer_), in_parallel(\(x) identity(x))), c(NA_real_, NA_real_) ) }) test_that("map forces arguments in same way as base R", { f_map <- map(1:2, in_parallel(\(i) \(x) x + i)) f_base <- lapply(1:2, \(i) \(x) x + i) expect_equal(f_map[[1]](0), f_base[[1]](0)) expect_equal(f_map[[2]](0), f_base[[2]](0)) }) test_that("primitive dispatch correctly", { skip_if_not_installed("carrier") method <- \(x) "dispatched!" x <- structure(list(), class = "test_class") expect_identical( map( list(x, x), in_parallel(\(x) as.character(x), as.character.test_class = method) ), list("dispatched!", "dispatched!") ) }) test_that("map() with empty input copies names", { named_list <- named(list()) expect_identical( map(named_list, in_parallel(\(x) identity(x))), named(list()) ) expect_identical( map_lgl(named_list, in_parallel(\(x) identity(x))), named(lgl()) ) expect_identical( map_int(named_list, in_parallel(\(x) identity(x))), named(int()) ) expect_identical( map_dbl(named_list, in_parallel(\(x) identity(x))), named(dbl()) ) expect_identical( map_chr(named_list, in_parallel(\(x) identity(x))), named(chr()) ) }) # map_vec ------------------------------------------------------------------ test_that("still iterates using [[", { df <- data.frame(x = 1, y = 2, z = 3) expect_equal(map_vec(df, in_parallel(\(x) length(x))), c(x = 1, y = 1, z = 1)) }) test_that("requires output be length 1 and have common type", { expect_snapshot(error = TRUE, { map_vec(1:2, in_parallel(~ rep(1, .x))) map_vec(1:2, in_parallel(~ if (.x == 1) factor("x") else 1)) }) }) test_that("row-binds data frame output", { out <- map_vec(1:2, in_parallel(~ data.frame(x = .x))) expect_equal(out, data.frame(x = 1:2)) }) test_that("concatenates list output", { out <- map_vec(1:2, in_parallel(~ list(.x))) expect_equal(out, list(1, 2)) }) test_that("can enforce .ptype", { expect_snapshot(error = TRUE, { map_vec(1:2, in_parallel(~ factor("x")), .ptype = integer()) }) }) # map2 --------------------------------------------------------------------- test_that("x and y mapped to first and second argument", { expect_equal(map2(1, 2, in_parallel(\(x, y) x)), list(1)) expect_equal(map2(1, 2, in_parallel(\(x, y) y)), list(2)) }) test_that("variants return expected types", { x <- list(1, 2, 3) expect_true(is_bare_list(map2(x, 0, in_parallel(~1)))) expect_true(is_bare_logical(map2_lgl(x, 0, in_parallel(~TRUE)))) expect_true(is_bare_integer(map2_int(x, 0, in_parallel(~1)))) expect_true(is_bare_double(map2_dbl(x, 0, in_parallel(~1.5)))) expect_true(is_bare_character(map2_chr(x, 0, in_parallel(~"x")))) expect_equal(walk2(x, 0, in_parallel(~"x")), x) x <- list(FALSE, 1L, 1) expect_true(is_bare_double(map2_vec(x, 0, ~.x, .parallel = TRUE))) }) test_that("0 length input gives 0 length output", { expect_equal(map2(list(), list(), in_parallel(\(x) identity(x))), list()) expect_equal(map2(NULL, NULL, in_parallel(\(x) identity(x))), list()) expect_equal(map2_lgl(NULL, NULL, in_parallel(\(x) identity(x))), logical()) }) test_that("verifies result types and length", { expect_snapshot(error = TRUE, { map2_int(1, 1, in_parallel(~"x")) map2_int(1, 1, in_parallel(~ 1:2)) map2_vec(1, 1, in_parallel(~1), .ptype = character()) }) }) test_that("works with vctrs records (#963)", { x <- new_rcrd(list(x = c(1, 2), y = c("a", "b"))) out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b"))) expect_identical(map2(x, 1, in_parallel(~.x)), out) }) test_that("requires vector inputs", { expect_snapshot(error = TRUE, { map2(environment(), "a", in_parallel(\(x) identity(x))) map2("a", environment(), "a", in_parallel(\(x) identity(x))) }) }) test_that("recycles inputs", { expect_equal(map2(1:2, 1, in_parallel(\(x, y) x + y)), list(2, 3)) expect_equal(map2(integer(), 1, in_parallel(\(x, y) x + y)), list()) expect_equal(map2(NULL, 1, in_parallel(\(x, y) x + y)), list()) expect_snapshot(error = TRUE, { map2(1:2, 1:3, in_parallel(\(x, y) x + y)) map2(1:2, integer(), in_parallel(\(x, y) x + y)) }) }) test_that("only takes names from x", { x1 <- 1:2 x2 <- set_names(x1, letters[1:2]) x3 <- set_names(x1, "") expect_named(map2(x1, 1, in_parallel(\(x, y) x + y)), NULL) expect_named(map2(x2, 1, in_parallel(\(x, y) x + y)), c("a", "b")) expect_named(map2(x3, 1, in_parallel(\(x, y) x + y)), c("", "")) # recycling them if needed (#779) x4 <- c(a = 1) expect_named(map2(x4, 1:2, in_parallel(\(x, y) x + y)), c("a", "a")) }) test_that("don't evaluate symbolic objects (#428)", { map2( exprs(1 + 2), NA, in_parallel(~ testthat::expect_identical(.x, quote(1 + 2))) ) walk2( exprs(1 + 2), NA, in_parallel(~ testthat::expect_identical(.x, quote(1 + 2))) ) expect_true(TRUE) # so the test is not deemed empty and skipped }) # pmap ---------------------------------------------------------------------- test_that(".f called with named arguments", { x <- list(x = 1, 2, y = 3) expect_equal(pmap(x, in_parallel(\(...) list(...))), list(x)) }) # no longer tested as `...` are forbidden when `.parallel = TRUE` #test_that("... are passed after varying argumetns", { # out <- pmap(list(x = 1:2), list, n = 1:2, .parallel = TRUE) # expect_equal(out, list( # list(x = 1, n = 1:2), # list(x = 2, n = 1:2) # )) #}) test_that("variants return expected types", { l <- list(list(1, 2, 3)) expect_true(is_bare_list(pmap(l, in_parallel(~1)))) expect_true(is_bare_logical(pmap_lgl(l, in_parallel(~TRUE)))) expect_true(is_bare_integer(pmap_int(l, in_parallel(~1)))) expect_true(is_bare_double(pmap_dbl(l, in_parallel(~1.5)))) expect_true(is_bare_character(pmap_chr(l, in_parallel(~"x")))) expect_equal(pwalk(l, in_parallel(~"x")), l) l <- list(list(FALSE, 1L, 1)) expect_true(is_bare_double(pmap_vec(l, in_parallel(~.x)))) }) test_that("verifies result types and length", { expect_snapshot(error = TRUE, { pmap_int(list(1), in_parallel(~"x")) pmap_int(list(1), in_parallel(~ 1:2)) pmap_vec(list(1), in_parallel(~1), .ptype = character()) }) }) test_that("0 length input gives 0 length output", { expect_equal( pmap(list(list(), list()), in_parallel(\(x) identity(x))), list() ) expect_equal(pmap(list(NULL, NULL), in_parallel(\(x) identity(x))), list()) expect_equal(pmap(list(), in_parallel(\(x) identity(x))), list()) expect_equal(pmap(NULL, in_parallel(\(x) identity(x))), list()) expect_equal(pmap_lgl(NULL, in_parallel(\(x) identity(x))), logical()) }) test_that("requires list of vectors", { expect_snapshot(error = TRUE, { pmap(environment(), in_parallel(\(x) identity(x))) pmap(list(environment()), in_parallel(\(x) identity(x))) }) }) test_that("recycles inputs", { expect_equal(pmap(list(1:2, 1), in_parallel(\(x, y) x + y)), list(2, 3)) expect_equal(pmap(list(integer(), 1), in_parallel(\(x, y) x + y)), list()) expect_equal(pmap(list(NULL, 1), in_parallel(\(x, y) x + y)), list()) expect_snapshot(error = TRUE, { pmap(list(1:2, 1:3), in_parallel(\(x, y) x + y)) pmap(list(1:2, integer()), in_parallel(\(x, y) x + y)) }) }) 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), in_parallel(\(x, y) x + y)), NULL) expect_named(pmap(list(x2, x2), in_parallel(\(x, y) x + y)), c("a", "b")) expect_named(pmap(list(x3, x2), in_parallel(\(x, y) x + y)), c("", "")) # recycling them if needed (#779) x4 <- c(a = 1) expect_named(pmap(list(x4, 1:2), in_parallel(\(x, y) x + y)), c("a", "a")) }) 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, in_parallel(\(...) list(...), `[[.mydf` = `[[.mydf`)), list(list(x = 1, y = 2), list(x = 2, y = 1)) ) expect_equal( pmap_lgl(df, in_parallel(~TRUE, `[[.mydf` = `[[.mydf`)), c(TRUE, TRUE) ) expect_equal(pmap_int(df, in_parallel(~2, `[[.mydf` = `[[.mydf`)), c(2, 2)) expect_equal( pmap_dbl(df, in_parallel(~3.5, `[[.mydf` = `[[.mydf`)), c(3.5, 3.5) ) expect_equal( pmap_chr(df, in_parallel(~"x", `[[.mydf` = `[[.mydf`)), c("x", "x") ) }) test_that("pmap works with empty lists", { expect_identical(pmap(list(), in_parallel(~1)), list()) }) test_that("preserves S3 class of input vectors (#358)", { date <- as.Date("2018-09-27") expect_identical(pmap(list(date), in_parallel(\(x) identity(x))), list(date)) }) test_that("works with vctrs records (#963)", { x <- new_rcrd(list(x = c(1, 2), y = c("a", "b"))) out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b"))) expect_identical(pmap(list(x, 1, 1:2), in_parallel(~.x)), out) }) test_that("don't evaluate symbolic objects (#428)", { pmap( list(exprs(1 + 2)), in_parallel(~ testthat::expect_identical(.x, quote(1 + 2))) ) pwalk( list(exprs(1 + 2)), in_parallel(~ testthat::expect_identical(.x, quote(1 + 2))) ) expect_true(TRUE) # so the test is not deemed empty and skipped }) # imap ---------------------------------------------------------------------- test_that("atomic vector imap works", { x <- 1:3 |> set_names() expect_true(all(imap_lgl(x, in_parallel(\(x, y) x == y)))) expect_length(imap_chr(x, in_parallel(\(...) paste(...))), 3) expect_equal(imap_int(x, in_parallel(~ .x + as.integer(.y))), x * 2) expect_equal(imap_dbl(x, in_parallel(~ .x + as.numeric(.y))), x * 2) expect_equal(imap_vec(x, in_parallel(~ .x + as.numeric(.y))), x * 2) }) # map_at -------------------------------------------------------------------- test_that("map_at() works with tidyselect", { skip_if_not_installed("tidyselect") local_options(lifecycle_verbosity = "quiet") x <- list(a = "b", b = "c", aa = "bb") one <- map_at(x, vars(a), in_parallel(\(x) toupper(x))) expect_identical(one$a, "B") expect_identical(one$aa, "bb") two <- map_at( x, vars(tidyselect::contains("a")), in_parallel(\(x) toupper(x)) ) expect_identical(two$a, "B") expect_identical(two$aa, "BB") }) test_that("negative .at omits locations", { x <- c(1, 2, 3) out <- map_at(x, -1, in_parallel(~ .x * 2)) expect_equal(out, list(1, 4, 6)) }) # --------------------------------------------------------------------------- mirai::daemons(0) purrr/tests/testthat/test-imap.R0000644000176200001440000000116715063325731016466 0ustar liggesusersx <- 1:3 |> set_names() test_that("imap is special case of map2", { expect_identical(imap(x, paste), map2(x, names(x), paste)) }) test_that("imap always returns a list", { expect_bare(imap(x, paste), "list") }) test_that("atomic vector imap works", { expect_true(all(imap_lgl(x, `==`))) expect_length(imap_chr(x, paste), 3) expect_equal(imap_int(x, ~ .x + as.integer(.y)), x * 2) expect_equal(imap_dbl(x, ~ .x + as.numeric(.y)), x * 2) expect_equal(imap_vec(x, ~ .x + as.numeric(.y)), x * 2) }) test_that("iwalk returns invisibly", { expect_output(iwalk(mtcars, ~ cat(.y, ": ", median(.x), "\n", sep = ""))) }) purrr/tests/testthat/test-map2.R0000644000176200001440000000423615063325731016377 0ustar liggesuserstest_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))) 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("0 length input gives 0 length output", { expect_equal(map2(list(), list(), identity), list()) expect_equal(map2(NULL, NULL, identity), list()) expect_equal(map2_lgl(NULL, NULL, identity), logical()) }) 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()) }) }) test_that("works with vctrs records (#963)", { x <- new_rcrd(list(x = c(1, 2), y = c("a", "b"))) out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b"))) expect_identical(map2(x, 1, ~.x), out) }) 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()) expect_snapshot(error = TRUE, { map2(1:2, 1:3, `+`) map2(1:2, integer(), `+`) }) }) test_that("only takes names from x", { x1 <- 1:2 x2 <- set_names(x1, letters[1:2]) x3 <- set_names(x1, "") expect_named(map2(x1, 1, `+`), NULL) expect_named(map2(x2, 1, `+`), c("a", "b")) expect_named(map2(x3, 1, `+`), c("", "")) # recycling them if needed (#779) 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))) }) purrr/tests/testthat/test-adverb-safely.R0000644000176200001440000000053015063325731020255 0ustar liggesuserstest_that("safely has NULL error when successful", { out <- safely(log10)(10) expect_equal(out, list(result = 1, error = NULL)) }) test_that("safely has NULL result on failure", { out <- safely(log10)("a") expect_equal(out$result, NULL) expect_equal( out$error$message, "non-numeric argument to mathematical function" ) }) purrr/tests/testthat/test-list-flatten.R0000644000176200001440000000420115063325731020136 0ustar liggesuserstest_that("flattening removes single layer of nesting", { expect_equal(list_flatten(list(list(1), list(2))), list(1, 2)) expect_equal(list_flatten(list(list(1), list(list(2)))), list(1, list(2))) expect_equal(list_flatten(list(list(1), list(), list(2))), list(1, 2)) }) test_that("flattening a flat list is idempotent", { expect_equal(list_flatten(list(1, 2)), list(1, 2)) }) test_that("uses either inner or outer names if only one present", { expect_equal(list_flatten(list(x = list(1), list(y = 2))), list(x = 1, y = 2)) }) test_that("can control names if both present", { x <- list(a = list(x = 1)) expect_equal(list_flatten(x), list(a_x = 1)) expect_equal(list_flatten(x, name_spec = "{inner}"), list(x = 1)) expect_equal(list_flatten(x, name_spec = "{outer}"), list(a = 1)) }) test_that("requires a list", { expect_snapshot(list_flatten(1:2), error = TRUE) }) test_that("list_flatten() restores", { # This simulates a recursive list-of type my_num_list <- function(...) { new_my_num_list(list2(...)) } new_my_num_list <- function(xs) { stopifnot( every(xs, function(x) { is_null(x) || is.numeric(x) || inherits(x, "my_num_list") }) ) new_vctr(xs, class = "my_num_list") } local_methods( vec_restore.my_num_list = function(x, to, ...) { new_my_num_list(x) } ) xs <- my_num_list(1, 2, my_num_list(3:4)) expect_equal( list_flatten(xs), my_num_list(1, 2, 3:4) ) }) test_that("list_flatten() supports strict types", { local_methods( vec_cast.list.my_strict_list = function(x, to, ...) { abort("Can't coerce to list.") } ) x <- structure(list(1), class = c("my_strict_list", "list")) expect_equal( list_flatten(list(x)), list(1) ) }) test_that("list_flatten() works with vctrs::list_of()", { # Currently only with flat lists because list_of can't be recursive expect_equal( list_flatten(list_of(1, 2, 3)), list_of(1, 2, 3) ) }) test_that("list_flatten() honors its is_node param", { expect_equal(list_flatten(list(mtcars)), list(mtcars)) expect_equal(list_flatten(list(mtcars), is_node = is.list), as.list(mtcars)) }) purrr/tests/testthat/test-reduce.R0000644000176200001440000001471115063325731017006 0ustar liggesuserstest_that("empty input returns init or error", { expect_snapshot(reduce(list()), error = TRUE) expect_equal(reduce(list(), `+`, .init = 0), 0) }) test_that("first/value value used as first value", { expect_equal(reduce(c(1, 1), `+`), 2) expect_equal(reduce(c(1, 1), `+`, .init = 1), 3) }) test_that("length 1 argument reduced with init", { expect_equal(reduce(1, `+`, .init = 1), 2) }) test_that("direction of reduce determines how generated trees lean", { expect_identical(reduce(1:4, list), list(list(list(1L, 2L), 3L), 4L)) expect_identical( reduce(1:4, list, .dir = "backward"), list(1L, list(2L, list(3L, 4L))) ) }) test_that("can shortcircuit reduction with done()", { x <- c(TRUE, TRUE, FALSE, TRUE, TRUE) out <- reduce(x, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL) expect_identical(out, c("foo", "foo")) # Empty done box yields the same value as returning the # result-so-far (the last value) in a done box out2 <- reduce(x, ~ if (.y) c(.x, "foo") else done(), .init = NULL) expect_identical(out2, out) }) test_that("reduce() forces arguments (#643)", { compose <- function(f, g) function(x) f(g(x)) expect_identical(reduce(list(identity, identity), compose)(1), 1) }) # accumulate -------------------------------------------------------------- test_that("accumulate passes arguments to function", { tt <- c("a", "b", "c") expect_equal(accumulate(tt, paste, sep = "."), c("a", "a.b", "a.b.c")) expect_equal( accumulate(tt, paste, sep = ".", .dir = "backward"), c("a.b.c", "b.c", "c") ) expect_equal( accumulate(tt, paste, sep = ".", .init = "z"), c("z", "z.a", "z.a.b", "z.a.b.c") ) expect_equal( accumulate(tt, paste, sep = ".", .dir = "backward", .init = "z"), c("a.b.c.z", "b.c.z", "c.z", "z") ) }) test_that("accumulate keeps input names", { input <- set_names(1:26, letters) expect_identical(accumulate(input, sum), set_names(cumsum(1:26), letters)) expect_identical( accumulate(input, sum, .dir = "backward"), set_names(rev(cumsum(rev(1:26))), rev(letters)) ) }) test_that("accumulate keeps input names when init is supplied", { expect_identical(accumulate(1:2, c, .init = 0L), list(0L, 0:1, 0:2)) expect_identical( accumulate(0:1, c, .init = 2L, .dir = "backward"), list(0:2, 1:2, 2L) ) expect_identical( accumulate(c(a = 1L, b = 2L), c, .init = 0L), list(.init = 0L, a = 0:1, b = 0:2) ) expect_identical( accumulate(c(a = 0L, b = 1L), c, .init = 2L, .dir = "backward"), list(b = 0:2, a = 1:2, .init = 2L) ) }) test_that("can terminate accumulate() early", { tt <- c("a", "b", "c") paste2 <- function(x, y) { out <- paste(x, y, sep = ".") if (x == "b" || y == "b") { done(out) } else { out } } expect_equal(accumulate(tt, paste2), c("a", "a.b")) expect_equal(accumulate(tt, paste2, .dir = "backward"), c("b.c", "c")) expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a", "z.a.b")) expect_equal( accumulate(tt, paste2, .dir = "backward", .init = "z"), c("b.c.z", "c.z", "z") ) }) test_that("can terminate accumulate() early with an empty box", { tt <- c("a", "b", "c") paste2 <- function(x, y) { out <- paste(x, y, sep = ".") if (x == "b" || y == "b") { done() } else { out } } expect_equal(accumulate(tt, paste2), "a") expect_equal(accumulate(tt, paste2, .dir = "backward"), "c") expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a")) expect_equal( accumulate(tt, paste2, .dir = "backward", .init = "z"), c("c.z", "z") ) # Init value is always included, even if done at first iteration expect_equal(accumulate(c("b", "c"), paste2), "b") }) test_that("accumulate() forces arguments (#643)", { compose <- function(f, g) function(x) f(g(x)) fns <- accumulate(list(identity, identity), compose) expect_true(every(fns, function(f) identical(f(1), 1))) }) test_that("accumulate() uses vctrs to simplify results", { out <- list("foo", factor("bar")) |> accumulate(~.y) expect_identical(out, c("foo", "bar")) }) 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")) }) 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", { paste2 <- function(x, y, sep) paste(x, y, sep = sep) x <- c("a", "b", "c") expect_equal(reduce2(x, c("-", "."), paste2), "a-b.c") expect_equal(reduce2(x, c(".", "-", "."), paste2, .init = "x"), "x.a-b.c") }) test_that("requires equal length vectors", { expect_snapshot(reduce2(1:3, 1, `+`), error = TRUE) }) test_that("requires init if `.x` is empty", { expect_snapshot(reduce2(list()), error = TRUE) }) test_that("reduce returns original input if it was length one", { x <- list(c(0, 1), c(2, 3), c(4, 5)) expect_equal(reduce(x[1], paste), x[[1]]) }) test_that("can shortcircuit reduce2() with done()", { x <- c(TRUE, TRUE, FALSE, TRUE, TRUE) out <- reduce2(x, 1:5, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL) expect_identical(out, c("foo", "foo")) }) test_that("reduce2() forces arguments (#643)", { compose <- function(f, g, ...) function(x) f(g(x)) fns <- reduce2(list(identity, identity), "foo", compose) expect_identical(fns(1), 1) }) # accumulate2 ------------------------------------------------------------- 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), 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", { paste2 <- function(x, y, sep) { out <- paste(x, y, sep = sep) if (y == "b") { done(out) } else { out } } x <- c("a", "b", "c") 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)", { compose <- function(f, g, ...) function(x) f(g(x)) fns <- accumulate2(list(identity, identity), "foo", compose) expect_true(every(fns, function(f) identical(f(1), 1))) }) purrr/tests/testthat/test-modify.R0000644000176200001440000001164515063325731017031 0ustar liggesusers# 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("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) 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("zap gives clear error", { expect_snapshot(error = TRUE, { modify_at(1, 1, ~ zap()) modify_at(list(1), 1, ~ zap()) modify_at(data.frame(x = 1), 1, ~ zap()) modify_at(lm(mpg ~ wt, data = mtcars), 1, ~ zap()) }) }) 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]) expect_equal(modify(df1, ~ if (is.numeric(.x)) .x + 1 else .x), df2) expect_equal(modify_at(df1, "x", ~ .x + 1), df2) }) test_that("modifying vectors preserves type", { expect_identical(modify(1:3, ~ .x + 1), 2:4) expect_equal(modify("a", ~ factor("b")), "b") 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("bad type has useful error", { 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("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("can 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)) }) test_that("modifying data frame ignores [<- methods", { df <- function(...) structure(data_frame(...), class = c("df", "data.frame")) local_bindings( "[<-.df" = function(...) stop("Forbidden"), .env = globalenv() ) x <- df(x = 1, y = "x") expect_equal(modify(x, ~2), df(x = 2, y = 2)) expect_equal(modify_if(x, is.character, ~2), df(x = 1, y = 2)) expect_equal(modify_at(x, "y", ~2), df(x = 1, y = 2)) expect_equal(modify2(x, list(2, 3), ~.y), df(x = 2, y = 3)) }) # 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) expect_identical( modify_if(iris, is.factor, as.character, .else = as.integer), exp ) expect_equal( modify_if(c(TRUE, FALSE), ~.x, ~FALSE, .else = ~TRUE), c(FALSE, TRUE) ) expect_equal(modify_if(1:2, ~ .x == 1, ~3L, .else = ~4L), c(3, 4)) expect_equal( modify_if(c(1, 10), ~ .x < 5, ~ .x * 10, .else = ~ .x / 2), c(10, 5) ) expect_equal( modify_if(c("a", "b"), ~ .x == "a", ~"A", .else = ~"B"), c("A", "B") ) }) test_that("modify_at() can use tidyselect", { skip_if_not_installed("tidyselect") local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = 1, y = 3) expect_equal( modify_at(df, vars(x), ~2), data.frame(x = 2, y = 3) ) }) test_that("imodify uses index", { expect_equal(imodify(list(2), ~.y), list(1)) expect_equal(imodify(list(a = 2), ~.y), list(a = "a")) }) # input validation -------------------------------------------------------- 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)) 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", { expect_snapshot(error = TRUE, { modify(mean, identity) modify_if(mean, TRUE, identity) modify_at(mean, "x", identity) modify2(mean, 1, identity) }) }) purrr/tests/testthat/_snaps/0000755000176200001440000000000015166122162015713 5ustar liggesuserspurrr/tests/testthat/_snaps/list-transpose.md0000644000176200001440000000417415166114151021231 0ustar liggesusers# can't transpose data frames Code list_transpose(df) Condition Error in `list_transpose()`: ! `x` must be a list, not a object. # integer template requires exact length of list() simplify etc Code list_transpose(x, ptype = list()) Condition Error in `list_transpose()`: ! Can't convert `result[[1]][[1]]` to . --- Code list_transpose(x, ptype = list(integer())) Condition Error in `list_transpose()`: ! Length of `ptype` (1) and `template` (2) must be the same when transposing by position. # simplification fails silently unless requested Code list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE) Condition Error in `list_transpose()`: ! Can't combine `result$x[[1]]` and `result$x[[2]]` . Code list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE) Condition Error in `list_transpose()`: ! `result$x[[2]]` must have size 1, not size 2. # 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 the number 10. Code list_transpose(list(1), template = mean) Condition Error in `list_transpose()`: ! `template` must be a character or numeric vector, not a function. # fail mixing named and unnamed vectors Code test_list_transpose() Condition Error in `list_transpose()`: ! Can't combine named and unnamed vectors. purrr/tests/testthat/_snaps/deprec-cross.md0000644000176200001440000000073615166114150020632 0ustar liggesusers# filtering requires a predicate function Code cross2(1:3, 1:3, .filter = ~ c(TRUE, TRUE)) Condition Error in `cross()`: ! The filter function must return a single `TRUE` or `FALSE`, not a logical vector. # filtering fails when filter function doesn't return a logical Code cross3(1:3, 1:3, 1:3, .filter = filter) Condition Error in `cross()`: ! The filter function must return a single `TRUE` or `FALSE`, not an integer. purrr/tests/testthat/_snaps/list-modify.md0000644000176200001440000000206115166114151020473 0ustar liggesusers# list_modify() validates inputs Code list_modify(1:3) Condition Error in `list_modify()`: ! `.x` must be a list, not an integer vector. --- Code list_modify(list(a = 1), 2, a = 2) Condition Error in `list_modify()`: ! `...` arguments must be either all named or all unnamed. --- Code list_modify(list(x = 1), x = 2, x = 3) Condition Error in `list_modify()`: ! Arguments in `...` must have unique names. x Multiple arguments named `x` at positions 1 and 2. # merge() validates inputs Code list_merge(1:3) Condition Error in `list_merge()`: ! `.x` must be a list, not an integer vector. --- Code list_merge(list(x = 1), x = 2, x = 3) Condition Error in `list_merge()`: ! Arguments in `...` must have unique names. x Multiple arguments named `x` at positions 1 and 2. # update_list() is deprecated Code . <- update_list(list()) Condition Warning: `update_list()` was deprecated in purrr 1.0.0. purrr/tests/testthat/_snaps/deprec-invoke.md0000644000176200001440000000235315166114150020771 0ustar liggesusers# invoke_* is deprecated Code . <- invoke(identity, 1) Condition Warning: `invoke()` was deprecated in purrr 1.0.0. i Please use `exec()` instead. Code . <- invoke_map(identity, list()) Condition Warning: `invoke_map()` was deprecated in purrr 1.0.0. i Please use map() + exec() instead. Code . <- invoke_map_lgl(identity, list()) Condition Warning: `invoke_lgl()` was deprecated in purrr 1.0.0. i Please use map_lgl() + exec() instead. Code . <- invoke_map_int(identity, list()) Condition Warning: `invoke_int()` was deprecated in purrr 1.0.0. i Please use map_int() + exec() instead. Code . <- invoke_map_dbl(identity, list()) Condition Warning: `invoke_dbl()` was deprecated in purrr 1.0.0. i Please use map_dbl() + exec() instead. Code . <- invoke_map_chr(identity, list()) Condition Warning: `invoke_chr()` was deprecated in purrr 1.0.0. i Please use map_chr() + exec() instead. Code . <- invoke_map_raw(identity, list()) Condition Warning: `invoke_raw()` was deprecated in purrr 1.0.0. i Please use map_raw() + exec() instead. purrr/tests/testthat/_snaps/parallel.md0000644000176200001440000001111715166122162020032 0ustar liggesusers# Can't use `...` in a parallel map Code map(list(x = 1, y = 2), in_parallel(function(x) list(x)), a = "wrong") Condition Error in `map()`: ! Can't use `...` with parallelized functions. # all inform about location of problem Code map_int(1:3, in_parallel(function(x, bad = 2:1) if (x == 3) bad else x)) Condition Error in `map_int()`: ! `x[[3]]` must have size 1, not size 2. Code map_int(1:3, in_parallel(function(x, bad = "x") if (x == 3) bad else x)) Condition Error in `map_int()`: ! Can't convert `[[3]]` to . Code map(1:3, in_parallel(function(x, bad = stop("Doesn't work")) if (x == 3) bad else x)) Condition Error in `map()`: i In index: 3. Caused by error: ! Doesn't work # error location uses name if present Code map_int(c(a = 1, b = 2, c = 3), in_parallel(function(x, bad = stop( "Doesn't work")) if (x == 3) bad else x)) Condition Error in `map_int()`: i In index: 3. i With name: c. Caused by error: ! Doesn't work Code map_int(c(a = 1, b = 2, 3), in_parallel(function(x, bad = stop("Doesn't work")) if (x == 3) bad else x)) Condition Error in `map_int()`: i In index: 3. Caused by error: ! Doesn't work # requires output be length 1 and have common type Code map_vec(1:2, in_parallel(~ rep(1, .x))) Condition Error in `map_vec()`: ! `out[[2]]` must have size 1, not size 2. Code map_vec(1:2, in_parallel(~ 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, in_parallel(~ factor("x")), .ptype = integer()) Condition Error in `map_vec()`: ! Can't convert `[[1]]` > to . # verifies result types and length Code map2_int(1, 1, in_parallel(~"x")) Condition Error in `map2_int()`: ! Can't convert `[[1]]` to . Code map2_int(1, 1, in_parallel(~ 1:2)) Condition Error in `map2_int()`: ! `x[[1]]` must have size 1, not size 2. Code map2_vec(1, 1, in_parallel(~1), .ptype = character()) Condition Error in `map2_vec()`: ! Can't convert `[[1]]` to . --- Code pmap_int(list(1), in_parallel(~"x")) Condition Error in `pmap_int()`: ! Can't convert `[[1]]` to . Code pmap_int(list(1), in_parallel(~ 1:2)) Condition Error in `pmap_int()`: ! `x[[1]]` must have size 1, not size 2. Code pmap_vec(list(1), in_parallel(~1), .ptype = character()) Condition Error in `pmap_vec()`: ! Can't convert `[[1]]` to . # requires vector inputs Code map2(environment(), "a", in_parallel(function(x) identity(x))) Condition Error in `map2()`: ! `.x` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. Code map2("a", environment(), "a", in_parallel(function(x) identity(x))) Condition Error in `map2()`: ! `.y` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. # recycles inputs Code map2(1:2, 1:3, in_parallel(function(x, y) x + y)) Condition Error in `map2()`: ! Can't recycle `.x` (size 2) to match `.y` (size 3). Code map2(1:2, integer(), in_parallel(function(x, y) x + y)) Condition Error in `map2()`: ! Can't recycle `.x` (size 2) to match `.y` (size 0). --- Code pmap(list(1:2, 1:3), in_parallel(function(x, y) x + y)) Condition Error in `pmap()`: ! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 3). Code pmap(list(1:2, integer()), in_parallel(function(x, y) x + y)) Condition Error in `pmap()`: ! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 0). # requires list of vectors Code pmap(environment(), in_parallel(function(x) identity(x))) Condition Error in `pmap()`: ! `.l` must be a list, not an environment. Code pmap(list(environment()), in_parallel(function(x) identity(x))) Condition Error in `pmap()`: ! `.l[[1]]` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. purrr/tests/testthat/_snaps/pluck-assign.md0000644000176200001440000000027715166114152020643 0ustar liggesusers# assign_in() requires at least one location Code assign_in(x, NULL, value = "foo") Condition Error in `assign_in()`: ! `where` must contain at least one element. purrr/tests/testthat/_snaps/adverb-slowly.md0000644000176200001440000000022215166114147021027 0ustar liggesusers# validates inputs Code slowly(mean, 10) Condition Error in `slowly()`: ! `rate` must be a rate object, not a number. purrr/tests/testthat/_snaps/conditions.md0000644000176200001440000000351115166114150020404 0ustar liggesusers# stop_bad_type() constructs default `what` Code stop_bad_type(NA, "`NULL`") Condition Error: ! Object must be `NULL`, not `NA`. --- Code stop_bad_type(NA, "`NULL`", arg = ".foo") Condition Error: ! `.foo` must be `NULL`, not `NA`. --- Code stop_bad_type(NA, "`NULL`", arg = quote(.foo)) Condition Error in `what_bad_object()`: ! `arg` must be `NULL` or a string, not a symbol. # stop_bad_element_type() constructs type errors Code stop_bad_element_type(1:3, 3, "a foobaz") Condition Error: ! Element 3 must be a foobaz, not an integer vector. --- Code stop_bad_element_type(1:3, 3, "a foobaz", actual = "a quux") Condition Error: ! Element 3 must be a foobaz, not an integer vector. --- Code stop_bad_element_type(1:3, 3, "a foobaz", arg = "..arg") Condition Error: ! `..arg[[3]]` must be a foobaz, not an integer vector. # stop_bad_element_type() accepts `what` Code stop_bad_element_type(1:3, 3, "a foobaz", what = "Result") Condition Error: ! Result 3 must be a foobaz, not an integer vector. # stop_bad_element_length() constructs error message Code stop_bad_element_length(1:3, 8, 10) Condition Error: ! Element 8 must have length 10, not 3. --- Code stop_bad_element_length(1:3, 8, 10, arg = ".foo") Condition Error: ! `.foo[[8]]` must have length 10, not 3. --- Code stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result") Condition Error: ! `.foo[[8]]` must have length 10, not 3. --- Code stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result", recycle = TRUE) Condition Error: ! `.foo[[8]]` must have length 1 or 10, not 3. purrr/tests/testthat/_snaps/adverb-auto-browse.md0000644000176200001440000000027215166114147021752 0ustar liggesusers# auto_browse() not intended for primitive functions Code auto_browse(log)(NULL) Condition Error in `auto_browse()`: ! `.f` must not be a primitive function. purrr/tests/testthat/_snaps/deprec-utils.md0000644000176200001440000000144215166114150020634 0ustar liggesusers# rdunif and rbernoulli are deprecated Code . <- rdunif(10, 1) Condition Warning: `rdunif()` was deprecated in purrr 1.0.0. Code . <- rbernoulli(10) Condition Warning: `rbernoulli()` was deprecated in purrr 1.0.0. # rdunif fails if a and b are not unit length numbers Code rdunif(1000, 1, "a") Condition Error in `rdunif()`: ! is.numeric(a) is not TRUE --- Code rdunif(1000, 1, c(0.5, 0.2)) Condition Error in `rdunif()`: ! length(a) == 1 is not TRUE --- Code rdunif(1000, FALSE, 2) Condition Error in `rdunif()`: ! is.numeric(b) is not TRUE --- Code rdunif(1000, c(2, 3), 2) Condition Error in `rdunif()`: ! length(b) == 1 is not TRUE purrr/tests/testthat/_snaps/modify.md0000644000176200001440000000660515166122162017533 0ustar liggesusers# modfiying data.frame preserves type and size Code modify(df1, ~ integer()) Condition Error in `modify()`: ! 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 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. # zap gives clear error Code modify_at(1, 1, ~ zap()) Condition Error in `map_vec()`: ! `out[[1]]` must be a vector, not a object. x Detected incompatible scalar S3 list. To be treated as a vector, the object must explicitly inherit from or should implement a `vec_proxy()` method. Class: . i If this object comes from a package, please report this error to the package author. i Read our FAQ about creating vector types (`?vctrs::howto_faq_fix_scalar_type_error`) to learn more. Code modify_at(list(1), 1, ~ zap()) Condition Error in `modify_at()`: ! Can't use `zap()` to change the size of the output. Code modify_at(data.frame(x = 1), 1, ~ zap()) Condition Error in `modify_at()`: ! Can't use `zap()` to change the size of the output. Code modify_at(lm(mpg ~ wt, data = mtcars), 1, ~ zap()) Condition Error in `modify_at()`: ! Can't use `zap()` to change the size of the output. # bad type has useful error Code modify(1:3, ~"foo") Condition Error in `map_vec()`: ! Can't convert `[[1]]` to . Code modify_at(1:3, 1, ~"foo") Condition Error in `map_vec()`: ! Can't convert `[[1]]` to . Code modify_if(1:3, is_integer, ~"foo") Condition Error in `map_vec()`: ! Can't convert `[[1]]` to . Code modify2(1:3, "foo", ~.y) Condition Error in `map2_vec()`: ! Can't convert `[[1]]` to . # modify2() recycles arguments Code modify2(1:3, integer(), `+`) Condition Error in `map2()`: ! Can't recycle `.x` (size 3) to match `.y` (size 0). Code modify2(1:3, 1:4, `+`) Condition Error in `map2()`: ! Can't recycle `.x` (size 3) to match `.y` (size 4). # modify_if() requires predicate functions Code modify_if(list(1, 2), ~NA, ~"foo") Condition Error in `modify_if()`: i In index: 1. Caused by error: ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. # user friendly error for non-supported cases Code modify(mean, identity) Condition Error in `modify()`: ! `.x` must be a vector, list, or data frame, not a function. Code modify_if(mean, TRUE, identity) Condition Error in `modify_if()`: ! `.x` must be a vector, list, or data frame, not a function. Code modify_at(mean, "x", identity) Condition Error in `modify_at()`: ! `.x` must be a vector, list, or data frame, not a function. Code modify2(mean, 1, identity) Condition Error in `modify2()`: ! `.x` must be a vector, list, or data frame, not a function. purrr/tests/testthat/_snaps/adverb-compose.md0000644000176200001440000000044515166114147021152 0ustar liggesusers# composed function prints informatively Code # Single input compose(fn1) Output 1. function(x) x + 1 Code # Multiple inputs compose(fn1, fn2) Output 1. function(x) x / 1 2. function(x) x + 1 purrr/tests/testthat/_snaps/modify-tree.md0000644000176200001440000000053515166114152020464 0ustar liggesusers# validates inputs Code modify_tree(list(), is_node = ~1) Condition Error in `modify_tree()`: ! `is_node()` must return a single `TRUE` or `FALSE`, not a number. Code modify_tree(list(), is_node = 1) Condition Error in `modify_tree()`: ! Can't convert `is_node`, a double vector, to a function. purrr/tests/testthat/_snaps/lmap.md0000644000176200001440000000070015166114151017162 0ustar liggesusers# validates inputs Code lmap(list(1), ~1) Condition Error in `lmap()`: ! `.f(.x[[1]])` must return a list, not a number. Code lmap(list(1), environment()) Condition Error in `lmap()`: ! Can't convert `.f`, an environment, to a function. Code lmap(list(1), ~1, .else = environment()) Condition Error in `lmap()`: ! Can't convert `.else`, an environment, to a function. purrr/tests/testthat/_snaps/deprec-lift.md0000644000176200001440000000137315166114150020435 0ustar liggesusers# lift functions are deprecated Code . <- lift_dl(function() { }) Condition Warning: `lift()` was deprecated in purrr 1.0.0. Code . <- lift_dv(function() { }) Condition Warning: `lift_dv()` was deprecated in purrr 1.0.0. Code . <- lift_vl(function() { }) Condition Warning: `lift_vl()` was deprecated in purrr 1.0.0. Code . <- lift_vd(function() { }) Condition Warning: `lift_vd()` was deprecated in purrr 1.0.0. Code . <- lift_ld(function() { }) Condition Warning: `lift_ld()` was deprecated in purrr 1.0.0. Code . <- lift_lv(function() { }) Condition Warning: `lift_lv()` was deprecated in purrr 1.0.0. purrr/tests/testthat/_snaps/list-combine.md0000644000176200001440000000455515166114151020632 0ustar liggesusers# list_c() concatenates vctrs of compatible types Code list_c(list("a", 1)) Condition Error in `list_c()`: ! Can't combine `x[[1]]` and `x[[2]]` . # list_c() can enforce ptype Code list_c(list("a"), ptype = integer()) Condition Error in `list_c()`: ! Can't convert `x[[1]]` to . # list_cbind() column-binds compatible data frames Code list_cbind(list(df1, df3)) Condition Error in `list_cbind()`: ! Can't recycle `..1` (size 2) to match `..2` (size 3). # list_cbind() can enforce size Code list_cbind(list(df1), size = 3) Condition Error: ! Can't recycle input of size 2 to size 3. # list_rbind() row-binds compatible data.frames Code list_rbind(list(df1, df3)) Condition Error in `list_rbind()`: ! Can't combine `..1$x` and `..2$x` . # list_rbind() can enforce ptype Code ptype <- data.frame(x = character(), stringsAsFactors = FALSE) list_rbind(list(df1), ptype = ptype) Condition Error in `list_rbind()`: ! Can't convert `..1$x` to match type of `x` . # assert input is a list Code list_c(1) Condition Error in `list_c()`: ! `x` must be a list, not the number 1. Code list_rbind(1) Condition Error in `list_rbind()`: ! `x` must be a list, not the number 1. Code list_cbind(1) Condition Error in `list_cbind()`: ! `x` must be a list, not the number 1. --- Code list_c(mtcars) Condition Error in `list_c()`: ! `x` must be a list, not a object. Code list_rbind(mtcars) Condition Error in `list_rbind()`: ! `x` must be a list, not a object. Code list_cbind(mtcars) Condition Error in `list_cbind()`: ! `x` must be a list, not a object. # assert input is list of data frames Code list_rbind(list(1, mtcars, 3)) Condition Error in `list_rbind()`: ! Each element of `x` must be either a data frame or `NULL`. i Elements 1 and 3 are not. Code list_cbind(list(1, mtcars, 3)) Condition Error in `list_cbind()`: ! Each element of `x` must be either a data frame or `NULL`. i Elements 1 and 3 are not. purrr/tests/testthat/_snaps/deprec-along.md0000644000176200001440000000030315166114150020567 0ustar liggesusers# list-along is deprecated Code . <- list_along(1:4) Condition Warning: `list_along()` was deprecated in purrr 1.0.0. i Please use rep_along(x, list()) instead. purrr/tests/testthat/_snaps/map2.md0000644000176200001440000000244615166122162017102 0ustar liggesusers# verifies result types and length Code map2_int(1, 1, ~"x") Condition Error in `map2_int()`: i In index: 1. Caused by error: ! Can't coerce from a string to an integer. Code map2_int(1, 1, ~ 1:2) Condition Error in `map2_int()`: i In index: 1. Caused by error: ! Result must be length 1, not 2. Code map2_vec(1, 1, ~1, .ptype = character()) Condition Error in `map2_vec()`: ! Can't convert `[[1]]` to . # requires vector inputs Code map2(environment(), "a", identity) Condition Error in `map2()`: ! `.x` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. Code map2("a", environment(), "a", identity) Condition Error in `map2()`: ! `.y` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. # recycles inputs Code map2(1:2, 1:3, `+`) Condition Error in `map2()`: ! Can't recycle `.x` (size 2) to match `.y` (size 3). Code map2(1:2, integer(), `+`) Condition Error in `map2()`: ! Can't recycle `.x` (size 2) to match `.y` (size 0). purrr/tests/testthat/_snaps/rate.md0000644000176200001440000000256115166114152017174 0ustar liggesusers# rates have print methods Code rate_delay(20, max_times = Inf) Message Attempts: 0/Inf pause: 20 Code rate_backoff() Message Attempts: 0/3 pause_base: 1 pause_cap: 60 pause_min: 1 # rate_delay() delays Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! Request failed after 3 attempts. --- Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! This `rate` object has already be run more than `max_times` allows. i Do you need to reset it with `rate_reset()`? # rate_backoff() backs off Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! Request failed after 3 attempts. --- Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! This `rate` object has already be run more than `max_times` allows. i Do you need to reset it with `rate_reset()`? # rate_sleep() checks that rate is still valid Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! Request failed after 0 attempts. --- Code rate_sleep(rate) Condition Error in `rate_sleep()`: ! This `rate` object has already be run more than `max_times` allows. i Do you need to reset it with `rate_reset()`? purrr/tests/testthat/_snaps/detect.md0000644000176200001440000000060115166114150017500 0ustar liggesusers# `detect()` requires a predicate function Code detect(list(1:2, 2), is.na) Condition Error in `detect()`: ! `.f()` must return a single `TRUE` or `FALSE`, not a logical vector. --- Code detect_index(list(1:2, 2), is.na) Condition Error in `detect_index()`: ! `.f()` must return a single `TRUE` or `FALSE`, not a logical vector. purrr/tests/testthat/_snaps/every-some-none.md0000644000176200001440000000606415166122162021273 0ustar liggesusers# every(), some(), and none() require logical scalar predicate results Code every(list(1), function(x) 1) Condition Error in `every()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not the number 1. --- Code some(list(1), function(x) 1) Condition Error in `some()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not the number 1. --- Code none(list(1), function(x) 1) Condition Error in `none()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not the number 1. --- Code every(list(1), function(x) NA_integer_) Condition Error in `every()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not an integer `NA`. --- Code some(list(1), function(x) NA_integer_) Condition Error in `some()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not an integer `NA`. --- Code none(list(1), function(x) NA_integer_) Condition Error in `none()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not an integer `NA`. --- Code every(list(1), function(x) c(TRUE, FALSE)) Condition Error in `every()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not a logical vector. --- Code some(list(1), function(x) c(TRUE, FALSE)) Condition Error in `some()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not a logical vector. --- Code none(list(1), function(x) c(TRUE, FALSE)) Condition Error in `none()`: ! `.p()` must return a single `TRUE`, `FALSE`, or `NA`, not a logical vector. # every(), some(), and none() require vector `.x` Code every(function() 1, identity) Condition Error in `every()`: ! `.x` must be a vector, not a function. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. --- Code some(function() 1, identity) Condition Error in `some()`: ! `.x` must be a vector, not a function. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. --- Code none(function() 1, identity) Condition Error in `none()`: ! `.x` must be a vector, not a function. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. # pairlists, expressions, and calls are deprecated but work Code out <- every(expression(1, 2), is.double) Condition Warning: Use of calls and expressions in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` --- Code out <- every(pairlist(1, 2), is.double) Condition Warning: Use of pairlists in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` --- Code x <- every(quote(f(a, b)), is.name) Condition Warning: Use of calls and expressions in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` purrr/tests/testthat/_snaps/progress-bars.md0000644000176200001440000000030215166114152021021 0ustar liggesusers# useful for bad progress spec Code map(1, .progress = 1) Condition Error in `map()`: ! `.progress` must be TRUE, FALSE, a string, or a named list, not the number 1. purrr/tests/testthat/_snaps/list-simplify.md0000644000176200001440000000372115166122162021045 0ustar liggesusers# ptype is enforced Code list_simplify(list(1, 2), ptype = character()) Condition Error in `list_simplify()`: ! Can't convert `[[1]]` to . --- Code list_simplify(list(1, 2), ptype = character(), strict = FALSE) Condition Error in `list_simplify()`: ! Can't convert `[[1]]` to . # strict simplification will error Code list_simplify(list(mean)) Condition Error in `list_simplify()`: ! `x[[1]]` must be a vector, not a function. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. Code list_simplify(list(1, "a")) Condition Error in `list_simplify()`: ! Can't combine `[[1]]` and `[[2]]` . Code list_simplify(list(1, 1:2)) Condition Error in `list_simplify()`: ! `x[[2]]` must have size 1, not size 2. Code list_simplify(list(data.frame(x = 1), data.frame(x = 1:2))) Condition Error in `list_simplify()`: ! `x[[2]]` must have size 1, not size 2. Code list_simplify(list(1, 2), ptype = character()) Condition Error in `list_simplify()`: ! Can't convert `[[1]]` to . # list_simplify() validates inputs Code list_simplify(1:5) Condition Error in `list_simplify()`: ! `x` must be a list, not an integer vector. --- Code list_simplify(list(), strict = NA) Condition Error in `list_simplify()`: ! `strict` must be `TRUE` or `FALSE`, not `NA`. # list_simplify_internal() validates inputs Code list_simplify_internal(list(), simplify = 1) Condition Error: ! `simplify` must be `TRUE`, `FALSE`, or `NA`, not the number 1. --- Code list_simplify_internal(list(), simplify = FALSE, ptype = integer()) Condition Error: ! Can't specify `ptype` when `simplify = FALSE`. purrr/tests/testthat/_snaps/keep.md0000644000176200001440000000063715166114151017166 0ustar liggesusers# keep() and discard() require predicate functions Code keep(1:3, ~NA) Condition Error in `keep()`: i In index: 1. Caused by error: ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. Code discard(1:3, ~NA) Condition Error in `discard()`: i In index: 1. Caused by error: ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. purrr/tests/testthat/_snaps/arrays.md0000644000176200001440000000032215166114150017531 0ustar liggesusers# array_branch throws an error for wrong margins on a vector Code array_branch(1:3, 2) Condition Error in `array_branch()`: ! `margin` must be `NULL` or `1` with 1D arrays, not "2". purrr/tests/testthat/_snaps/deprec-when.md0000644000176200001440000000055715166114150020443 0ustar liggesusers# when is deprecated Code . <- when(1:5 < 3 ~ 1, ~0) Condition Warning: `when()` was deprecated in purrr 1.0.0. i Please use `if` instead. # error when named arguments have no matching conditions Code when(1:5, a = sum(.) < 5 ~ 3) Condition Error in `when()`: ! At least one matching condition is needed. purrr/tests/testthat/_snaps/reduce.md0000644000176200001440000000127515166114153017512 0ustar liggesusers# empty input returns init or error Code reduce(list()) Condition Error in `reduce()`: ! Must supply `.init` when `.x` is empty. # accumulate() does fail when simpification is required Code accumulate(list(1, "a"), ~.y, .simplify = TRUE) Condition Error in `accumulate()`: ! Can't combine `res[[1]]` and `res[[2]]` . # requires equal length vectors Code reduce2(1:3, 1, `+`) Condition Error in `reduce2()`: ! `.y` must have length 2, not 1. # requires init if `.x` is empty Code reduce2(list()) Condition Error in `reduce2()`: ! Must supply `.init` when `.x` is empty. purrr/tests/testthat/_snaps/deprec-splice.md0000644000176200001440000000026015166114150020750 0ustar liggesusers# splice is deprecated Code . <- splice() Condition Warning: `splice()` was deprecated in purrr 1.0.0. i Please use `list_flatten()` instead. purrr/tests/testthat/_snaps/deprec-prepend.md0000644000176200001440000000134615166114150021134 0ustar liggesusers# prepend is deprecated Code . <- prepend(1, 2) Condition Warning: `prepend()` was deprecated in purrr 1.0.0. i Please use append(after = 0) instead. # prepend throws error if before param is neither NULL nor between 1 and length(x) Code prepend(list(), 1, before = 1) Condition Error in `prepend()`: ! is.null(before) || (before > 0 && before <= n) is not TRUE --- Code x %>% prepend(4, before = 0) Condition Error in `prepend()`: ! is.null(before) || (before > 0 && before <= n) is not TRUE --- Code x %>% prepend(4, before = 4) Condition Error in `prepend()`: ! is.null(before) || (before > 0 && before <= n) is not TRUE purrr/tests/testthat/_snaps/map-raw.md0000644000176200001440000000145015166114151017600 0ustar liggesusers# _raw funtions are deprecated Code . <- map_raw(list(), ~.x) Condition Warning: `map_raw()` was deprecated in purrr 1.0.0. i Please use `map_vec()` instead. Code . <- map2_raw(list(), list(), ~.x) Condition Warning: `map2_raw()` was deprecated in purrr 1.0.0. i Please use `map2_vec()` instead. Code . <- imap_raw(list(), ~.x) Condition Warning: `imap_raw()` was deprecated in purrr 1.0.0. i Please use `imap_vec()` instead. Code . <- pmap_raw(list(), ~.x) Condition Warning: `pmap_raw()` was deprecated in purrr 1.0.0. i Please use `pmap_vec()` instead. Code . <- flatten_raw(list()) Condition Warning: `flatten_raw()` was deprecated in purrr 1.0.0. purrr/tests/testthat/_snaps/head-tail.md0000644000176200001440000000057415166114150020071 0ustar liggesusers# head_while and tail_while require predicate function Code head_while(1:3, ~NA) Condition Error in `head_while()`: ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. --- Code tail_while(1:3, ~ c(TRUE, FALSE)) Condition Error in `tail_while()`: ! `.p()` must return a single `TRUE` or `FALSE`, not a logical vector. purrr/tests/testthat/_snaps/pluck-depth.md0000644000176200001440000000030015166114152020446 0ustar liggesusers# vec_depth() is deprecated Code . <- vec_depth(list()) Condition Warning: `vec_depth()` was deprecated in purrr 1.0.0. i Please use `pluck_depth()` instead. purrr/tests/testthat/_snaps/map-depth.md0000644000176200001440000000324615166114151020120 0ustar liggesusers# map_depth modifies values at specified depth Code map_depth(x1, 6, length) Condition Error in `.fmap()`: i In index: 1. Caused by error in `.fmap()`: i In index: 1. Caused by error in `.fmap()`: i In index: 1. Caused by error in `map_depth()`: ! List not deep enough --- Code map_depth(x1, -5, length) Condition Error in `map_depth()`: ! Negative `.depth` (-5) must be greater than -4. # default doesn't recurse into data frames, but can customise Code map_depth(x, 2, class) Condition Error in `.fmap()`: i In index: 1. Caused by error in `map_depth()`: ! List not deep enough # modify_depth modifies values at specified depth Code modify_depth(x1, 5, length) Condition Error in `map()`: i In index: 1. Caused by error in `map()`: i In index: 1. Caused by error in `map()`: i In index: 1. Caused by error in `modify_depth()`: ! List not deep enough --- Code modify_depth(x1, -5, length) Condition Error in `modify_depth()`: ! Negative `.depth` (-5) must be greater than -4. # vectorised operations on the recursive and atomic levels yield same results Code modify_depth(x, 5, `+`, 10L) Condition Error in `map()`: i In index: 1. Caused by error in `map()`: i In index: 1. Caused by error in `map()`: i In index: 1. Caused by error in `modify_depth()`: ! List not deep enough # validates depth Code check_depth(mean) Condition Error: ! `depth` must be a whole number, not a function. purrr/tests/testthat/_snaps/map-if-at.md0000644000176200001440000000034615166114151020012 0ustar liggesusers# map_if requires predicate functions Code map_if(1:3, ~NA, ~"foo") Condition Error in `map_if()`: i In index: 1. Caused by error: ! `.p()` must return a single `TRUE` or `FALSE`, not `NA`. purrr/tests/testthat/_snaps/adverb-insistently.md0000644000176200001440000000042015166114147022063 0ustar liggesusers# insistently() resets rate state Request failed after 0 attempts. --- Request failed after 0 attempts. # validates inputs Code insistently(mean, 10) Condition Error in `insistently()`: ! `rate` must be a rate object, not a number. purrr/tests/testthat/_snaps/adverb-partial.md0000644000176200001440000000042315166114150021127 0ustar liggesusers# partial() squashes quosures before printing Code foo Output function (...) foo(y = 3, ...) # checks inputs Code partial(1) Condition Error in `partial()`: ! `.f` must be a function, not a number. purrr/tests/testthat/_snaps/superseded-transpose.md0000644000176200001440000000126715166114153022423 0ustar liggesusers# input must be a list Code transpose(1:3) Condition Error in `transpose()`: ! `.l` must be a list, not an integer vector. # elements of input must be atomic vectors Code transpose(list(environment())) Condition Error in `transpose()`: ! Element 1 must be a vector, not an environment. --- Code transpose(list(list(), environment())) Condition Error in `transpose()`: ! Element 2 must be a vector, not an environment. # can't transpose expressions Code transpose(list(expression(a))) Condition Error in `transpose()`: ! Transposed element must be a vector, not an expression vector. purrr/tests/testthat/_snaps/pmap.md0000644000176200001440000000236215166122162017175 0ustar liggesusers# verifies result types and length Code pmap_int(list(1), ~"x") Condition Error in `pmap_int()`: i In index: 1. Caused by error: ! Can't coerce from a string to an integer. Code pmap_int(list(1), ~ 1:2) Condition Error in `pmap_int()`: i In index: 1. Caused by error: ! Result must be length 1, not 2. Code pmap_vec(list(1), ~1, .ptype = character()) Condition Error in `pmap_vec()`: ! Can't convert `[[1]]` to . # 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. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. # recycles inputs Code pmap(list(1:2, 1:3), `+`) Condition Error in `pmap()`: ! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 3). Code pmap(list(1:2, integer()), `+`) Condition Error in `pmap()`: ! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 0). purrr/tests/testthat/_snaps/pluck.md0000644000176200001440000001253315166114152017357 0ustar liggesusers# can pluck/chuck from NULL Code chuck(NULL, 1) Condition Error in `chuck()`: ! Can't pluck from NULL at level 1. # unsupported types have useful error Code pluck(quote(x), 1) Condition Error in `pluck_raw()`: ! Can't pluck from a symbol at level 1. Code pluck(quote(f(x, 1)), 1) Condition Error in `pluck_raw()`: ! Can't pluck from a call at level 1. Code pluck(expression(1), 1) Condition Error in `pluck_raw()`: ! Can't pluck from an expression vector at level 1. # dots must be unnamed Code pluck(1, a = 1) Condition Error in `pluck()`: ! Arguments in `...` must be passed by position, not name. x Problematic argument: * a = 1 --- Code chuck(1, a = 1) Condition Error in `chuck()`: ! Arguments in `...` must be passed by position, not name. x Problematic argument: * a = 1 # can pluck by position (positive and negative) Code chuck(x, 0) Condition Error in `chuck()`: ! Index 1 is zero. --- Code chuck(x, 4) Condition Error in `chuck()`: ! Index 1 exceeds the length of plucked object (4 > 3). --- Code chuck(x, -4) Condition Error in `chuck()`: ! Index 1 is zero. --- Code chuck(x, -5) Condition Error in `chuck()`: ! Negative index 1 must be greater than or equal to -3, not -5. # special numbers don't match Code chuck(x, NA_integer_) Condition Error in `chuck()`: ! Index 1 must be finite, not NA. --- Code chuck(x, NA_real_) Condition Error in `chuck()`: ! Index 1 must be finite, not NA. --- Code chuck(x, NaN) Condition Error in `chuck()`: ! Index 1 must be finite, not NaN. --- Code chuck(x, Inf) Condition Error in `chuck()`: ! Index 1 must be finite, not Inf. --- Code chuck(x, -Inf) Condition Error in `chuck()`: ! Index 1 must be finite, not -Inf. # can pluck by name Code chuck(x, "b") Condition Error in `chuck()`: ! Can't find name `b` in vector. --- Code chuck(x, NA_character_) Condition Error in `chuck()`: ! Index 1 can't be NA. --- Code chuck(x, "") Condition Error in `chuck()`: ! Index 1 can't be an empty string (""). # even if names don't exist Code chuck(x, "a") Condition Error in `chuck()`: ! Index 1 is attempting to pluck from an unnamed vector using a string name. # empty and NA names never match Code chuck(x, "") Condition Error in `chuck()`: ! Index 1 can't be an empty string (""). --- Code chuck(x, NA_character_) Condition Error in `chuck()`: ! Index 1 can't be NA. # require length 1 character/double vectors Code pluck(1, 1:2) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 2. Code pluck(1, integer()) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 0. Code pluck(1, NULL) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 0. Code pluck(1, TRUE) Condition Error in `pluck_raw()`: ! Index 1 must be a character or numeric vector, not `TRUE`. # validate index even when indexing NULL Code pluck(NULL, 1:2) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 2. Code pluck(NULL, TRUE) Condition Error in `pluck_raw()`: ! Index 1 must be a character or numeric vector, not `TRUE`. # accessors throw correct errors Code pluck(1:3, function() NULL) Condition Error: ! unused argument (1:3) Code pluck(1:3, function(x, y) y) Condition Error: ! argument "y" is missing, with no default # can pluck/chuck environment by name Code chuck(x, "y") Condition Error in `chuck()`: ! Can't find object `y` in environment. --- Code chuck(x, NA_character_) Condition Error in `chuck()`: ! Index 1 can't be NA. # environments error with invalid indices Code pluck(environment(), 1) Condition Error in `pluck_raw()`: ! Index 1 must be a string, not a number. --- Code pluck(environment(), letters) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 26. # can pluck/chuck from S4 objects Code chuck(A, "b") Condition Error in `chuck()`: ! Can't find slot `b`. --- Code chuck(A, NA_character_) Condition Error in `chuck()`: ! Index 1 can't be NA. # S4 objects error with invalid indices Code pluck(A, 1) Condition Error in `pluck_raw()`: ! Index 1 must be a string, not a number. --- Code pluck(A, letters) Condition Error in `pluck_raw()`: ! Index 1 must have length 1, not 26. # pluck() dispatches on vector methods Code chuck(x, 1, 1) Condition Error in `chuck()`: ! Length of S3 object must be a scalar integer. --- Code chuck(x, 1, "b", 1) Condition Error in `chuck()`: ! Index 2 is attempting to pluck from an unnamed vector using a string name. purrr/tests/testthat/_snaps/superseded-flatten.md0000644000176200001440000000133115166114153022032 0ustar liggesusers# input must be a list Code flatten(1) Condition Error in `flatten()`: ! `.x` must be a list, not a number. --- Code flatten_dbl(1) Condition Error in `flatten_dbl()`: ! `.x` must be a list, not a number. # contents of list must be supported types Code flatten(list(quote(a))) Condition Error in `flatten()`: ! `.x[[1]]` must be a vector, not a symbol. --- Code flatten(list(expression(a))) Condition Error in `flatten()`: ! `.x[[1]]` must be a vector, not an expression vector. # must be a list Code flatten_lgl(1) Condition Error in `flatten_lgl()`: ! `.x` must be a list, not a number. purrr/tests/testthat/_snaps/map.md0000644000176200001440000000402115166122162017007 0ustar liggesusers# fails on non-vectors Code map(environment(), identity) Condition Error in `map()`: ! `.x` must be a vector, not an environment. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. --- Code map(quote(a), identity) Condition Error in `map()`: ! `.x` must be a vector, not a symbol. i Read our FAQ about scalar types (`?vctrs::faq_error_scalar_type`) to learn more. # all inform about location of problem Code map_int(1:3, ~ fail_at_3(.x, 2:1)) Condition Error in `map_int()`: i In index: 3. Caused by error: ! Result must be length 1, not 2. Code map_int(1:3, ~ fail_at_3(.x, "x")) Condition Error in `map_int()`: i In index: 3. Caused by error: ! Can't coerce from a string to an integer. Code map(1:3, ~ fail_at_3(.x, stop("Doesn't work"))) Condition Error in `map()`: i In index: 3. Caused by error in `fail_at_3()`: ! Doesn't work # error location uses name if present Code map_int(c(a = 1, b = 2, c = 3), ~ fail_at_3(.x, stop("Error"))) Condition Error in `map_int()`: i In index: 3. i With name: c. Caused by error in `fail_at_3()`: ! Error Code map_int(c(a = 1, b = 2, 3), ~ fail_at_3(.x, stop("Error"))) Condition Error in `map_int()`: i In index: 3. Caused by error in `fail_at_3()`: ! Error # requires output be length 1 and have common type Code map_vec(1:2, ~ rep(1, .x)) Condition Error in `map_vec()`: ! `out[[2]]` must have size 1, not size 2. 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 in `map_vec()`: ! Can't convert `[[1]]` > to . purrr/tests/testthat/_snaps/list-flatten.md0000644000176200001440000000020015166114151020632 0ustar liggesusers# requires a list Code list_flatten(1:2) Condition Error in `list_flatten()`: ! `x` must be a node. purrr/tests/testthat/_snaps/deprec-rerun.md0000644000176200001440000000105015166114150020622 0ustar liggesusers# is deprecated Code . <- rerun(5, rnorm(1)) Condition Warning: `rerun()` was deprecated in purrr 1.0.0. i Please use `map()` instead. # Previously rerun(5, rnorm(1)) # Now map(1:5, ~ rnorm(1)) Code . <- rerun(5, rnorm(1), rnorm(2)) Condition Warning: `rerun()` was deprecated in purrr 1.0.0. i Please use `map()` instead. # Previously rerun(5, rnorm(1), rnorm(2)) # Now map(1:5, ~ list(rnorm(1), rnorm(2))) purrr/tests/testthat/_snaps/utils.md0000644000176200001440000000350315166114153017377 0ustar liggesusers# errors on invalid subsetting vectors Code where_at(x, c(FALSE, TRUE)) Condition Error: ! Can't subset elements with `at`. x Logical subscript `at` must be size 1 or 3, not 2. Code where_at(x, NA_real_) Condition Error: ! Can't subset elements. x Subscript can't contain missing values. x It has a missing value at location 1. Code where_at(x, 4) Condition Error: ! Can't subset elements past the end. i Location 4 doesn't exist. i There are only 3 elements. # validates its inputs Code where_at(x, list()) Condition Error: ! `list()` must be a numeric vector, character vector, or function, not an empty list. # tidyselect `at` is deprecated Code . <- where_at(data.frame(x = 1), vars("x"), user_env = globalenv()) Condition Warning: Using `vars()` in .at was deprecated in purrr 1.0.0. # pairlists, expressions, and calls are deprecated Code x <- vctrs_vec_compat(expression(1, 2), globalenv()) Condition Warning: Use of calls and expressions in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` --- Code x <- vctrs_vec_compat(pairlist(1, 2), globalenv()) Condition Warning: Use of pairlists in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` --- Code x <- vctrs_vec_compat(quote(f(a, b = 1)), globalenv()) Condition Warning: Use of calls and expressions in purrr functions was deprecated in purrr 1.0.0. i Please coerce explicitly with `as.list()` # can't work with regular S4 objects Code map(foo(), identity) Condition Error in `x[[i]]`: ! this S4 class is not subsettable purrr/tests/testthat/_snaps/coerce.md0000644000176200001440000000250615166114150017476 0ustar liggesusers# can coerce to logical vectors Code coerce_lgl(2L) Condition Error: ! Can't coerce from an integer to a logical. --- Code coerce_lgl(1.5) Condition Error: ! Can't coerce from a number to a logical. --- Code coerce_lgl("true") Condition Error: ! Can't coerce from a string to a logical. # can coerce to integer vectors Code coerce_int(1.5) Condition Error: ! Can't coerce from a number to an integer. --- Code coerce_int("1") Condition Error: ! Can't coerce from a string to an integer. # can coerce to double vctrs Code coerce_dbl("1.5") Condition Error: ! Can't coerce from a string to a double. # can't coerce to character vectors Code expect_equal(coerce_chr(TRUE), "TRUE") Condition Error: ! Can't coerce from a logical value to a string. Code expect_equal(coerce_chr(1L), "1") Condition Error: ! Can't coerce from an integer to a string. Code expect_equal(coerce_chr(1.5), "1.500000") Condition Error: ! Can't coerce from a number to a string. # can't coerce to expressions Code coerce(list(1), "expression") Condition Error: ! Can't coerce from a list to expression. purrr/tests/testthat/test-pluck.R0000644000176200001440000001700515166122162016651 0ustar liggesuserstest_that("can pluck/chuck from NULL", { expect_equal(pluck(NULL, 1), NULL) expect_snapshot(chuck(NULL, 1), error = TRUE) }) test_that("can pluck vector types ", { x <- list( lgl = c(TRUE, FALSE), int = 1:2, dbl = c(1, 2.5), chr = c("a", "b"), cpx = c(1 + 1i, 2 + 2i), raw = charToRaw("ab"), lst = list(1, 2) ) expect_equal(pluck(x, "lgl", 2), FALSE) expect_identical(pluck(x, "int", 2), 2L) expect_equal(pluck(x, "dbl", 2), 2.5) expect_equal(pluck(x, "chr", 2), "b") expect_equal(pluck(x, "cpx", 2), 2 + 2i) expect_equal(pluck(x, "raw", 2), charToRaw("b")) expect_equal(pluck(x, "lst", 2), 2) }) test_that("unsupported types have useful error", { expect_snapshot(error = TRUE, { pluck(quote(x), 1) pluck(quote(f(x, 1)), 1) pluck(expression(1), 1) }) }) test_that("dots must be unnamed", { expect_snapshot(pluck(1, a = 1), error = TRUE) expect_snapshot(chuck(1, a = 1), error = TRUE) }) test_that("can pluck by position (positive and negative)", { x <- list("a", "b", "c") expect_equal(pluck(x, 1), "a") expect_equal(pluck(x, -1), "c") expect_equal(pluck(x, 0), NULL) expect_equal(pluck(x, 4), NULL) expect_equal(pluck(x, -4), NULL) expect_equal(pluck(x, -5), NULL) expect_snapshot(chuck(x, 0), error = TRUE) expect_snapshot(chuck(x, 4), error = TRUE) expect_snapshot(chuck(x, -4), error = TRUE) expect_snapshot(chuck(x, -5), error = TRUE) }) test_that("special numbers don't match", { x <- list() expect_equal(pluck(x, NA_integer_), NULL) expect_equal(pluck(x, NA_real_), NULL) expect_equal(pluck(x, NaN), NULL) expect_equal(pluck(x, Inf), NULL) expect_equal(pluck(x, -Inf), NULL) expect_snapshot(chuck(x, NA_integer_), error = TRUE) expect_snapshot(chuck(x, NA_real_), error = TRUE) expect_snapshot(chuck(x, NaN), error = TRUE) expect_snapshot(chuck(x, Inf), error = TRUE) expect_snapshot(chuck(x, -Inf), error = TRUE) }) test_that("can pluck by name", { x <- list(a = "a") expect_equal(pluck(x, "a"), "a") expect_equal(pluck(x, "b"), NULL) expect_equal(pluck(x, NA_character_), NULL) expect_equal(pluck(x, ""), NULL) expect_snapshot(chuck(x, "b"), error = TRUE) expect_snapshot(chuck(x, NA_character_), error = TRUE) expect_snapshot(chuck(x, ""), error = TRUE) }) test_that("even if names don't exist", { x <- list("a") expect_equal(pluck(x, "a"), NULL) expect_snapshot(chuck(x, "a"), error = TRUE) }) test_that("matches first name if duplicated", { x <- list(1, 2, 3, 4, 5) names(x) <- c("a", "a", NA, "", "b") expect_equal(pluck(x, "a"), 1) }) test_that("empty and NA names never match", { x <- list(1, 2, 3) names(x) <- c("", NA, "x") expect_equal(pluck(x, "x"), 3) expect_equal(pluck(x, ""), NULL) expect_equal(pluck(x, NA_character_), NULL) expect_snapshot(chuck(x, ""), error = TRUE) expect_snapshot(chuck(x, NA_character_), error = TRUE) }) test_that("require length 1 character/double vectors", { expect_snapshot(error = TRUE, { pluck(1, 1:2) pluck(1, integer()) pluck(1, NULL) pluck(1, TRUE) }) }) test_that("validate index even when indexing NULL", { expect_snapshot(error = TRUE, { pluck(NULL, 1:2) pluck(NULL, TRUE) }) }) test_that("can pluck 0-length object", { expect_equal(pluck(list(integer()), 1), integer()) }) test_that("supports splicing", { x <- list(list(bar = 1, foo = 2)) idx <- list(1, "foo") expect_identical(pluck(x, !!!idx), 2) }) # functions --------------------------------------------------------------- test_that("can pluck attributes", { x <- structure( list( structure( list(), x = 1 ) ), y = 2 ) expect_equal(pluck(x, attr_getter("y")), 2) expect_equal(pluck(x, 1, attr_getter("x")), 1) }) test_that("attr_getter() uses exact (non-partial) matching", { x <- 1 attr(x, "labels") <- "foo" expect_identical(attr_getter("labels")(x), "foo") expect_identical(attr_getter("label")(x), NULL) }) test_that("attr_getter() evaluates eagerly", { getters <- new_list(2) attrs <- c("foo", "bar") for (i in seq_along(attrs)) { getters[[i]] <- attr_getter(attrs[[i]]) } x <- structure(list(), foo = "foo", bar = "bar") expect_identical(getters[[1]](x), "foo") }) test_that("accessors throw correct errors", { expect_snapshot(error = TRUE, { pluck(1:3, function() NULL) pluck(1:3, function(x, y) y) }) }) test_that("pluck() functions dispatch on base getters", { expect_identical(pluck(iris, "Species", levels), levels(iris$Species)) }) test_that("pluck() supports primitive and built-in functions (#404)", { x <- list(1:2) expect_equal(pluck(x, 1, as.character), c("1", "2")) expect_equal(pluck(x, 1, sum), 3) }) # environments ------------------------------------------------------------ test_that("can pluck/chuck environment by name", { x <- new_environment(list(x = 10)) expect_equal(pluck(x, "x"), 10) expect_equal(pluck(x, "y"), NULL) expect_equal(pluck(x, NA_character_), NULL) expect_snapshot(chuck(x, "y"), error = TRUE) expect_snapshot(chuck(x, NA_character_), error = TRUE) }) test_that("environments error with invalid indices", { expect_snapshot(pluck(environment(), 1), error = TRUE) expect_snapshot(pluck(environment(), letters), error = TRUE) }) test_that("plucking promise from an environment evaluates it", { x <- new_environment() delayedAssign("q", { 1 }, assign.env = x) expect_equal(pluck(x, "q"), 1) }) # S4 ---------------------------------------------------------------------- newA <- methods::setClass("A", list(a = "numeric")) test_that("can pluck/chuck from S4 objects", { A <- newA(a = 1) expect_equal(pluck(A, "a"), 1) expect_equal(pluck(A, "b"), NULL) expect_equal(pluck(A, NA_character_), NULL) expect_snapshot(chuck(A, "b"), error = TRUE) expect_snapshot(chuck(A, NA_character_), error = TRUE) }) test_that("S4 objects error with invalid indices", { A <- newA(a = 1) expect_snapshot(pluck(A, 1), error = TRUE) expect_snapshot(pluck(A, letters), error = TRUE) }) # S3 ---------------------------------------------------------------------- test_that("pluck() dispatches on vector methods", { new_test_pluck <- function(x) { structure(list(x), class = "test_pluck") } inner <- list(a = "foo", b = list("bar")) x <- list(new_test_pluck(inner)) with_bindings( .env = global_env(), `[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]], names.test_pluck = function(x) names(.subset2(x, 1)), length.test_pluck = function(x) length(.subset2(x, 1)), { expect_identical(pluck(x, 1, 1), "foo") expect_identical(pluck(x, 1, "b", 1), "bar") expect_identical(chuck(x, 1, 1), "foo") expect_identical(chuck(x, 1, "b", 1), "bar") } ) # With faulty length() method with_bindings( .env = global_env(), `[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]], length.test_pluck = function(x) NA, { expect_null(pluck(x, 1, 1)) expect_snapshot(chuck(x, 1, 1), error = TRUE) } ) # With faulty names() method with_bindings( .env = global_env(), `[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]], names.test_pluck = function(x) NA, length.test_pluck = function(x) length(.subset2(x, 1)), { expect_null(pluck(x, 1, "b", 1)) expect_snapshot(chuck(x, 1, "b", 1), error = TRUE) } ) }) # Setting ----------------------------------------------------------------- test_that("pluck<- is an alias for assign_in()", { x <- list(list(bar = 1, foo = 2)) pluck(x, 1, "foo") <- 30 expect_identical(x, list(list(bar = 1, foo = 30))) }) purrr/tests/testthat/test-superseded-flatten.R0000644000176200001440000000512514334365317021340 0ustar liggesuserstest_that("input must be a list", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(flatten(1), error = TRUE) expect_snapshot(flatten_dbl(1), error = TRUE) }) test_that("contents of list must be supported types", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(flatten(list(quote(a))), error = TRUE) expect_snapshot(flatten(list(expression(a))), error = TRUE) }) test_that("each second level element becomes first level element", { expect_equal(flatten(list(1:2)), list(1, 2)) expect_equal(flatten(list(1, 2)), list(1, 2)) }) test_that("can flatten all atomic vectors", { expect_equal(flatten(list(F)), list(F)) expect_equal(flatten(list(1L)), list(1L)) expect_equal(flatten(list(1)), list(1)) expect_equal(flatten(list("a")), list("a")) expect_equal(flatten(list(as.raw(1))), list(as.raw(1))) expect_equal(flatten(list(1i)), list(1i)) }) test_that("NULLs are silently dropped", { expect_equal(flatten(list(NULL, NULL)), list()) expect_equal(flatten(list(NULL, 1)), list(1)) expect_equal(flatten(list(1, NULL)), list(1)) }) test_that("names are preserved", { expect_equal(flatten(list(list(x = 1), list(y = 1))), list(x = 1, y = 1)) expect_equal(flatten(list(list(a = 1, b = 2), 3)), list(a = 1, b = 2, 3)) }) test_that("names of 'scalar' elements are preserved", { out <- flatten(list(a = list(1), b = list(2))) expect_equal(out, list(a = 1, b = 2)) out <- flatten(list(a = list(1), b = 2:3)) expect_equal(out, list(a = 1, 2, 3)) out <- flatten(list(list(a = 1, b = 2), c = 3)) expect_equal(out, list(a = 1, b = 2, c = 3)) }) test_that("child names beat parent names", { out <- flatten(list(a = list(x = 1), b = list(y = 2))) expect_equal(out, list(x = 1, y = 2)) }) # atomic flatten ---------------------------------------------------------- test_that("must be a list", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(flatten_lgl(1), error = TRUE) }) test_that("can flatten all atomic vectors", { expect_equal(flatten_lgl(list(F)), F) expect_equal(flatten_int(list(1L)), 1L) expect_equal(flatten_dbl(list(1)), 1) expect_equal(flatten_chr(list("a")), "a") }) test_that("preserves inner names", { expect_equal( flatten_dbl(list(c(a = 1), c(b = 2))), c(a = 1, b = 2) ) }) # data frame flatten ------------------------------------------------------ test_that("can flatten to a data frame with named lists", { skip_if_not_installed("dplyr") dfs <- list(c(a = 1), c(b = 2)) expect_equal(flatten_dfr(dfs), tibble::tibble(a = 1, b = 2)) expect_equal(flatten_dfc(dfs), tibble::tibble(a = 1, b = 2)) }) purrr/tests/testthat/test-map.R0000644000176200001440000001053115063325731016310 0ustar liggesuserstest_that("preserves names", { out <- map(list(x = 1, y = 2), identity) expect_equal(names(out), c("x", "y")) }) test_that("creates simple call", { out <- map(1, function(x) sys.call())[[1]] expect_equal(out, quote(.f(.x[[i]], ...))) }) test_that("fails on non-vectors", { expect_snapshot(map(environment(), identity), error = TRUE) expect_snapshot(map(quote(a), identity), error = TRUE) }) test_that("works with vctrs records (#963)", { x <- new_rcrd(list(x = c(1, 2), y = c("a", "b"))) out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b"))) expect_identical(map(x, identity), out) }) test_that("works with matrices/arrays (#970)", { expect_identical( map_int(matrix(1:4, nrow = 2), identity), 1:4 ) }) test_that("all inform about location of problem", { fail_at_3 <- function(x, bad) { if (x == 3) bad else x } expect_snapshot(error = TRUE, { map_int(1:3, ~ fail_at_3(.x, 2:1)) map_int(1:3, ~ fail_at_3(.x, "x")) map(1:3, ~ fail_at_3(.x, stop("Doesn't work"))) }) cnd <- catch_cnd(map(1:3, ~ fail_at_3(.x, stop("Doesn't work")))) expect_s3_class(cnd, "purrr_error_indexed") expect_equal(cnd$location, 3) expect_equal(cnd$name, NULL) }) test_that("error location uses name if present", { fail_at_3 <- function(x, bad) { if (x == 3) bad else x } expect_snapshot(error = TRUE, { map_int(c(a = 1, b = 2, c = 3), ~ fail_at_3(.x, stop("Error"))) map_int(c(a = 1, b = 2, 3), ~ fail_at_3(.x, stop("Error"))) }) cnd <- catch_cnd(map(c(1, 2, c = 3), ~ fail_at_3(.x, stop("Doesn't work")))) expect_s3_class(cnd, "purrr_error_indexed") expect_equal(cnd$location, 3) expect_equal(cnd$name, "c") }) test_that("0 length input gives 0 length output", { expect_equal(map(list(), identity), list()) expect_equal(map(NULL, identity), list()) expect_equal(map_lgl(NULL, identity), logical()) }) test_that("map() always returns a list", { expect_bare(map(mtcars, mean), "list") }) test_that("types automatically coerced correctly", { expect_identical(map_lgl(c(NA, 0, 1), identity), c(NA, FALSE, TRUE)) expect_identical(map_int(c(NA, FALSE, TRUE), identity), c(NA, 0L, 1L)) expect_identical(map_int(c(NA, 1, 2), identity), c(NA, 1L, 2L)) expect_identical(map_dbl(c(NA, FALSE, TRUE), identity), c(NA, 0, 1)) expect_identical(map_dbl(c(NA, 1L, 2L), identity), c(NA, 1, 2)) expect_identical(map_chr(NA, identity), NA_character_) }) test_that("logical and integer NA become correct double NA", { expect_identical( map_dbl(list(NA, NA_integer_), identity), c(NA_real_, NA_real_) ) }) test_that("map forces arguments in same way as base R", { f_map <- map(1:2, function(i) function(x) x + i) f_base <- lapply(1:2, function(i) function(x) x + i) expect_equal(f_map[[1]](0), f_base[[1]](0)) expect_equal(f_map[[2]](0), f_base[[2]](0)) }) test_that("walk is used for side-effects", { expect_output(walk(1:3, str)) }) test_that("primitive dispatch correctly", { local_bindings(.env = global_env(), as.character.test_class = function(x) { "dispatched!" }) x <- structure(list(), class = "test_class") expect_identical( map(list(x, x), as.character), list("dispatched!", "dispatched!") ) }) test_that("map() with empty input copies names", { named_list <- named(list()) expect_identical(map(named_list, identity), named(list())) expect_identical(map_lgl(named_list, identity), named(lgl())) expect_identical(map_int(named_list, identity), named(int())) expect_identical(map_dbl(named_list, identity), named(dbl())) expect_identical(map_chr(named_list, identity), named(chr())) }) # 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 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) }) }) 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("can enforce .ptype", { expect_snapshot(error = TRUE, { map_vec(1:2, ~ factor("x"), .ptype = integer()) }) }) purrr/tests/testthat/test-deprec-invoke.R0000644000176200001440000000445714326706774020313 0ustar liggesuserstest_that("invoke_* is deprecated", { expect_snapshot({ . <- invoke(identity, 1) . <- invoke_map(identity, list()) . <- invoke_map_lgl(identity, list()) . <- invoke_map_int(identity, list()) . <- invoke_map_dbl(identity, list()) . <- invoke_map_chr(identity, list()) . <- invoke_map_raw(identity, list()) }) }) # invoke ------------------------------------------------------------------ test_that("invoke() evaluates expressions in the right environment", { local_options(lifecycle_verbosity = "quiet") x <- letters f <- toupper expect_equal(invoke("f", quote(x)), toupper(letters)) }) test_that("invoke() follows promises to find the evaluation env", { local_options(lifecycle_verbosity = "quiet") x <- letters f <- toupper f1 <- function(y) { f2 <- function(z) purrr::invoke(z, quote(x)) f2(y) } expect_equal(f1("f"), toupper(letters)) }) # invoke_map -------------------------------------------------------------- test_that("invoke_map() works with bare function", { local_options(lifecycle_verbosity = "quiet") data <- list(1:2, 3:4) expected <- list("1 2", "3 4") expect_equal(invoke_map(paste, data), expected) expect_equal(invoke_map("paste", data), expected) expect_equal(invoke_map_chr(paste, data), unlist(expected)) expect_identical(invoke_map_dbl(`+`, data), c(3, 7)) expect_identical(invoke_map_int(`+`, data), c(3L, 7L)) expect_identical(invoke_map_lgl(`&&`, data), c(TRUE, TRUE)) expect_identical(invoke_map_raw(identity, as.raw(1:3)), as.raw(1:3)) }) test_that("invoke_map() works with bare function with data frames", { local_options(lifecycle_verbosity = "quiet") skip_if_not_installed("dplyr") data <- list(1:2, 3:4) ops <- set_names(c(`+`, `-`), c("a", "b")) expect_identical(invoke_map_dfr(ops, data), invoke_map_dfc(ops, data)) }) test_that("invoke_map() evaluates expressions in the right environment", { local_options(lifecycle_verbosity = "quiet") shadowed_object <- letters shadowed_fun <- toupper expect_equal( invoke_map("shadowed_fun", list(quote(shadowed_object))), list(toupper(letters)) ) }) test_that("invoke_maps doesn't rely on c() returning list", { local_options(lifecycle_verbosity = "quiet") day <- as.Date("2016-09-01") expect_equal(invoke_map(identity, list(day)), list(day)) }) purrr/tests/testthat/test-map-if-at.R0000644000176200001440000000211015063325731017300 0ustar liggesuserstest_that("map_if() and map_at() always return a list", { skip_if_not_installed("tibble") df <- tibble::tibble(x = 1, y = "a") expect_identical(map_if(df, is.character, ~"out"), list(x = 1, y = "out")) expect_identical(map_at(df, 1, ~"out"), list(x = "out", y = "a")) }) test_that("map_at() works with tidyselect", { skip_if_not_installed("tidyselect") local_options(lifecycle_verbosity = "quiet") x <- list(a = "b", b = "c", aa = "bb") one <- map_at(x, vars(a), toupper) expect_identical(one$a, "B") expect_identical(one$aa, "bb") two <- map_at(x, vars(tidyselect::contains("a")), toupper) expect_identical(two$a, "B") expect_identical(two$aa, "BB") }) test_that("negative .at omits locations", { x <- c(1, 2, 3) out <- map_at(x, -1, ~ .x * 2) expect_equal(out, list(1, 4, 6)) }) test_that("map_if requires predicate functions", { expect_snapshot(map_if(1:3, ~NA, ~"foo"), error = TRUE) }) test_that("`.else` maps false elements", { expect_identical( map_if(-1:1, ~ .x > 0, paste, .else = ~"bar", "suffix"), list("bar", "bar", "1 suffix") ) }) purrr/tests/testthat/test-coerce.R0000644000176200001440000000261715063325731017001 0ustar liggesuserstest_that("can coerce to logical vectors", { expect_equal(coerce_lgl(c(TRUE, FALSE, NA)), c(TRUE, FALSE, NA)) expect_equal(coerce_lgl(c(1L, 0L, NA)), c(TRUE, FALSE, NA)) expect_snapshot(coerce_lgl(2L), error = TRUE) expect_equal(coerce_lgl(c(1, 0, NA)), c(TRUE, FALSE, NA)) expect_snapshot(coerce_lgl(1.5), error = TRUE) expect_snapshot(coerce_lgl("true"), error = TRUE) }) test_that("can coerce to integer vectors", { expect_identical(coerce_int(c(TRUE, FALSE, NA)), c(1L, 0L, NA)) expect_identical(coerce_int(c(NA, 1L, 10L)), c(NA, 1L, 10L)) expect_identical(coerce_int(c(NA, 1, 10)), c(NA, 1L, 10L)) expect_snapshot(coerce_int(1.5), error = TRUE) expect_snapshot(coerce_int("1"), error = TRUE) }) test_that("can coerce to double vctrs", { expect_identical(coerce_dbl(c(TRUE, FALSE, NA)), c(1, 0, NA)) expect_identical(coerce_dbl(c(NA, 1L, 10L)), c(NA, 1, 10)) expect_identical(coerce_dbl(c(NA, 1.5)), c(NA, 1.5)) expect_snapshot(coerce_dbl("1.5"), error = TRUE) }) test_that("can't coerce to character vectors", { expect_equal(coerce_chr(NA), NA_character_) expect_snapshot(error = TRUE, { expect_equal(coerce_chr(TRUE), "TRUE") expect_equal(coerce_chr(1L), "1") expect_equal(coerce_chr(1.5), "1.500000") }) expect_equal(coerce_chr("x"), "x") }) test_that("can't coerce to expressions", { expect_snapshot(coerce(list(1), "expression"), error = TRUE) }) purrr/tests/testthat/test-deprec-when.R0000644000176200001440000000241415063325731017735 0ustar liggesuserstest_that("when is deprecated", { expect_snapshot({ . <- when(1:5 < 3 ~ 1, ~0) }) }) test_that("when chooses the correct action", { local_options(lifecycle_verbosity = "quiet") x <- 1:5 |> when( sum(.) <= 50 ~ sum(.), sum(.) <= 100 ~ sum(.) / 2, ~0 ) expect_equal(x, 15) y <- 1:10 |> when( sum(.) <= 50 ~ sum(.), sum(.) <= 100 ~ sum(.) / 2, ~0 ) expect_equal(y, sum(1:10) / 2) z <- 1:100 |> when( sum(.) <= 50 ~ sum(.), sum(.) <= 100 ~ sum(.) / 2, ~0 ) expect_equal(z, 0) }) test_that("named arguments work with when", { local_options(lifecycle_verbosity = "quiet") x <- 1:10 |> when( sum(.) <= x ~ sum(.) * x, sum(.) <= 2 * x ~ sum(.) * x / 2, ~0, x = 60 ) expect_equal(x, sum(1:10) * 60) }) test_that("default values work without a formula", { local_options(lifecycle_verbosity = "quiet") x <- iris |> subset(Sepal.Length > 10) |> when( nrow(.) > 0 ~ ., head(iris, 10) ) expect_equal(x, head(iris, 10)) }) test_that("error when named arguments have no matching conditions", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(1:5 |> when(a = sum(.) < 5 ~ 3), error = TRUE) }) purrr/tests/testthat/test-adverb-partial.R0000644000176200001440000001334115063325731020432 0ustar liggesuserstest_that("dots are correctly placed in the signature", { out <- partialised_body(partial(runif, n = rpois(1, 5))) exp <- expr(runif(n = rpois(1, 5), ...)) expect_identical(out, exp) }) test_that("no lazy evaluation means arguments aren't repeatedly evaluated", { counter <- env(n = 0) lazy <- partial(list, n = { counter$n <- counter$n + 1 NULL }) walk(1:10, ~ lazy()) expect_identical(counter$n, 10) counter <- env(n = 0) qq <- partial( list, n = !!{ counter$n <- counter$n + 1 NULL } ) walk(1:10, ~ qq()) expect_identical(counter$n, 1) }) test_that("partial() still works with functions using `missing()`", { fn <- function(x) missing(x) expect_false(partial(fn, x = 3)()) fn <- function(x, y) missing(y) expect_true(partial(fn)()) expect_true(partial(fn, x = 1)()) expect_false(partial(fn, x = 1, y = 2)()) }) test_that("partialised arguments are evaluated in their environments", { n <- 0 partialised <- local({ n <- 10 partial(list, n = n) }) expect_identical(partialised(), list(n = 10)) }) test_that("partialised function is evaluated in its environment", { fn <- function(...) stop("tilt") partialised <- local({ fn <- function(x) x partial(fn, x = "foo") }) expect_identical(partialised(), "foo") }) test_that("partial() matches argument with primitives", { minus <- partial(`-`, .y = 5) expect_identical(minus(1), -4) minus <- partial(`-`, e2 = 5) expect_identical(minus(1), -4) }) test_that("partial() squashes quosures before printing", { foo <- function(x, y) y foo <- partial(foo, y = 3) # Reproducible environment tag environment(foo) <- global_env() expect_snapshot(foo) }) test_that("partial() handles primitives with named arguments after `...`", { expect_identical(partial(min, na.rm = TRUE)(1, NA), 1) expect_true(is_na(partial(min, na.rm = FALSE)(1, NA))) }) test_that("partialised function does not infloop when given the same name (#387)", { fn <- function(...) "foo" fn <- partial(fn) expect_identical(fn(), "foo") }) test_that("partial() handles `... =` arguments", { fn <- function(...) list(...) default <- partial(fn, "partial") expect_identical(default(1), list("partial", 1)) after <- partial(fn, "partial", ... = ) expect_identical(after(1), list("partial", 1)) before <- partial(fn, ... = , "partial") expect_identical(before(1), list(1, "partial")) }) test_that("partial() supports substituted arguments", { fn <- function(x) substitute(x) fn <- partial(fn, letters) expect_identical(fn(), quote(letters)) }) test_that("partial() supports generics (#647)", { expect_identical(partial(mean, na.rm = TRUE)(1), 1) foo <- TRUE expect_identical(partial(mean, na.rm = foo)(1), 1) }) test_that("partial() supports lexically defined methods in the def env", { local({ mean.purrr__foobar <- function(...) TRUE foobar <- structure(list(), class = "purrr__foobar") expect_true(partial(mean, na.rm = TRUE)(foobar)) expect_true(partial(mean, trim = letters, na.rm = TRUE)(foobar)) }) }) test_that("substitute() works for both partialised and non-partialised arguments", { fn <- function(x, y) list(substitute(x), substitute(y)) expect_identical(partial(fn, foo)(y = bar), alist(foo, bar)) }) test_that("partial() still supports quosures and multiple environments", { arg <- local({ n <- 0 quo({ n <<- n + 1 n }) }) x <- "foo" fn <- partial(list, !!arg, x = x) expect_identical(fn(), list(1, x = "foo")) expect_identical(fn(), list(2, x = "foo")) }) test_that("partial() preserves visibility when arguments are from the same environment (#656)", { fn <- partial(identity, 1) expect_identical(withVisible(fn()), list(value = 1, visible = TRUE)) fn <- function(x) invisible(x) fn <- partial(fn, 1) expect_identical(withVisible(fn()), list(value = 1, visible = FALSE)) }) test_that("checks inputs", { expect_snapshot(partial(1), error = TRUE) }) # helpers ----------------------------------------------------------------- test_that("quo_invert() inverts quosured arguments", { call <- expr(list(!!quo(foo), !!quo(bar))) expect_identical(quo_invert(call), quo(list(foo, bar))) call <- expr(list(foo, !!quo(bar))) expect_identical(quo_invert(call), quo(list(foo, bar))) call <- expr(list(!!quo(foo), bar)) expect_identical(quo_invert(call), quo(list(foo, bar))) }) test_that("quo_invert() detects local quosures", { foo <- local(quo(foo)) call <- expr(list(!!foo, !!quo(bar))) expect_identical( quo_invert(call), new_quosure(expr(list(foo, !!quo(bar))), quo_get_env(foo)) ) bar <- local(quo(bar)) call <- expr(list(!!quo(foo), !!bar)) expect_identical(quo_invert(call), quo(list(foo, !!bar))) }) test_that("quo_invert() supports quosures in function position", { call <- expr((!!quo(list))(!!quo(foo), !!quo(bar))) expect_identical(quo_invert(call), quo(list(foo, bar))) fn <- local(quo(list)) env <- quo_get_env(fn) call <- expr((!!fn)(!!quo(foo), !!new_quosure(quote(bar), env))) expect_identical( quo_invert(call), new_quosure(expr(list(!!quo(foo), bar)), env) ) }) test_that("quo_invert() supports quosures", { bar <- local(quo(bar)) call <- quo(list(!!quo(foo), !!bar)) expect_identical(quo_invert(call), quo(list(foo, !!bar))) foo <- quo(foo) call <- local(quo(list(!!foo, !!bar))) expect_identical( quo_invert(call), new_quosure(expr(list(!!foo, !!bar)), quo_get_env(call)) ) }) test_that("quo_invert() unwraps constants", { call <- expr(foo(!!quo(NULL))) expect_identical(quo_invert(call), quote(foo(NULL))) foo <- local(quo(foo)) call <- expr(foo(!!foo, !!quo(NULL))) expect_identical( quo_invert(call), new_quosure(quote(foo(foo, NULL)), quo_get_env(foo)) ) }) purrr/tests/testthat/test-rate.R0000644000176200001440000000400115063325731016461 0ustar liggesuserstest_that("new_rate() creates rate objects", { rate <- new_rate("foo", jitter = FALSE, max_times = 10) expect_identical(rate$state$i, 0L) expect_identical(rate$max_times, 10) expect_false(rate$jitter) }) test_that("can bump and reset count", { rate <- new_rate("foo") rate_bump_count(rate) rate_bump_count(rate) expect_identical(rate_count(rate), 2L) rate_reset(rate) expect_identical(rate_count(rate), 0L) }) test_that("rates have print methods", { expect_snapshot({ # Also checks infinite `max_times` prints properly rate_delay(20, max_times = Inf) rate_backoff() }) }) test_that("rate_delay() delays", { rate <- rate_delay( pause = 0.02, max_times = 3 ) rate_sleep(rate, quiet = FALSE) rate_reset(rate) msg <- catch_cnd(rate_sleep(rate)) expect_true(inherits_all(msg, c("purrr_condition_rate_init", "condition"))) msg <- catch_cnd(rate_sleep(rate, quiet = FALSE)) expect_true(inherits_all(msg, c("purrr_message_rate_retry", "message"))) expect_identical(msg$length, 0.02) msg <- catch_cnd(rate_sleep(rate, quiet = FALSE)) expect_identical(msg$length, 0.02) expect_snapshot(rate_sleep(rate), error = TRUE) expect_snapshot(rate_sleep(rate), error = TRUE) }) test_that("rate_backoff() backs off", { rate <- rate_backoff( pause_base = 0.02, pause_min = 0, jitter = FALSE ) msg <- catch_cnd(rate_sleep(rate)) expect_true(inherits_all(msg, c("purrr_condition_rate_init", "condition"))) msg <- catch_cnd(rate_sleep(rate, quiet = FALSE)) expect_true(inherits_all(msg, c("purrr_message_rate_retry", "message"))) expect_identical(msg$length, 0.04) msg <- catch_cnd(rate_sleep(rate, quiet = FALSE)) expect_identical(msg$length, 0.08) expect_snapshot(rate_sleep(rate), error = TRUE) expect_snapshot(rate_sleep(rate), error = TRUE) }) test_that("rate_sleep() checks that rate is still valid", { rate <- rate_delay(1, max_times = 0) expect_snapshot(rate_sleep(rate), error = TRUE) expect_snapshot(rate_sleep(rate), error = TRUE) }) purrr/tests/testthat/test-detect.R0000644000176200001440000000152515063325731017006 0ustar liggesusersy <- 4:10 test_that("detect functions work", { is_odd <- function(x) x %% 2 == 1 expect_equal(detect(y, is_odd), 5) expect_equal(detect_index(y, is_odd), 2) expect_equal(detect(y, is_odd, .dir = "backward"), 9) expect_equal(detect_index(y, is_odd, .dir = "backward"), 6) }) test_that("detect returns NULL when match not found", { expect_null(detect(y, function(x) x > 11)) }) test_that("detect_index returns 0 when match not found", { expect_equal(detect_index(y, function(x) x > 11), 0) }) test_that("has_element checks whether a list contains an object", { expect_true(has_element(list(1, 2), 1)) expect_false(has_element(list(1, 2), 3)) }) test_that("`detect()` requires a predicate function", { expect_snapshot(detect(list(1:2, 2), is.na), error = TRUE) expect_snapshot(detect_index(list(1:2, 2), is.na), error = TRUE) }) purrr/tests/testthat/test-list-modify.R0000644000176200001440000001173615063325731020003 0ustar liggesusers# list_assign ------------------------------------------------------------- test_that("can modify named lists by name or position", { expect_equal(list_assign(list(a = 1), b = 2), list(a = 1, b = 2)) expect_equal(list_assign(list(a = 1), a = 2), list(a = 2)) expect_equal(list_assign(list(a = 1), a = NULL), list(a = NULL)) expect_equal(list_assign(list(a = 1, b = 2), b = zap()), list(a = 1)) expect_equal(list_assign(list(a = 1), 2), list(a = 2)) expect_equal(list_assign(list(a = 1, b = 2), zap()), list(b = 2)) }) test_that("can modify unnamed lists by name or position", { expect_equal(list_assign(list(3), 1, 2), list(1, 2)) expect_equal(list_assign(list(3), NULL), list(NULL)) expect_equal(list_assign(list(3), zap()), list()) expect_equal(list_assign(list(3), zap(), zap()), list()) expect_equal(list_assign(list(1), a = 2), list(1, a = 2)) expect_equal(list_assign(list(1), a = NULL), list(1, a = NULL)) expect_equal(list_assign(list(1), a = zap()), list(1)) }) test_that("doesn't replace recursively", { x <- list(y = list(a = 1)) expect_equal(list_assign(x, y = list(b = 1)), list(y = list(b = 1))) }) # list_modify ------------------------------------------------------------- test_that("named lists have values replaced by name", { expect_equal(list_modify(list(a = 1), b = 2), list(a = 1, b = 2)) expect_equal(list_modify(list(a = 1), a = 2), list(a = 2)) expect_equal(list_modify(list(a = 1), a = NULL), list(a = NULL)) expect_equal(list_modify(list(a = 1, b = 2), b = zap()), list(a = 1)) }) test_that("unnamed lists are replaced by position", { expect_equal(list_modify(list(3), 1, 2), list(1, 2)) expect_equal(list_modify(list(3), NULL), list(NULL)) expect_equal(list_modify(list(3), zap()), list()) expect_equal(list_modify(list(3), zap(), zap()), list()) expect_equal(list_modify(list(1, 2, 3), 4), list(4, 2, 3)) }) test_that("can update unnamed lists with named inputs", { expect_identical(list_modify(list(1), a = 2), list(1, a = 2)) expect_identical(list_modify(list(1), a = NULL), list(1, a = NULL)) expect_identical(list_modify(list(1), a = zap()), list(1)) }) test_that("can update named lists with unnamed inputs", { expect_identical(list_modify(list(a = 1, b = 2), 2), list(a = 2, b = 2)) expect_identical(list_modify(list(a = 1, b = 2), zap()), list(b = 2)) expect_identical( list_modify(list(a = 1, b = 2), 2, 3, 4), list(a = 2, b = 3, 4) ) }) test_that("lists are replaced recursively", { expect_equal( list_modify( list(a = list(x = 1)), a = list(x = 2), ), list(a = list(x = 2)) ) expect_equal( list_modify( list(a = list(x = 1)), a = list(y = 2) ), list(a = list(x = 1, y = 2)) ) }) test_that("but data.frames are not", { x1 <- list(x = data.frame(x = 1)) x2 <- list(x = data.frame(y = 2)) out <- list_modify(x1, !!!x2) expect_equal(out, x2) # unless you really want it out <- list_modify(x1, !!!x2, .is_node = is.list) expect_equal(out, list(x = data.frame(x = 1, y = 2))) }) test_that("list_modify() validates inputs", { expect_snapshot(list_modify(1:3), error = TRUE) expect_snapshot(list_modify(list(a = 1), 2, a = 2), error = TRUE) expect_snapshot(list_modify(list(x = 1), x = 2, x = 3), error = TRUE) }) test_that("list_modify() preserves class & attributes", { x <- structure(list(a = 1, b = 2), x = 10, class = "foo") expect_equal( list_modify(x, a = 10, b = 20), structure(list(a = 10, b = 20), x = 10, class = "foo") ) }) # list_merge -------------------------------------------------------------- test_that("list_merge concatenates values from two lists", { l1 <- list(x = 1:10, y = 4, z = list(a = 1, b = 2)) l2 <- list(x = 11, z = list(a = 2:5, c = 3)) l <- list_merge(l1, !!!l2) expect_equal(l$x, c(l1$x, l2$x)) expect_equal(l$y, c(l1$y, l2$y)) expect_equal(l$z$a, c(l1$z$a, l2$z$a)) expect_equal(l$z$b, c(l1$z$b, l2$z$b)) expect_equal(l$z$c, c(l1$z$c, l2$z$c)) }) test_that("list_merge concatenates without needing names", { l1 <- list(1:10, 4, list(1, 2)) l2 <- list(11, 5, list(2:5, 3)) expect_length(list_merge(l1, !!!l2), 3) }) test_that("list_merge returns the non-empty list", { expect_equal(list_merge(list(3)), list(3)) expect_equal(list_merge(list(), 2), list(2)) }) test_that("merge() validates inputs", { expect_snapshot(list_merge(1:3), error = TRUE) expect_snapshot(list_merge(list(x = 1), x = 2, x = 3), error = TRUE) }) # update_list ------------------------------------------------------------ test_that("update_list() is deprecated", { expect_snapshot({ . <- update_list(list()) }) }) test_that("can modify element called x", { local_options(lifecycle_verbosity = "quiet") expect_equal(update_list(list(), x = 1), list(x = 1)) }) test_that("quosures and formulas are evaluated", { local_options(lifecycle_verbosity = "quiet") expect_identical(update_list(list(x = 1), y = quo(x + 1)), list(x = 1, y = 2)) expect_identical(update_list(list(x = 1), y = ~ x + 1), list(x = 1, y = 2)) }) purrr/tests/testthat/test-deprec-prepend.R0000644000176200001440000000166415063325731020437 0ustar liggesuserstest_that("prepend is deprecated", { expect_snapshot({ . <- prepend(1, 2) }) }) test_that("prepend is clearer version of merging with c()", { local_options(lifecycle_verbosity = "quiet") x <- 1:3 expect_identical( x %>% prepend(4), x %>% c(4, .) ) expect_identical( x %>% prepend(4, before = 3), x %>% { c(.[1:2], 4, .[3]) } ) }) test_that("prepend appends at the beginning for empty list by default", { local_options(lifecycle_verbosity = "quiet") x <- list() expect_identical( x %>% prepend(1), x %>% c(1, .) ) }) test_that("prepend throws error if before param is neither NULL nor between 1 and length(x)", { local_options(lifecycle_verbosity = "quiet") expect_snapshot(prepend(list(), 1, before = 1), error = TRUE) x <- as.list(1:3) expect_snapshot(x %>% prepend(4, before = 0), error = TRUE) expect_snapshot(x %>% prepend(4, before = 4), error = TRUE) }) purrr/tests/testthat/test-list-simplify.R0000644000176200001440000000372315163460322020342 0ustar liggesuserstest_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")) 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("only uses outer names", { out <- list_simplify(list(a = 1, c(b = 1), c = c(d = 1))) expect_named(out, c("a", "", "c")) }) test_that("empty lists simplify to NULL", { expect_equal(list_simplify(list()), NULL) expect_equal(list_simplify(set_names(list())), NULL) }) 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) # 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(mean)) list_simplify(list(1, "a")) list_simplify(list(1, 1:2)) list_simplify(list(data.frame(x = 1), data.frame(x = 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("list_simplify() validates inputs", { expect_snapshot(list_simplify(1:5), error = TRUE) expect_snapshot(list_simplify(list(), strict = NA), error = TRUE) }) test_that("list_simplify_internal() validates inputs", { expect_snapshot(list_simplify_internal(list(), simplify = 1), error = TRUE) expect_snapshot( list_simplify_internal(list(), simplify = FALSE, ptype = integer()), error = TRUE ) }) purrr/tests/testthat/test-list-transpose.R0000644000176200001440000001013115063325731020516 0ustar liggesuserstest_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("can't transpose data frames", { df <- data.frame(x = 1:2, y = 4:5) # i.e. be consistent with other `list_*()` functions from purrr/vctrs expect_snapshot(error = TRUE, list_transpose(df)) }) 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), c = c(NA, 4)) ) # Change order expect_equal( list_transpose(x, template = c("b", "a"), default = NA), list(b = c(2, 3), a = c(1, NA)) ) # Remove expect_equal( list_transpose(x, template = "b", default = NA), list(b = c(2, 3)) ) # Add expect_equal( list_transpose(x, template = 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, template = c(3, 2, 1), default = NA), list(c(3, NA), c(2, 5), c(1, 4)) ) # Remove expect_equal( list_transpose(x, template = 2, default = NA), list(c(2, 5)) ) # Add expect_equal( list_transpose(x, template = 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"))), 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_identical( 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, template = c("x", "y"), default = NA), list(x = c(1, NA), y = c(NA, "a")) ) expect_equal( list_transpose(x, template = 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), template = mean) }) }) test_that("fail mixing named and unnamed vectors", { test_list_transpose <- function() { x <- list(list(a = 1, b = 2), list(a = 3, b = 4)) list_transpose(list(x = list(a = 1, b = 2), y = list(3, 4))) } expect_snapshot(error = TRUE, { test_list_transpose() }) }) purrr/tests/testthat/setup.R0000644000176200001440000000004213426303100015675 0ustar liggesusersSys.setlocale("LC_MESSAGES", "C") purrr/tests/testthat/test-every-some-none.R0000644000176200001440000001435715163460322020572 0ustar liggesuserstest_that("every returns TRUE if all elements are TRUE", { x <- list(0, 1, TRUE) expect_false(every(x, isTRUE)) expect_true(every(x[3], isTRUE)) }) test_that("some returns FALSE if all elements are FALSE", { x <- list(1, 0, FALSE) expect_false(some(x, isTRUE)) expect_true(some(x[1], negate(isTRUE))) }) test_that("none returns TRUE if all elements are FALSE", { x <- list(1, 0, TRUE) expect_false(none(x, isTRUE)) expect_true(none(x[1], isTRUE)) }) test_that("every() has the same behaviour as `&&` (#751)", { expect_false(every(list(NA, FALSE), identity)) expect_false(every(list(FALSE, NA), identity)) expect_identical(every(list(NA, TRUE), identity), NA) expect_identical(every(list(TRUE, NA), identity), NA) expect_identical(every(list(NA, NA), identity), NA) }) test_that("some() has the same behaviour as `||`", { expect_true(some(list(TRUE, NA), identity)) expect_true(some(list(NA, TRUE), identity)) expect_identical(some(list(NA, FALSE), identity), NA) expect_identical(some(list(FALSE, NA), identity), NA) expect_identical(some(list(NA, NA), identity), NA) }) test_that("every(), some(), and none() have correct empty size behavior", { # All pass expect_identical(every(list(), identity), all(list())) # All don't pass expect_identical(none(list(), identity), all(list())) # Any pass expect_identical(some(list(), identity), any(list())) }) test_that("every(), some(), and none() work on `NULL`", { # All pass expect_identical(every(NULL, identity), all(NULL)) # All don't pass expect_identical(none(NULL, identity), all(NULL)) # Any pass expect_identical(some(NULL, identity), any(NULL)) }) test_that("every(), some(), and none() have correct early stopping behavior", { expect_identical(every(list(TRUE, FALSE, TRUE), identity), FALSE) expect_identical(none(list(FALSE, TRUE, FALSE), identity), FALSE) expect_identical(some(list(FALSE, TRUE, FALSE), identity), TRUE) }) test_that("every(), some(), and none() have correct `NA` propagation behavior", { # Propagates through non-early-stopping case expect_identical(every(list(NA, TRUE), identity), NA) expect_identical(none(list(NA, FALSE), identity), NA) expect_identical(some(list(NA, FALSE), identity), NA) # Overruled by early-stopping case expect_identical(every(list(NA, FALSE), identity), FALSE) expect_identical(none(list(NA, TRUE), identity), FALSE) expect_identical(some(list(NA, TRUE), identity), TRUE) }) test_that("every(), some(), and none() require logical scalar predicate results", { # No coercion to `TRUE` or `FALSE` expect_snapshot(every(list(1), function(x) 1), error = TRUE) expect_snapshot(some(list(1), function(x) 1), error = TRUE) expect_snapshot(none(list(1), function(x) 1), error = TRUE) # `NA` must be a logical `NA`, no coercion happens for `TRUE` or `FALSE`, # so we also don't coerce `NA`s of any other kind expect_snapshot(every(list(1), function(x) NA_integer_), error = TRUE) expect_snapshot(some(list(1), function(x) NA_integer_), error = TRUE) expect_snapshot(none(list(1), function(x) NA_integer_), error = TRUE) # Must be length 1 expect_snapshot(every(list(1), function(x) c(TRUE, FALSE)), error = TRUE) expect_snapshot(some(list(1), function(x) c(TRUE, FALSE)), error = TRUE) expect_snapshot(none(list(1), function(x) c(TRUE, FALSE)), error = TRUE) # Attributes are allowed, we ignore them expect_true(every(list(1), function(x) structure(TRUE, foo = "bar"))) expect_true(some(list(1), function(x) structure(TRUE, foo = "bar"))) expect_false(none(list(1), function(x) structure(TRUE, foo = "bar"))) # Classes are allowed for historical reasons. # We probably wouldn't consider these to be logical scalars these days. expect_true(every(list(1), function(x) structure(TRUE, class = "mylgl"))) expect_true(some(list(1), function(x) structure(TRUE, class = "mylgl"))) expect_false(none(list(1), function(x) structure(TRUE, class = "mylgl"))) # We bypass any S3 `length()` methods! local_methods(length.mylgl = function(x) 2L) expect_true(every(list(1), function(x) structure(TRUE, class = "mylgl"))) expect_true(some(list(1), function(x) structure(TRUE, class = "mylgl"))) expect_false(none(list(1), function(x) structure(TRUE, class = "mylgl"))) }) test_that("every(), some(), and none() require vector `.x`", { expect_snapshot(every(function() 1, identity), error = TRUE) expect_snapshot(some(function() 1, identity), error = TRUE) expect_snapshot(none(function() 1, identity), error = TRUE) }) test_that("every(), some(), and none() work on atomic vectors", { expect_identical(every(1:3, is.integer), TRUE) expect_identical(none(1:3, is.integer), FALSE) expect_identical(some(1:3, is.integer), TRUE) }) test_that("every(), some(), and none() work colwise across data frames", { # If it naively worked off `vec_size()` then extracted elements with `[[`, # this would return incorrect results. This definition is consistent with # `map()`. df <- data_frame(a = 1L, b = 2) expect_identical(every(df, is.integer), FALSE) expect_identical(none(df, is.double), FALSE) expect_identical(some(df, is.double), TRUE) }) test_that("every(), some(), and none() work on list scalars", { # For consistency with `map()` obj <- structure(list(1, "x"), class = "my_scalar") expect_identical(every(obj, is.double), FALSE) expect_identical(none(obj, is.character), FALSE) expect_identical(some(obj, is.character), TRUE) }) test_that("every(), some(), and none() work with vctrs records", { x <- new_rcrd(list(x = c(1, 2, 3), y = c("a", "b", "c"))) out <- list() every(x, function(elt) { out <<- append(out, list(elt)) TRUE }) expect_identical(out, vec_chop(x)) out <- list() some(x, function(elt) { out <<- append(out, list(elt)) FALSE }) expect_identical(out, vec_chop(x)) out <- list() none(x, function(elt) { out <<- append(out, list(elt)) FALSE }) expect_identical(out, vec_chop(x)) }) test_that("pairlists, expressions, and calls are deprecated but work", { local_options(lifecycle_verbosity = "warning") expect_snapshot(out <- every(expression(1, 2), is.double)) expect_true(out) expect_snapshot(out <- every(pairlist(1, 2), is.double)) expect_true(out) expect_snapshot(x <- every(quote(f(a, b)), is.name)) expect_true(out) }) purrr/tests/testthat.R0000644000176200001440000000006613413154757014565 0ustar liggesuserslibrary(testthat) library(purrr) test_check("purrr") purrr/MD50000644000176200001440000003642215166226231011747 0ustar liggesuserse41937fc3c9beee22a291bbd6455e418 *DESCRIPTION 08d07c474f334bd4fd11467a9b5028d1 *LICENSE 9633cd07140f89882461e1b5f6baa1c3 *NAMESPACE 188ce8ad62ed4521b5298345995b6a24 *NEWS.md 849b41f5e471f84dfce49867a3d0ed9c *R/adverb-auto-browse.R 94899d1cf71a2eb3e69cd8bec078862c *R/adverb-compose.R 4d6998e2f3b91840d43382ba41c4e705 *R/adverb-insistently.R 41619c2a07d5e552ea79d26de6a8a149 *R/adverb-negate.R c1ff7d549db462f5a5b50eba73aac098 *R/adverb-partial.R a523ef572de757421451f03865e449dc *R/adverb-possibly.R a6c11bf334099256b85cf1cc9f12a4a2 *R/adverb-quietly.R 5636f74aae6b4661b9a4ff595ed57149 *R/adverb-safely.R a7adda4b54d8cd3253165fec950ae553 *R/adverb-slowly.R efee0ba51584da8c478a86f39aa83331 *R/arrays.R 3b5b847b3ab116d84f02ce849d5d691f *R/cleancall.R fd40672225cb6b82fb57d391fb4dde38 *R/coerce.R fa46e60c734343b50fc65a0340f8522d *R/compat-obj-type.R dc33ac17ff199e6c9b3c2115fb6fefc6 *R/compat-types-check.R 3dd9a3582c8a0066ab7c6e0b3b009a06 *R/conditions.R a5048a175f84428c18db22a2610b049e *R/deprec-along.R ac4030bb377061e9dd93cb22b616ad40 *R/deprec-cross.R a74c5c464097dc0b9197276bdf15ece7 *R/deprec-invoke.R 718d6a4dd2dc1769b3376fa16065c3af *R/deprec-lift.R cef49bcf47810041894f1a8304417693 *R/deprec-prepend.R 2cc33cfb665fbdbda4be32ecc4cb2e0c *R/deprec-rerun.R 9acfb00cb0ea069d7a6a3043f413715f *R/deprec-splice.R 25146641df2fa65a2f916da6cc77c297 *R/deprec-utils.R 028507b6662cdcba981f2e212be1a746 *R/deprec-when.R 18a439355fb4da22219cb234906b85d5 *R/detect.R 934a092c2864f1276aefdadba326dce2 *R/every-some-none.R 3eecf3331e4ec26852fb241fff26a828 *R/faq.R b2e55d1d5aef7d6e25c288dc35d0856d *R/head-tail.R 6d1cc1c28048881991d86ecef72b90fe *R/imap.R 8598f0bee755ef0477d1dd56f95dc93d *R/keep.R e65930628645577798de5cb0955a7906 *R/list-combine.R 9cec3bc402c8ee51bfe75599dafc557f *R/list-flatten.R 173b8118f97ee827b9482b90e7ed75d5 *R/list-modify.R 283bcb8162f72633debd92e65414dff1 *R/list-simplify.R e58c3bc1290f834ac4788f5e476ccf3f *R/list-transpose.R ab3d0d16ebb2a5e10d11cdcf02c71a93 *R/lmap.R 441a351e3b437ed568f5259e76500b91 *R/map-depth.R 7abff405251772d3bf7c894cd3f5f9bd *R/map-if-at.R 6c26cbb6cb95046c804508f40d64e97f *R/map-mapper.R 668d39e7af02dd1eb2390cfc9211de00 *R/map-raw.R fb75a26c4448f41160a354b25120f837 *R/map.R 051013051a7e20f31c459cdaa5451869 *R/map2.R 08fc55a4b847afe0a1d9bdd2bde5aeea *R/modify-tree.R 3afb428c62d7ad6d56c9407a4115ea0d *R/modify.R 4de308ff9c82c52176fcfe9da12e8815 *R/package-purrr.R 6f5c53bc7b5db91e187d458046715270 *R/parallelization.R 018bca962220548d24305eb8af346e08 *R/pluck-assign.R 93a51b1178711fefd527689937f9f144 *R/pluck-depth.R 6ea20871e175b74c1acac954f306448d *R/pluck.R 3feafbc2d304242edf9b570c6cdb721e *R/pmap.R bb1e7ef515287303caff3647e0c39cc7 *R/progress-bars.R e7a630622b42c4a94856b0d12ff3fc7b *R/rate.R 323973039b5e6292e90f38c1c79bcf58 *R/reduce.R f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/reexport-pipe.R ffe64893c11ede22a4ce0e82a810850a *R/reexport-rlang.R 676324d0f2547e366101d30e48110bae *R/superseded-flatten.R d5ae04671aaafd61eb9f22897d44c423 *R/superseded-map-df.R 020546f1f9cd2af8f4a53e1ff1bd4f3d *R/superseded-simplify.R c6c70b19ad301896c2949613f1eebee4 *R/superseded-transpose.R ba11a8f9e5ed9cf92d845971be084f68 *R/utils.R 02b699df000f8c8a85524e742c0fa54f *README.md aaa79747e596f8ebaf97334da9019508 *build/vignette.rds 211b73eca0cae17eb855b3067ab6d8fb *inst/doc/base.R b44c347c7cf1ed68e512eb02cf2d27a6 *inst/doc/base.Rmd e763eb1ad6b4ca8b54d15cda2cb762cd *inst/doc/base.html 24439c5a0bebf0c9af162debb225dc5d *inst/doc/other-langs.Rmd 24b544aaa0a653a5bfc645b6232a298e *inst/doc/other-langs.html 4db1a81d77d43a5207c47efe0377c12c *inst/doc/purrr.R 0345aefb10965bd3d6dba2fc6624bb69 *inst/doc/purrr.Rmd 41326f8bc1c79abd284a21721e41fc83 *inst/doc/purrr.html b245902cc292a506d74a94c790d31914 *man/accumulate.Rd a6e5ef70ca9479a693a2eca55172b2d8 *man/along.Rd 436c1d64da16fe444906f743c3a74f3c *man/array-coercion.Rd 787f04952b638e78a3be57d71d1dba6d *man/as_mapper.Rd 9a7ae57daeeef10f5dcb19372db63e10 *man/as_vector.Rd 147341fcbc75baa0a9c8ba7478fe8a16 *man/attr_getter.Rd d2631b08e55eba7b459c1ea5009a5bc6 *man/auto_browse.Rd 1c791828a7f69a5fe52840f160b7d9f8 *man/chuck.Rd 88c29db4415b8e139e7779ada0e723a7 *man/compose.Rd 48731b31012b8d4188fd52ccc09c9e9f *man/cross.Rd c65476d5f8f5c026e752ca8d8445060d *man/detect.Rd 5300dd5bdcf47f9f1af96f655aee801b *man/every.Rd 6fb35089007e4d9d2c5588fe7380d180 *man/faq-adverbs-export.Rd cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg c3978703d8f40f2679795335715e98f4 *man/figures/lifecycle-experimental.svg 952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing.svg 27b879bf3677ea76e3991d56ab324081 *man/figures/lifecycle-questioning.svg 6902bbfaf963fbc4ed98b86bda80caa2 *man/figures/lifecycle-soft-deprecated.svg 53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg 1c1fe7a759b86dc6dbcbe7797ab8246c *man/figures/lifecycle-superseded.svg e982d6107abb499b8e8dd0132e7b2400 *man/figures/logo.png efba13d3891d9627d2ad9aa3006aaf88 *man/flatten.Rd 01da9802fe500f7257ccc2dfbeec9d67 *man/has_element.Rd af76e793cdbc6a32fc65bbf80304baae *man/head_while.Rd f96d2743aeed6685f6406d2b205df129 *man/imap.Rd 209be44888efecb51195121d4ea9263b *man/in_parallel.Rd 6d33a6ff2291f210668af6a233c9df0d *man/insistently.Rd d9eb7a573a99415abbdfa520c1a91971 *man/invoke.Rd d7b426e42da4c5e449500948903c0c60 *man/keep.Rd 8563c63d68667fec61ab5b9975eedcd6 *man/keep_at.Rd adcb4274f0012e9d4c7f82be8b9681c5 *man/lift.Rd 96c41e2fa45779e84c35f2d4cef91bc2 *man/list_assign.Rd aac52b8d6bee72b4186e55f4a6b9a2d7 *man/list_c.Rd 0fd8999bb3e39535e2d6e331e3085170 *man/list_flatten.Rd 1501a0f8de3bf86fb4a4aa146f01ed0d *man/list_simplify.Rd 9930e91101d13c11df7faac795f2ac7c *man/list_transpose.Rd 643c7997dc23685dbe87b8bb082d8cbd *man/lmap.Rd e4f07730f06db77f5582e12d0d04feb9 *man/map.Rd 39034a70968664aeecaeefed04de35f3 *man/map2.Rd 67def395e897a3ca682f5bd3bc1bde2f *man/map_depth.Rd 0931f556e4647c28f4fb5790e56013d0 *man/map_dfr.Rd bb442b8a2c438b32aa6795f2dbe7360b *man/map_if.Rd 1532e1a51e943a3aae74c922912467d3 *man/map_raw.Rd 4d87509435f610b1ad68c7407c4f4f2a *man/modify.Rd ed73b7f7b31f237f9abdd787ea811ffe *man/modify_in.Rd cc92313696765c527ea410f59bccbc3a *man/modify_tree.Rd 58abc04b7a49b7b1eef29fab8787d5a3 *man/negate.Rd f57745d9d7361732b91bd8a90accae40 *man/partial.Rd 20ddcacb06bef90d0ef483349d9eb688 *man/pipe.Rd 913b2ee8558d57c42d562039976e5b2c *man/pluck.Rd 54881a56d1fe77e6520646d4c27a16d9 *man/pluck_depth.Rd 9dde7e709a4fdf6a199b4f7ad07c89ed *man/pmap.Rd a6afbf279a12c85bc0e6e16335c3b219 *man/possibly.Rd 6626ac358a303017849dd6845fa1532b *man/prepend.Rd 458373eec8a77a1f41cc91335431db64 *man/progress_bars.Rd 1882ddc6d0747a2a9b2ad3fdfde07358 *man/purrr-package.Rd a9e8ba8302fe11e6a4c1ed293ade3765 *man/purrr_error_indexed.Rd 03cc986eb9e2dea0db3b94079adb8d4c *man/quietly.Rd f282657e9c3e032d1dfce7e1795fe2fe *man/rate-helpers.Rd 728813ebb9c2c67d82794d6056f14316 *man/rate_sleep.Rd f1c14c2625eb3c41dffaffbd38b7bfed *man/rbernoulli.Rd 0b3a16966d9fe29d0bd3b03a53a39145 *man/rdunif.Rd 1f3dbf7d4b0bd209595f72ee7e74f6d9 *man/reduce.Rd 442d055f9895caea4dc8df0506344f5f *man/reexports.Rd 11ffe0cd8f9dc16f8aa30a594ff39076 *man/rerun.Rd c7cc36ddf062f8e4ff29c23ee4257bce *man/rmd/indexed-error.Rmd cd9285c04c02d4292f50240709d2a709 *man/safely.Rd 6157171b3d93e20d7399a078adeeeb22 *man/slowly.Rd 122d3e9e04863b26f0171d283cd7408e *man/splice.Rd 6910ef35fbc2860fa14609332a0d7d76 *man/transpose.Rd f7f186a8c48e8ad4a42c3c66f20e678b *man/update_list.Rd 6fa23f43877dff764121432edcb98f9c *man/when.Rd d25d5af44b59cd40d3830b54f7a7cf7f *src/Makevars e1d92300bef9c36d6ccd744782e66e40 *src/backports.c fe1477e2f8f7dc5f1ff53a5649902380 *src/backports.h f6985f69ecbbb6d953442a26aae9bd85 *src/cleancall.c 07a0b2f422fb87c0d5e789157fac4b31 *src/cleancall.h e2ea020f707b9f2a7d5802d8a87c302c *src/coerce.c 9d0421297cfdab0c06f7ec2e36759e34 *src/coerce.h ee77b27f9b5bde03c2625ca3504d6c85 *src/conditions.c 7b9fc51f5a512ce14bf25ccfe00650af *src/conditions.h 6343cf4cffbd9d58c0ee9022ee6a7bdb *src/every-some-none.c cfb390458d214a983383df824878698d *src/flatten.c b5774a55daae974f5b1660dfe23145e0 *src/init.c e6a50f4835012476a4839c0087296918 *src/map.c 1774cecb4cb23c3c852fd88aed7c2dbb *src/map.h 04047af9b8389c9475b14911d2f16f2f *src/pluck.c 8c9586189bdd80b8853ea0f8738f40c2 *src/transpose.c d5222a476c0e51d92b1d8f70c438ad2d *src/utils.c a7f78c827fa5cb8d9cc4b737e108c492 *src/utils.h 8e9d16c5c6aedcc157783b13df5b9db0 *tests/testthat.R 4ba4a6038e95827dcd78d38d8c558e0d *tests/testthat/_snaps/adverb-auto-browse.md b40a11b179154d841671b8ec7c3eff74 *tests/testthat/_snaps/adverb-compose.md 8c57450be765a49add6ea74ebad5913b *tests/testthat/_snaps/adverb-insistently.md b571942611035e733b7b36f04f0e1698 *tests/testthat/_snaps/adverb-partial.md ce54aff1634c67cb621b9e3ff249c0df *tests/testthat/_snaps/adverb-slowly.md a1d1067bded31124fdd9536228fe8b8d *tests/testthat/_snaps/arrays.md e4691b67c5b29efcd8e09c6c7f157ed3 *tests/testthat/_snaps/coerce.md ed845c01f73ef3fe75711cdefac84307 *tests/testthat/_snaps/conditions.md cff43fa75b4ff8b03494b52d80b0ccaa *tests/testthat/_snaps/deprec-along.md 16b6e4fc7143d4923e43699f7f940800 *tests/testthat/_snaps/deprec-cross.md a4ec0ff99d776c2c939a01619536b861 *tests/testthat/_snaps/deprec-invoke.md 3882353452b0fe1c2a6378697501d4fc *tests/testthat/_snaps/deprec-lift.md 9c2e32786ddeb964e3aa2b8e549a2152 *tests/testthat/_snaps/deprec-prepend.md c4c0cc263578a7a9765002e6a251c6a6 *tests/testthat/_snaps/deprec-rerun.md ff3c35718998d19eb67fbbb22c76b9a8 *tests/testthat/_snaps/deprec-splice.md 129e792efebe1e0a5c6ae7978aefceb6 *tests/testthat/_snaps/deprec-utils.md c8b9f9cfcb73f6443f08842bfb76d74e *tests/testthat/_snaps/deprec-when.md 113e6255205e8773ccba683de6549196 *tests/testthat/_snaps/detect.md 5bce6d8882146a2aadef80d75e57fa43 *tests/testthat/_snaps/every-some-none.md ec1184c2b5af139e2fc0555e92ad1194 *tests/testthat/_snaps/head-tail.md f4fcce4fabd63522a679254907c8e7c2 *tests/testthat/_snaps/keep.md 9d1773507504fc19e7acc742d9e23b3b *tests/testthat/_snaps/list-combine.md 052fc838ec962e3fc18382d11c89c44c *tests/testthat/_snaps/list-flatten.md 38cd7aee18cd6206cabd9a7cc66ad33e *tests/testthat/_snaps/list-modify.md f58252f5887b2348d6f774e4ef3b0748 *tests/testthat/_snaps/list-simplify.md 36b988c022f8acc82d77223976eea773 *tests/testthat/_snaps/list-transpose.md 7015ad0737bb266bcc438378a33a4c0e *tests/testthat/_snaps/lmap.md 2e4bd2910c71e25afd14f1824d19cb59 *tests/testthat/_snaps/map-depth.md 77bc7274ed3168ea411945fbf3f3640f *tests/testthat/_snaps/map-if-at.md 2471d23e2ee8145617818c8ca0d3d3fd *tests/testthat/_snaps/map-raw.md e006e2a44bcf2c175714136c5b14fb13 *tests/testthat/_snaps/map.md d89798569e244fd81c5eb505e0209eb0 *tests/testthat/_snaps/map2.md 9762cd6f920cbf29ae9308da740b5650 *tests/testthat/_snaps/modify-tree.md ef03963550d497a90a86a43af1de6950 *tests/testthat/_snaps/modify.md f3067596d38e8a562674ca2f8fa57932 *tests/testthat/_snaps/parallel.md 48cb68a5e24f2afab3092fcbde903d19 *tests/testthat/_snaps/pluck-assign.md 9d4fca1a111f1c86c9e794291a5fe4b7 *tests/testthat/_snaps/pluck-depth.md f903175c481f33469048e8ccf763a4aa *tests/testthat/_snaps/pluck.md 645e90798496c97574cbe1a4afa58d98 *tests/testthat/_snaps/pmap.md e4b23788406dc74450190a0232937800 *tests/testthat/_snaps/progress-bars.md b3b7d358c885f430aa5ec3db9d5817aa *tests/testthat/_snaps/rate.md 25c9dc826948f5d3a8d4ac98da7e8eb5 *tests/testthat/_snaps/reduce.md 589c1c71919f7adf8f4d503451c1a827 *tests/testthat/_snaps/superseded-flatten.md b4656054afc8ab8c4cc8c8861fa4588d *tests/testthat/_snaps/superseded-transpose.md 45b968ed8903176d52d3e893a257f666 *tests/testthat/_snaps/utils.md 9910f862c678e5cab0747535444ef2b6 *tests/testthat/helper-map.R 95ca8e1eff88f95013ff5de9710514bb *tests/testthat/helper.R 0cddd9f63f32e83702987889ecf4eda7 *tests/testthat/setup.R 37f5b19ee29615a6e671c6a19ef6ef3a *tests/testthat/test-adverb-auto-browse.R 1f8c46b3dfc70214011b7e5de24357d8 *tests/testthat/test-adverb-compose.R 88f4841de74fa10ac1e540977c06c95c *tests/testthat/test-adverb-insistently.R 768f4925032ee87d54669591116d53c7 *tests/testthat/test-adverb-negate.R 6d8a2927f8aa7a1f7326581a1b58da41 *tests/testthat/test-adverb-partial.R ed037715f9bcbebd02810e4269f6b4cf *tests/testthat/test-adverb-possibly.R c85cbc0b31bb34ef9caa062bdd3882ac *tests/testthat/test-adverb-quietly.R 5a6d26eed92e39b3c3aa2f4ab369ff84 *tests/testthat/test-adverb-safely.R 10a18d7711e07edcb223e068afe8baa7 *tests/testthat/test-adverb-slowly.R fb57d26764a86888edaac33f82ca0cf7 *tests/testthat/test-arrays.R 74305d55a5c2f9a9baa32f7de6f5fd3b *tests/testthat/test-coerce.R f69e71c5a04890eeda57de82a2006dbb *tests/testthat/test-conditions.R 539c737bbbd41452d6cb09ff478e406d *tests/testthat/test-deprec-along.R 93b002b2d558d5077c83c405e073f203 *tests/testthat/test-deprec-cross.R 3425f2a2e22c4d7316334ac0a817e3bf *tests/testthat/test-deprec-invoke.R debf3bd391b84a1ca377b107a35a6d0f *tests/testthat/test-deprec-lift.R f2ade13a75d382dceb7a228c3b8dcc4c *tests/testthat/test-deprec-prepend.R d3399e94e5de71ab38702c570f4b1e04 *tests/testthat/test-deprec-rerun.R 49ecf2ddfbe2cdda9d2178af829c4d22 *tests/testthat/test-deprec-splice.R 723176601ab0a3480f9aae8e38940d28 *tests/testthat/test-deprec-utils.R 91f8c5e049922dd61866b26aa47686b7 *tests/testthat/test-deprec-when.R fa091acf9d3b5c77444e418c35c04543 *tests/testthat/test-detect.R 7f196fdb3b175dfe530e2bb1e7e02b5f *tests/testthat/test-every-some-none.R 87ea19c0e9fc1fe325cf2d34f910e0b0 *tests/testthat/test-head-tail.R 1c659e6f7c76f086f1282ae037445490 *tests/testthat/test-imap.R 488947e53cdaa8e53b201f9cf0aa7a44 *tests/testthat/test-keep.R eb39c3fdd03bade73b017aab30f47daa *tests/testthat/test-list-combine.R af38877243ea25e0e330f5a79974157b *tests/testthat/test-list-flatten.R 57bc2c90e4b148e65aca9525d8577b4a *tests/testthat/test-list-modify.R bbbe00018e314d5ac5ea1afbe07a2d5e *tests/testthat/test-list-simplify.R 1d4c163d4f184d3e7417abef36080a00 *tests/testthat/test-list-transpose.R 79f15e5f115d6ac02d86bd189277e0fa *tests/testthat/test-lmap.R c73f1302d04dfd7e63d5cf5d4f9dd77b *tests/testthat/test-map-depth.R f784e54448cc83d33c727dd1413059a7 *tests/testthat/test-map-if-at.R 05a72b8293c2048bacba1d7b540480c0 *tests/testthat/test-map-mapper.R f86a078df21ad6c0730eaa37150ac07a *tests/testthat/test-map-raw.R edb1bd61ef5a2bd064715bddbe41dc73 *tests/testthat/test-map.R 1209d6add84920debf39be72a0301515 *tests/testthat/test-map2.R 4f5b859882e6eb7547154590c341775a *tests/testthat/test-modify-tree.R fc1b01eaf6e1880015c2a806a9b8940b *tests/testthat/test-modify.R 8641e9dfa286bc8f9149a5ead97626f5 *tests/testthat/test-parallel.R 3055b51b127f09a69669a012e6c611a9 *tests/testthat/test-pluck-assign.R 577a43785506b3269e467a98fa5c6e28 *tests/testthat/test-pluck-depth.R 5dbd84a57f187bb2affbadb155bba145 *tests/testthat/test-pluck.R 3ac1ec33f746ad91ff210a9a1af17392 *tests/testthat/test-pmap.R 6d53cea742e68da588724a655c47da3a *tests/testthat/test-progress-bars.R ac8f9eb3aeb7d12124bdd4daf45fc715 *tests/testthat/test-rate.R f2c942874688e7b7397de5273db5bd2b *tests/testthat/test-reduce.R 50fbffb1584f3312fc9447ea7ccc9572 *tests/testthat/test-superseded-flatten.R a5402b4bcede338bb608b0955f01e8a5 *tests/testthat/test-superseded-map-df.R 566197e01cb28db2387ea55d25dab167 *tests/testthat/test-superseded-simplify.R 7e4dc9d4b075924f8d1dde23cc78723d *tests/testthat/test-superseded-transpose.R 0776c87576603899375367ad3ef3407b *tests/testthat/test-utils.R b44c347c7cf1ed68e512eb02cf2d27a6 *vignettes/base.Rmd 24439c5a0bebf0c9af162debb225dc5d *vignettes/other-langs.Rmd 0345aefb10965bd3d6dba2fc6624bb69 *vignettes/purrr.Rmd purrr/R/0000755000176200001440000000000015166146732011640 5ustar liggesuserspurrr/R/keep.R0000644000176200001440000000556215163460322012706 0ustar liggesusers#' Keep/discard elements based on their values #' #' `keep()` selects all elements where `.p` evaluates to `TRUE`; #' `discard()` selects all elements where `.p` evaluates to `FALSE`. #' `compact()` discards elements where `.p` evaluates to an empty vector. #' #' In other languages, `keep()` and `discard()` are often called `select()`/ #' `filter()` and `reject()`/ `drop()`, but those names are already taken #' in R. `keep()` is similar to [Filter()], but the argument order is more #' convenient, and the evaluation of the predicate function `.p` is stricter. #' #' @param .x A list or vector. #' @param .p A predicate function (i.e. a function that returns either `TRUE` #' or `FALSE`) specified in one of the following ways: #' #' * A named function, e.g. `is.character`. #' * An anonymous function, e.g. `\(x) all(x < 0)` or `function(x) all(x < 0)`. #' * A formula, e.g. `~ all(.x < 0)`. Use `.x` to refer to the first argument. #' No longer recommended. #' #' @seealso [keep_at()]/[discard_at()] to keep/discard elements by name. #' @param ... Additional arguments passed on to `.p`. #' @export #' @examples #' rep(10, 10) |> #' map(sample, 5) |> #' keep(function(x) mean(x) > 6) #' #' # Or use shorthand form #' rep(10, 10) |> #' map(sample, 5) |> #' keep(\(x) mean(x) > 6) #' #' # Using a string instead of a function will select all list elements #' # where that subelement is TRUE #' x <- rerun(5, a = rbernoulli(1), b = sample(10)) #' x #' x |> keep("a") #' x |> discard("a") #' #' # compact() discards elements that are NULL or that have length zero #' list(a = "a", b = NULL, c = integer(0), d = NA, e = list()) |> #' compact() keep <- function(.x, .p, ...) { where <- where_if(.x, .p, ...) .x[!is.na(where) & where] } #' @export #' @rdname keep discard <- function(.x, .p, ...) { where <- where_if(.x, .p, ...) .x[is.na(where) | !where] } #' @export #' @rdname keep compact <- function(.x, .p = identity) { .f <- as_mapper(.p) discard(.x, function(x) is_empty(.f(x))) } #' Keep/discard elements based on their name/position #' #' @description #' `keep_at()` and `discard_at()` are similar to `[` or `dplyr::select()`: they #' return the same type of data structure as the input, but only containing #' the requested elements. (If you're looking for a function similar to #' `[[` see [pluck()]/[chuck()]). #' #' @seealso [keep()]/[discard()] to keep/discard elements by value. #' @inheritParams map_at #' @export #' @examples #' x <- c(a = 1, b = 2, cat = 10, dog = 15, elephant = 5, e = 10) #' x |> keep_at(letters) #' x |> discard_at(letters) #' #' # Can also use a function #' x |> keep_at(\(x) nchar(x) == 3) #' x |> discard_at(\(x) nchar(x) == 3) keep_at <- function(x, at) { where <- where_at(x, at, user_env = caller_env()) x[where] } #' @export #' @rdname keep_at discard_at <- function(x, at) { where <- where_at(x, at, user_env = caller_env()) x[!where] } purrr/R/adverb-auto-browse.R0000644000176200001440000000307215063325731015467 0ustar liggesusers#' Wrap a function so it will automatically `browse()` on error #' #' A function wrapped with `auto_browse()` will automatically enter an #' interactive debugger using [browser()] when ever it encounters an error. #' #' @inheritParams safely #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' # For interactive usage, auto_browse() is useful because it automatically #' # starts a browser() in the right place. #' f <- function(x) { #' y <- 20 #' if (x > 5) { #' stop("!") #' } else { #' x #' } #' } #' if (interactive()) { #' map(1:6, auto_browse(f)) #' } #' auto_browse <- function(.f) { if (is_primitive(.f)) { cli::cli_abort( "{.arg .f} must not be a primitive function.", arg = ".f" ) } function(...) { withCallingHandlers( .f(...), error = function(e) { # 1: h(simpleError(msg, call)) # 2: .handleSimpleError(function (e) <...> # 3: stop(...) frame <- sys.frame(4) browse_in_frame(frame) }, warning = function(e) { if (getOption("warn") >= 2) { frame <- sys.frame(7) browse_in_frame(frame) } } ) } } browse_in_frame <- function(frame) { # ESS should problably set `.Platform$GUI == "ESS"` # In the meantime, check that ESSR is attached if (is_attached("ESSR")) { # Workaround ESS issue with_env( frame, on.exit({ browser() NULL }) ) return_from(frame) } else { eval_bare(quote(browser()), env = frame) } } purrr/R/cleancall.R0000644000176200001440000000015015063325731013667 0ustar liggesuserscall_with_cleanup <- function(ptr, ...) { .Call(cleancall_call, pairlist(ptr, ...), parent.frame()) } purrr/R/deprec-cross.R0000644000176200001440000001461415063325731014354 0ustar liggesusers#' Produce all combinations of list elements #' #' @description #' `r lifecycle::badge("deprecated")` #' #' These functions were deprecated in purrr 1.0.0 because they #' are slow and buggy, and we no longer think they are the right #' approach to solving this problem. Please use `tidyr::expand_grid()` #' instead. #' #' Here is an example of equivalent usages for `cross()` and #' `expand_grid()`: #' #' ```R #' data <- list( #' id = c("John", "Jane"), #' sep = c("! ", "... "), #' greeting = c("Hello.", "Bonjour.") #' ) #' #' # With deprecated `cross()` #' data |> cross() |> map_chr(\(...) paste0(..., collapse = "")) #' #' # With `expand_grid()` #' tidyr::expand_grid(!!!data) |> pmap_chr(paste) #' ``` #' #' @details #' `cross2()` returns the product set of the elements of #' `.x` and `.y`. `cross3()` takes an additional #' `.z` argument. `cross()` takes a list `.l` and #' returns the cartesian product of all its elements in a list, with #' one combination by element. `cross_df()` is like #' `cross()` but returns a data frame, with one combination by #' row. #' #' `cross()`, `cross2()` and `cross3()` return the #' cartesian product is returned in wide format. This makes it more #' amenable to mapping operations. `cross_df()` returns the output #' in long format just as `expand.grid()` does. This is adapted #' to rowwise operations. #' #' When the number of combinations is large and the individual #' elements are heavy memory-wise, it is often useful to filter #' unwanted combinations on the fly with `.filter`. It must be #' a predicate function that takes the same number of arguments as the #' number of crossed objects (2 for `cross2()`, 3 for #' `cross3()`, `length(.l)` for `cross()`) and #' returns `TRUE` or `FALSE`. The combinations where the #' predicate function returns `TRUE` will be removed from the #' result. #' @seealso [expand.grid()] #' @param .x,.y,.z Lists or atomic vectors. #' @param .l A list of lists or atomic vectors. Alternatively, a data #' frame. `cross_df()` requires all elements to be named. #' @param .filter A predicate function that takes the same number of #' arguments as the number of variables to be combined. #' @return `cross2()`, `cross3()` and `cross()` #' always return a list. `cross_df()` always returns a data #' frame. `cross()` returns a list where each element is one #' combination so that the list can be directly mapped #' over. `cross_df()` returns a data frame where each row is one #' combination. #' @keywords internal #' @export #' @examples #' # We build all combinations of names, greetings and separators from our #' # list of data and pass each one to paste() #' data <- list( #' id = c("John", "Jane"), #' greeting = c("Hello.", "Bonjour."), #' sep = c("! ", "... ") #' ) #' #' data |> #' cross() |> #' map(lift(paste)) #' #' # cross() returns the combinations in long format: many elements, #' # each representing one combination. With cross_df() we'll get a #' # data frame in long format: crossing three objects produces a data #' # frame of three columns with each row being a particular #' # combination. This is the same format that expand.grid() returns. #' args <- data |> cross_df() #' #' # In case you need a list in long format (and not a data frame) #' # just run as.list() after cross_df() #' args |> as.list() #' #' # This format is often less practical for functional programming #' # because applying a function to the combinations requires a loop #' out <- vector("character", length = nrow(args)) #' for (i in seq_along(out)) #' out[[i]] <- invoke("paste", map(args, i)) #' out #' #' # It's easier to transpose and then use invoke_map() #' args |> transpose() |> map_chr(\(x) exec(paste, !!!x)) #' #' # Unwanted combinations can be filtered out with a predicate function #' filter <- function(x, y) x >= y #' cross2(1:5, 1:5, .filter = filter) |> str() #' #' # To give names to the components of the combinations, we map #' # setNames() on the product: #' x <- seq_len(3) #' cross2(x, x, .filter = `==`) |> #' map(setNames, c("x", "y")) #' #' # Alternatively we can encapsulate the arguments in a named list #' # before crossing to get named components: #' list(x = x, y = x) |> #' cross(.filter = `==`) cross <- function(.l, .filter = NULL) { lifecycle::deprecate_warn( "1.0.0", "purrr::cross()", "tidyr::expand_grid()", details = c(i = "See .") ) if (is_empty(.l)) { return(.l) } if (!is.null(.filter)) { .filter <- as_mapper(.filter) } n <- length(.l) lengths <- lapply(.l, length) names <- names(.l) factors <- cumprod(lengths) total_length <- factors[n] factors <- c(1, factors[-n]) out <- replicate(total_length, vector("list", n), simplify = FALSE) for (i in seq_along(out)) { for (j in seq_len(n)) { index <- floor((i - 1) / factors[j]) %% length(.l[[j]]) + 1 out[[i]][[j]] <- .l[[j]][[index]] } names(out[[i]]) <- names # Filter out unwanted elements. We set them to NULL instead of # completely removing them so we don't mess up the loop indexing. # NULL elements are removed later on. if (!is.null(.filter)) { is_to_filter <- do.call(".filter", unname(out[[i]])) if (!is_bool(is_to_filter)) { cli::cli_abort( "The filter function must return a single `TRUE` or `FALSE`, not {.obj_type_friendly {is_to_filter}}." ) } if (is_to_filter) { out[i] <- list(NULL) } } } # Remove filtered elements compact(out) } #' @export #' @rdname cross cross2 <- function(.x, .y, .filter = NULL) { lifecycle::deprecate_warn( "1.0.0", "purrr::cross2()", "tidyr::expand_grid()", details = c(i = "See .") ) cross(list(.x, .y), .filter = .filter) } #' @export #' @rdname cross cross3 <- function(.x, .y, .z, .filter = NULL) { lifecycle::deprecate_warn( "1.0.0", "purrr::cross3()", "tidyr::expand_grid()", details = c(i = "See .") ) cross(list(.x, .y, .z), .filter = .filter) } #' @rdname cross #' @export cross_df <- function(.l, .filter = NULL) { lifecycle::deprecate_warn( "1.0.0", "purrr::cross_df()", "tidyr::expand_grid()", details = c(i = "See .") ) check_installed("tibble") cross(.l, .filter = .filter) |> transpose() |> simplify_all() |> tibble::as_tibble() } purrr/R/deprec-utils.R0000644000176200001440000000230215063325731014352 0ustar liggesusers#' Generate random sample from a Bernoulli distribution #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because it's not related to the #' core purpose of purrr. #' #' @param n Number of samples #' @param p Probability of getting `TRUE` #' @return A logical vector #' @keywords internal #' @export #' @examples #' rbernoulli(10) #' rbernoulli(100, 0.1) rbernoulli <- function(n, p = 0.5) { lifecycle::deprecate_warn("1.0.0", "rbernoulli()") stats::runif(n) > (1 - p) } #' Generate random sample from a discrete uniform distribution #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because it's not related to the #' core purpose of purrr. #' #' @param n Number of samples to draw. #' @param a,b Range of the distribution (inclusive). #' @keywords internal #' @export #' @examples #' table(rdunif(1e3, 10)) #' table(rdunif(1e3, 10, -5)) rdunif <- function(n, b, a = 1) { lifecycle::deprecate_warn("1.0.0", "rdunif()") stopifnot(is.numeric(a), length(a) == 1) stopifnot(is.numeric(b), length(b) == 1) a1 <- min(a, b) b1 <- max(a, b) sample(b1 - a1 + 1, n, replace = TRUE) + a1 - 1 } purrr/R/reexport-rlang.R0000644000176200001440000000206114326706774014740 0ustar liggesusers#' @export rlang::set_names #' @export rlang::exec #' @export rlang::zap #' @export rlang::`%||%` #' @export rlang::done #' @export rlang::rep_along # Predicates --------------------------------------------------- #' @export rlang::is_bare_list #' @export rlang::is_bare_atomic #' @export rlang::is_bare_vector #' @export rlang::is_bare_double #' @export rlang::is_bare_integer #' @export rlang::is_bare_numeric #' @export rlang::is_bare_character #' @export rlang::is_bare_logical #' @export rlang::is_list #' @export rlang::is_atomic #' @export rlang::is_vector #' @export rlang::is_integer #' @export rlang::is_double #' @export rlang::is_character #' @export rlang::is_logical #' @export rlang::is_null #' @export rlang::is_function #' @export rlang::is_scalar_list #' @export rlang::is_scalar_atomic #' @export rlang::is_scalar_vector #' @export rlang::is_scalar_double #' @export rlang::is_scalar_character #' @export rlang::is_scalar_logical #' @export rlang::is_scalar_integer #' @export rlang::is_empty #' @export rlang::is_formula purrr/R/deprec-rerun.R0000644000176200001440000000411015063325731014344 0ustar liggesusers#' Re-run expressions multiple times #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because we believe that NSE #' functions are not a good fit for purrr. Also, `rerun(n, x)` can just as #' easily be expressed as `map(1:n, \(i) x)` #' #' `rerun()` is a convenient way of generating sample data. It works similarly to #' \code{\link{replicate}(..., simplify = FALSE)}. #' #' @param .n Number of times to run expressions #' @param ... Expressions to re-run. #' @return A list of length `.n`. Each element of `...` will be #' re-run once for each `.n`. #' #' There is one special case: if there's a single unnamed input, the second #' level list will be dropped. In this case, `rerun(n, x)` behaves like #' `replicate(n, x, simplify = FALSE)`. #' @export #' @keywords internal #' @examples #' # old #' 5 |> rerun(rnorm(5)) |> str() #' # new #' 1:5 |> map(\(i) rnorm(5)) |> str() #' #' # old #' 5 |> #' rerun(x = rnorm(5), y = rnorm(5)) |> #' map_dbl(\(l) cor(l$x, l$y)) #' # new #' 1:5 |> #' map(\(i) list(x = rnorm(5), y = rnorm(5))) |> #' map_dbl(\(l) cor(l$x, l$y)) rerun <- function(.n, ...) { deprec_rerun(.n, ..., .purrr_user_env = caller_env()) dots <- quos(...) # Special case: if single unnamed argument, insert directly into the output # rather than wrapping in a list. if (length(dots) == 1 && !is_named(dots)) { dots <- dots[[1]] eval_dots <- eval_tidy } else { eval_dots <- function(x) lapply(x, eval_tidy) } out <- vector("list", .n) for (i in seq_len(.n)) { out[[i]] <- eval_dots(dots) } out } deprec_rerun <- function(.n, ..., .purrr_user_env) { n <- .n old <- substitute(rerun(n, ...)) if (dots_n(...) == 1) { new <- substitute(map(1:n, ~...)) } else { new <- substitute(map(1:n, ~ list(...))) } lifecycle::deprecate_warn( when = "1.0.0", what = "rerun()", with = "map()", details = c( " " = "# Previously", " " = expr_deparse(old), "", " " = "# Now", " " = expr_deparse(new) ), user_env = .purrr_user_env ) } purrr/R/lmap.R0000644000176200001440000000527715063325731012721 0ustar liggesusers#' Apply a function to list-elements of a list #' #' @description #' `lmap()`, `lmap_at()` and `lmap_if()` are similar to `map()`, `map_at()` and #' `map_if()`, except instead of mapping over `.x[[i]]`, they instead map over #' `.x[i]`. #' #' This has several advantages: #' #' * It makes it possible to work with functions that exclusively take a list. #' * It allows `.f` to access the attributes of the encapsulating list, #' like [names()]. #' * It allows `.f` to return a larger or small list than it receives #' changing the size of the output. #' #' @param .x A list or data frame. #' @param .f A function that takes a length-1 list and returns a list (of any #' length.) #' @inheritParams map_if #' @inheritParams map_at #' @inheritParams map #' @return A list or data frame, matching `.x`. There are no guarantees about #' the length. #' @family map variants #' @export #' @examples #' set.seed(1014) #' #' # Let's write a function that returns a larger list or an empty list #' # depending on some condition. It also uses the input name to name the #' # output #' maybe_rep <- function(x) { #' n <- rpois(1, 2) #' set_names(rep_len(x, n), paste0(names(x), seq_len(n))) #' } #' #' # The output size varies each time we map f() #' x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10]) #' x |> lmap(maybe_rep) |> str() #' #' # We can apply f() on a selected subset of x #' x |> lmap_at(c("a", "d"), maybe_rep) |> str() #' #' # Or only where a condition is satisfied #' x |> lmap_if(is.character, maybe_rep) |> str() lmap <- function(.x, .f, ...) { lmap_helper(.x, rep(TRUE, length(.x)), .f, ...) } #' @rdname lmap #' @export lmap_if <- function(.x, .p, .f, ..., .else = NULL) { where <- where_if(.x, .p) lmap_helper(.x, where, .f, ..., .else = .else) } #' @rdname lmap #' @export lmap_at <- function(.x, .at, .f, ...) { where <- where_at(.x, .at, user_env = caller_env()) lmap_helper(.x, where, .f, ...) } lmap_helper <- function( .x, .ind, .f, ..., .else = NULL, .purrr_error_call = caller_env() ) { .f <- rlang::as_function(.f, call = .purrr_error_call) if (!is.null(.else)) { .else <- rlang::as_function(.else, call = .purrr_error_call) } out <- vector("list", length(.x)) for (i in seq_along(.x)) { if (.ind[[i]]) { res <- .f(.x[i], ...) } else if (is.null(.else)) { res <- .x[i] } else { res <- .else(.x[i], ...) } if (!is.list(res)) { cli::cli_abort( "{.code .f(.x[[{i}]])} must return a list, not {.obj_type_friendly {res}}.", call = .purrr_error_call ) } out[[i]] <- res } if (is.data.frame(.x)) { out <- lapply(out, as.data.frame) list_cbind(out) } else { list_flatten(out) } } purrr/R/arrays.R0000644000176200001440000000526215163460322013260 0ustar liggesusers#' Coerce array to list #' #' `array_branch()` and `array_tree()` enable arrays to be #' used with purrr's functionals by turning them into lists. The #' details of the coercion are controlled by the `margin` #' argument. `array_tree()` creates an hierarchical list (a tree) #' that has as many levels as dimensions specified in `margin`, #' while `array_branch()` creates a flat list (by analogy, a #' branch) along all mentioned dimensions. #' #' When no margin is specified, all dimensions are used by #' default. When `margin` is a numeric vector of length zero, the #' whole array is wrapped in a list. #' @param array An array to coerce into a list. #' @param margin A numeric vector indicating the positions of the #' indices to be to be enlisted. If `NULL`, a full margin is #' used. If `numeric(0)`, the array as a whole is wrapped in a #' list. #' @name array-coercion #' @export #' @examples #' # We create an array with 3 dimensions #' x <- array(1:12, c(2, 2, 3)) #' #' # A full margin for such an array would be the vector 1:3. This is #' # the default if you don't specify a margin #' #' # Creating a branch along the full margin is equivalent to #' # as.list(array) and produces a list of size length(x): #' array_branch(x) |> str() #' #' # A branch along the first dimension yields a list of length 2 #' # with each element containing a 2x3 array: #' array_branch(x, 1) |> str() #' #' # A branch along the first and third dimensions yields a list of #' # length 2x3 whose elements contain a vector of length 2: #' array_branch(x, c(1, 3)) |> str() #' #' # Creating a tree from the full margin creates a list of lists of #' # lists: #' array_tree(x) |> str() #' #' # The ordering and the depth of the tree are controlled by the #' # margin argument: #' array_tree(x, c(3, 1)) |> str() array_branch <- function(array, margin = NULL) { dims <- dim(array) %||% length(array) margin <- margin %||% seq_along(dims) if (length(margin) == 0) { list(array) } else if (is.null(dim(array))) { if (!identical(as.integer(margin), 1L)) { cli::cli_abort( "{.arg margin} must be `NULL` or `1` with 1D arrays, not {.str {margin}}.", arg = "margin" ) } as.list(array) } else { out <- apply(array, margin, list) if (!is.null(dim(out))) { dim(out) <- NULL } list_flatten(out) } } #' @rdname array-coercion #' @export array_tree <- function(array, margin = NULL) { dims <- dim(array) %||% length(array) margin <- margin %||% seq_along(dims) if (length(margin) > 1) { new_margin <- ifelse(margin[-1] > margin[[1]], margin[-1] - 1, margin[-1]) apply(array, margin[[1]], array_tree, new_margin) } else { array_branch(array, margin) } } purrr/R/modify-tree.R0000644000176200001440000000420215063325731014177 0ustar liggesusers#' Recursively modify a list #' #' `modify_tree()` allows you to recursively modify a list, supplying functions #' that either modify each leaf or each node (or both). #' #' @param x A list. #' @param ... Reserved for future use. Must be empty #' @param leaf A function applied to each leaf. #' @param is_node A predicate function that determines whether an element is #' a node (by returning `TRUE`) or a leaf (by returning `FALSE`). The #' default value, `NULL`, treats simple lists as nodes and everything else #' (including richer objects like data frames and linear models) as leaves, #' using [vctrs::obj_is_list()]. To recurse into all objects built on lists #' use [is.list()]. #' @param pre,post Functions applied to each node. `pre` is applied on the #' way "down", i.e. before the leaves are transformed with `leaf`, while #' `post` is applied on the way "up", i.e. after the leaves are transformed. #' @family modify variants #' @export #' @examples #' x <- list(list(a = 2:1, c = list(b1 = 2), b = list(c2 = 3, c1 = 4))) #' x |> str() #' #' # Transform each leaf #' x |> modify_tree(leaf = \(x) x + 100) |> str() #' #' # Recursively sort the nodes #' sort_named <- function(x) { #' nms <- names(x) #' if (!is.null(nms)) { #' x[order(nms)] #' } else { #' x #' } #' } #' x |> modify_tree(post = sort_named) |> str() modify_tree <- function( x, ..., leaf = identity, is_node = NULL, pre = identity, post = identity ) { check_dots_empty() leaf <- rlang::as_function(leaf) is_node <- as_is_node(is_node) post <- rlang::as_function(post) pre <- rlang::as_function(pre) worker <- function(x) { if (is_node(x)) { out <- pre(x) out <- modify(out, worker) out <- post(out) } else { out <- leaf(x) } out } worker(x) } as_is_node <- function( f, error_call = caller_env(), error_arg = caller_arg(f) ) { if (is.null(f)) { obj_is_list } else { is_node_f <- rlang::as_function(f, call = error_call, arg = error_arg) as_predicate( is_node_f, .mapper = FALSE, .purrr_error_call = error_call, .purrr_error_arg = error_arg ) } } purrr/R/coerce.R0000644000176200001440000000144615063325731013222 0ustar liggesusers# Used internally by map and flatten. # Exposed here for testing coerce <- function(x, type) { .Call(coerce_impl, x, type) } coerce_lgl <- function(x) coerce(x, "logical") coerce_int <- function(x) coerce(x, "integer") coerce_dbl <- function(x) coerce(x, "double") coerce_chr <- function(x) coerce(x, "character") # Can rewrite after https://github.com/r-lib/rlang/issues/1643 local_deprecation_user_env <- function( user_env = caller_env(2), frame = caller_env() ) { old <- the$deprecation_user_env the$deprecation_user_env <- user_env defer(the$deprecation_user_env <- old, frame) } # Lightweight equivalent of withr::defer() defer <- function(expr, env = caller_env(), after = FALSE) { thunk <- as.call(list(function() expr)) do.call(on.exit, list(thunk, TRUE, after), envir = env) } purrr/R/compat-obj-type.R0000644000176200001440000001733315063325731014776 0ustar liggesusers# nocov start --- r-lib/rlang compat-obj-type # # Changelog # ========= # # 2022-10-04: # - `obj_type_friendly(value = TRUE)` now shows numeric scalars # literally. # - `stop_friendly_type()` now takes `show_value`, passed to # `obj_type_friendly()` as the `value` argument. # # 2022-10-03: # - Added `allow_na` and `allow_null` arguments. # - `NULL` is now backticked. # - Better friendly type for infinities and `NaN`. # # 2022-09-16: # - Unprefixed usage of rlang functions with `rlang::` to # avoid onLoad issues when called from rlang (#1482). # # 2022-08-11: # - Prefixed usage of rlang functions with `rlang::`. # # 2022-06-22: # - `friendly_type_of()` is now `obj_type_friendly()`. # - Added `obj_type_oo()`. # # 2021-12-20: # - Added support for scalar values and empty vectors. # - Added `stop_input_type()` # # 2021-06-30: # - Added support for missing arguments. # # 2021-04-19: # - Added support for matrices and arrays (#141). # - Added documentation. # - Added changelog. #' Return English-friendly type #' @param x Any R object. #' @param value Whether to describe the value of `x`. Special values #' like `NA` or `""` are always described. #' @param length Whether to mention the length of vectors and lists. #' @return A string describing the type. Starts with an indefinite #' article, e.g. "an integer vector". #' @noRd obj_type_friendly <- function(x, value = TRUE) { if (is_missing(x)) { return("absent") } if (is.object(x)) { if (inherits(x, "quosure")) { type <- "quosure" } else { type <- paste(class(x), collapse = "/") } return(sprintf("a <%s> object", type)) } if (!is_vector(x)) { return(.rlang_as_friendly_type(typeof(x))) } n_dim <- length(dim(x)) if (!n_dim) { if (!is_list(x) && length(x) == 1) { if (is_na(x)) { return(switch( typeof(x), logical = "`NA`", integer = "an integer `NA`", double = if (is.nan(x)) { "`NaN`" } else { "a numeric `NA`" }, complex = "a complex `NA`", character = "a character `NA`", .rlang_stop_unexpected_typeof(x) )) } show_infinites <- function(x) { if (x > 0) { "`Inf`" } else { "`-Inf`" } } str_encode <- function(x, width = 30, ...) { if (nchar(x) > width) { x <- substr(x, 1, width - 3) x <- paste0(x, "...") } encodeString(x, ...) } if (value) { if (is.numeric(x) && is.infinite(x)) { return(show_infinites(x)) } if (is.numeric(x) || is.complex(x)) { number <- as.character(round(x, 2)) what <- if (is.complex(x)) "the complex number" else "the number" return(paste(what, number)) } return(switch( typeof(x), logical = if (x) "`TRUE`" else "`FALSE`", character = { what <- if (nzchar(x)) "the string" else "the empty string" paste(what, str_encode(x, quote = "\"")) }, raw = paste("the raw value", as.character(x)), .rlang_stop_unexpected_typeof(x) )) } return(switch( typeof(x), logical = "a logical value", integer = "an integer", double = if (is.infinite(x)) show_infinites(x) else "a number", complex = "a complex number", character = if (nzchar(x)) "a string" else "\"\"", raw = "a raw value", .rlang_stop_unexpected_typeof(x) )) } if (length(x) == 0) { return(switch( typeof(x), logical = "an empty logical vector", integer = "an empty integer vector", double = "an empty numeric vector", complex = "an empty complex vector", character = "an empty character vector", raw = "an empty raw vector", list = "an empty list", .rlang_stop_unexpected_typeof(x) )) } } vec_type_friendly(x) } vec_type_friendly <- function(x, length = FALSE) { if (!is_vector(x)) { abort("`x` must be a vector.") } type <- typeof(x) n_dim <- length(dim(x)) add_length <- function(type) { if (length && !n_dim) { paste0(type, sprintf(" of length %s", length(x))) } else { type } } if (type == "list") { if (n_dim < 2) { return(add_length("a list")) } else if (is.data.frame(x)) { return("a data frame") } else if (n_dim == 2) { return("a list matrix") } else { return("a list array") } } type <- switch( type, logical = "a logical %s", integer = "an integer %s", numeric = , double = "a double %s", complex = "a complex %s", character = "a character %s", raw = "a raw %s", type = paste0("a ", type, " %s") ) if (n_dim < 2) { kind <- "vector" } else if (n_dim == 2) { kind <- "matrix" } else { kind <- "array" } out <- sprintf(type, kind) if (n_dim >= 2) { out } else { add_length(out) } } .rlang_as_friendly_type <- function(type) { switch( type, list = "a list", NULL = "`NULL`", environment = "an environment", externalptr = "a pointer", weakref = "a weak reference", S4 = "an S4 object", name = , symbol = "a symbol", language = "a call", pairlist = "a pairlist node", expression = "an expression vector", char = "an internal string", promise = "an internal promise", ... = "an internal dots object", any = "an internal `any` object", bytecode = "an internal bytecode object", primitive = , builtin = , special = "a primitive function", closure = "a function", type ) } .rlang_stop_unexpected_typeof <- function(x, call = caller_env()) { abort( sprintf("Unexpected type <%s>.", typeof(x)), call = call ) } #' Return OO type #' @param x Any R object. #' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, #' `"R6"`, or `"R7"`. #' @noRd obj_type_oo <- function(x) { if (!is.object(x)) { return("bare") } class <- inherits(x, c("R6", "R7_object"), which = TRUE) if (class[[1]]) { "R6" } else if (class[[2]]) { "R7" } else if (isS4(x)) { "S4" } else { "S3" } } #' @param x The object type which does not conform to `what`. Its #' `obj_type_friendly()` is taken and mentioned in the error message. #' @param what The friendly expected type as a string. Can be a #' character vector of expected types, in which case the error #' message mentions all of them in an "or" enumeration. #' @param show_value Passed to `value` argument of `obj_type_friendly()`. #' @param ... Arguments passed to [abort()]. #' @inheritParams args_error_context #' @noRd stop_input_type <- function( x, what, ..., allow_na = FALSE, allow_null = FALSE, show_value = TRUE, arg = caller_arg(x), call = caller_env() ) { # From compat-cli.R cli <- env_get_list( nms = c("format_arg", "format_code"), last = topenv(), default = function(x) sprintf("`%s`", x), inherit = TRUE ) if (allow_na) { what <- c(what, cli$format_code("NA")) } if (allow_null) { what <- c(what, cli$format_code("NULL")) } if (length(what)) { what <- oxford_comma(what) } message <- sprintf( "%s must be %s, not %s.", cli$format_arg(arg), what, obj_type_friendly(x, value = show_value) ) abort(message, ..., call = call, arg = arg) } oxford_comma <- function(chr, sep = ", ", final = "or") { n <- length(chr) if (n < 2) { return(chr) } head <- chr[seq_len(n - 1)] last <- chr[n] head <- paste(head, collapse = sep) # Write a or b. But a, b, or c. if (n > 2) { paste0(head, sep, final, " ", last) } else { paste0(head, " ", final, " ", last) } } # nocov end purrr/R/adverb-possibly.R0000644000176200001440000000150615063325731015064 0ustar liggesusers#' Wrap a function to return a value instead of an error #' #' Create a modified version of `.f` that return a default value (`otherwise`) #' whenever an error occurs. #' #' @inheritParams safely #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' # To replace errors with a default value, use possibly(). #' list("a", 10, 100) |> #' map_dbl(possibly(log, NA_real_)) #' #' # The default, NULL, will be discarded with `list_c()` #' list("a", 10, 100) |> #' map(possibly(log)) |> #' list_c() possibly <- function(.f, otherwise = NULL, quiet = TRUE) { .f <- as_mapper(.f) force(otherwise) check_bool(quiet) function(...) { tryCatch(.f(...), error = function(e) { if (!quiet) { message("Error: ", conditionMessage(e)) } otherwise }) } } purrr/R/map-raw.R0000644000176200001440000000217615063325731013327 0ustar liggesusers#' Functions that return raw vectors #' #' @description #' `r lifecycle::badge("deprecated")` #' #' These functions were deprecated in purrr 1.0.0 because they are of limited #' use and you can now use [map_vec()] instead. They are variants of [map()], #' [map2()], [imap()], [pmap()], and [flatten()] that return raw vectors. #' #' @keywords internal #' @export map_raw <- function(.x, .f, ...) { lifecycle::deprecate_warn("1.0.0", "map_raw()", "map_vec()") map_("raw", .x, .f, ...) } #' @export #' @rdname map_raw map2_raw <- function(.x, .y, .f, ...) { lifecycle::deprecate_warn("1.0.0", "map2_raw()", "map2_vec()") map2_("raw", .x, .y, .f, ...) } #' @rdname map_raw #' @export imap_raw <- function(.x, .f, ...) { lifecycle::deprecate_warn("1.0.0", "imap_raw()", "imap_vec()") map2_("raw", .x, vec_index(.x), .f, ...) } #' @export #' @rdname map_raw pmap_raw <- function(.l, .f, ...) { lifecycle::deprecate_warn("1.0.0", "pmap_raw()", "pmap_vec()") pmap_("raw", .l, .f, ...) } #' @export #' @rdname map_raw flatten_raw <- function(.x) { lifecycle::deprecate_warn("1.0.0", "flatten_raw()") .Call(vflatten_impl, .x, "raw") } purrr/R/head-tail.R0000644000176200001440000000150015063325731013601 0ustar liggesusers#' Find head/tail that all satisfies a predicate. #' #' @inheritParams map_if #' @inheritParams map #' @return A vector the same type as `.x`. #' @export #' @examples #' pos <- function(x) x >= 0 #' head_while(5:-5, pos) #' tail_while(5:-5, negate(pos)) #' #' big <- function(x) x > 100 #' head_while(0:10, big) #' tail_while(0:10, big) head_while <- function(.x, .p, ...) { # Find location of first FALSE .p <- as_predicate(.p, ..., .mapper = TRUE) loc <- detect_index(.x, negate(.p), ...) if (loc == 0) { return(.x) } .x[seq_len(loc - 1)] } #' @export #' @rdname head_while tail_while <- function(.x, .p, ...) { .p <- as_predicate(.p, ..., .mapper = TRUE) # Find location of last FALSE loc <- detect_index(.x, negate(.p), ..., .dir = "backward") if (loc == 0) { return(.x) } .x[-seq_len(loc)] } purrr/R/list-flatten.R0000644000176200001440000000536215063325731014371 0ustar liggesusers#' Flatten a list #' #' Flattening a list removes a single layer of internal hierarchy, #' i.e. it inlines elements that are lists leaving non-lists alone. #' #' @param x A list. #' @param name_spec If both inner and outer names are present, control #' how they are combined. Should be a glue specification that uses #' variables `inner` and `outer`. #' @param name_repair One of `"minimal"`, `"unique"`, `"universal"`, or #' `"check_unique"`. See [vctrs::vec_as_names()] for the meaning of these #' options. #' @inheritParams rlang::args_dots_empty #' @inheritParams modify_tree #' @return A list of the same type as `x`. The list might be shorter #' if `x` contains empty lists, the same length if it contains lists #' of length 1 or no sub-lists, or longer if it contains lists of #' length > 1. #' @export #' @examples #' x <- list(1, list(2, 3), list(4, list(5))) #' x |> list_flatten() |> str() #' x |> list_flatten() |> list_flatten() |> str() #' #' # Flat lists are left as is #' list(1, 2, 3, 4, 5) |> list_flatten() |> str() #' #' # Empty lists will disappear #' list(1, list(), 2, list(3)) |> list_flatten() |> str() #' #' # Another way to see this is that it reduces the depth of the list #' x <- list( #' list(), #' list(list()) #' ) #' x |> pluck_depth() #' x |> list_flatten() |> pluck_depth() #' #' # Use name_spec to control how inner and outer names are combined #' x <- list(x = list(a = 1, b = 2), y = list(c = 1, d = 2)) #' x |> list_flatten() |> names() #' x |> list_flatten(name_spec = "{outer}") |> names() #' x |> list_flatten(name_spec = "{inner}") |> names() #' #' # Set `is_node = is.list` to also flatten richer objects built on lists like #' # data frames and linear models #' df <- data.frame(x = 1:3, y = 4:6) #' x <- list( #' a_string = "something", #' a_list = list(1:3, "else"), #' a_df = df #' ) #' x |> list_flatten(is_node = is.list) #' #' # Note that objects that are already "flat" retain their classes #' list_flatten(df, is_node = is.list) list_flatten <- function( x, ..., is_node = NULL, name_spec = "{outer}_{inner}", name_repair = c("minimal", "unique", "check_unique", "universal") ) { is_node <- as_is_node(is_node) if (!is_node(x)) { cli::cli_abort("{.arg x} must be a node.") } check_dots_empty() check_string(name_spec) # Take the proxy as we restore on exit proxy <- vec_proxy(x) # Unclass S3 lists to avoid their coercion methods. Wrap atoms in a # list of size 1 so the elements can be concatenated in a single list. proxy <- map_if(proxy, is_node, unclass, .else = list) out <- list_unchop( proxy, ptype = list(), name_spec = name_spec, name_repair = name_repair, error_arg = x, error_call = current_env() ) # Preserve input type vec_restore(out, x) } purrr/R/deprec-invoke.R0000644000176200001440000001247115063325731014515 0ustar liggesusers#' Invoke functions. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' These functions were superded in purrr 0.3.0 and deprecated in purrr 1.0.0. #' #' * `invoke()` is deprecated in favour of the simpler `exec()` function #' reexported from rlang. `exec()` evaluates a function call built #' from its inputs and supports [dynamic dots][rlang::dyn-dots]: #' #' ```R #' # Before: #' invoke(mean, list(na.rm = TRUE), x = 1:10) #' #' # After #' exec(mean, 1:10, !!!list(na.rm = TRUE)) #' ``` #' #' * `invoke_map()` is deprecated because it's harder to understand than the #' corresponding code using `map()`/`map2()` and `exec()`: #' #' ```R #' # Before: #' invoke_map(fns, list(args)) #' invoke_map(fns, list(args1, args2)) #' #' # After: #' map(fns, exec, !!!args) #' map2(fns, list(args1, args2), \(fn, args) exec(fn, !!!args)) #' ``` #' @param .f For `invoke`, a function; for `invoke_map` a #' list of functions. #' @param .x For `invoke`, an argument-list; for `invoke_map` a #' list of argument-lists the same length as `.f` (or length 1). #' The default argument, `list(NULL)`, will be recycled to the #' same length as `.f`, and will call each function with no #' arguments (apart from any supplied in `...`. #' @param ... Additional arguments passed to each function. #' @param .env Environment in which [do.call()] should #' evaluate a constructed expression. This only matters if you pass #' as `.f` the name of a function rather than its value, or as #' `.x` symbols of objects rather than their values. #' @keywords internal #' @examples #' # was #' invoke(runif, list(n = 10)) #' invoke(runif, n = 10) #' # now #' exec(runif, n = 10) #' #' # was #' args <- list("01a", "01b") #' invoke(paste, args, sep = "-") #' # now #' exec(paste, !!!args, sep = "-") #' #' # was #' funs <- list(runif, rnorm) #' funs |> invoke_map(n = 5) #' funs |> invoke_map(list(list(n = 10), list(n = 5))) #' #' # now #' funs |> map(exec, n = 5) #' funs |> map2(list(list(n = 10), list(n = 5)), function(f, args) exec(f, !!!args)) #' #' # or use pmap + a tibble #' df <- tibble::tibble( #' fun = list(runif, rnorm), #' args = list(list(n = 10), list(n = 5)) #' ) #' df |> pmap(function(fun, args) exec(fun, !!!args)) #' #' #' # was #' list(m1 = mean, m2 = median) |> invoke_map(x = rcauchy(100)) #' # now #' list(m1 = mean, m2 = median) |> map(function(f) f(rcauchy(100))) #' #' @export invoke <- function(.f, .x = NULL, ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke()", "exec()") .env <- .env %||% parent.frame() args <- c(as.list(.x), list(...)) do.call(.f, args, envir = .env) } as_invoke_function <- function(f) { if (is.function(f)) { list(f) } else { f } } #' @rdname invoke #' @export invoke_map <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_map()", I("map() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_lgl <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_lgl()", I("map_lgl() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_lgl(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_int <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_int()", I("map_int() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_int(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_dbl <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_dbl()", I("map_dbl() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_dbl(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_chr <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_chr()", I("map_chr() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_chr(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_raw <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn("1.0.0", "invoke_raw()", I("map_raw() + exec()")) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_("raw", .f, .x, invoke, ...) } #' @rdname invoke #' @export invoke_map_dfr <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_warn( "1.0.0", "invoke_df()", I("map() + exec() + list_rbind()") ) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_dfr(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export invoke_map_dfc <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_soft( "1.0.0", "invoke_dfc()", I("map() + exec() + list_cbind()") ) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_dfc(.f, .x, invoke, ..., .env = .env) } #' @rdname invoke #' @export #' @usage NULL invoke_map_df <- function(.f, .x = list(NULL), ..., .env = NULL) { lifecycle::deprecate_soft( "1.0.0", "invoke_df()", I("map() + exec() + list_rbind()") ) .env <- .env %||% parent.frame() .f <- as_invoke_function(.f) map2_dfr(.f, .x, invoke, ..., .env = .env) } purrr/R/map2.R0000644000176200001440000000640615163460322012617 0ustar liggesusers#' Map over two inputs #' #' @description #' These functions are variants of [map()] that iterate over two arguments at #' a time. #' #' @param .x,.y A pair of vectors, usually the same length. If not, a vector #' of length 1 will be recycled to the length of the other. #' @param .f A function, specified in one of the following ways: #' #' * A named function. #' * An anonymous function, e.g. `\(x, y) x + y` or `function(x, y) x + y`. #' * A formula, e.g. `~ .x + .y`. Use `.x` to refer to the current #' element of `x` and `.y` to refer to the current element of `y`. #' No longer recommended. #' #' `r lifecycle::badge("experimental")` #' #' Wrap a function with [in_parallel()] to declare that it should be performed #' in parallel. See [in_parallel()] for more details. #' Use of `...` is not permitted in this context. #' @inheritParams map #' @inherit map return #' @family map variants #' @export #' @examples #' x <- list(1, 1, 1) #' y <- list(10, 20, 30) #' #' map2(x, y, \(x, y) x + y) #' # Or just #' map2(x, y, `+`) #' #' # Split into pieces, fit model to each piece, then predict #' by_cyl <- mtcars |> split(mtcars$cyl) #' mods <- by_cyl |> map(\(df) lm(mpg ~ wt, data = df)) #' map2(mods, by_cyl, predict) map2 <- function(.x, .y, .f, ..., .progress = FALSE) { map2_("list", .x, .y, .f, ..., .progress = .progress) } #' @export #' @rdname map2 map2_lgl <- function(.x, .y, .f, ..., .progress = FALSE) { map2_("logical", .x, .y, .f, ..., .progress = .progress) } #' @export #' @rdname map2 map2_int <- function(.x, .y, .f, ..., .progress = FALSE) { map2_("integer", .x, .y, .f, ..., .progress = .progress) } #' @export #' @rdname map2 map2_dbl <- function(.x, .y, .f, ..., .progress = FALSE) { map2_("double", .x, .y, .f, ..., .progress = .progress) } #' @export #' @rdname map2 map2_chr <- function(.x, .y, .f, ..., .progress = FALSE) { map2_("character", .x, .y, .f, ..., .progress = .progress) } map2_ <- function( .type, .x, .y, .f, ..., .progress = FALSE, .purrr_user_env = caller_env(2), .purrr_error_call = caller_env() ) { .progress <- as_progress( .progress, user_env = .purrr_user_env, caller_env = .purrr_error_call ) .x <- vctrs_vec_compat(.x, .purrr_user_env) .y <- vctrs_vec_compat(.y, .purrr_user_env) n <- vec_size_common(.x = .x, .y = .y, .call = .purrr_error_call) args <- vec_recycle_common( .x = .x, .y = .y, .size = n, .call = .purrr_error_call ) .x <- args$.x .y <- args$.y names <- vec_names(.x) .f <- as_mapper(.f, ...) if (running_in_parallel(.f)) { attributes(args) <- list( class = "data.frame", row.names = if (is.null(names)) .set_row_names(n) else names ) return(mmap_(args, .f, .progress, .type, .purrr_error_call, ...)) } i <- 0L with_indexed_errors( i = i, names = names, error_call = .purrr_error_call, call_with_cleanup(map2_impl, environment(), .type, .progress, n, names, i) ) } #' @rdname map2 #' @export map2_vec <- function(.x, .y, .f, ..., .ptype = NULL, .progress = FALSE) { out <- map2(.x, .y, .f, ..., .progress = .progress) simplify_impl(out, ptype = .ptype) } #' @export #' @rdname map2 walk2 <- function(.x, .y, .f, ..., .progress = FALSE) { map2(.x, .y, .f, ..., .progress = .progress) invisible(.x) } purrr/R/progress-bars.R0000644000176200001440000000537115163460322014551 0ustar liggesusers#' Progress bars in purrr #' #' @description #' purrr's map functions have a `.progress` argument that you can use to #' create a progress bar. `.progress` can be: #' #' * `FALSE`, the default: does not create a progress bar. #' * `TRUE`: creates a basic unnamed progress bar. #' * A string: creates a basic progress bar with the given name. #' * A named list of progress bar parameters, as described below. #' #' It's good practice to name your progress bars, to make it clear what #' calculation or process they belong to. We recommend keeping the names #' under 20 characters, so the whole progress bar fits comfortably even on #' on narrower displays. #' #' ## Progress bar parameters #' #' * `clear`: whether to remove the progress bar from the screen after #' termination. Defaults to `TRUE`. #' * `format`: format string. This overrides the default format string of #' the progress bar type. It must be given for the `custom` type. #' Format strings may contain R expressions to evaluate in braces. #' They support cli [pluralization][cli::pluralization], and #' [styling][cli::inline-markup] and they can contain special #' [progress variables][cli::progress-variables]. #' * `format_done`: format string for successful termination. By default #' the same as `format`. #' * `format_failed`: format string for unsuccessful termination. #' By default the same as `format`. #' * `name`: progress bar name. This is by default the empty string and it #' is displayed at the beginning of the progress bar. #' * `show_after`: numeric scalar. Only show the progress bar after this #' number of seconds. It overrides the `cli.progress_show_after` #' global option. #' * `type`: progress bar type. Currently supported types are: #' * `iterator`: the default, a for loop or a mapping function, #' * `tasks`: a (typically small) number of tasks, #' * `download`: download of one file, #' * `custom`: custom type, `format` must not be `NULL` for this type. #' The default display is different for each progress bar type. #' #' ## Further documentation #' #' purrr's progress bars are powered by cli, so see #' [Introduction to progress bars in cli](https://cli.r-lib.org/articles/progress.html) #' and [Advanced cli progress bars](https://cli.r-lib.org/articles/progress-advanced.html) #' for more details. #' #' @name progress_bars NULL as_progress <- function( progress, user_env = caller_env(2), caller_env = caller_env() ) { if (isFALSE(progress) || isTRUE(progress) || is_string(progress)) { progress } else if (is.list(progress)) { progress$caller <- progress$caller %||% user_env progress } else { stop_input_type( progress, c("TRUE", "FALSE", "a string", "a named list"), arg = ".progress", call = caller_env ) } } purrr/R/conditions.R0000644000176200001440000000524415063325731014133 0ustar liggesusers#' Error conditions for bad types #' #' @param x The object whose type doesn't match `expected`. #' @param what What does `x` represent? This is used to introduce the #' object in the error message and should be capitalised. If `NULL` #' and `arg` is `NULL` as well, defaults to `"Object"`. Otherwise #' defaults to `arg` wrapped in backquotes. #' @param expected,actual The expected and actual type of `x`, in #' friendly representation. If `actual` is not supplied, `x` is #' passed to `friendly_type_of()` to provide a default value. #' @param index The index of `x` when it is an element of a vector. #' @param ...,message,.subclass Only use these fields when creating a subclass. #' #' @details #' #' Some of the fields are expected to be in friendly representation, #' i.e. a longer description that includes indefinite articles. For #' example, a friendly representation of `"integer"` would be #' `"an integer vector"`. #' #' Fields in pretty representation are meant for printing, not for #' testing. They should not be relied on in unit tests as upstream #' packages might tweak the friendly representation at any time. #' #' @keywords internal #' @name purrr-conditions-type #' @noRd NULL stop_bad_type <- function( x, expected, ..., what = NULL, arg = NULL, call = caller_env() ) { what <- what %||% what_bad_object(arg) cli::cli_abort( "{what} must be {expected}, not {.obj_type_friendly {x}}.", arg = arg, call = call ) } stop_bad_element_type <- function( x, index, expected, ..., what = NULL, arg = NULL, call = caller_env() ) { what <- what_bad_element(what, arg, index) cli::cli_abort( "{what} must be {expected}, not {.obj_type_friendly {x}}.", arg = arg, call = call ) } stop_bad_element_length <- function( x, index, expected_length, ..., what = NULL, arg = NULL, recycle = FALSE, call = caller_env() ) { what <- what_bad_element(what, arg, index) if (recycle) { expected <- sprintf("1 or %s", expected_length) } else { expected <- expected_length } cli::cli_abort( "{what} must have length {expected}, not {length(x)}.", arg = arg, call = call ) } # Helpers ----------------------------------------------------------------- what_bad_object <- function(arg) { if (is_null(arg)) { "Object" } else if (is_string(arg)) { sprintf("`%s`", arg) } else { stop_bad_type(arg, "`NULL` or a string", arg = "arg") } } what_bad_element <- function(what, arg, index) { stopifnot(is_integerish(index, n = 1, finite = TRUE)) if (is_null(arg)) { what <- what %||% "Element" sprintf("%s %d", what, index) } else { sprintf("`%s[[%d]]`", arg, index) } } purrr/R/deprec-splice.R0000644000176200001440000000211015063325731014466 0ustar liggesusers#' Splice objects and lists of objects into a list #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because we no longer believe that #' this style of implicit/automatic splicing is a good idea; instead use #' `rlang::list2()` + `!!!` or [list_flatten()]. #' #' `splice()` splices all arguments into a list. Non-list objects and lists #' with a S3 class are encapsulated in a list before concatenation. #' #' @param ... Objects to concatenate. #' @return A list. #' @keywords internal #' @examples #' inputs <- list(arg1 = "a", arg2 = "b") #' #' # splice() concatenates the elements of inputs with arg3 #' splice(inputs, arg3 = c("c1", "c2")) |> str() #' list(inputs, arg3 = c("c1", "c2")) |> str() #' c(inputs, arg3 = c("c1", "c2")) |> str() #' @export splice <- function(...) { lifecycle::deprecate_warn("1.0.0", "splice()", "list_flatten()") splice_if(list(...), is_bare_list) } splice_if <- function(.x, .p) { unspliced <- !where_if(.x, .p) out <- modify_if(.x, unspliced, list) list_flatten(out, name_spec = "{inner}") } purrr/R/adverb-negate.R0000644000176200001440000000101214326706774014466 0ustar liggesusers#' Negate a predicate function so it selects what it previously rejected #' #' Negating a function changes `TRUE` to `FALSE` and `FALSE` to `TRUE`. #' #' @inheritParams keep #' @inheritSection safely Adverbs #' @family adverbs #' @return A new predicate function. #' @export #' @examples #' x <- list(x = 1:10, y = rbernoulli(10), z = letters) #' x |> keep(is.numeric) |> names() #' x |> keep(negate(is.numeric)) |> names() #' # Same as #' x |> discard(is.numeric) negate <- function(.p) { compose(`!`, as_mapper(.p)) } purrr/R/superseded-simplify.R0000644000176200001440000000616415063325731015761 0ustar liggesusers#' Coerce a list to a vector #' #' @description #' `r lifecycle::badge("superseded")` #' #' These functions were superseded in purrr 1.0.0 in favour of #' `list_simplify()` which has more consistent semantics based on vctrs #' principles: #' #' * `as_vector(x)` is now `list_simplify(x)` #' * `simplify(x)` is now `list_simplify(x, strict = FALSE)` #' * `simplify_all(x)` is `map(x, list_simplify, strict = FALSE)` #' #' Superseded functions will not go away, but will only receive critical #' bug fixes. #' #' @param .x A list of vectors #' @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 #' # was #' as.list(letters) |> as_vector("character") #' # now #' as.list(letters) |> list_simplify(ptype = character()) #' #' # was: #' list(1:2, 3:4, 5:6) |> as_vector(integer(2)) #' # now: #' list(1:2, 3:4, 5:6) |> list_c(ptype = integer()) as_vector <- function(.x, .type = NULL) { # 1.0.0 lifecycle::signal_stage("superseded", "as_vector()", "list_simplify()") as_vector_(.x, .type) } as_vector_ <- function(.x, .type = NULL) { if (can_simplify(.x, .type)) { unlist(.x) } else { cli::cli_abort( "Can't coerce {.arg .x} to a vector.", arg = ".x" ) } } #' @export #' @rdname as_vector simplify <- function(.x, .type = NULL) { # 1.0.0 lifecycle::signal_stage( "superseded", "simplify()", I("`list_simplify(strict = FALSE)`") ) if (can_simplify(.x, .type)) { unlist(.x) } else { .x } } #' @export #' @rdname as_vector simplify_all <- function(.x, .type = NULL) { # 1.0.0 lifecycle::signal_stage( "superseded", "simplify_all()", I("`map(xs, \\(x) list_simplify(strict = FALSE))`") ) map(.x, simplify) } # Simplify a list of atomic vectors of the same type to a vector # # simplify_list(list(1, 2, 3)) can_simplify <- function(x, type = NULL) { is_atomic <- vapply(x, is.atomic, logical(1)) if (!all(is_atomic)) { return(FALSE) } mode <- unique(vapply(x, typeof, character(1))) if ( length(mode) > 1 && !all(c("double", "integer") %in% mode) ) { return(FALSE) } # This can be coerced safely. If type is supplied, perform # additional check is.null(type) || can_coerce(x, type) } can_coerce <- function(x, type) { actual <- typeof(x[[1]]) if (is_mold(type)) { lengths <- unique(map_int(x, length)) if (length(lengths) > 1 || !(lengths == length(type))) { return(FALSE) } else { type <- typeof(type) } } if (actual == "integer" && type %in% c("integer", "double", "numeric")) { return(TRUE) } if (actual %in% c("integer", "double") && type == "numeric") { return(TRUE) } actual == type } # is a mold? As opposed to a string is_mold <- function(type) { modes <- c( "numeric", "logical", "integer", "double", "complex", "character", "raw" ) length(type) > 1 || (!type %in% modes) } purrr/R/every-some-none.R0000644000176200001440000000404115163460322015001 0ustar liggesusers#' Do every, some, or none of the elements of a list satisfy a predicate? #' #' * `some()` returns `TRUE` when `.p` is `TRUE` for at least one element. #' * `every()` returns `TRUE` when `.p` is `TRUE` for all elements. #' * `none()` returns `TRUE` when `.p` is `FALSE` for all elements. #' #' @inheritParams keep #' @param ... Additional arguments passed on to `.p`. #' @return A logical vector of length 1. #' @export #' @examples #' x <- list(0:10, 5.5) #' x |> every(is.numeric) #' x |> every(is.integer) #' x |> some(is.integer) #' x |> none(is.character) #' #' # Missing values are propagated: #' some(list(NA, FALSE), identity) #' #' # If you need to use these functions in a context where missing values are #' # unsafe (e.g. in `if ()` conditions), make sure to use safe predicates: #' if (some(list(NA, FALSE), rlang::is_true)) "foo" else "bar" every <- function(.x, .p, ...) { satisfies_predicate(.x, .p, ..., .purrr_predicate = "every") } #' @export #' @rdname every some <- function(.x, .p, ...) { satisfies_predicate(.x, .p, ..., .purrr_predicate = "some") } #' @export #' @rdname every none <- function(.x, .p, ...) { satisfies_predicate(.x, .p, ..., .purrr_predicate = "none") } satisfies_predicate <- function( .x, .p, ..., .purrr_predicate, .purrr_user_env = caller_env(2), .purrr_error_call = caller_env() ) { # Not using `as_predicate()` as R level predicate result checks are too slow. # Checks are done at the C level instead (#1169). Also, `NA` propagates # through these functions, which `as_predicate()` doesn't allow. .p <- as_mapper(.p, ...) # Consistent with `map()` .x <- vctrs_vec_compat(.x, .purrr_user_env) obj_check_vector(.x, arg = ".x", call = .purrr_error_call) n <- vec_size(.x) i <- 0L # We refer to `.p`, `.x`, `i`, `...`, and `.purrr_error_call` all from C level switch( .purrr_predicate, every = .Call(every_impl, environment(), n, i), some = .Call(some_impl, environment(), n, i), none = .Call(none_impl, environment(), n, i), abort("Unreachable", .internal = TRUE) ) } purrr/R/imap.R0000644000176200001440000000410315163460322012676 0ustar liggesusers#' Apply a function to each element of a vector, and its index #' #' `imap(x, ...)`, an indexed map, is short hand for #' `map2(x, names(x), ...)` if `x` has names, or `map2(x, seq_along(x), ...)` #' if it does not. This is useful if you need to compute on both the value #' and the position of an element. #' #' @param .f A function, specified in one of the following ways: #' #' * A named function, e.g. `paste`. #' * An anonymous function, e.g. `\(x, idx) x + idx` or #' `function(x, idx) x + idx`. #' * A formula, e.g. `~ .x + .y`. Use `.x` to refer to the current element and #' `.y` to refer to the current index. No longer recommended. #' #' `r lifecycle::badge("experimental")` #' #' Wrap a function with [in_parallel()] to declare that it should be performed #' in parallel. See [in_parallel()] for more details. #' Use of `...` is not permitted in this context. #' @inheritParams map #' @return A vector the same length as `.x`. #' @export #' @family map variants #' @examples #' imap_chr(sample(10), paste) #' #' imap_chr(sample(10), \(x, idx) paste0(idx, ": ", x)) #' #' iwalk(mtcars, \(x, idx) cat(idx, ": ", median(x), "\n", sep = "")) imap <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2(.x, vec_index(.x), .f, ...) } #' @rdname imap #' @export imap_lgl <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2_lgl(.x, vec_index(.x), .f, ...) } #' @rdname imap #' @export imap_chr <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2_chr(.x, vec_index(.x), .f, ...) } #' @rdname imap #' @export imap_int <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2_int(.x, vec_index(.x), .f, ...) } #' @rdname imap #' @export imap_dbl <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2_dbl(.x, vec_index(.x), .f, ...) } #' @rdname imap #' @export imap_vec <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) map2_vec(.x, vec_index(.x), .f, ...) } #' @export #' @rdname imap iwalk <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) walk2(.x, vec_index(.x), .f, ...) } vec_index <- function(x) { names(x) %||% seq_along(x) } purrr/R/adverb-slowly.R0000644000176200001440000000152514326707000014544 0ustar liggesusers#' Wrap a function to wait between executions #' #' `slowly()` takes a function and modifies it to wait a given #' amount of time between each call. #' #' @inheritParams insistently #' @param rate A [rate][rate-helpers] object. Defaults to a constant delay. #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' # For these example, we first create a custom rate #' # with a low waiting time between attempts: #' rate <- rate_delay(0.1) #' #' # slowly() causes a function to sleep for a given time between calls: #' slow_runif <- slowly(\(x) runif(1), rate = rate, quiet = FALSE) #' out <- map(1:5, slow_runif) slowly <- function(f, rate = rate_delay(), quiet = TRUE) { f <- as_mapper(f) check_rate(rate) check_bool(quiet) function(...) { rate_sleep(rate, quiet = quiet) f(...) } } purrr/R/pluck-depth.R0000644000176200001440000000205515063325731014177 0ustar liggesusers#' Compute the depth of a vector #' #' The depth of a vector is how many levels that you can index/pluck into it. #' `pluck_depth()` was previously called `vec_depth()`. #' #' @param x A vector #' @param is_node Optionally override the default criteria for determine an #' element can be recursed within. The default matches the behaviour of #' `pluck()` which can recurse into lists and expressions. #' @return An integer. #' @export #' @examples #' x <- list( #' list(), #' list(list()), #' list(list(list(1))) #' ) #' pluck_depth(x) #' x |> map_int(pluck_depth) pluck_depth <- function(x, is_node = NULL) { if (is.null(is_node)) { is_node <- function(x) is.expression(x) || is.list(x) } is_node <- as_is_node(is_node) if (is_node(x)) { depths <- map_int(x, pluck_depth, is_node = is_node) 1L + max(depths, 0L) } else if (is_atomic(x)) { 1L } else { 0L } } #' @export #' @rdname pluck_depth #' @usage NULL vec_depth <- function(x) { lifecycle::deprecate_warn("1.0.0", "vec_depth()", "pluck_depth()") pluck_depth(x) } purrr/R/list-simplify.R0000644000176200001440000000544715163460322014571 0ustar liggesusers#' Simplify a list to an atomic or S3 vector #' #' Simplification maintains a one-to-one correspondence between the input #' and output, implying that each element of `x` must contain a one element #' vector or a one-row data frame. If you don't want to maintain this #' correspondence, then you probably want either [list_c()]/[list_rbind()] or #' [list_flatten()]. #' #' @param x A list. #' @param strict What should happen if simplification fails? If `TRUE` #' (the default) 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. #' @inheritParams rlang::args_dots_empty #' @returns A vector the same length as `x`. #' @export #' @examples #' list_simplify(list(1, 2, 3)) #' #' # Only works when vectors are length one and have compatible types: #' try(list_simplify(list(1, 2, 1:3))) #' try(list_simplify(list(1, 2, "x"))) #' #' # Unless you strict = FALSE, in which case you get the input back: #' list_simplify(list(1, 2, 1:3), strict = FALSE) #' list_simplify(list(1, 2, "x"), strict = FALSE) list_simplify <- function(x, ..., strict = TRUE, ptype = NULL) { check_dots_empty() check_bool(strict) 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 = caller_arg(x), error_call = caller_env() ) { check_bool(simplify, allow_na = TRUE, call = error_call) if (!is.null(ptype) && isFALSE(simplify)) { cli::cli_abort( "Can't specify {.arg ptype} when `simplify = FALSE`.", arg = "ptype", call = error_call ) } if (isFALSE(simplify)) { return(x) } simplify_impl( x, strict = !is.na(simplify), ptype = ptype, error_arg = error_arg, error_call = error_call ) } simplify_impl <- function( x, strict = TRUE, ptype = NULL, error_arg = caller_arg(x), error_call = caller_env() ) { obj_check_list(x, arg = error_arg, call = error_call) # Handle the cases where we definitely can't simplify if (strict) { list_check_all_vectors(x, arg = error_arg, call = error_call) list_check_all_size(x, 1, arg = error_arg, call = error_call) } else { can_simplify <- list_all_vectors(x) && all(list_sizes(x) == 1L) if (!can_simplify) { return(x) } } names <- vec_names(x) x <- vec_set_names(x, NULL) out <- tryCatch( list_unchop( x, ptype = ptype, error_arg = error_arg, error_call = error_call ), vctrs_error_incompatible_type = function(err) { if (strict || !is.null(ptype)) { cnd_signal(err) } else { x } } ) if (!is.null(out)) { out <- vec_set_names(out, names) } out } purrr/R/deprec-along.R0000644000176200001440000000131014326706774014323 0ustar liggesusers#' Create a list of given length #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 since it's not related to the #' core purpose of purrr. #' #' It can be useful to create an empty list that you plan to fill later. This is #' similar to the idea of [seq_along()], which creates a vector of the same #' length as its input. #' #' @param x A vector. #' @return A list of the same length as `x`. #' @keywords internal #' @examples #' x <- 1:5 #' seq_along(x) #' list_along(x) #' @name along #' @rdname along #' @export list_along <- function(x) { lifecycle::deprecate_soft("1.0.0", "list_along()", I("rep_along(x, list())")) vector("list", length(x)) } purrr/R/pmap.R0000644000176200001440000001303515163460322012711 0ustar liggesusers#' Map over multiple input simultaneously (in "parallel") #' #' @description #' These functions are variants of [map()] that iterate over multiple arguments #' simultaneously. They are parallel in the sense that each input is processed #' in parallel with the others, not in the sense of multicore computing, i.e. #' they share the same notion of "parallel" as [base::pmax()] and [base::pmin()]. #' #' @param .l A list of vectors. The length of `.l` determines the number of #' arguments that `.f` will be called with. Arguments will be supply by #' position if unnamed, and by name if named. #' #' Vectors of length 1 will be recycled to any length; all other elements #' must be have the same length. #' #' A data frame is an important special case of `.l`. It will cause `.f` #' to be called once for each row. #' @param .f A function, specified in one of the following ways: #' #' * A named function. #' * An anonymous function, e.g. `\(x, y, z) x + y / z` or #' `function(x, y, z) x + y / z` #' * A formula, e.g. `~ ..1 + ..2 / ..3`. No longer recommended. #' #' `r lifecycle::badge("experimental")` #' #' Wrap a function with [in_parallel()] to declare that it should be performed #' in parallel. See [in_parallel()] for more details. #' Use of `...` is not permitted in this context. #' @inheritParams map #' @returns #' The output length is determined by the maximum length of all elements of `.l`. #' The output names are determined by the names of the first element of `.l`. #' The output type is determined by the suffix: #' #' * No suffix: a list; `.f()` can return anything. #' #' * `_lgl()`, `_int()`, `_dbl()`, `_chr()` return a logical, integer, double, #' or character vector respectively; `.f()` must return a compatible atomic #' vector of length 1. #' #' * `_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 it is length 1. #' #' * `pwalk()` returns the input `.l` (invisibly). This makes it easy to #' use in a pipe. The return value of `.f()` is ignored. #' #' Any errors thrown by `.f` will be wrapped in an error with class #' [purrr_error_indexed]. #' @family map variants #' @export #' @examples #' x <- list(1, 1, 1) #' y <- list(10, 20, 30) #' z <- list(100, 200, 300) #' pmap(list(x, y, z), sum) #' #' # Matching arguments by position #' pmap(list(x, y, z), function(first, second, third) (first + third) * second) #' #' # Matching arguments by name #' l <- list(a = x, b = y, c = z) #' pmap(l, function(c, b, a) (a + c) * b) #' #' # Vectorizing a function over multiple arguments #' df <- data.frame( #' x = c("apple", "banana", "cherry"), #' pattern = c("p", "n", "h"), #' replacement = c("P", "N", "H"), #' stringsAsFactors = FALSE #' ) #' pmap(df, gsub) #' pmap_chr(df, gsub) #' #' # Use `...` to absorb unused components of input list .l #' df <- data.frame( #' x = 1:3, #' y = 10:12, #' z = letters[1:3] #' ) #' plus <- function(x, y) x + y #' \dontrun{ #' # this won't work #' pmap(df, plus) #' } #' # but this will #' plus2 <- function(x, y, ...) x + y #' pmap_dbl(df, plus2) #' #' # The "p" for "parallel" in pmap() is the same as in base::pmin() #' # and base::pmax() #' df <- data.frame( #' x = c(1, 2, 5), #' y = c(5, 4, 8) #' ) #' # all produce the same result #' pmin(df$x, df$y) #' map2_dbl(df$x, df$y, min) #' pmap_dbl(df, min) pmap <- function(.l, .f, ..., .progress = FALSE) { pmap_("list", .l, .f, ..., .progress = .progress) } #' @export #' @rdname pmap pmap_lgl <- function(.l, .f, ..., .progress = FALSE) { pmap_("logical", .l, .f, ..., .progress = .progress) } #' @export #' @rdname pmap pmap_int <- function(.l, .f, ..., .progress = FALSE) { pmap_("integer", .l, .f, ..., .progress = .progress) } #' @export #' @rdname pmap pmap_dbl <- function(.l, .f, ..., .progress = FALSE) { pmap_("double", .l, .f, ..., .progress = .progress) } #' @export #' @rdname pmap pmap_chr <- function(.l, .f, ..., .progress = FALSE) { pmap_("character", .l, .f, ..., .progress = .progress) } pmap_ <- function( .type, .l, .f, ..., .progress = FALSE, .purrr_user_env = caller_env(2), .purrr_error_call = caller_env() ) { .progress <- as_progress( .progress, user_env = .purrr_user_env, caller_env = .purrr_error_call ) .l <- vctrs_list_compat(.l, error_call = .purrr_error_call) .l <- map(.l, vctrs_vec_compat) n <- vec_size_common(!!!.l, .arg = ".l", .call = .purrr_error_call) .l <- vec_recycle_common( !!!.l, .size = n, .arg = ".l", .call = .purrr_error_call ) if (length(.l) > 0L) { names <- vec_names(.l[[1L]]) } else { names <- NULL } .f <- as_mapper(.f, ...) if (running_in_parallel(.f)) { attributes(.l) <- list( names = names(.l), class = "data.frame", row.names = if (is.null(names)) .set_row_names(n) else names ) return(mmap_(.l, .f, .progress, .type, .purrr_error_call, ...)) } call_names <- names(.l) call_n <- length(.l) i <- 0L with_indexed_errors( i = i, names = names, error_call = .purrr_error_call, call_with_cleanup( pmap_impl, environment(), .type, .progress, n, names, i, call_names, call_n ) ) } #' @export #' @rdname pmap pmap_vec <- function(.l, .f, ..., .ptype = NULL, .progress = FALSE) { .f <- as_mapper(.f, ...) out <- pmap(.l, .f, ..., .progress = .progress) simplify_impl(out, ptype = .ptype) } #' @export #' @rdname pmap pwalk <- function(.l, .f, ..., .progress = FALSE) { pmap(.l, .f, ..., .progress = .progress) invisible(.l) } purrr/R/superseded-flatten.R0000644000176200001440000000606314334365317015564 0ustar liggesusers#' Flatten a list of lists into a simple vector #' #' @description #' `r lifecycle::badge("superseded")` #' #' These functions were superseded in purrr 1.0.0 because their behaviour was #' inconsistent. Superseded functions will not go away, but will only receive #' critical bug fixes. #' #' * `flatten()` has been superseded by [list_flatten()]. #' * `flatten_lgl()`, `flatten_int()`, `flatten_dbl()`, and `flatten_chr()` #' have been superseded by [list_c()]. #' * `flatten_dfr()` and `flatten_dfc()` have been superseded by [list_rbind()] #' and [list_cbind()] respectively. #' #' @param .x A list to flatten. The contents of the list can be anything for #' `flatten()` (as a list is returned), but the contents must match the #' type for the other functions. #' @return `flatten()` returns a list, `flatten_lgl()` a logical #' vector, `flatten_int()` an integer vector, `flatten_dbl()` a #' double vector, and `flatten_chr()` a character vector. #' #' `flatten_dfr()` and `flatten_dfc()` return data frames created by #' row-binding and column-binding respectively. They require dplyr to #' be installed. #' @keywords internal #' @inheritParams map #' @export #' @examples #' x <- map(1:3, \(i) sample(4)) #' x #' #' # was #' x |> flatten_int() |> str() #' # now #' x |> list_c() |> str() #' #' x <- list(list(1, 2), list(3, 4)) #' # was #' x |> flatten() |> str() #' # now #' x |> list_flatten() |> str() flatten <- function(.x) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten()", "list_flatten()") .Call(flatten_impl, .x) } #' @export #' @rdname flatten flatten_lgl <- function(.x) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()") .Call(vflatten_impl, .x, "logical") } #' @export #' @rdname flatten flatten_int <- function(.x) { lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()") .Call(vflatten_impl, .x, "integer") } #' @export #' @rdname flatten flatten_dbl <- function(.x) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()") .Call(vflatten_impl, .x, "double") } #' @export #' @rdname flatten flatten_chr <- function(.x) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()") .Call(vflatten_impl, .x, "character") } #' @export #' @rdname flatten flatten_dfr <- function(.x, .id = NULL) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_dfr()", "list_rbind()") check_installed("dplyr", "for `flatten_dfr()`.") res <- .Call(flatten_impl, .x) dplyr::bind_rows(res, .id = .id) } #' @export #' @rdname flatten flatten_dfc <- function(.x) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_dfc()", "list_cbind()") check_installed("dplyr", "for `flatten_dfc()`.") res <- .Call(flatten_impl, .x) dplyr::bind_cols(res) } #' @export #' @rdname flatten #' @usage NULL flatten_df <- function(.x, .id = NULL) { # in 1.0.0 lifecycle::signal_stage("superseded", "flatten_df()", "list_rbind()") check_installed("dplyr", "for `flatten_dfr()`.") res <- .Call(flatten_impl, .x) dplyr::bind_rows(res, .id = .id) } purrr/R/deprec-when.R0000644000176200001440000000560715063325731014166 0ustar liggesusers#' Match/validate a set of conditions for an object and continue with the action #' associated with the first valid match. #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because it's not related to the #' core purpose of purrr. You can pull your code out of a pipe and use regular #' `if`/`else` statements instead. #' #' `when()` is a flavour of pattern matching (or an if-else abstraction) in #' which a value is matched against a sequence of condition-action sets. When a #' valid match/condition is found the action is executed and the result of the #' action is returned. #' #' @param . the value to match against #' @param ... formulas; each containing a condition as LHS and an action as RHS. #' named arguments will define additional values. #' @return The value resulting from the action of the first valid #' match/condition is returned. If no matches are found, and no default is #' given, NULL will be returned. #' # @details condition-action sets are written as formulas with conditions as # left-hand sides and actions as right-hand sides. A formula with only a # right-hand will be treated as a condition which is always satisfied. For # such a default case one can also omit the `~` symbol, but note that its # value will then be evaluated. Any named argument will be made available in # all conditions and actions, which is useful in avoiding repeated temporary # computations or temporary assignments. # #' Validity of the conditions are tested with `isTRUE`, or equivalently #' with `identical(condition, TRUE)`. #' In other words conditions resulting in more than one logical will never #' be valid. Note that the input value is always treated as a single object, #' as opposed to the `ifelse` function. #' #' @keywords internal #' @examples #' 1:10 |> #' when( #' sum(.) <= 50 ~ sum(.), #' sum(.) <= 100 ~ sum(.)/2, #' ~ 0 #' ) #' #' # now #' x <- 1:10 #' if (sum(x) < 10) { #' sum(x) #' } else if (sum(x) < 100) { #' sum(x) / 2 #' } else { #' 0 #' } #' @export when <- function(., ...) { lifecycle::deprecate_warn("1.0.0", "when()", I("`if`")) dots <- list(...) names <- names(dots) named <- if (is.null(names)) rep(FALSE, length(dots)) else names != "" if (sum(!named) == 0) { cli::cli_abort("At least one matching condition is needed.") } is_formula <- vapply(dots, function(dot) identical(class(dot), "formula"), logical(1L)) env <- new.env(parent = parent.frame()) env[["."]] <- . if (sum(named) > 0) { for (i in which(named)) { env[[names[i]]] <- dots[[i]] } } result <- NULL for (i in which(!named)) { if (is_formula[i]) { action <- length(dots[[i]]) if (action == 2 || is_true(eval(dots[[i]][[2]], env, env))) { result <- eval(dots[[i]][[action]], env, env) break } } else { result <- dots[[i]] } } result } purrr/R/superseded-transpose.R0000644000176200001440000000514715063325731016143 0ustar liggesusers#' Transpose a list. #' #' @description #' `r lifecycle::badge("superseded")` #' #' `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`, `transpose()` would make a list with elements `a` and #' `b` that contained lists of length n. It's called transpose because #' \code{x[[1]][[2]]} is equivalent to \code{transpose(x)[[2]][[1]]}. #' #' This function was superseded in purrr 1.0.0 because [list_transpose()] #' has a better name and can automatically simplify the output, as is commonly #' needed. Superseded functions will not go away, but will only receive critical #' bug fixes. #' #' @param .l A list of vectors to transpose. The first element is used as the #' template; you'll get a warning if a subsequent element has a different #' length. #' @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`. #' #' `transpose()` is its own inverse, much like the transpose operation on a #' matrix. You can get back the original input by transposing it twice. #' @keywords internal #' @export #' @examples #' x <- map(1:5, \(i) list(x = runif(1), y = runif(5))) #' # was #' x |> 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)) #' # was #' y |> transpose() |> str() #' # now: #' y |> list_transpose() |> str() #' #' # 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() |> 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 #' ll <- list( #' list(x = 1, y = "one"), #' list(z = "deux", x = 2) #' ) #' 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) { # 1.0.0 if (!isTRUE(the$transpose_signalled)) { lifecycle::signal_stage("superseded", "transpose()", "list_transpose()") the$transpose_signalled <- TRUE } .Call(transpose_impl, .l, .names) } purrr/R/faq.R0000644000176200001440000000227414326706774012544 0ustar liggesusers#' Best practices for exporting adverb-wrapped functions #' #' @description #' Exporting functions created with purrr adverbs in your package #' requires some precautions because the functions will contain internal #' purrr code. This means that creating them once and for all when #' the package is built may cause problems when purrr is updated, because #' a function that the adverb uses might no longer exist. #' #' Instead, either create the modified function once per session on package #' load or wrap the call within another function every time you use it: #' #' * Using the \code{\link[=.onLoad]{.onLoad()}} hook: #' ``` #' #' My function #' #' @export #' insist_my_function <- function(...) "dummy" #' #' my_function <- function(...) { #' # Implementation #' } #' #' .onLoad <- function(lib, pkg) { #' insist_my_function <<- purrr::insistently(my_function) #' } #' ``` #' #' * Using a wrapper function: #' ``` #' my_function <- function(...) { #' # Implementation #' } #' #' #' My function #' #' @export #' insist_my_function <- function(...) { #' purrr::insistently(my_function)(...) #' } #' ``` #' @keywords internal #' @name faq-adverbs-export NULL purrr/R/reexport-pipe.R0000644000176200001440000000021315063325731014554 0ustar liggesusers#' Pipe operator #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL purrr/R/modify.R0000644000176200001440000001416215166143356013255 0ustar liggesusers#' Modify elements selectively #' #' @description #' #' Unlike [map()] and its variants which always return a fixed object #' type (list for `map()`, integer vector for `map_int()`, etc), the #' `modify()` family always returns the same type as the input object. #' #' * `modify()` is a shortcut for `x[[i]] <- f(x[[i]]); return(x)`. #' #' * `modify_if()` only modifies the elements of `x` that satisfy a #' predicate and leaves the others unchanged. `modify_at()` only #' modifies elements given by names or positions. #' #' * `modify2()` modifies the elements of `.x` but also passes the #' elements of `.y` to `.f`, just like [map2()]. `imodify()` passes #' the names or the indices to `.f` like [imap()] does. #' #' * [modify_in()] modifies a single element in a [pluck()] location. #' #' @param .x A vector. #' @param .y A vector, usually the same length as `.x`. #' @inheritParams map2 #' @inheritParams map #' @param .f A function specified in the same way as the corresponding map #' function. #' @return An object the same class as `.x` #' #' @details #' #' Since the transformation can alter the structure of the input; it's #' your responsibility to ensure that the transformation produces a #' valid output. For example, if you're modifying a data frame, `.f` #' must preserve the length of the input. #' #' @section Genericity: #' #' `modify()` and variants are generic over classes that implement #' `length()`, `[[` and `[[<-` methods. If the default implementation #' is not compatible for your class, you can override them with your #' own methods. #' #' If you implement your own `modify()` method, make sure it satisfies #' the following invariants: #' #' ``` #' modify(x, identity) === x #' modify(x, compose(f, g)) === modify(x, g) |> modify(f) #' ``` #' #' These invariants are known as the functor #' laws (https://wiki.haskell.org/Functor#Functor_Laws) in computer #' science. #' #' #' @family map variants #' @family modify variants #' @examples #' # Convert factors to characters #' iris |> #' modify_if(is.factor, as.character) |> #' str() #' #' # Specify which columns to map with a numeric vector of positions: #' mtcars |> modify_at(c(1, 4, 5), as.character) |> str() #' #' # Or with a vector of names: #' mtcars |> modify_at(c("cyl", "am"), as.character) |> str() #' #' list(x = sample(c(TRUE, FALSE), 100, replace = TRUE), y = 1:100) |> #' list_transpose(simplify = FALSE) |> #' modify_if("x", \(l) list(x = l$x, y = l$y * 100)) |> #' list_transpose() #' #' # Use modify2() to map over two vectors and preserve the type of #' # the first one: #' x <- c(foo = 1L, bar = 2L) #' y <- c(TRUE, FALSE) #' modify2(x, y, \(x, cond) if (cond) x else 0L) #' #' # Use a predicate function to decide whether to map a function: #' modify_if(iris, is.factor, as.character) #' #' # Specify an alternative with the `.else` argument: #' modify_if(iris, is.factor, as.character, .else = as.integer) #' @export modify <- function(.x, .f, ...) { .f <- as_mapper(.f, ...) if (obj_is_list(.x)) { out <- map(vec_proxy(.x), .f, ...) vec_restore(out, .x) } else if (is.data.frame(.x)) { size <- vec_size(.x) out <- unclass(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.list(.x) || is.null(.x)) { .x[] <- map(.x, .f, ...) .x } else { cli::cli_abort( "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}." ) } } #' @rdname modify #' @inheritParams map_if #' @export modify_if <- function(.x, .p, .f, ..., .else = NULL) { where <- where_if(.x, .p) .x <- modify_where(.x, where, .f, ...) if (!is.null(.else)) { .else <- as_mapper(.else, ...) .x <- modify_where(.x, !where, .else, ...) } .x } #' @rdname modify #' @inheritParams map_at #' @export modify_at <- function(.x, .at, .f, ...) { where <- where_at(.x, .at, user_env = caller_env()) modify_where(.x, where, .f, ...) } #' @rdname modify #' @export modify2 <- function(.x, .y, .f, ...) { .f <- as_mapper(.f, ...) if (obj_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 <- unclass(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)) { out <- map2(.x, .y, .f, ...) if (length(out) > length(.x)) { .x <- .x[rep(1L, length(out))] } .x[] <- out .x } else { cli::cli_abort( "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}." ) } } #' @rdname modify #' @export imodify <- function(.x, .f, ...) { modify2(.x, vec_index(.x), .f, ...) } # helpers ----------------------------------------------------------------- modify_where <- function( .x, .where, .f, ..., .purrr_error_call = caller_env() ) { if (obj_is_list(.x)) { out <- vec_proxy(.x) out[.where] <- no_zap(map(out[.where], .f, ...), .purrr_error_call) vec_restore(out, .x) } else if (is.data.frame(.x)) { size <- vec_size(.x) out <- unclass(vec_proxy(.x)) new <- no_zap(map(out[.where], .f, ...), .purrr_error_call) 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 } else if (is.null(.x) || is.list(.x)) { .x[.where] <- no_zap(map(.x[.where], .f, ...), .purrr_error_call) .x } else { cli::cli_abort( "{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}.", call = .purrr_error_call ) } } no_zap <- function(x, error_call) { has_zap <- some(x, is_zap) if (!has_zap) { x } else { cli::cli_abort( "Can't use {.fn zap} to change the size of the output.", call = error_call ) } } purrr/R/utils.R0000644000176200001440000000650415163460322013117 0ustar liggesuserswhere_at <- function( x, at, user_env, error_arg = caller_arg(at), error_call = caller_env() ) { if (is_formula(at)) { at <- rlang::as_function(at, arg = error_arg, call = error_call) } if (is.function(at)) { at <- at(names2(x)) } if (is_quosures(at)) { lifecycle::deprecate_warn( when = "1.0.0", what = I("Using `vars()` in .at"), user_env = user_env ) check_installed("tidyselect", "for using tidyselect in `map_at()`.") at <- tidyselect::vars_select(.vars = names2(x), !!!at) } if (is.numeric(at) || is.logical(at) || is.character(at)) { if (is.character(at)) { at <- intersect(at, names2(x)) } loc <- vec_as_location( at, length(x), names2(x), missing = "error", arg = "at", call = error_call ) seq_along(x) %in% loc } else { cli::cli_abort( "{.arg {error_arg}} must be a numeric vector, character vector, or function, not {.obj_type_friendly {at}}.", arg = error_arg, call = error_call ) } } where_if <- function(.x, .p, ..., .purrr_error_call = caller_env()) { if (is_logical(.p)) { stopifnot(length(.p) == length(.x)) .p } else { .p <- as_predicate(.p, ..., .mapper = TRUE, .purrr_error_call = NULL) map_(.x, .p, ..., .type = "logical", .purrr_error_call = .purrr_error_call) } } as_predicate <- function( .fn, ..., .mapper, .purrr_error_call = caller_env(), .purrr_error_arg = caller_arg(.fn) ) { force(.purrr_error_call) force(.purrr_error_arg) if (.mapper) { .fn <- as_mapper(.fn, ...) } function(...) { out <- .fn(...) if (!is_bool(out)) { cli::cli_abort( "{.fn { .purrr_error_arg }} must return a single `TRUE` or `FALSE`, not {.obj_type_friendly {out}}.", arg = .purrr_error_arg, call = .purrr_error_call ) } out } } paste_line <- function(...) { paste(chr(...), collapse = "\n") } `list_slice2<-` <- function(x, i, value) { if (is.null(value)) { x[i] <- list(NULL) } else { x[[i]] <- value } x } vctrs_list_compat <- function( x, user_env, error_call = caller_env(), error_arg = caller_arg(x) ) { out <- vctrs_vec_compat(x, user_env) obj_check_list(out, call = error_call, arg = error_arg) out } # When we want to use vctrs, but treat lists like purrr does # # Treats data frames and S3 scalar lists like bare lists. # But ensures rcrd vctrs retain their class. vctrs_vec_compat <- function(x, user_env) { if (inherits(x, "by")) { class(x) <- NULL } if (is.null(x)) { list() } else if (is.pairlist(x)) { lifecycle::deprecate_soft( when = "1.0.0", what = I("Use of pairlists in purrr functions"), details = "Please coerce explicitly with `as.list()`", user_env = user_env ) as.list(x) } else if (is.array(x) && length(dim(x)) > 1) { dim(x) <- NULL x } else if (is_call(x) || is.expression(x)) { lifecycle::deprecate_soft( when = "1.0.0", what = I("Use of calls and expressions in purrr functions"), details = "Please coerce explicitly with `as.list()`", user_env = user_env ) as.list(x) } else if (isS4(x)) { set_names(lapply(seq_along(x), function(i) x[[i]]), names(x)) } else if (is.data.frame(x) || (is.list(x) && !vec_is(x))) { unclass(x) } else { x } } purrr/R/compat-types-check.R0000644000176200001440000002053215063325731015457 0ustar liggesusers# nocov start --- r-lib/rlang compat-types-check # # Dependencies # ============ # # - compat-obj-type.R # # Changelog # ========= # # 2022-10-07: # - `check_number_whole()` and `_decimal()` no longer treat # non-numeric types such as factors or dates as numbers. Numeric # types are detected with `is.numeric()`. # # 2022-10-04: # - Added `check_name()` that forbids the empty string. # `check_string()` allows the empty string by default. # # 2022-09-28: # - Removed `what` arguments. # - Added `allow_na` and `allow_null` arguments. # - Added `allow_decimal` and `allow_infinite` arguments. # - Improved errors with absent arguments. # # # 2022-09-16: # - Unprefixed usage of rlang functions with `rlang::` to # avoid onLoad issues when called from rlang (#1482). # # 2022-08-11: # - Added changelog. # Scalars ----------------------------------------------------------------- check_bool <- function( x, ..., allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_bool(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } if (allow_na && identical(x, NA)) { return(invisible(NULL)) } } stop_input_type( x, c("`TRUE`", "`FALSE`"), ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } check_string <- function( x, ..., allow_empty = TRUE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { is_string <- .rlang_check_is_string( x, allow_empty = allow_empty, allow_na = allow_na, allow_null = allow_null ) if (is_string) { return(invisible(NULL)) } } stop_input_type( x, "a single string", ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } .rlang_check_is_string <- function(x, allow_empty, allow_na, allow_null) { if (is_string(x)) { if (allow_empty || !is_string(x, "")) { return(TRUE) } } if (allow_null && is_null(x)) { return(TRUE) } if (allow_na && (identical(x, NA) || identical(x, na_chr))) { return(TRUE) } FALSE } check_name <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { is_string <- .rlang_check_is_string( x, allow_empty = FALSE, allow_na = FALSE, allow_null = allow_null ) if (is_string) { return(invisible(NULL)) } } stop_input_type( x, "a valid name", ..., allow_na = FALSE, allow_null = allow_null, arg = arg, call = call ) } check_number_decimal <- function( x, ..., min = -Inf, max = Inf, allow_infinite = TRUE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { .rlang_types_check_number( x, ..., min = min, max = max, allow_decimal = TRUE, allow_infinite = allow_infinite, allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } check_number_whole <- function( x, ..., min = -Inf, max = Inf, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { .rlang_types_check_number( x, ..., min = min, max = max, allow_decimal = FALSE, allow_infinite = FALSE, allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } .rlang_types_check_number <- function( x, ..., min = -Inf, max = Inf, allow_decimal = FALSE, allow_infinite = FALSE, allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (allow_decimal) { what <- "a number" } else { what <- "a whole number" } .stop <- function(x, what, ...) { stop_input_type( x, what, ..., allow_na = allow_na, allow_null = allow_null, arg = arg, call = call ) } if (!missing(x)) { is_number <- is_number( x, allow_decimal = allow_decimal, allow_infinite = allow_infinite ) if (is_number) { if (min > -Inf && max < Inf) { what <- sprintf("a number between %s and %s", min, max) } else { what <- NULL } if (x < min) { what <- what %||% sprintf("a number larger than %s", min) .stop(x, what, ...) } if (x > max) { what <- what %||% sprintf("a number smaller than %s", max) .stop(x, what, ...) } return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } if ( allow_na && (identical(x, NA) || identical(x, na_dbl) || identical(x, na_int)) ) { return(invisible(NULL)) } } .stop(x, what, ...) } is_number <- function(x, allow_decimal = FALSE, allow_infinite = FALSE) { if (!typeof(x) %in% c("integer", "double")) { return(FALSE) } if (!is.numeric(x)) { return(FALSE) } if (length(x) != 1) { return(FALSE) } if (is.na(x)) { return(FALSE) } if (!allow_decimal && !is_integerish(x)) { return(FALSE) } if (!allow_infinite && is.infinite(x)) { return(FALSE) } TRUE } check_symbol <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_symbol(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a symbol", ..., allow_null = allow_null, arg = arg, call = call ) } check_arg <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_symbol(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an argument name", ..., allow_null = allow_null, arg = arg, call = call ) } check_call <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_call(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a defused call", ..., allow_null = allow_null, arg = arg, call = call ) } check_environment <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_environment(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an environment", ..., allow_null = allow_null, arg = arg, call = call ) } check_function <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_function(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a function", ..., allow_null = allow_null, arg = arg, call = call ) } check_closure <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_closure(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "an R function", ..., allow_null = allow_null, arg = arg, call = call ) } check_formula <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_formula(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a formula", ..., allow_null = allow_null, arg = arg, call = call ) } # Vectors ----------------------------------------------------------------- check_character <- function( x, ..., allow_null = FALSE, arg = caller_arg(x), call = caller_env() ) { if (!missing(x)) { if (is_character(x)) { return(invisible(NULL)) } if (allow_null && is_null(x)) { return(invisible(NULL)) } } stop_input_type( x, "a character vector", ..., allow_null = allow_null, arg = arg, call = call ) } # nocov end purrr/R/superseded-map-df.R0000644000176200001440000001372015063325731015265 0ustar liggesusers#' Functions that return data frames #' #' @description #' `r lifecycle::badge("superseded")` #' #' These [map()], [map2()], [imap()], and [pmap()] variants return data #' frames by row-binding or column-binding the outputs together. #' #' The functions were superseded in purrr 1.0.0 because their names #' suggest they work like `_lgl()`, `_int()`, etc which require length #' 1 outputs, but actually they return results of any size because the results #' are combined without any size checks. Additionally, they use #' `dplyr::bind_rows()` and `dplyr::bind_cols()` which require dplyr to be #' installed and have confusing semantics with edge cases. Superseded #' functions will not go away, but will only receive critical bug fixes. #' #' Instead, we recommend using `map()`, `map2()`, etc with [list_rbind()] and #' [list_cbind()]. These use [vctrs::vec_rbind()] and [vctrs::vec_cbind()] #' under the hood, and have names that more clearly reflect their semantics. #' #' @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 #' the index (if `.x` is unnamed) of the input. If `NULL`, the default, no #' variable will be created. #' #' Only applies to `_dfr` variant. #' @keywords internal #' @export #' @examples #' # map --------------------------------------------- #' # Was: #' mtcars |> #' split(mtcars$cyl) |> #' map(\(df) lm(mpg ~ wt, data = df)) |> #' map_dfr(\(mod) as.data.frame(t(as.matrix(coef(mod))))) #' #' # Now: #' mtcars |> #' split(mtcars$cyl) |> #' map(\(df) lm(mpg ~ wt, data = df)) |> #' map(\(mod) as.data.frame(t(as.matrix(coef(mod))))) |> #' list_rbind() #' #' # for certain pathological inputs `map_dfr()` and `map_dfc()` actually #' # both combine the list by column #' df <- data.frame( #' x = c(" 13", " 15 "), #' y = c(" 34", " 67 ") #' ) #' #' # Was: #' map_dfr(df, trimws) #' map_dfc(df, trimws) #' #' # But list_rbind()/list_cbind() fail because they require data frame inputs #' try(map(df, trimws) |> list_rbind()) #' #' # Instead, use modify() to apply a function to each column of a data frame #' modify(df, trimws) #' #' # map2 --------------------------------------------- #' #' ex_fun <- function(arg1, arg2){ #' col <- arg1 + arg2 #' x <- as.data.frame(col) #' } #' arg1 <- 1:4 #' arg2 <- 10:13 #' #' # was #' map2_dfr(arg1, arg2, ex_fun) #' # now #' map2(arg1, arg2, ex_fun) |> list_rbind() #' #' # was #' map2_dfc(arg1, arg2, ex_fun) #' # now #' map2(arg1, arg2, ex_fun) |> list_cbind() map_dfr <- function(.x, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map_dfr()", I("`map()` + `list_rbind()`") ) check_installed("dplyr", "for `map_dfr()`.") .f <- as_mapper(.f, ...) res <- map(.x, .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @usage NULL #' @export map_df <- function(.x, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map_df()", I("`map()` + `list_rbind()`") ) check_installed("dplyr", "for `map_dfr()`.") .f <- as_mapper(.f, ...) res <- map(.x, .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @export map_dfc <- function(.x, .f, ...) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map_dfc()", I("`map()` + `list_cbind()`") ) check_installed("dplyr", "for `map_dfc()`.") .f <- as_mapper(.f, ...) res <- map(.x, .f, ...) dplyr::bind_cols(res) } #' @rdname map_dfr #' @export imap_dfr <- function(.x, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "imap_dfr()", I("`imap()` + `list_rbind()`") ) .f <- as_mapper(.f, ...) res <- map2(.x, vec_index(.x), .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @export imap_dfc <- function(.x, .f, ...) { # in 1.0.0 lifecycle::signal_stage( "superseded", "imap_dfc()", I("`imap()` + `list_cbind()`") ) .f <- as_mapper(.f, ...) res <- map2(.x, vec_index(.x), .f, ...) dplyr::bind_cols(res) } #' @rdname map_dfr #' @export map2_dfr <- function(.x, .y, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map2_dfr()", I("`map2()` + `list_rbind()`") ) check_installed("dplyr", "for `map2_dfr()`.") .f <- as_mapper(.f, ...) res <- map2(.x, .y, .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @export map2_dfc <- function(.x, .y, .f, ...) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map2_dfc()", I("`map2()` + `list_cbind()`") ) check_installed("dplyr", "for `map2_dfc()`.") .f <- as_mapper(.f, ...) res <- map2(.x, .y, .f, ...) dplyr::bind_cols(res) } #' @rdname map_dfr #' @export #' @usage NULL map2_df <- function(.x, .y, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "map2_df()", I("`map2()` + `list_rbind()`") ) check_installed("dplyr", "for `map2_dfr()`.") .f <- as_mapper(.f, ...) res <- map2(.x, .y, .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @export pmap_dfr <- function(.l, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "pmap_dfr()", I("`pmap()` + `list_rbind()`") ) check_installed("dplyr", "for `pmap_dfr()`.") .f <- as_mapper(.f, ...) res <- pmap(.l, .f, ...) dplyr::bind_rows(res, .id = .id) } #' @rdname map_dfr #' @export pmap_dfc <- function(.l, .f, ...) { # in 1.0.0 lifecycle::signal_stage( "superseded", "pmap_dfc()", I("`pmap()` + `list_cbind()`") ) check_installed("dplyr", "for `pmap_dfc()`.") .f <- as_mapper(.f, ...) res <- pmap(.l, .f, ...) dplyr::bind_cols(res) } #' @rdname map_dfr #' @export #' @usage NULL pmap_df <- function(.l, .f, ..., .id = NULL) { # in 1.0.0 lifecycle::signal_stage( "superseded", "pmap_df()", I("`pmap()` + `list_rbind()`") ) check_installed("dplyr", "for `pmap_dfr()`.") .f <- as_mapper(.f, ...) res <- pmap(.l, .f, ...) dplyr::bind_rows(res, .id = .id) } purrr/R/map.R0000644000176200001440000002425415163460322012536 0ustar liggesusers#' Apply a function to each element of a vector #' #' @description #' The map functions transform their input by applying a function to #' each element of a list or atomic vector and returning an object of #' the same length as the input. #' #' * `map()` always returns a list. See the [modify()] family for #' versions that return an object of the same type as the input. #' #' * `map_lgl()`, `map_int()`, `map_dbl()` and `map_chr()` return an #' atomic vector of the indicated type (or die trying). For these functions, #' `.f` must return a length-1 vector of the appropriate type. #' #' * `map_vec()` simplifies to the common type of the output. It works with #' most types of simple vectors like Date, POSIXct, factors, etc. #' #' * `walk()` calls `.f` for its side-effect and returns #' the input `.x`. #' #' @param .x A list or atomic vector. #' @param .f A function, specified in one of the following ways: #' #' * A named function, e.g. `mean`. #' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. #' * A formula, e.g. `~ .x + 1`. Use `.x` to refer to the first #' argument. No longer recommended. #' * A string, integer, or list, e.g. `"idx"`, `1`, or `list("idx", 1)` which #' are shorthand for `\(x) pluck(x, "idx")`, `\(x) pluck(x, 1)`, and #' `\(x) pluck(x, "idx", 1)` respectively. Optionally supply `.default` to #' set a default value if the indexed element is `NULL` or does not exist. #' #' `r lifecycle::badge("experimental")` #' #' Wrap a function with [in_parallel()] to declare that it should be performed #' in parallel. See [in_parallel()] for more details. #' Use of `...` is not permitted in this context. #' #' @param ... Additional arguments passed on to the mapped function. #' #' We now generally recommend against using `...` to pass additional #' (constant) arguments to `.f`. Instead use a shorthand anonymous function: #' #' ```R #' # Instead of #' x |> map(f, 1, 2, collapse = ",") #' # do: #' x |> map(\(x) f(x, 1, 2, collapse = ",")) #' ``` #' #' This makes it easier to understand which arguments belong to which #' function and will tend to yield better error messages. #' #' @param .progress Whether to show a progress bar. Use `TRUE` to turn on #' a basic progress bar, use a string to give it a name, or see #' [progress_bars] for more 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; `.f()` can return anything. #' #' * `_lgl()`, `_int()`, `_dbl()`, `_chr()` return a logical, integer, double, #' or character vector respectively; `.f()` must return a compatible atomic #' vector of length 1. #' #' * `_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. The return value of `.f()` is ignored. #' #' Any errors thrown by `.f` will be wrapped in an error with class #' [purrr_error_indexed]. #' @export #' @family map variants #' @seealso [map_if()] for applying a function to only those elements #' of `.x` that meet a specified condition. #' @examples #' # Compute normal distributions from an atomic vector #' 1:10 |> #' map(rnorm, n = 10) #' #' # You can also use an anonymous function #' 1:10 |> #' map(\(x) rnorm(10, x)) #' #' # Simplify output to a vector instead of a list by computing the mean of the distributions #' 1:10 |> #' map(rnorm, n = 10) |> # output a list #' map_dbl(mean) # output an atomic vector #' #' # Using set_names() with character vectors is handy to keep track #' # of the original inputs: #' set_names(c("foo", "bar")) |> map_chr(paste0, ":suffix") #' #' # Working with lists #' favorite_desserts <- list(Sophia = "banana bread", Eliott = "pancakes", Karina = "chocolate cake") #' favorite_desserts |> map_chr(\(food) paste(food, "rocks!")) #' #' # Extract by name or position #' # .default specifies value for elements that are missing or NULL #' l1 <- list(list(a = 1L), list(a = NULL, b = 2L), list(b = 3L)) #' l1 |> map("a", .default = "???") #' l1 |> map_int("b", .default = NA) #' l1 |> map_int(2, .default = NA) #' #' # Supply multiple values to index deeply into a list #' l2 <- list( #' list(num = 1:3, letters[1:3]), #' list(num = 101:103, letters[4:6]), #' list() #' ) #' l2 |> map(c(2, 2)) #' #' # Use a list to build an extractor that mixes numeric indices and names, #' # and .default to provide a default value if the element does not exist #' l2 |> map(list("num", 3)) #' l2 |> map_int(list("num", 3), .default = NA) #' #' # Working with data frames #' # Use map_lgl(), map_dbl(), etc to return a vector instead of a list: #' mtcars |> map_dbl(sum) #' #' # A more realistic example: split a data frame into pieces, fit a #' # model to each piece, summarise and extract R^2 #' mtcars |> #' split(mtcars$cyl) |> #' map(\(df) lm(mpg ~ wt, data = df)) |> #' map(summary) |> #' map_dbl("r.squared") #' #' @examplesIf interactive() && rlang::is_installed("mirai") && rlang::is_installed("carrier") #' # Run in interactive sessions only as spawns additional processes #' #' # To use parallelized map: #' # 1. Set daemons (number of parallel processes) first: #' mirai::daemons(2) #' #' # 2. Wrap .f with in_parallel(): #' mtcars |> map_dbl(in_parallel(\(x) mean(x))) #' #' # Note that functions from packages should be fully qualified with `pkg::` #' # or call `library(pkg)` within the function #' 1:10 |> #' map(in_parallel(\(x) vctrs::vec_init(integer(), x))) |> #' map_int(in_parallel(\(x) { library(vctrs); vec_size(x) })) #' #' # A locally-defined function (or any required variables) #' # should be passed via ... of in_parallel(): #' slow_lm <- function(formula, data) { #' Sys.sleep(0.5) #' lm(formula, data) #' } #' #' mtcars |> #' split(mtcars$cyl) |> #' map(in_parallel(\(df) slow_lm(mpg ~ disp, data = df), slow_lm = slow_lm)) #' #' # Tear down daemons when no longer in use: #' mirai::daemons(0) #' map <- function(.x, .f, ..., .progress = FALSE) { map_("list", .x, .f, ..., .progress = .progress) } #' @rdname map #' @export map_lgl <- function(.x, .f, ..., .progress = FALSE) { map_("logical", .x, .f, ..., .progress = .progress) } #' @rdname map #' @export map_int <- function(.x, .f, ..., .progress = FALSE) { map_("integer", .x, .f, ..., .progress = .progress) } #' @rdname map #' @export map_dbl <- function(.x, .f, ..., .progress = FALSE) { map_("double", .x, .f, ..., .progress = .progress) } #' @rdname map #' @export map_chr <- function(.x, .f, ..., .progress = FALSE) { map_("character", .x, .f, ..., .progress = .progress) } map_ <- function( .type, .x, .f, ..., .progress = FALSE, .purrr_user_env = caller_env(2), .purrr_error_call = caller_env() ) { .progress <- as_progress( .progress, user_env = .purrr_user_env, caller_env = .purrr_error_call ) .x <- vctrs_vec_compat(.x, .purrr_user_env) vec_assert(.x, arg = ".x", call = .purrr_error_call) if (running_in_parallel(.f)) { return(mmap_(.x, .f, .progress, .type, .purrr_error_call, ...)) } .f <- as_mapper(.f, ...) n <- vec_size(.x) names <- vec_names(.x) i <- 0L with_indexed_errors( i = i, names = names, error_call = .purrr_error_call, call_with_cleanup(map_impl, environment(), .type, .progress, n, names, i) ) } mmap_ <- function(.x, .f, .progress, .type, error_call, ...) { if (...length()) { cli::cli_abort( "Can't use `...` with parallelized functions.", call = error_call ) } m <- mirai::mirai_map(.x, .f) options <- if (isFALSE(.progress)) { ".stop" } else if (is.logical(.progress)) { c(".stop", ".progress") } else if (is.character(.progress) || is.list(.progress)) { list(.stop = TRUE, .progress = .progress) } else { cli::cli_abort( "Unknown cli progress bar configuation, see manual.", call = error_call ) } x <- with_parallel_indexed_errors( mirai::collect_mirai(m, options = options), interrupt_expr = mirai::stop_mirai(m), error_call = error_call ) if (.type != "list") { x <- simplify_impl(x, ptype = vector(mode = .type), error_call = error_call) } x } #' @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, .progress = FALSE) { out <- map(.x, .f, ..., .progress = .progress) simplify_impl(out, ptype = .ptype) } #' @rdname map #' @export walk <- function(.x, .f, ..., .progress = FALSE) { map(.x, .f, ..., .progress = .progress) invisible(.x) } with_indexed_errors <- function( expr, i, names = NULL, error_call = caller_env() ) { withCallingHandlers( expr, error = function(cnd) { if (i == 0L) { # Error happened before or after loop } else { message <- c(i = "In index: {i}.") if (!is.null(names) && !is.na(names[[i]]) && names[[i]] != "") { name <- names[[i]] message <- c(message, i = "With name: {name}.") } else { name <- NULL } cli::cli_abort( message, location = i, name = name, parent = cnd, call = error_call, class = "purrr_error_indexed" ) } } ) } with_parallel_indexed_errors <- function( expr, interrupt_expr = NULL, error_call = caller_env() ) { withCallingHandlers( expr, error = function(cnd) { location <- cnd$location iname <- cnd$name cli::cli_abort( c( i = "In index: {location}.", i = if (length(iname) && nzchar(iname)) "With name: {iname}." ), location = location, name = iname, parent = cnd$parent, call = error_call, class = "purrr_error_indexed" ) }, interrupt = function(cnd) { interrupt_expr } ) } #' Indexed errors (`purrr_error_indexed`) #' #' @description #' #' ```{r, child = "man/rmd/indexed-error.Rmd"} #' ``` #' #' @keywords internal #' @name purrr_error_indexed NULL purrr/R/adverb-safely.R0000644000176200001440000000367515163460322014511 0ustar liggesusers#' Wrap a function to capture errors #' #' Creates a modified version of `.f` that always succeeds. It returns a list #' with components `result` and `error`. If the function succeeds, `result` #' contains the returned value and `error` is `NULL`. If an error occurred, #' `error` is an `error` object and `result` is either `NULL` or `otherwise`. #' #' # Adverbs #' This function is called an adverb because it modifies the effect of a #' function (a verb). If you'd like to include a function created an adverb #' in a package, be sure to read [faq-adverbs-export]. #' #' @param .f A function to modify, specified in one of the following ways: #' * A named function, e.g. `mean`. #' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. #' * A formula, e.g. `~ .x + 1`. No longer recommended. #' @param otherwise Default value to use when an error occurs. #' @param quiet Hide errors (`TRUE`, the default), or display them #' as they occur? #' @returns A function that takes the same arguments as `.f`, but returns #' a different value, as described above. #' @family adverbs #' @export #' @examples #' safe_log <- safely(log) #' safe_log(10) #' safe_log("a") #' #' list("a", 10, 100) |> #' map(safe_log) |> #' transpose() #' #' # This is a bit easier to work with if you supply a default value #' # of the same type and use the simplify argument to transpose(): #' safe_log <- safely(log, otherwise = NA_real_) #' list("a", 10, 100) |> #' map(safe_log) |> #' transpose() |> #' simplify_all() safely <- function(.f, otherwise = NULL, quiet = TRUE) { .f <- as_mapper(.f) force(otherwise) check_bool(quiet) function(...) capture_error(.f(...), otherwise, quiet) } capture_error <- function(code, otherwise = NULL, quiet = TRUE) { tryCatch( list(result = code, error = NULL), error = function(e) { if (!quiet) { message("Error: ", conditionMessage(e)) } list(result = otherwise, error = e) } ) } purrr/R/parallelization.R0000644000176200001440000001752615163460322015157 0ustar liggesusers#' Parallelization in purrr #' #' @description #' `r lifecycle::badge("experimental")` #' #' All map functions allow parallelized operation using \CRANpkg{mirai}. #' #' Wrap functions passed to the `.f` argument of [map()] and its variants with #' [in_parallel()]. #' #' [in_parallel()] is a \pkg{purrr} adverb that plays two roles: #' * It is a signal to purrr verbs like [map()] to go ahead and perform #' computations in parallel. #' * It helps you create self-contained functions that are isolated from your #' workspace. This is important because the function is packaged up #' (serialized) to be sent across to parallel processes. Isolation is #' critical for performance because it prevents accidentally sending very #' large objects between processes. #' #' For maps to actually be performed in parallel, the user must also set #' [mirai::daemons()], otherwise they fall back to sequential processing. #' [mirai::require_daemons()] may be used to enforce the use of parallel #' processing. See the section 'Daemons settings' below. #' #' @param .f A fresh formula or function. "Fresh" here means that they should be #' declared in the call to [in_parallel()]. #' @param ... Named arguments to declare in the environment of the function. #' #' @return A 'crate' (classed function). #' #' @section Creating self-contained functions: #' #' * They should call package functions with an explicit `::` namespace. For #' instance `ggplot()` from the ggplot2 package must be called with its #' namespace prefix: `ggplot2::ggplot()`. An alternative is to use `library()` #' within the function to attach a package to the search path, which allows #' subsequent use of package functions without the explicit namespace. #' #' * They should declare any data they depend on. Declare data by supplying #' named arguments to `...`. When `.f` is an anonymous function to a #' locally-defined function of the form `\(x) fun(x)`, `fun` itself must be #' supplied to `...` in the manner of: `in_parallel(\(x) fun(x), fun = fun)`. #' #' * Functions (closures) supplied to `...` must themselves be self-contained, #' as they are modified to share the same closure as the main function. This #' means that all helper functions and other required variables must also be #' supplied as further `...` arguments. This applies only for functions #' directly supplied to `...`: containers (such as lists) are not #' recursively analysed. In other words, if you supply complex #' objects to `...` you're at risk of unexpectedly including large objects. #' #' [in_parallel()] is a simple wrapper of [carrier::crate()] and you may refer #' to that package for more details. #' #' Example usage: #' ```r #' # The function needs to be freshly-defined, so instead of: #' mtcars |> map_dbl(in_parallel(sum)) #' # Use an anonymous function: #' mtcars |> map_dbl(in_parallel(\(x) sum(x))) #' #' # Package functions need to be explicitly namespaced, so instead of: #' map(1:3, in_parallel(\(x) vec_init(integer(), x))) #' # Use :: to namespace all package functions: #' map(1:3, in_parallel(\(x) vctrs::vec_init(integer(), x))) #' #' fun <- function(x) { param + helper(x) } #' helper <- function(x) { x %% 2 } #' param <- 5 #' # Operating in parallel, locally-defined functions, including helper #' # functions and other objects required by it, will not be found: #' map(1:3, in_parallel(\(x) fun(x))) #' # Use the ... argument to supply these objects: #' map(1:3, in_parallel(\(x) fun(x), fun = fun, helper = helper, param = param)) #' ``` #' #' @section When to use: #' #' Parallelizing a map using 'n' processes does not automatically lead to it #' taking 1/n of the time. Additional overhead from setting up the parallel task #' and communicating with parallel processes eats into this benefit, and can #' outweigh it for very short tasks or those involving large amounts of data. #' #' The threshold at which parallelization becomes clearly beneficial will differ #' according to your individual setup and task, but a rough guide would be in #' the order of 100 microseconds to 1 millisecond for each map iteration. #' #' @section Daemons settings: #' #' How and where parallelization occurs is determined by [mirai::daemons()]. #' This is a function from the \pkg{mirai} package that sets up daemons #' (persistent background processes that receive parallel computations) on your #' local machine or across the network. #' #' Daemons must be set prior to performing any parallel map operation, otherwise #' [in_parallel()] will fall back to sequential processing. To ensure that maps #' are always performed in parallel, place [mirai::require_daemons()] before the #' map. #' #' It is usual to set daemons once per session. You can leave them running on #' your local machine as they consume almost no resources whilst waiting to #' receive tasks. The following sets up 6 daemons locally: #' #' ```r #' mirai::daemons(6) #' ``` #' #' Function arguments: #' #' * `n`: the number of daemons to launch on your local machine, e.g. #' `mirai::daemons(6)`. As a rule of thumb, for maximum efficiency this should #' be (at most) one less than the number of cores on your machine, leaving one #' core for the main R process. #' * `url` and `remote`: used to set up and launch daemons for distributed #' computing over the network. See [mirai::daemons()] documentation for more #' details. #' #' Resetting daemons: #' #' Daemons persist for the duration of your session. To reset and tear down any #' existing daemons: #' #' ```r #' mirai::daemons(0) #' ``` #' #' All daemons automatically terminate when your session ends. You do not need #' to explicitly terminate daemons in this instance, although it is still good #' practice to do so. #' #' Note: if you are using parallel map within a package, do not make any #' [mirai::daemons()] calls within your package. It should always be #' up to the user how they wish to set up parallel processing: (i) resources are #' only known at run-time e.g. availability of local or remote daemons, (ii) #' packages should make use of existing daemons when already set, rather than #' reset them, and (iii) it helps prevent inadvertently spawning too many #' daemons when functions are used recursively within each other. #' #' @references #' #' \pkg{purrr}'s parallelization is powered by \CRANpkg{mirai}. See the #' [mirai website](https://mirai.r-lib.org/) for more details. #' #' @seealso [map()] for usage examples. #' @aliases parallelization #' @export #' @examplesIf interactive() && rlang::is_installed("mirai") && rlang::is_installed("carrier") #' # Run in interactive sessions only as spawns additional processes #' #' default_param <- 0.5 #' #' delay <- function(secs = default_param) { #' Sys.sleep(secs) #' } #' #' slow_lm <- function(formula, data) { #' delay() #' lm(formula, data) #' } #' #' # Example of a 'crate' returned by in_parallel(). The object print method #' # shows the size of the crate and any objects contained within: #' crate <- in_parallel( #' \(df) slow_lm(mpg ~ disp, data = df), #' slow_lm = slow_lm, #' delay = delay, #' default_param = default_param #' ) #' crate #' #' # Use mirai::mirai() to test that a crate is self-contained #' # by running it in a daemon and collecting its return value: #' mirai::mirai(crate(mtcars), crate = crate) |> mirai::collect_mirai() #' in_parallel <- function(.f, ...) { parallel_pkgs_installed() inject( carrier::crate( !!substitute(.f), !!!list(...), .parent_env = globalenv(), .error_arg = ".f", .error_call = environment() ) ) } running_in_parallel <- function(x) { inherits(x, "crate") && parallel_pkgs_installed() && mirai::daemons_set() } parallel_pkgs_installed <- function() { is.logical(the$parallel_pkgs_installed) || { check_installed( c("carrier", "mirai"), version = c("0.3.0", "2.5.1"), reason = "for parallel map." ) the$parallel_pkgs_installed <- TRUE } } purrr/R/map-mapper.R0000644000176200001440000000514515163460322014016 0ustar liggesusers#' Convert an object into a mapper function #' #' `as_mapper` is the powerhouse behind the varied function #' specifications that most purrr functions allow. It is an S3 #' generic. The default method forwards its arguments to #' [rlang::as_function()]. #' #' @param .f A function, formula, or vector (not necessarily atomic). #' #' If a __function__, it is used as is. #' #' If a __formula__, e.g. `~ .x + 2`, it is converted to a function. #' No longer recommended. #' #' If __character vector__, __numeric vector__, or __list__, it is #' converted to an extractor function. Character vectors index by #' name and numeric vectors index by position; use a list to index #' by position and name at different levels. If a component is not #' present, the value of `.default` will be returned. #' @param .default,.null Optional additional argument for extractor functions #' (i.e. when `.f` is character, integer, or list). Returned when #' value is absent (does not exist) or empty (has length 0). #' `.null` is deprecated; please use `.default` instead. #' @param ... Additional arguments passed on to methods. #' @export #' @examples #' as_mapper(\(x) x + 1) #' as_mapper(1) #' #' as_mapper(c("a", "b", "c")) #' # Equivalent to function(x) x[["a"]][["b"]][["c"]] #' #' as_mapper(list(1, "a", 2)) #' # Equivalent to function(x) x[[1]][["a"]][[2]] #' #' as_mapper(list(1, attr_getter("a"))) #' # Equivalent to function(x) attr(x[[1]], "a") #' #' as_mapper(c("a", "b", "c"), .default = NA) as_mapper <- function(.f, ...) { UseMethod("as_mapper") } #' @export as_mapper.default <- function(.f, ...) { rlang::as_function(.f) } #' @export #' @rdname as_mapper as_mapper.character <- function(.f, ..., .null, .default = NULL) { .default <- find_extract_default(.null, .default) plucker(as.list(.f), .default) } #' @export #' @rdname as_mapper as_mapper.numeric <- function(.f, ..., .null, .default = NULL) { .default <- find_extract_default(.null, .default) plucker(as.list(.f), .default) } #' @export #' @rdname as_mapper as_mapper.list <- function(.f, ..., .null, .default = NULL) { .default <- find_extract_default(.null, .default) plucker(.f, .default) } find_extract_default <- function(.null, .default) { if (!missing(.null)) { # warning("`.null` is deprecated; please use `.default` instead", call. = FALSE) .null } else { .default } } plucker <- function(i, default) { x <- NULL # supress global variables check NOTE i <- as.list(i) # Use metaprogramming to create function that prints nicely new_function( exprs(x = , ... = ), expr(pluck_raw(x, !!i, .default = !!default)) ) } purrr/R/package-purrr.R0000644000176200001440000000031714334365317014525 0ustar liggesusers#' @keywords internal #' @import rlang #' @import vctrs #' @importFrom cli cli_progress_bar #' @importFrom lifecycle deprecated #' @useDynLib purrr, .registration = TRUE "_PACKAGE" the <- new_environment() purrr/R/adverb-quietly.R0000644000176200001440000000241214350275346014715 0ustar liggesusers#' Wrap a function to capture side-effects #' #' Create a modified version of `.f` that captures side-effects along with #' the return value of the function and returns a list containing #' the `result`, `output`, `messages` and `warnings`. #' #' @inheritParams safely #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' f <- function() { #' print("Hi!") #' message("Hello") #' warning("How are ya?") #' "Gidday" #' } #' f() #' #' f_quiet <- quietly(f) #' str(f_quiet()) quietly <- function(.f) { .f <- as_mapper(.f) function(...) capture_output(.f(...)) } capture_output <- function(code) { warnings <- character() wHandler <- function(w) { warnings <<- c(warnings, conditionMessage(w)) invokeRestart("muffleWarning") } messages <- character() mHandler <- function(m) { messages <<- c(messages, conditionMessage(m)) invokeRestart("muffleMessage") } temp <- file() sink(temp) on.exit({ sink() close(temp) }) result <- withCallingHandlers( code, warning = wHandler, message = mHandler ) output <- paste0(readLines(temp, warn = FALSE), collapse = "\n") list( result = result, output = output, warnings = warnings, messages = messages ) } purrr/R/pluck-assign.R0000644000176200001440000000433414326706774014374 0ustar liggesusers#' Modify a pluck location #' #' @description #' #' * `assign_in()` takes a data structure and a [pluck] location, #' assigns a value there, and returns the modified data structure. #' #' * `modify_in()` applies a function to a pluck location, assigns the #' result back to that location with [assign_in()], and returns the #' modified data structure. #' #' @inheritParams pluck #' @param .f A function to apply at the pluck location given by `.where`. #' @param ... Arguments passed to `.f`. #' @param .where,where A pluck location, as a numeric vector of #' positions, a character vector of names, or a list combining both. #' The location must exist in the data structure. #' @seealso [pluck()] #' @export #' @examples #' # Recall that pluck() returns a component of a data structure that #' # might be arbitrarily deep #' x <- list(list(bar = 1, foo = 2)) #' pluck(x, 1, "foo") #' #' # Use assign_in() to modify the pluck location: #' str(assign_in(x, list(1, "foo"), 100)) #' # Or zap to remove it #' str(assign_in(x, list(1, "foo"), zap())) #' #' # Like pluck(), this works even when the element (or its parents) don't exist #' pluck(x, 1, "baz") #' str(assign_in(x, list(2, "baz"), 100)) #' #' # modify_in() applies a function to that location and update the #' # element in place: #' modify_in(x, list(1, "foo"), \(x) x * 200) #' #' # Additional arguments are passed to the function in the ordinary way: #' modify_in(x, list(1, "foo"), `+`, 100) modify_in <- function(.x, .where, .f, ...) { .where <- as.list(.where) .f <- rlang::as_function(.f) value <- .f(pluck(.x, !!!.where), ...) assign_in(.x, .where, value) } #' @rdname modify_in #' @param value A value to replace in `.x` at the pluck location. #' Use `zap()` to instead remove the element. #' @export assign_in <- function(x, where, value) { n <- length(where) if (n == 0) { cli::cli_abort( "{.arg where} must contain at least one element.", arg = "where" ) } else if (n > 1) { old <- pluck(x, where[[1]], .default = list()) if (!is_zap(value) || !identical(old, list())) { value <- assign_in(old, where[-1], value) } } if (is_zap(value)) { x[[where[[1]]]] <- NULL } else { list_slice2(x, where[[1]]) <- value } x } purrr/R/map-depth.R0000644000176200001440000001143015063325731013633 0ustar liggesusers#' Map/modify elements at given depth #' #' `map_depth()` calls `map(.y, .f)` on all `.y` at the specified `.depth` in #' `.x`. `modify_depth()` calls `modify(.y, .f)` on `.y` at the specified #' `.depth` in `.x`. #' #' @inheritParams map #' @param .depth Level of `.x` to map on. Use a negative value to #' count up from the lowest level of the list. #' #' * `map_depth(x, 0, fun)` is equivalent to `fun(x)`. #' * `map_depth(x, 1, fun)` is equivalent to `x <- map(x, fun)` #' * `map_depth(x, 2, fun)` is equivalent to `x <- map(x, \(y) map(y, fun))` #' @param .ragged If `TRUE`, will apply to leaves, even if they're not #' at depth `.depth`. If `FALSE`, will throw an error if there are #' no elements at depth `.depth`. #' @inheritParams modify_tree #' @seealso [modify_tree()] for a recursive version of `modify_depth()` that #' allows you to apply a function to every leaf or every node. #' @family map variants #' @family modify variants #' @export #' @examples #' # map_depth() ------------------------------------------------- #' # Use `map_depth()` to recursively traverse nested vectors and map #' # a function at a certain depth: #' x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6)) #' x |> str() #' x |> map_depth(2, \(y) paste(y, collapse = "/")) |> str() #' #' # Equivalent to: #' x |> map(\(y) map(y, \(z) paste(z, collapse = "/"))) |> str() #' #' # When ragged is TRUE, `.f()` will also be passed leaves at depth < `.depth` #' x <- list(1, list(1, list(1, list(1, 1)))) #' x |> str() #' x |> map_depth(4, \(x) length(unlist(x)), .ragged = TRUE) |> str() #' x |> map_depth(3, \(x) length(unlist(x)), .ragged = TRUE) |> str() #' x |> map_depth(2, \(x) length(unlist(x)), .ragged = TRUE) |> str() #' x |> map_depth(1, \(x) length(unlist(x)), .ragged = TRUE) |> str() #' x |> map_depth(0, \(x) length(unlist(x)), .ragged = TRUE) |> str() #' #' # modify_depth() ------------------------------------------------- #' l1 <- list( #' obj1 = list( #' prop1 = list(param1 = 1:2, param2 = 3:4), #' prop2 = list(param1 = 5:6, param2 = 7:8) #' ), #' obj2 = list( #' prop1 = list(param1 = 9:10, param2 = 11:12), #' prop2 = list(param1 = 12:14, param2 = 15:17) #' ) #' ) #' #' # In the above list, "obj" is level 1, "prop" is level 2 and "param" #' # is level 3. To apply sum() on all params, we map it at depth 3: #' l1 |> modify_depth(3, sum) |> str() #' #' # modify() lets us pluck the elements prop1/param2 in obj1 and obj2: #' l1 |> modify(c("prop1", "param2")) |> str() #' #' # But what if we want to pluck all param2 elements? Then we need to #' # act at a lower level: #' l1 |> modify_depth(2, "param2") |> str() #' #' # modify_depth() can be with other purrr functions to make them operate at #' # a lower level. Here we ask pmap() to map paste() simultaneously over all #' # elements of the objects at the second level. paste() is effectively #' # mapped at level 3. #' l1 |> modify_depth(2, \(x) pmap(x, paste, sep = " / ")) |> str() map_depth <- function( .x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL ) { force(.ragged) .depth <- check_depth(.depth, pluck_depth(.x, .is_node)) .f <- as_mapper(.f, ...) .is_node <- as_is_node(.is_node) map_depth_rec( map, .x, .depth, .f, ..., .ragged = .ragged, .is_node = .is_node ) } #' @rdname map_depth #' @export modify_depth <- function( .x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL ) { force(.ragged) .depth <- check_depth(.depth, pluck_depth(.x, .is_node)) .f <- as_mapper(.f, ...) .is_node <- as_is_node(.is_node) map_depth_rec( modify, .x, .depth, .f, ..., .ragged = .ragged, .is_node = .is_node ) } map_depth_rec <- function( .fmap, .x, .depth, .f, ..., .ragged, .is_node, .purrr_error_call = caller_env() ) { if (.depth == 0) { if (identical(.fmap, map)) { return(.f(.x, ...)) } else { .x[] <- .f(.x, ...) return(.x) } } if (!.is_node(.x)) { if (.ragged) { return(.fmap(.x, .f, ...)) } else { cli::cli_abort("List not deep enough", call = .purrr_error_call) } } if (.depth == 1) { .fmap(.x, .f, ...) } else { .fmap(.x, function(x) { map_depth_rec( .fmap = .fmap, .x = x, .depth = .depth - 1, .f = .f, ..., .ragged = .ragged, .is_node = .is_node, .purrr_error_call = .purrr_error_call ) }) } } check_depth <- function(depth, max_depth, error_call = caller_env()) { check_number_whole(depth, call = error_call) if (depth < 0) { if (-depth > max_depth) { cli::cli_abort( "Negative {.arg .depth} ({depth}) must be greater than -{max_depth}.", arg = ".depth", call = error_call ) } depth <- max_depth + depth } depth } purrr/R/list-transpose.R0000644000176200001440000001236715063325731014755 0ustar liggesusers#' Transpose a list #' #' @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 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`. #' #' It's called transpose because `x[["a"]][["b"]]` is equivalent to #' `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 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 union #' of the names of the elements of `x`, or if they're not present, the #' union of 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 #' element. #' @param ptype An optional vector prototype used to control the simplification. #' 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 element. #' @inheritParams rlang::args_dots_empty #' @export #' @examples #' # list_transpose() is useful in conjunction with safely() #' x <- list("a", 1, 2) #' y <- x |> map(safely(log)) #' y |> str() #' # Put all the errors and results together #' y |> list_transpose() |> str() #' # Supply a default result to further simplify #' y |> list_transpose(default = list(result = NA)) |> str() #' #' # list_transpose() will try to simplify by default: #' x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6)) #' x |> list_transpose() #' # 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 an 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")) #' ll |> list_transpose(template = 1) #' #' # And specify a default if you want to simplify #' ll |> list_transpose(template = c("x", "y", "z"), default = NA) list_transpose <- function( x, ..., template = NULL, simplify = NA, ptype = NULL, default = NULL ) { obj_check_list(x) check_dots_empty() if (length(x) == 0) { template <- integer() } else if (is.null(template)) { indexes <- map(x, vec_index) call <- current_env() withCallingHandlers( template <- reduce(indexes, vec_set_union), vctrs_error_ptype2 = function(e) { cli::cli_abort( "Can't combine named and unnamed vectors.", arg = template, call = call ) } ) } 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_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[[i]] %||% NA, ptype = ptype[[i]], error_arg = result_index(idx) ) out[[i]] <- res } out } result_index <- function(idx) { if (is.character(idx)) { paste0("result$", idx) } else { paste0("result[[", idx, "]]") } } match_template <- function( x, template, error_arg = caller_arg(x), error_call = caller_env() ) { 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( "Length of {.arg {error_arg}} ({length(x)}) and {.arg template} ({length(template)}) must be the same when transposing by position.", arg = error_arg, call = error_call ) } x } else { rep_along(template, list(x)) } } else { cli::cli_abort("Invalid `template`", .internal = TRUE) } } purrr/R/deprec-lift.R0000644000176200001440000001376115063325731014163 0ustar liggesusers#' Lift the domain of a function #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `lift_xy()` is a composition helper. It helps you compose #' functions by lifting their domain from a kind of input to another #' kind. The domain can be changed from and to a list (l), a vector #' (v) and dots (d). For example, `lift_ld(fun)` transforms a #' function taking a list to a function taking dots. #' #' The most important of those helpers is probably `lift_dl()` #' because it allows you to transform a regular function to one that #' takes a list. This is often essential for composition with purrr #' functional tools. Since this is such a common function, #' `lift()` is provided as an alias for that operation. #' #' These functions were superseded in purrr 1.0.0 because we no longer believe #' "lifting" to be a mainstream operation, and we are striving to reduce purrr #' to its most useful core. Superseded functions will not go away, but will only #' receive critical bug fixes. #' #' @inheritParams as_vector #' @param ..f A function to lift. #' @param ... Default arguments for `..f`. These will be #' evaluated only once, when the lifting factory is called. #' @return A function. #' @name lift #' @seealso [invoke()] NULL #' @rdname lift #' @section from ... to `list(...)` or `c(...)`: #' Here dots should be taken here in a figurative way. The lifted #' functions does not need to take dots per se. The function is #' simply wrapped a function in [do.call()], so instead #' of taking multiple arguments, it takes a single named list or #' vector which will be interpreted as its arguments. This is #' particularly useful when you want to pass a row of a data frame #' or a list to a function and don't want to manually pull it apart #' in your function. #' @param .unnamed If `TRUE`, `ld` or `lv` will not #' name the parameters in the lifted function signature. This #' prevents matching of arguments by name and match by position #' instead. #' @keywords internal #' @export #' @examples #' ### Lifting from ... to list(...) or c(...) #' #' x <- list(x = c(1:100, NA, 1000), na.rm = TRUE, trim = 0.9) #' lift_dl(mean)(x) #' # You can also use the lift() alias for this common operation: #' lift(mean)(x) #' # now: #' exec(mean, !!!x) #' #' # Default arguments can also be specified directly in lift_dl() #' list(c(1:100, NA, 1000)) |> lift_dl(mean, na.rm = TRUE)() #' # now: #' mean(c(1:100, NA, 1000), na.rm = TRUE) #' #' # lift_dl() and lift_ld() are inverse of each other. #' # Here we transform sum() so that it takes a list #' fun <- sum |> lift_dl() #' fun(list(3, NA, 4, na.rm = TRUE)) #' # now: #' fun <- function(x) exec("sum", !!!x) #' exec(sum, 3, NA, 4, na.rm = TRUE) lift <- function(..f, ..., .unnamed = FALSE) { lifecycle::deprecate_warn("1.0.0", "lift()") force(..f) defaults <- list(...) function(.x = list(), ...) { if (.unnamed) { .x <- unname(.x) } do.call("..f", c(.x, defaults, list(...))) } } #' @rdname lift #' @export lift_dl <- lift #' @rdname lift #' @export lift_dv <- function(..f, ..., .unnamed = FALSE) { lifecycle::deprecate_warn("1.0.0", "lift_dv()") force(..f) defaults <- list(...) function(.x, ...) { if (.unnamed) { .x <- unname(.x) } .x <- as.list(.x) do.call("..f", c(.x, defaults, list(...))) } } #' @rdname lift #' @section from `c(...)` to `list(...)` or `...`: #' These factories allow a function taking a vector to take a list #' or dots instead. The lifted function internally transforms its #' inputs back to an atomic vector. purrr does not obey the usual R #' casting rules (e.g., `c(1, "2")` produces a character #' vector) and will produce an error if the types are not #' compatible. Additionally, you can enforce a particular vector #' type by supplying `.type`. #' @export #' @examples #' ### Lifting from c(...) to list(...) or ... #' #' # In other situations we need the vector-valued function to take a #' # variable number of arguments as with pmap(). This is a job for #' # lift_vd(): #' pmap_dbl(mtcars, lift_vd(mean)) #' # now #' pmap_dbl(mtcars, \(...) mean(c(...))) lift_vl <- function(..f, ..., .type) { lifecycle::deprecate_warn("1.0.0", "lift_vl()") force(..f) defaults <- list(...) if (missing(.type)) { .type <- NULL } function(.x = list(), ...) { x <- as_vector_(.x, .type) do.call("..f", c(list(x), defaults, list(...))) } } #' @rdname lift #' @export lift_vd <- function(..f, ..., .type) { lifecycle::deprecate_warn("1.0.0", "lift_vd()") force(..f) defaults <- list(...) if (missing(.type)) { .type <- NULL } function(...) { x <- as_vector_(list(...), .type) do.call("..f", c(list(x), defaults)) } } #' @rdname lift #' @section from list(...) to c(...) or ...: #' `lift_ld()` turns a function that takes a list into a #' function that takes dots. `lift_vd()` does the same with a #' function that takes an atomic vector. These factory functions are #' the inverse operations of `lift_dl()` and `lift_dv()`. #' #' `lift_vd()` internally coerces the inputs of `..f` to #' an atomic vector. The details of this coercion can be controlled #' with `.type`. #' #' @export #' @examples #' ### Lifting from list(...) to c(...) or ... #' #' # This kind of lifting is sometimes needed for function #' # composition. An example would be to use pmap() with a function #' # that takes a list. In the following, we use some() on each row of #' # a data frame to check they each contain at least one element #' # satisfying a condition: #' mtcars |> pmap_lgl(lift_ld(some, partial(`<`, 200))) #' # now #' mtcars |> pmap_lgl(\(...) any(c(...) > 200)) #' lift_ld <- function(..f, ...) { lifecycle::deprecate_warn("1.0.0", "lift_ld()") force(..f) defaults <- list(...) function(...) { do.call("..f", c(list(list(...)), defaults)) } } #' @rdname lift #' @export lift_lv <- function(..f, ...) { lifecycle::deprecate_warn("1.0.0", "lift_lv()") force(..f) defaults <- list(...) function(.x, ...) { do.call("..f", c(list(as.list(.x)), defaults, list(...))) } } purrr/R/deprec-prepend.R0000644000176200001440000000225715063325731014660 0ustar liggesusers#' Prepend a vector #' #' @description #' `r lifecycle::badge("deprecated")` #' #' This function was deprecated in purrr 1.0.0 because it's not related to the #' core purpose of purrr. #' #' This is a companion to [append()] to help merging two #' lists or atomic vectors. `prepend()` is a clearer semantic #' signal than `c()` that a vector is to be merged at the beginning of #' another, especially in a pipe chain. #' #' @param x the vector to be modified. #' @param values to be included in the modified vector. #' @param before a subscript, before which the values are to be appended. If #' `NULL`, values will be appended at the beginning even for `x` of length 0. #' @return A merged vector. #' @keywords internal #' @export #' @examples #' x <- as.list(1:3) #' #' x |> append("a") #' x |> prepend("a") #' x |> prepend(list("a", "b"), before = 3) #' prepend(list(), x) prepend <- function(x, values, before = NULL) { lifecycle::deprecate_warn("1.0.0", "prepend()", I("append(after = 0)")) n <- length(x) stopifnot(is.null(before) || (before > 0 && before <= n)) if (is.null(before) || before == 1) { c(values, x) } else { c(x[1:(before - 1)], values, x[before:n]) } } purrr/R/reduce.R0000644000176200001440000003630515063325731013233 0ustar liggesusers#' Reduce a list to a single value by iteratively applying a binary function #' #' @description #' #' `reduce()` is an operation that combines the elements of a vector #' into a single value. The combination is driven by `.f`, a binary #' function that takes two values and returns a single value: reducing #' `f` over `1:3` computes the value `f(f(1, 2), 3)`. #' #' @inheritParams map #' @param ... Additional arguments passed on to the reduce function. #' #' We now generally recommend against using `...` to pass additional #' (constant) arguments to `.f`. Instead use a shorthand anonymous function: #' #' ```R #' # Instead of #' x |> reduce(f, 1, 2, collapse = ",") #' # do: #' x |> reduce(\(x, y) f(x, y, 1, 2, collapse = ",")) #' ``` #' #' This makes it easier to understand which arguments belong to which #' function and will tend to yield better error messages. #' #' @param .y For `reduce2()` an additional #' argument that is passed to `.f`. If `init` is not set, `.y` #' should be 1 element shorter than `.x`. #' @param .f For `reduce()`, a 2-argument function. The function will be passed #' the accumulated value as the first argument and the "next" value as the #' second argument. #' #' For `reduce2()`, a 3-argument function. The function will be passed the #' accumulated value as the first argument, the next value of `.x` as the #' second argument, and the next value of `.y` as the third argument. #' #' The reduction terminates early if `.f` returns a value wrapped in #' a [done()]. #' #' @param .init If supplied, will be used as the first value to start #' 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 reduction as a string, one of #' `"forward"` (the default) or `"backward"`. See the section about #' direction below. #' #' @section Direction: #' #' When `.f` is an associative operation like `+` or `c()`, the #' direction of reduction does not matter. For instance, reducing the #' vector `1:3` with the binary function `+` computes the sum `((1 + #' 2) + 3)` from the left, and the same sum `(1 + (2 + 3))` from the #' right. #' #' In other cases, the direction has important consequences on the #' reduced value. For instance, reducing a vector with `list()` from #' the left produces a left-leaning nested list (or tree), while #' reducing `list()` from the right produces a right-leaning list. #' #' @seealso [accumulate()] for a version that returns all intermediate #' values of the reduction. #' @examples #' # Reducing `+` computes the sum of a vector while reducing `*` #' # computes the product: #' 1:3 |> reduce(`+`) #' 1:10 |> reduce(`*`) #' #' # By ignoring the input vector (nxt), you can turn output of one step into #' # the input for the next. This code takes 10 steps of a random walk: #' reduce(1:10, \(acc, nxt) acc + rnorm(1), .init = 0) #' #' # When the operation is associative, the direction of reduction #' # does not matter: #' reduce(1:4, `+`) #' reduce(1:4, `+`, .dir = "backward") #' #' # However with non-associative operations, the reduced value will #' # be different as a function of the direction. For instance, #' # `list()` will create left-leaning lists when reducing from the #' # right, and right-leaning lists otherwise: #' str(reduce(1:4, list)) #' str(reduce(1:4, list, .dir = "backward")) #' #' # reduce2() takes a ternary function and a second vector that is #' # one element smaller than the first vector: #' paste2 <- function(x, y, sep = ".") paste(x, y, sep = sep) #' letters[1:4] |> reduce(paste2) #' letters[1:4] |> reduce2(c("-", ".", "-"), paste2) #' #' x <- list(c(0, 1), c(2, 3), c(4, 5)) #' y <- list(c(6, 7), c(8, 9)) #' reduce2(x, y, paste) #' #' #' # You can shortcircuit a reduction and terminate it early by #' # returning a value wrapped in a done(). In the following example #' # we return early if the result-so-far, which is passed on the LHS, #' # meets a condition: #' paste3 <- function(out, input, sep = ".") { #' if (nchar(out) > 4) { #' return(done(out)) #' } #' paste(out, input, sep = sep) #' } #' letters |> reduce(paste3) #' #' # Here the early return branch checks the incoming inputs passed on #' # the RHS: #' paste4 <- function(out, input, sep = ".") { #' if (input == "j") { #' return(done(out)) #' } #' paste(out, input, sep = sep) #' } #' letters |> reduce(paste4) #' @export reduce <- function(.x, .f, ..., .init, .dir = c("forward", "backward")) { reduce_impl(.x, .f, ..., .init = .init, .dir = .dir) } #' @rdname reduce #' @export reduce2 <- function(.x, .y, .f, ..., .init) { reduce2_impl(.x, .y, .f, ..., .init = .init, .left = TRUE) } reduce_impl <- function( .x, .f, ..., .init, .dir, .acc = FALSE, .purrr_error_call = caller_env() ) { left <- arg_match0(.dir, c("forward", "backward")) == "forward" out <- reduce_init(.x, .init, left = left, error_call = .purrr_error_call) idx <- reduce_index(.x, .init, left = left) if (.acc) { acc_out <- accum_init(out, idx, left = left) acc_idx <- accum_index(acc_out, left = left) } .f <- as_mapper(.f, ...) # Left-reduce passes the result-so-far on the left, right-reduce # passes it on the right. A left-reduce produces left-leaning # computation trees while right-reduce produces right-leaning trees. if (left) { fn <- .f } else { fn <- function(x, y, ...) .f(y, x, ...) } for (i in seq_along(idx)) { prev <- out elt <- .x[[idx[[i]]]] out <- forceAndCall(2, fn, out, elt, ...) if (is_done_box(out)) { return(reduce_early(out, prev, .acc, acc_out, acc_idx[[i]], left)) } if (.acc) { acc_out[[acc_idx[[i]]]] <- out } } if (.acc) { acc_out } else { out } } reduce_early <- function(out, prev, acc, acc_out, acc_idx, left = TRUE) { if (is_done_box(out, empty = TRUE)) { out <- prev offset <- if (left) -1L else 1L } else { out <- unbox(out) offset <- 0L } if (!acc) { return(out) } acc_idx <- acc_idx + offset acc_out[[acc_idx]] <- out if (left) { acc_out[seq_len(acc_idx)] } else { acc_out[seq(acc_idx, length(acc_out))] } } reduce_init <- function(x, init, left = TRUE, error_call = caller_env()) { if (!missing(init)) { init } else { if (is_empty(x)) { cli::cli_abort( "Must supply {.arg .init} when {.arg .x} is empty.", arg = ".init", call = error_call ) } else if (left) { x[[1]] } else { x[[length(x)]] } } } reduce_index <- function(x, init, left = TRUE) { n <- length(x) if (left) { if (missing(init)) { seq_len2(2L, n) } else { seq_len(n) } } else { if (missing(init)) { rev(seq_len(n - 1L)) } else { rev(seq_len(n)) } } } accum_init <- function(first, idx, left) { len <- length(idx) + 1L out <- new_list(len) if (left) { out[[1]] <- first } else { out[[len]] <- first } out } accum_index <- function(out, left) { n <- length(out) if (left) { seq_len2(2, n) } else { rev(seq_len(n - 1L)) } } reduce2_impl <- function( .x, .y, .f, ..., .init, .left = TRUE, .acc = FALSE, .purrr_error_call = caller_env() ) { out <- reduce_init(.x, .init, left = .left, error_call = .purrr_error_call) x_idx <- reduce_index(.x, .init, left = .left) y_idx <- reduce_index(.y, NULL, left = .left) if (length(x_idx) != length(y_idx)) { cli::cli_abort( "{.arg .y} must have length {length(x_idx)}, not {length(y_idx)}.", arg = ".y", call = .purrr_error_call ) } .f <- as_mapper(.f, ...) if (.acc) { acc_out <- accum_init(out, x_idx, left = .left) acc_idx <- accum_index(acc_out, left = .left) } for (i in seq_along(x_idx)) { prev <- out x_i <- x_idx[[i]] y_i <- y_idx[[i]] out <- forceAndCall(3, .f, out, .x[[x_i]], .y[[y_i]], ...) if (is_done_box(out)) { return(reduce_early(out, prev, .acc, acc_out, acc_idx[[i]])) } if (.acc) { acc_out[[acc_idx[[i]]]] <- out } } if (.acc) { acc_out } else { out } } seq_len2 <- function(start, end) { if (start > end) { return(integer(0)) } start:end } #' Accumulate intermediate results of a vector reduction #' #' @description #' #' `accumulate()` sequentially applies a 2-argument function to elements of a #' vector. Each application of the function uses the initial value or result #' of the previous application as the first argument. The second argument is #' the next value of the vector. The results of each application are #' returned in a list. The accumulation can optionally terminate before #' processing the whole vector in response to a `done()` signal returned by #' the accumulation function. #' #' By contrast to `accumulate()`, `reduce()` applies a 2-argument function in #' the same way, but discards all results except that of the final function #' application. #' #' `accumulate2()` sequentially applies a function to elements of two lists, `.x` and `.y`. #' #' @inheritParams map #' #' @param .y For `accumulate2()` `.y` is the second argument of the pair. It #' needs to be 1 element shorter than the vector to be accumulated (`.x`). #' If `.init` is set, `.y` needs to be one element shorted than the #' concatenation of the initial value and `.x`. #' #' @param .f For `accumulate()` `.f` is 2-argument function. The function will #' be passed the accumulated result or initial value as the first argument. #' The next value in sequence is passed as the second argument. #' #' For `accumulate2()`, a 3-argument function. The #' function will be passed the accumulated result as the first #' argument. The next value in sequence from `.x` is passed as the second argument. The #' next value in sequence from `.y` is passed as the third argument. #' #' The accumulation terminates early if `.f` returns a value wrapped in #' a [done()]. #' #' @param .init If supplied, will be used as the first value to start #' the accumulation, rather than using `.x[[1]]`. This is useful if #' you want to ensure that `reduce` returns a correct value when `.x` #' is empty. If missing, and `.x` is empty, will throw an error. #' @param .dir The direction of accumulation as a string, one of #' `"forward"` (the default) or `"backward"`. See the section about #' direction below. #' @param .simplify If `NA`, the default, the accumulated list of #' results is simplified to an atomic vector if possible. #' If `TRUE`, the result is simplified, erroring if not possible. #' If `FALSE`, the result is not simplified, always returning a list. #' @param .ptype If `simplify` is `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 #' names, the initial value is given the name `".init"`, otherwise #' the returned vector is kept unnamed. #' #' If `.dir` is `"forward"` (the default), the first element is the #' initial value (`.init` if supplied, or the first element of `.x`) #' and the last element is the final reduced value. In case of a #' right accumulation, this order is reversed. #' #' The accumulation terminates early if `.f` returns a value wrapped #' in a [done()]. If the done box is empty, the last value is #' used instead and the result is one element shorter (but always #' includes the initial value, even when terminating at the first #' iteration). #' #' @inheritSection reduce Direction #' #' @seealso [reduce()] when you only need the final reduced value. #' @examples #' # With an associative operation, the final value is always the #' # same, no matter the direction. You'll find it in the first element for a #' # backward (left) accumulation, and in the last element for forward #' # (right) one: #' 1:5 |> accumulate(`+`) #' 1:5 |> accumulate(`+`, .dir = "backward") #' #' # The final value is always equal to the equivalent reduction: #' 1:5 |> reduce(`+`) #' #' # It is easier to understand the details of the reduction with #' # `paste()`. #' accumulate(letters[1:5], paste, sep = ".") #' #' # Note how the intermediary reduced values are passed to the left #' # with a left reduction, and to the right otherwise: #' accumulate(letters[1:5], paste, sep = ".", .dir = "backward") #' #' # By ignoring the input vector (nxt), you can turn output of one step into #' # the input for the next. This code takes 10 steps of a random walk: #' accumulate(1:10, \(acc, nxt) acc + rnorm(1), .init = 0) #' #' # `accumulate2()` is a version of `accumulate()` that works with #' # 3-argument functions and one additional vector: #' paste2 <- function(acc, nxt, sep = ".") paste(acc, nxt, sep = sep) #' letters[1:4] |> accumulate(paste2) #' letters[1:4] |> accumulate2(c("-", ".", "-"), paste2) #' #' # You can shortcircuit an accumulation and terminate it early by #' # returning a value wrapped in a done(). In the following example #' # we return early if the result-so-far, which is passed on the LHS, #' # meets a condition: #' paste3 <- function(out, input, sep = ".") { #' if (nchar(out) > 4) { #' return(done(out)) #' } #' paste(out, input, sep = sep) #' } #' letters |> accumulate(paste3) #' #' # Note how we get twice the same value in the accumulation. That's #' # because we have returned it twice. To prevent this, return an empty #' # done box to signal to accumulate() that it should terminate with the #' # value of the last iteration: #' paste3 <- function(out, input, sep = ".") { #' if (nchar(out) > 4) { #' return(done()) #' } #' paste(out, input, sep = sep) #' } #' letters |> accumulate(paste3) #' #' # Here the early return branch checks the incoming inputs passed on #' # the RHS: #' paste4 <- function(out, input, sep = ".") { #' if (input == "f") { #' return(done()) #' } #' paste(out, input, sep = sep) #' } #' letters |> accumulate(paste4) #' #' #' # Simulating stochastic processes with drift #' \dontrun{ #' library(dplyr) #' library(ggplot2) #' #' map(1:5, \(i) rnorm(100)) |> #' set_names(paste0("sim", 1:5)) |> #' map(\(l) accumulate(l, \(acc, nxt) .05 + acc + nxt)) |> #' map(\(x) tibble(value = x, step = 1:100)) |> #' list_rbind(names_to = "simulation") |> #' ggplot(aes(x = step, y = value)) + #' geom_line(aes(color = simulation)) + #' ggtitle("Simulations of a random walk with drift") #' } #' @export accumulate <- function( .x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = NA, .ptype = NULL ) { .dir <- arg_match0(.dir, c("forward", "backward")) .f <- as_mapper(.f, ...) res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE) names(res) <- accumulate_names(names(.x), .init, .dir) 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) res } accumulate_names <- function(nms, init, dir) { if (is_null(nms)) { return(NULL) } if (!missing(init)) { nms <- c(".init", nms) } if (dir == "backward") { nms <- rev(nms) } nms } purrr/R/adverb-insistently.R0000644000176200001440000000442214326707000015577 0ustar liggesusers#' Transform a function to wait then retry after an error #' #' @description #' `insistently()` takes a function and modifies it to retry after given #' amount of time whenever it errors. #' #' @inheritParams safely #' @param rate A [rate][rate-helpers] object. Defaults to jittered exponential #' backoff. #' @inheritParams rate_sleep #' @seealso [httr::RETRY()] is a special case of [insistently()] for #' HTTP verbs. #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' # For the purpose of this example, we first create a custom rate #' # object with a low waiting time between attempts: #' rate <- rate_delay(0.1) #' #' # insistently() makes a function repeatedly try to work #' risky_runif <- function(lo = 0, hi = 1) { #' y <- runif(1, lo, hi) #' if(y < 0.9) { #' stop(y, " is too small") #' } #' y #' } #' #' # Let's now create an exponential backoff rate with a low waiting #' # time between attempts: #' rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005, max_times = 4) #' #' # Modify your function to run insistently. #' insistent_risky_runif <- insistently(risky_runif, rate, quiet = FALSE) #' #' set.seed(6) # Succeeding seed #' insistent_risky_runif() #' #' set.seed(3) # Failing seed #' try(insistent_risky_runif()) #' #' # You can also use other types of rate settings, like a delay rate #' # that waits for a fixed amount of time. Be aware that a delay rate #' # has an infinite amount of attempts by default: #' rate <- rate_delay(0.2, max_times = 3) #' insistent_risky_runif <- insistently(risky_runif, rate = rate, quiet = FALSE) #' try(insistent_risky_runif()) #' #' # insistently() and possibly() are a useful combination #' rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005) #' possibly_insistent_risky_runif <- possibly(insistent_risky_runif, otherwise = -99) #' #' set.seed(6) #' possibly_insistent_risky_runif() #' #' set.seed(3) #' possibly_insistent_risky_runif() insistently <- function(f, rate = rate_backoff(), quiet = TRUE) { f <- as_mapper(f) check_rate(rate) check_bool(quiet) function(...) { rate_reset(rate) repeat { rate_sleep(rate, quiet = quiet) out <- capture_error(f(...), quiet = quiet) if (is_null(out$error)) { return(out$result) } } } } purrr/R/list-combine.R0000644000176200001440000000542215063325731014345 0ustar liggesusers#' Combine list elements into a single data structure #' #' @description #' * `list_c()` combines elements into a vector by concatenating them together #' with [vctrs::vec_c()]. #' #' * `list_rbind()` combines elements into a data frame by row-binding them #' together with [vctrs::vec_rbind()]. #' #' * `list_cbind()` combines elements into a data frame by column-binding them #' together with [vctrs::vec_cbind()]. #' #' @param x A list. For `list_rbind()` and `list_cbind()` the list must #' only contain only data frames or `NULL`. #' @param ptype An optional prototype to ensure that the output type is always #' the same. #' @param names_to By default, `names(x)` are lost. To keep them, supply a #' string to `names_to` and the names will be saved into a column with that #' name. If `names_to` is supplied and `x` is not named, the position of #' the elements will be used instead of the names. #' @param size An optional integer size to ensure that every input has the #' same size (i.e. number of rows). #' @param name_repair One of `"unique"`, `"universal"`, or `"check_unique"`. #' See [vctrs::vec_as_names()] for the meaning of these options. #' @inheritParams rlang::args_dots_empty #' @export #' @examples #' x1 <- list(a = 1, b = 2, c = 3) #' list_c(x1) #' #' x2 <- list( #' a = data.frame(x = 1:2), #' b = data.frame(y = "a") #' ) #' list_rbind(x2) #' list_rbind(x2, names_to = "id") #' list_rbind(unname(x2), names_to = "id") #' #' list_cbind(x2) list_c <- function(x, ..., ptype = NULL) { obj_check_list(x) check_dots_empty() # For `list_c()`, we don't expose `list_unchop()`'s `name_spec` arg, # and instead strip outer names to avoid collisions with inner names x <- unname(x) list_unchop( x, ptype = ptype, error_call = current_env() ) } #' @export #' @rdname list_c list_cbind <- function( x, ..., name_repair = c("unique", "universal", "check_unique"), size = NULL ) { check_list_of_data_frames(x) check_dots_empty() vec_cbind( !!!x, .name_repair = name_repair, .size = size, .error_call = current_env() ) } #' @export #' @rdname list_c list_rbind <- function(x, ..., names_to = rlang::zap(), ptype = NULL) { check_list_of_data_frames(x) check_dots_empty() vec_rbind( !!!x, .names_to = names_to, .ptype = ptype, .error_call = current_env() ) } check_list_of_data_frames <- function(x, error_call = caller_env()) { obj_check_list(x, call = error_call) is_df_or_null <- map_lgl(x, function(x) is.data.frame(x) || is.null(x)) if (all(is_df_or_null)) { return() } bad <- which(!is_df_or_null) cli::cli_abort( c( "Each element of {.arg x} must be either a data frame or {.code NULL}.", i = "Elements {bad} are not." ), arg = "x", call = error_call ) } purrr/R/map-if-at.R0000644000176200001440000000472415063325731013537 0ustar liggesusers#' Apply a function to each element of a vector conditionally #' #' @description #' The functions `map_if()` and `map_at()` take `.x` as input, apply #' the function `.f` to some of the elements of `.x`, and return a #' list of the same length as the input. #' #' * `map_if()` takes a predicate function `.p` as input to determine #' which elements of `.x` are transformed with `.f`. #' #' * `map_at()` takes a vector of names or positions `.at` to specify #' which elements of `.x` are transformed with `.f`. #' #' @inheritParams map #' @param .p A single predicate function, a formula describing such a #' predicate function, or a logical vector of the same length as `.x`. #' Alternatively, if the elements of `.x` are themselves lists of #' objects, a string indicating the name of a logical element in the #' inner lists. Only those elements where `.p` evaluates to #' `TRUE` will be modified. #' @param .else A function applied to elements of `.x` for which `.p` #' returns `FALSE`. #' @family map variants #' @export #' @examples #' # Use a predicate function to decide whether to map a function: #' iris |> map_if(is.factor, as.character) |> str() #' #' # Specify an alternative with the `.else` argument: #' iris |> map_if(is.factor, as.character, .else = as.integer) |> str() #' #' # Use numeric vector of positions select elements to change: #' iris |> map_at(c(4, 5), is.numeric) |> str() #' #' # Use vector of names to specify which elements to change: #' iris |> map_at("Species", toupper) |> str() map_if <- function(.x, .p, .f, ..., .else = NULL) { where <- where_if(.x, .p) out <- vector("list", length(.x)) out[where] <- map(.x[where], .f, ...) if (is_null(.else)) { out[!where] <- .x[!where] } else { out[!where] <- map(.x[!where], .else, ...) } set_names(out, names(.x)) } #' @rdname map_if #' @param .at A logical, integer, or character vector giving the elements #' to select. Alternatively, a function that takes a vector of names, #' and returns a logical, integer, or character vector of elements to select. #' #' `r lifecycle::badge("deprecated")`: if the tidyselect package is #' installed, you can use `vars()` and tidyselect helpers to select #' elements. #' @export map_at <- function(.x, .at, .f, ..., .progress = FALSE) { where <- where_at(.x, .at, user_env = caller_env()) out <- vector("list", length(.x)) out[where] <- map(.x[where], .f, ..., .progress = .progress) out[!where] <- .x[!where] set_names(out, names(.x)) } purrr/R/adverb-partial.R0000644000176200001440000001373715063325731014665 0ustar liggesusers#' Partially apply a function, filling in some arguments #' #' Partial function application allows you to modify a function by pre-filling #' some of the arguments. It is particularly useful in conjunction with #' functionals and other function operators. #' #' @details #' `partial()` creates a function that takes `...` arguments. Unlike #' [compose()] and other function operators like [negate()], it #' doesn't reuse the function signature of `.f`. This is because #' `partial()` explicitly supports NSE functions that use #' `substitute()` on their arguments. The only way to support those is #' to forward arguments through dots. #' #' Other unsupported patterns: #' #' - It is not possible to call `partial()` repeatedly on the same #' argument to pre-fill it with a different expression. #' #' - It is not possible to refer to other arguments in pre-filled #' argument. #' #' @param .f a function. For the output source to read well, this should be a #' named function. #' @param ... named arguments to `.f` that should be partially applied. #' #' Pass an empty `... = ` argument to specify the position of future #' arguments relative to partialised ones. See #' [rlang::call_modify()] to learn more about this syntax. #' #' These dots support quasiquotation. If you unquote a value, it is #' evaluated only once at function creation time. Otherwise, it is #' evaluated each time the function is called. #' @inheritSection safely Adverbs #' @inherit safely return #' @family adverbs #' @export #' @examples #' # Partial is designed to replace the use of anonymous functions for #' # filling in function arguments. Instead of: #' compact1 <- function(x) discard(x, is.null) #' #' # we can write: #' compact2 <- partial(discard, .p = is.null) #' #' # partial() works fine with functions that do non-standard #' # evaluation #' my_long_variable <- 1:10 #' plot2 <- partial(plot, my_long_variable) #' plot2() #' plot2(runif(10), type = "l") #' #' # Note that you currently can't partialise arguments multiple times: #' my_mean <- partial(mean, na.rm = TRUE) #' my_mean <- partial(my_mean, na.rm = FALSE) #' try(my_mean(1:10)) #' #' #' # The evaluation of arguments normally occurs "lazily". Concretely, #' # this means that arguments are repeatedly evaluated across invocations: #' f <- partial(runif, n = rpois(1, 5)) #' f #' f() #' f() #' #' # You can unquote an argument to fix it to a particular value. #' # Unquoted arguments are evaluated only once when the function is created: #' f <- partial(runif, n = !!rpois(1, 5)) #' f #' f() #' f() #' #' #' # By default, partialised arguments are passed before new ones: #' my_list <- partial(list, 1, 2) #' my_list("foo") #' #' # Control the position of these arguments by passing an empty #' # `... = ` argument: #' my_list <- partial(list, 1, ... = , 2) #' my_list("foo") partial <- function(.f, ...) { args <- enquos(...) fn_expr <- enexpr(.f) .fn <- switch( typeof(.f), builtin = , special = as_closure(.f), closure = .f, cli::cli_abort( "{.arg .f} must be a function, not {.obj_type_friendly { .f }}.", arg = ".f" ) ) env <- caller_env() heterogeneous_envs <- !every(args, quo_is_same_env, env) if (!heterogeneous_envs) { args <- map(args, quo_get_expr) } # Reuse function symbol if possible fn_sym <- if (is_symbol(fn_expr)) fn_expr else quote(.fn) # Pass on `...` from parent function. It should be last, this way if # `args` also contain a `...` argument, the position in `args` # prevails. call <- call_modify(call2(fn_sym), !!!args, ... = ) if (heterogeneous_envs) { # Forward caller environment where S3 methods might be defined. # See design note below. call <- new_quosure(call, env) # Unwrap quosured arguments if possible call <- quo_invert(call) # Derive a mask where dots can be forwarded mask <- new_data_mask(env(!!fn_sym := .fn)) fn <- function(...) { mask$... <- environment()$... eval_tidy(call, mask) } } else { body <- expr({ !!fn_sym <- !!.fn !!call }) fn <- new_function(pairlist2(... = ), body, env = env) } structure( fn, class = c("purrr_function_partial", "function"), body = call ) } #' @export print.purrr_function_partial <- function(x, ...) { cat("\n") body(x) <- partialised_body(x) print(x, ...) } partialised_body <- function(x) attr(x, "body") # For !!fn_sym <- !!.fn utils::globalVariables("!<-") # helpers ----------------------------------------------------------------- quo_invert <- function(call) { call <- duplicate(call, shallow = TRUE) if (is_quosure(call)) { rest <- quo_get_expr(call) } else { rest <- call } if (!is_call(rest)) { cli::cli_abort("Expected a call", .internal = TRUE) } first_quo <- NULL # Find first quosured argument. We unwrap constant quosures which # add no scoping information. while (!is_null(rest)) { elt <- node_car(rest) if (is_quosure(elt)) { if (quo_is_constant(elt)) { # Unwrap constant quosures node_poke_car(rest, quo_get_expr(elt)) } else if (is_null(first_quo)) { # Record first quosured argument first_quo <- elt first_node <- rest } } rest <- node_cdr(rest) } if (is_null(first_quo)) { return(call) } # Take the wrapping quosure env as reference if there is one. # Otherwise, take the first quosure detected in arguments. if (is_quosure(call)) { env <- quo_get_env(call) call <- quo_get_expr(call) } else { env <- quo_get_env(first_quo) } rest <- first_node while (!is_null(rest)) { cur <- node_car(rest) if (is_quosure(cur) && is_reference(quo_get_env(cur), env)) { node_poke_car(rest, quo_get_expr(cur)) } rest <- node_cdr(rest) } new_quosure(call, env) } quo_is_constant <- function(quo) { is_reference(quo_get_env(quo), empty_env()) } quo_is_same_env <- function(x, env) { quo_env <- quo_get_env(x) is_reference(quo_env, env) || is_reference(quo_env, empty_env()) } purrr/R/detect.R0000644000176200001440000000542315163460322013226 0ustar liggesusers#' Find the value or position of the first match #' #' @inheritParams keep #' @inheritParams map #' @param .f A function, specified in one of the following ways: #' #' * A named function, e.g. `mean`. #' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. #' * A formula, e.g. `~ .x + 1`. Use `.x` to refer to the first argument. No #' longer recommended. #' * A string, integer, or list, e.g. `"idx"`, `1`, or `list("idx", 1)` which #' are shorthand for `\(x) pluck(x, "idx")`, `\(x) pluck(x, 1)`, and #' `\(x) pluck(x, "idx", 1)` respectively. Optionally supply `.default` to #' set a default value if the indexed element is `NULL` or does not exist. #' @param .dir If `"forward"`, the default, starts at the beginning of #' the vector and move towards the end; if `"backward"`, starts at #' the end of the vector and moves towards the beginning. #' @param .default The value returned when nothing is detected. #' @return `detect` the value of the first item that matches the #' predicate; `detect_index` the position of the matching item. #' If not found, `detect` returns `NULL` and `detect_index` #' returns 0. #' #' @seealso [keep()] for keeping all matching values. #' @export #' @examples #' is_even <- function(x) x %% 2 == 0 #' #' 3:10 |> detect(is_even) #' 3:10 |> detect_index(is_even) #' #' 3:10 |> detect(is_even, .dir = "backward") #' 3:10 |> detect_index(is_even, .dir = "backward") #' #' #' # Since `.f` is passed to as_mapper(), you can supply a pluck object: #' x <- list( #' list(1, foo = FALSE), #' list(2, foo = TRUE), #' list(3, foo = TRUE) #' ) #' #' detect(x, "foo") #' detect_index(x, "foo") #' #' #' # If you need to find all values, use keep(): #' keep(x, "foo") #' #' # If you need to find all positions, use map_lgl(): #' which(map_lgl(x, "foo")) detect <- function( .x, .f, ..., .dir = c("forward", "backward"), .default = NULL ) { .f <- as_predicate(.f, ..., .mapper = TRUE) .dir <- arg_match0(.dir, c("forward", "backward")) for (i in index(.x, .dir, "detect")) { if (.f(.x[[i]], ...)) { return(.x[[i]]) } } .default } #' @export #' @rdname detect detect_index <- function(.x, .f, ..., .dir = c("forward", "backward")) { .f <- as_predicate(.f, ..., .mapper = TRUE) .dir <- arg_match0(.dir, c("forward", "backward")) for (i in index(.x, .dir, "detect_index")) { if (.f(.x[[i]], ...)) { return(i) } } 0L } index <- function(x, dir, right = NULL, fn) { idx <- seq_along(x) if (dir == "backward") { idx <- rev(idx) } idx } #' Does a list contain an object? #' #' @inheritParams map #' @param .y Object to test for #' @export #' @examples #' x <- list(1:10, 5, 9.9) #' x |> has_element(1:10) #' x |> has_element(3) has_element <- function(.x, .y) { some(.x, identical, .y) } purrr/R/pluck.R0000644000176200001440000001422015163460322013067 0ustar liggesusers#' Safely get or set an element deep within a nested data structure #' #' @description #' `pluck()` implements a generalised form of `[[` that allow you to index #' deeply and flexibly into data structures. (If you're looking for an #' equivalent of `[`, see [keep_at()].) `pluck()` always succeeds, returning #' `.default` if the index you are trying to access does not exist or is `NULL`. #' (If you're looking for a variant that errors, try [chuck()].) #' #' `pluck<-()` is the assignment equivalent, allowing you to modify an object #' deep within a nested data structure. #' #' `pluck_exists()` tells you whether or not an object exists using the #' same rules as pluck (i.e. a `NULL` element is equivalent to an absent #' element). #' #' @param .x,x A vector or environment #' @param ... A list of accessors for indexing into the object. Can be #' an positive integer, a negative integer (to index from the right), #' a string (to index into names), or an accessor function #' (except for the assignment variants which only support names and #' positions). If the object being indexed is an S4 object, #' accessing it by name will return the corresponding slot. #' #' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if #' your accessors are stored in a list, you can splice that in with #' `!!!`. #' @param .default Value to use if target is `NULL` or absent. #' #' @details #' * You can pluck or chuck with standard accessors like integer #' positions and string names, and also accepts arbitrary accessor #' functions, i.e. functions that take an object and return some #' internal piece. #' #' This is often more readable than a mix of operators and accessors #' because it reads linearly and is free of syntactic #' cruft. Compare: \code{accessor(x[[1]])$foo} to `pluck(x, 1, #' accessor, "foo")`. #' #' * These accessors never partial-match. This is unlike `$` which #' will select the `disp` object if you write `mtcars$di`. #' #' @seealso #' * [attr_getter()] for creating attribute getters suitable for use #' with `pluck()` and `chuck()`. #' * [modify_in()] for applying a function to a plucked location. #' * [keep_at()] is similar to `pluck()`, but retain the structure #' of the list instead of converting it into a vector. #' @export #' @examples #' # Let's create a list of data structures: #' obj1 <- list("a", list(1, elt = "foo")) #' obj2 <- list("b", list(2, elt = "bar")) #' x <- list(obj1, obj2) #' #' # pluck() provides a way of retrieving objects from such data #' # structures using a combination of numeric positions, vector or #' # list names, and accessor functions. #' #' # Numeric positions index into the list by position, just like `[[`: #' pluck(x, 1) #' # same as x[[1]] #' #' # Index from the back #' pluck(x, -1) #' # same as x[[2]] #' #' pluck(x, 1, 2) #' # same as x[[1]][[2]] #' #' # Supply names to index into named vectors: #' pluck(x, 1, 2, "elt") #' # same as x[[1]][[2]][["elt"]] #' #' # By default, pluck() consistently returns `NULL` when an element #' # does not exist: #' pluck(x, 10) #' try(x[[10]]) #' #' # You can also supply a default value for non-existing elements: #' pluck(x, 10, .default = NA) #' #' # The map() functions use pluck() by default to retrieve multiple #' # values from a list: #' map_chr(x, 1) #' map_int(x, c(2, 1)) #' #' # pluck() also supports accessor functions: #' my_element <- function(x) x[[2]]$elt #' pluck(x, 1, my_element) #' pluck(x, 2, my_element) #' #' # Even for this simple data structure, this is more readable than #' # the alternative form because it requires you to read both from #' # right-to-left and from left-to-right in different parts of the #' # expression: #' my_element(x[[1]]) #' #' # If you have a list of accessors, you can splice those in with `!!!`: #' idx <- list(1, my_element) #' pluck(x, !!!idx) pluck <- function(.x, ..., .default = NULL) { check_dots_unnamed() pluck_raw(.x, list2(...), .default = .default) } #' @rdname pluck #' @inheritParams modify_in #' @export `pluck<-` <- function(.x, ..., value) { assign_in(.x, list2(...), value) } #' @rdname pluck #' @export pluck_exists <- function(.x, ...) { check_dots_unnamed() !is_zap(pluck_raw(.x, list2(...), .default = zap())) } pluck_raw <- function(.x, index, .default = NULL) { .Call( pluck_impl, x = .x, index = index, missing = .default, strict = FALSE ) } #' Get an element deep within a nested data structure, failing if it doesn't #' exist #' #' `chuck()` implements a generalised form of `[[` that allow you to index #' deeply and flexibly into data structures. If the index you are trying to #' access does not exist (or is `NULL`), it will throw (i.e. chuck) an error. #' #' @seealso [pluck()] for a quiet equivalent. #' @inheritParams pluck #' @export #' @examples #' x <- list(a = 1, b = 2) #' #' # When indexing an element that doesn't exist `[[` sometimes returns NULL: #' x[["y"]] #' # and sometimes errors: #' try(x[[3]]) #' #' # chuck() consistently errors: #' try(chuck(x, "y")) #' try(chuck(x, 3)) chuck <- function(.x, ...) { check_dots_unnamed() .Call( pluck_impl, x = .x, index = list2(...), missing = NULL, strict = TRUE ) } #' Create an attribute getter function #' #' `attr_getter()` generates an attribute accessor function; i.e., it #' generates a function for extracting an attribute with a given #' name. Unlike the base R `attr()` function with default options, it #' doesn't use partial matching. #' #' @param attr An attribute name as string. #' #' @seealso [pluck()] #' @examples #' # attr_getter() takes an attribute name and returns a function to #' # access the attribute: #' get_rownames <- attr_getter("row.names") #' get_rownames(mtcars) #' #' # These getter functions are handy in conjunction with pluck() for #' # extracting deeply into a data structure. Here we'll first #' # extract by position, then by attribute: #' obj1 <- structure("obj", obj_attr = "foo") #' obj2 <- structure("obj", obj_attr = "bar") #' x <- list(obj1, obj2) #' #' pluck(x, 1, attr_getter("obj_attr")) # From first object #' pluck(x, 2, attr_getter("obj_attr")) # From second object #' @export attr_getter <- function(attr) { force(attr) function(x) attr(x, attr, exact = TRUE) } purrr/R/adverb-compose.R0000644000176200001440000000457115063325731014672 0ustar liggesusers#' Compose multiple functions together to create a new function #' #' Create a new function that is the composition of multiple functions, #' i.e. `compose(f, g)` is equivalent to `function(...) f(g(...))`. #' #' @param ... Functions to apply in order (from right to left by #' default). Formulas are converted to functions in the usual way. #' #' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if #' your functions are stored in a list, you can splice that in with #' `!!!`. #' @param .dir If `"backward"` (the default), the functions are called #' in the reverse order, from right to left, as is conventional in #' mathematics. If `"forward"`, they are called from left to right. #' @inheritSection safely Adverbs #' @family adverbs #' @return A function #' @export #' @examples #' not_null <- compose(`!`, is.null) #' not_null(4) #' not_null(NULL) #' #' add1 <- function(x) x + 1 #' compose(add1, add1)(8) #' #' fn <- compose(\(x) paste(x, "foo"), \(x) paste(x, "bar")) #' fn("input") #' #' # Lists of functions can be spliced with !!! #' fns <- list( #' function(x) paste(x, "foo"), #' \(x) paste(x, "bar") #' ) #' fn <- compose(!!!fns) #' fn("input") compose <- function(..., .dir = c("backward", "forward")) { .dir <- arg_match0(.dir, c("backward", "forward")) fns <- map(list2(...), rlang::as_closure, env = caller_env()) if (!length(fns)) { # Return the identity function return(compose(function(x, ...) x)) } if (.dir == "backward") { n <- length(fns) first_fn <- fns[[n]] fns <- rev(fns[-n]) } else { first_fn <- fns[[1]] fns <- fns[-1] } composed <- function() { env <- env(caller_env(), `_fn` = first_fn) first_call <- sys.call() first_call[[1]] <- quote(`_fn`) env$`_out` <- .Call(purrr_eval, first_call, env) call <- quote(`_fn`(`_out`)) for (fn in fns) { env$`_fn` <- fn env$`_out` <- .Call(purrr_eval, call, env) } env$`_out` } formals(composed) <- formals(first_fn) structure( composed, class = c("purrr_function_compose", "function"), first_fn = first_fn, fns = fns ) } #' @export print.purrr_function_compose <- function(x, ...) { cat("\n") first <- attr(x, "first_fn") cat("1. ") print(first, ...) fns <- attr(x, "fns") for (i in seq_along(fns)) { cat(sprintf("\n%d. ", i + 1)) print(fns[[i]], ...) } invisible(x) } purrr/R/list-modify.R0000644000176200001440000000757315063325731014231 0ustar liggesusers#' Modify a list #' #' @description #' * `list_assign()` modifies the elements of a list by name or position. #' * `list_modify()` modifies the elements of a list recursively. #' * `list_merge()` merges the elements of a list recursively. #' #' `list_modify()` is inspired by [utils::modifyList()]. #' #' @param .x List to modify. #' @param ... New values of a list. Use `zap()` to remove values. #' #' These values should be either all named or all unnamed. When #' inputs are all named, they are matched to `.x` by name. When they #' are all unnamed, they are matched by position. #' #' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if your #' replacement values are stored in a list, you can splice that in with #' `!!!`. #' @inheritParams map_depth #' @export #' @examples #' x <- list(x = 1:10, y = 4, z = list(a = 1, b = 2)) #' str(x) #' #' # Update values #' str(list_assign(x, a = 1)) #' #' # Replace values #' str(list_assign(x, z = 5)) #' str(list_assign(x, z = NULL)) #' str(list_assign(x, z = list(a = 1:5))) #' #' # Replace recursively with list_modify(), leaving the other elements of z alone #' str(list_modify(x, z = list(a = 1:5))) #' #' # Remove values #' str(list_assign(x, z = zap())) #' #' # Combine values with list_merge() #' str(list_merge(x, x = 11, z = list(a = 2:5, c = 3))) #' #' # All these functions support dynamic dots features. Use !!! to splice #' # a list of arguments: #' l <- list(new = 1, y = zap(), z = 5) #' str(list_assign(x, !!!l)) list_assign <- function(.x, ..., .is_node = NULL) { check_list(.x) y <- dots_list(..., .named = NULL, .homonyms = "error") list_recurse(.x, y, function(x, y) y, recurse = FALSE, is_node = .is_node) } #' @export #' @rdname list_assign list_modify <- function(.x, ..., .is_node = NULL) { check_list(.x) y <- dots_list(..., .named = NULL, .homonyms = "error") list_recurse(.x, y, function(x, y) y, is_node = .is_node) } #' @export #' @rdname list_assign list_merge <- function(.x, ..., .is_node = NULL) { check_list(.x) y <- dots_list(..., .named = NULL, .homonyms = "error") list_recurse(.x, y, c, is_node = .is_node) } list_recurse <- function( x, y, base_f, recurse = TRUE, error_call = caller_env(), is_node = NULL ) { is_node <- as_is_node( is_node, error_call = error_call, error_arg = ".is_node" ) if (!is_null(names(y)) && !is_named(y)) { cli::cli_abort( "`...` arguments must be either all named or all unnamed.", call = error_call ) } idx <- names(y) %||% rev(seq_along(y)) for (i in idx) { x_i <- pluck(x, i) y_i <- pluck(y, i) if (is_zap(y_i)) { x[[i]] <- NULL } else if (recurse && is_node(x_i) && is_node(y_i)) { list_slice2(x, i) <- list_recurse(x_i, y_i, base_f) } else { list_slice2(x, i) <- base_f(x_i, y_i) } } x } check_list <- function(x, call = caller_env(), arg = caller_arg(x)) { if (!is.list(x)) { cli::cli_abort( "{.arg {arg}} must be a list, not {.obj_type_friendly {x}}.", call = call, arg = arg ) } } #' Update a list with formulas #' #' @description #' `r lifecycle::badge("deprecated")` #' #' `update_list()` was deprecated in purrr 1.0.0, because we no longer believe #' that functions that use NSE are a good fit for purrr. #' #' `update_list()` handles formulas and quosures that can refer to #' values existing within the input list. This function is deprecated #' because we no longer believe that functions that use tidy evaluation are #' a good fit for purrr. #' #' @inheritParams list_modify #' @export #' @keywords internal update_list <- function(.x, ...) { lifecycle::deprecate_warn("1.0.0", "update_list()") dots <- dots_list(...) formulas <- map_lgl(dots, is_bare_formula, lhs = FALSE, scoped = TRUE) dots <- map_if(dots, formulas, as_quosure) dots <- map_if(dots, is_quosure, eval_tidy, data = .x) list_recurse(.x, dots, function(x, y) y) } purrr/R/rate.R0000644000176200001440000001347615063325731012723 0ustar liggesusers#' Create delaying rate settings #' #' These helpers create rate settings that you can pass to [insistently()] and #' [slowly()]. You can also use them in your own functions with [rate_sleep()]. #' #' @param max_times Maximum number of requests to attempt. #' @param jitter Whether to introduce a random jitter in the waiting time. #' @examples #' # A delay rate waits the same amount of time: #' rate <- rate_delay(0.02) #' for (i in 1:3) rate_sleep(rate, quiet = FALSE) #' #' # A backoff rate waits exponentially longer each time, with random #' # jitter by default: #' rate <- rate_backoff(pause_base = 0.2, pause_min = 0.005) #' for (i in 1:3) rate_sleep(rate, quiet = FALSE) #' @name rate-helpers NULL #' @rdname rate-helpers #' @param pause Delay between attempts in seconds. #' @export rate_delay <- function(pause = 1, max_times = Inf) { check_number_decimal(pause, allow_infinite = TRUE, min = 0) new_rate( "purrr_rate_delay", pause = pause, max_times = max_times, jitter = FALSE ) } #' @rdname rate-helpers #' @param pause_base,pause_cap `rate_backoff()` uses an exponential #' back-off so that each request waits `pause_base * 2^i` seconds, #' up to a maximum of `pause_cap` seconds. #' @param pause_min Minimum time to wait in the backoff; generally #' only necessary if you need pauses less than one second (which may #' not be kind to the server, use with caution!). #' @export rate_backoff <- function( pause_base = 1, pause_cap = 60, pause_min = 1, max_times = 3, jitter = TRUE ) { check_number_decimal(pause_base, min = 0) check_number_decimal(pause_cap, allow_infinite = TRUE, min = 0) check_number_decimal(pause_min, allow_infinite = TRUE, min = 0) check_number_whole(max_times, min = 1) check_bool(jitter) new_rate( "purrr_rate_backoff", pause_base = pause_base, pause_cap = pause_cap, pause_min = pause_min, max_times = max_times, jitter = jitter ) } new_rate <- function(.subclass, ..., jitter = TRUE, max_times = 3) { stopifnot( is_bool(jitter), is_number(max_times) || identical(max_times, Inf) ) rate <- list( ..., state = env(i = 0L), jitter = jitter, max_times = max_times ) structure( rate, class = c(.subclass, "purrr_rate") ) } #' @rdname rate-helpers #' @param x An object to test. #' @export is_rate <- function(x) { inherits(x, "purrr_rate") } #' @export print.purrr_rate_delay <- function(x, ...) { cli::cli_text("") cli::cli_bullets(c( " " = "Attempts: {rate_count(x)}/{x$max_times}", " " = "{.field pause}: {x$pause}" )) invisible(x) } #' @export print.purrr_rate_backoff <- function(x, ...) { cli::cli_text("") cli::cli_bullets(c( " " = "Attempts: {rate_count(x)}/{x$max_times}", " " = "{.field pause_base}: {x$pause_base}", " " = "{.field pause_cap}: {x$pause_cap}", " " = "{.field pause_min}: {x$pause_min}" )) invisible(x) } #' Wait for a given time #' #' If the rate's internal counter exceeds the maximum number of times #' it is allowed to sleep, `rate_sleep()` throws an error of class #' `purrr_error_rate_excess`. #' #' Call `rate_reset()` to reset the internal rate counter to 0. #' #' @param rate A [rate][rate_backoff] object determining the waiting time. #' @param quiet If `FALSE`, prints a message displaying how long until #' the next request. #' #' @seealso [rate_backoff()], [insistently()] #' @keywords internal #' @export rate_sleep <- function(rate, quiet = TRUE) { stopifnot(is_rate(rate)) i <- rate_count(rate) if (i > rate$max_times) { stop_rate_expired(rate) } if (i == rate$max_times) { stop_rate_excess(rate) } if (i == 0L) { rate_bump_count(rate) signal_rate_init(rate) return(invisible()) } on.exit(rate_bump_count(rate)) UseMethod("rate_sleep") } #' @export rate_sleep.purrr_rate_backoff <- function(rate, quiet = TRUE) { i <- rate_count(rate) pause_max <- min(rate$pause_cap, rate$pause_base * 2^i) if (rate$jitter) { pause_max <- stats::runif(1, 0, pause_max) } length <- max(rate$pause_min, pause_max) rate_sleep_impl(rate, length, quiet) } #' @export rate_sleep.purrr_rate_delay <- function(rate, quiet = TRUE) { rate_sleep_impl(rate, rate$pause, quiet) } rate_sleep_impl <- function(rate, length, quiet) { if (!quiet) { signal_rate_retry(rate, length, quiet) } Sys.sleep(length) } #' @rdname rate_sleep #' @export rate_reset <- function(rate) { stopifnot(is_rate(rate)) rate$state$i <- 0L invisible(rate) } rate_count <- function(rate) { rate$state$i } rate_bump_count <- function(rate, n = 1L) { rate$state$i <- rate$state$i + n invisible(rate) } signal_rate_init <- function(rate) { signal("", "purrr_condition_rate_init", rate = rate) } signal_rate_retry <- function(rate, length, quiet) { msg <- sprintf("Retrying in %s seconds.", format(length, digits = 2)) class <- "purrr_message_rate_retry" if (quiet) { signal(msg, class, rate = rate, length = length) } else { inform(msg, class, rate = rate, length = length) } } stop_rate_expired <- function(rate, error_call = caller_env()) { cli::cli_abort( c( "This `rate` object has already be run more than `max_times` allows.", i = "Do you need to reset it with `rate_reset()`?" ), class = "purrr_error_rate_expired", call = error_call ) } stop_rate_excess <- function(rate, error_call = caller_env()) { i <- rate_count(rate) # Bump counter to get an expired error next time around rate_bump_count(rate) cli::cli_abort( "Request failed after {i} attempts.", class = "purrr_error_rate_excess", call = error_call ) } check_rate <- function(rate, error_call = caller_env()) { if (!is_rate(rate)) { cli::cli_abort( "{.arg rate} must be a rate object, not {.obj_type_friendly {rate}}.", arg = "rate", call = error_call, ) } } purrr/vignettes/0000755000176200001440000000000015166146732013447 5ustar liggesuserspurrr/vignettes/other-langs.Rmd0000644000176200001440000000403215163460322016324 0ustar liggesusers--- title: "Functional programming in other languages" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Functional programming in other languages} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- purrr draws inspiration from many related tools: * List operations defined in the Haskell [prelude][haskell] * Scala's [list methods][scala]. * Functional programming libraries for javascript: [underscore.js](http://underscorejs.org), [lodash](https://lodash.com) and [lazy.js](http://danieltao.com/lazy.js/). * [rlist](https://renkun-ken.github.io/rlist/), another R package to support working with lists. Similar goals but somewhat different philosophy. However, the goal of purrr is not to try and simulate a purer functional programming language in R; we don't want to implement a second-class version of Haskell in R. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R: * Instead of point free (tacit) style, we use the pipe, `|>`, to write code that can be read from left to right. * Instead of currying, we use `...` to pass in extra arguments. * Before R 4.1, anonymous functions were verbose, so we provided a convenient shorthand. For unary functions, `~ .x + 1` is equivalent to `function(.x) .x + 1`. Now we recommend using the function shorthand notation introduced in R 4.1, where `\(x) x + 1` is equivalent to `function(x) x + 1`. * R is weakly typed, so we need `map` variants that describe the output type (like `map_int()`, `map_dbl()`, etc) because we don't know the return type of `.f`. * R has named arguments, so instead of providing different functions for minor variations (e.g. `detect()` and `detectLast()`) we use a named argument, `.right`. Type-stable functions are easy to reason about so additional arguments will never change the type of the output. [scala]:https://www.scala-lang.org/api/current/index.html [haskell]:http://hackage.haskell.org/package/base-4.7.0.1/docs/Prelude.html#g:11 purrr/vignettes/base.Rmd0000644000176200001440000003510615163460322015021 0ustar liggesusers--- title: "purrr <-> base R" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{purrr <-> base R} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 4.5, fig.align = "center" ) options(tibble.print_min = 6, tibble.print_max = 6) ``` # Introduction This vignette compares purrr's functionals to their base R equivalents, focusing primarily on the map family and related functions. This helps those familiar with base R understand better what purrr does, and shows purrr users how you might express the same ideas in base R code. We'll start with a rough overview of the major differences, give a rough translation guide, and then show a few examples. ```{r setup} library(purrr) library(tibble) ``` ## Key differences There are two primary differences between the base apply family and the purrr map family: purrr functions are named more consistently, and more fully explore the space of input and output variants. - purrr functions consistently use `.` as prefix to avoid [inadvertently matching arguments](https://adv-r.hadley.nz/functionals.html#argument-names) of the purrr function, instead of the function that you're trying to call. Base functions use a variety of techniques including upper case (e.g. `lapply(X, FUN, ...)`) or require anonymous functions (e.g. `Map()`). - All map functions are type stable: you can predict the type of the output using little information about the inputs. In contrast, the base functions `sapply()` and `mapply()` automatically simplify making the return value hard to predict. - The map functions all start with the data, followed by the function, then any additional constant argument. Most base apply functions also follow this pattern, but `mapply()` starts with the function, and `Map()` has no way to supply additional constant arguments. - purrr functions provide all combinations of input and output variants, and include variants specifically for the common two argument case. ## Direct translations The following sections give a high-level translation between base R commands and their purrr equivalents. See function documentation for the details. ### `Map` functions Here `x` denotes a vector and `f` denotes a function | Output | Input | Base R | purrr | |------------------|------------------|------------------|-------------------| | List | 1 vector | `lapply()` | `map()` | | List | 2 vectors | `mapply()`, `Map()` | `map2()` | | List | \>2 vectors | `mapply()`, `Map()` | `pmap()` | | Atomic vector of desired type | 1 vector | `vapply()` | `map_lgl()` (logical), `map_int()` (integer), `map_dbl()` (double), `map_chr()` (character), `map_vec()` (other vectors) | | Atomic vector of desired type | 2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `map2_lgl()` (logical), `map2_int()` (integer), `map2_dbl()` (double), `map2_chr()` (character), `map2_vec()` (other vectors) | | Atomic vector of desired type | \>2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `pmap_lgl()` (logical), `pmap_int()` (integer), `pmap_dbl()` (double), `pmap_chr()` (character), `pmap_vec()` (other vectors) | | Side effect only | 2 vectors | loops | `walk2()` | | Side effect only | 1 vector | loops | `walk()` | | Side effect only | \>2 vectors | loops | `pwalk()` | | Data frame (`rbind` outputs) | 1 vector | `lapply()` then `rbind()` | `map()` then `list_rbind()` | | Data frame (`rbind` outputs) | 2 vectors | `mapply()`/`Map()` then `rbind()` | `map2()` then `list_rbind()` | | Data frame (`rbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `rbind()` | `pmap()` then `list_rbind()` | | Data frame (`cbind` outputs) | 1 vector | `lapply()` then `cbind()` | `map()` then `list_cbind()` | | Data frame (`cbind` outputs) | 2 vectors | `mapply()`/`Map()` then `cbind()` | `map2()` then `list_cbind()` | | Data frame (`cbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `cbind()` | `pmap()` then `list_cbind()` | | Any | Vector and its names | `l/s/vapply(X, function(x) f(x, names(x)))` or `mapply/Map(f, x, names(x))` | `imap()`, `imap_*()` (`lgl`, `dbl`, `chr`, and etc. just like for `map()`, `map2()`, and `pmap()`) | | Any | Selected elements of the vector | `l/s/vapply(X[index], FUN, ...)` | `map_if()`, `map_at()` | | List | Recursively apply to list within list | `rapply()` | `map_depth()` | | List | List only | `lapply()` | `lmap()`, `lmap_at()`, `lmap_if()` | ### Extractor shorthands Since a common use case for map functions is list extracting components, purrr provides a handful of shortcut functions for various uses of `[[`. | Input | base R | purrr | |-------------------|--------------------------|---------------------------| | Extract by name | `` lapply(x, `[[`, "a") `` | `map(x, "a")` | | Extract by position | `` lapply(x, `[[`, 3) `` | `map(x, 3)` | | Extract deeply | `lapply(x, \(y) y[[1]][["x"]][[3]])` | `map(x, list(1, "x", 3))` | | Extract with default value | `lapply(x, function(y) tryCatch(y[[3]], error = function(e) NA))` | `map(x, 3, .default = NA)` | ### Predicates Here `p`, a predicate, denotes a function that returns `TRUE` or `FALSE` indicating whether an object fulfills a criterion, e.g. `is.character()`. | Description | base R | purrr | |-----------------------------|--------------------|-----------------------| | Find a matching element | `Find(p, x)` | `detect(x, p)`, | | Find position of matching element | `Position(p, x)` | `detect_index(x, p)` | | Do all elements of a vector satisfy a predicate? | `all(sapply(x, p))` | `every(x, p)` | | Does any elements of a vector satisfy a predicate? | `any(sapply(x, p))` | `some(x, p)` | | Does a list contain an object? | `any(sapply(x, identical, obj))` | `has_element(x, obj)` | | Keep elements that satisfy a predicate | `x[sapply(x, p)]` | `keep(x, p)` | | Discard elements that satisfy a predicate | `x[!sapply(x, p)]` | `discard(x, p)` | | Negate a predicate function | `function(x) !p(x)` | `negate(p)` | ### Other vector transforms | Description | base R | purrr | |-----------------------------|--------------------|-----------------------| | Accumulate intermediate results of a vector reduction | `Reduce(f, x, accumulate = TRUE)` | `accumulate(x, f)` | | Recursively combine two lists | `c(X, Y)`, but more complicated to merge recursively | `list_merge()`, `list_modify()` | | Reduce a list to a single value by iteratively applying a binary function | `Reduce(f, x)` | `reduce(x, f)` | ## Examples ### Varying inputs #### One input Suppose we would like to generate a list of samples of 5 from normal distributions with different means: ```{r} means <- 1:4 ``` There's little difference when generating the samples: - Base R uses `lapply()`: ```{r} set.seed(2020) samples <- lapply(means, rnorm, n = 5, sd = 1) str(samples) ``` - purrr uses `map()`: ```{r} set.seed(2020) samples <- map(means, rnorm, n = 5, sd = 1) str(samples) ``` #### Two inputs Lets make the example a little more complicated by also varying the standard deviations: ```{r} means <- 1:4 sds <- 1:4 ``` - This is relatively tricky in base R because we have to adjust a number of `mapply()`'s defaults. ```{r} set.seed(2020) samples <- mapply( rnorm, mean = means, sd = sds, MoreArgs = list(n = 5), SIMPLIFY = FALSE ) str(samples) ``` Alternatively, we could use `Map()` which doesn't simplify, but also doesn't take any constant arguments, so we need to use an anonymous function: ```{r} samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds) ``` In R 4.1 and up, you could use the shorter anonymous function form: ```{r} samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds) ``` - Working with a pair of vectors is a common situation so purrr provides the `map2()` family of functions: ```{r} set.seed(2020) samples <- map2(means, sds, rnorm, n = 5) str(samples) ``` #### Any number of inputs We can make the challenge still more complex by also varying the number of samples: ```{r} ns <- 4:1 ``` - Using base R's `Map()` becomes more straightforward because there are no constant arguments. ```{r} set.seed(2020) samples <- Map(rnorm, mean = means, sd = sds, n = ns) str(samples) ``` - In purrr, we need to switch from `map2()` to `pmap()` which takes a list of any number of arguments. ```{r} set.seed(2020) samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm) str(samples) ``` ### Outputs Given the samples, imagine we want to compute their means. A mean is a single number, so we want the output to be a numeric vector rather than a list. - There are two options in base R: `vapply()` or `sapply()`. `vapply()` requires you to specific the output type (so is relatively verbose), but will always return a numeric vector. `sapply()` is concise, but if you supply an empty list you'll get a list instead of a numeric vector. ```{r} # type stable medians <- vapply(samples, median, FUN.VALUE = numeric(1L)) medians # not type stable medians <- sapply(samples, median) ``` - purrr is little more compact because we can use `map_dbl()`. ```{r} medians <- map_dbl(samples, median) medians ``` What if we want just the side effect, such as a plot or a file output, but not the returned values? - In base R we can either use a for loop or hide the results of `lapply`. ```{r, fig.show='hide'} # for loop for (s in samples) { hist(s, xlab = "value", main = "") } # lapply invisible(lapply(samples, function(s) { hist(s, xlab = "value", main = "") })) ``` - In purrr, we can use `walk()`. ```{r, fig.show='hide'} walk(samples, ~ hist(.x, xlab = "value", main = "")) ``` ### Pipes You can join multiple steps together with the pipe: ```{r} set.seed(2020) means |> map(rnorm, n = 5, sd = 1) |> map_dbl(median) ``` The pipe is particularly compelling when working with longer transformations. For example, the following code splits `mtcars` up by `cyl`, fits a linear model, extracts the coefficients, and extracts the first one (the intercept). ```{r} mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df))|> map(coef) |> map_dbl(1) ``` purrr/vignettes/purrr.Rmd0000644000176200001440000002410215163460322015253 0ustar liggesusers--- title: "Get started with purrr" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Get started with purrr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ## Introduction purrr helps you write cleaner, more maintainable R code through functional programming concepts. But what is functional programming? At its core, it's an approach to programming that emphasizes using functions to transform data, similar to how you might use a series of tools to process raw materials into a final product. Instead of writing loops and modifying data step by step, functional programming encourages you to think about your data transformations as a series of function applications. This notion is rather abstract, but we believe mastering functional programming makes your code clearer and less prone to errors. You'll hopefully get some sense of that by the end of this vignette! This vignette discusses two of the most important parts of purrr: map functions and predicate functions. ```{r} library(purrr) ``` ## Map: A better way to loop `map()`[^1] provides a more compact way to apply functions to each element of a vector, returning a list: [^1]: You might wonder why this function is called `map()`. What does it have to do with depicting physical features of land or sea 🗺? In fact, the meaning comes from mathematics where map refers to "an operation that associates each element of a given set with one or more elements of a second set". This makes sense here because `map()` defines a mapping from one vector to another. And "map" also has the nice property of being short, which is useful for such a fundamental building block. ```{r} x <- 1:3 triple <- function(x) x * 3 out <- map(x, triple) str(out) ``` Or written with the pipe: ```{r} x |> map(triple) |> str() ``` This is equivalent to a for loop: ```{r} out <- vector("list", 3) for (i in seq_along(x)) { out[[i]] <- triple(x[[i]]) } str(out) ``` Even on its own, there are some benefits to `map()`: once you get used to the syntax, it's a very compact way to express the idea of transforming a vector, returning one output element for each input element. But there are several other reasons to use `map()`, which we'll explore in the following sections: - Progress bars - Parallel computing - Output variants - Input variants ### Progress bars For long-running jobs, like web scraping, model fitting, or data processing, it's really useful to get a progress bar that helps you estimate how long you'll need to wait. Progress bars are easy to enable in purrr: just set `.progress = TRUE`. It's hard to illustrate progress bars in a vignette, but you can try this example interactively: ```{r} #| eval: false out <- map(1:100, \(i) Sys.sleep(0.5), .progress = TRUE) ``` Learn more about progress bars in `?progress_bars`. ### Parallel computing By default, `map()` runs only in your current R session. But you can easily opt in to spreading your task across multiple R sessions, and hence multiple cores with `in_parallel()`. This can give big performance improvements if your task is primarily bound by compute performance. purrr's parallelism is powered by mirai, so to begin, you need to start up a number of background R sessions, called **daemons**: ```{r} #| eval: false mirai::daemons(6) ``` ```{r} #| echo: false mirai::daemons(sync = TRUE) ``` (You only need to do this once per session.) Now you can easily convert your `map()` call to run in parallel: ```{r} out <- map(1:5, in_parallel(\(i) Sys.sleep(0.5))) ``` It's important to realize that this parallelism works by spreading computation across clean R sessions. That means that code like this will not work, because the worker daemons won't have a copy of `my_lm()`: ```{r} #| error: true my_lm <- function(formula, data) { Sys.sleep(0.5) lm(formula, data) } by_cyl <- split(mtcars, mtcars$cyl) out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df))) ``` You can resolve this by passing additional data along to `in_parallel()`: ```{r} out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df), my_lm = my_lm)) ``` Learn more about parallel computing in `?in_parallel`. ```{r} #| echo: false mirai::daemons(0) ``` ### Output variants purrr functions are type-stable, which means it's easy to predict what type of output they return, e.g., `map()` always returns a list. But what if you want a different type of output? That's where the output variants come into play: - There are four variants for the four most important types of atomic vector: - `map_lgl()` returns a logical vector. - `map_int()` returns an integer vector. - `map_dbl()` returns a numeric (double) vector. - `map_chr()` returns a character vector. - For all other types of vector (like dates, date-times, factors, etc.), there's `map_vec()`. It's a little harder to precisely describe the output type, but if your function returns a length-1 vector of type "foo", then the output of `map_vec()` will be a length-n vector of type "foo". - `modify()` returns output with the same type as the input. For example, if the input is a data frame, the output will also be a data frame. - `walk()` returns the input (invisibly); it's useful when you're calling a function purely for its side effects, for example, generating plots or saving files. purrr, like many tidyverse functions, is designed to help you solve complex problems by stringing together simple pieces. This is particularly natural to do with the pipe. For example, the following code splits `mtcars` into one data frame for each value of `cyl`, fits a linear model to each subset, computes the model summary, and then extracts the R-squared: ```{r} mtcars |> split(mtcars$cyl) |> # from base R map(\(df) lm(mpg ~ wt, data = df)) |> map(summary) |> map_dbl(\(x) x$r.squared) ``` ### Input variants `map()` and friends all iterate over a single list, making it poorly suited for some problems. For example, how would you find a weighted mean when you have a list of observations and a list of weights? Imagine we have the following data: ```{r} xs <- map(1:8, ~ runif(10)) xs[[1]][[1]] <- NA ws <- map(1:8, ~ rpois(10, 5) + 1) ``` We could use `map_dbl()` to compute unweighted means: ```{r} map_dbl(xs, mean) ``` But there's no way to use `map()` to compute a weighted mean because we need to call `weighted.mean(xs[[1]], ws[[1]])`, `weighted.mean(xs[[2]], ws[[2]])`, etc. That's the job of `map2()`: ```{r} map2_dbl(xs, ws, weighted.mean) ``` Note that the arguments that vary for each call come before the function and arguments that are constant come after the function: ```{r} map2_dbl(xs, ws, weighted.mean, na.rm = TRUE) ``` But we generally recommend using an anonymous function instead, as this makes it very clear where each argument is going: ```{r} #| eval: false map2_dbl(xs, ws, \(x, w) weighted.mean(x, w, na.rm = TRUE)) ``` There are two important variants of `map2()`: `pmap()` which can take any number of varying arguments (passed as a list), and `imap()` which iterates over the values and indices of a single vector. Learn more in their documentation. ### Combinatorial explosion What makes purrr particularly special is that all of the above features (progress bars, parallel computing, output variants, and input variants) can be combined any way that you choose. The combination of inputs (prefixes) and outputs (suffixes) forms a matrix, and you can use `.progress` or `in_parallel()` with any of them: | Output type | Single input (`.x`) | Two inputs (`.x`, `.y`) | Multiple inputs (`.l`) | |-----------------|-----------------|-------------------|--------------------| | **List** | `map(.x, .f)` | `map2(.x, .y, .f)` | `pmap(.l, .f)` | | **Logical** | `map_lgl(.x, .f)` | `map2_lgl(.x, .y, .f)` | `pmap_lgl(.l, .f)` | | **Integer** | `map_int(.x, .f)` | `map2_int(.x, .y, .f)` | `pmap_int(.l, .f)` | | **Double** | `map_dbl(.x, .f)` | `map2_dbl(.x, .y, .f)` | `pmap_dbl(.l, .f)` | | **Character** | `map_chr(.x, .f)` | `map2_chr(.x, .y, .f)` | `pmap_chr(.l, .f)` | | **Vector** | `map_vec(.x, .f)` | `map_vec(.x, .y, .f)` | `map_vec(.l, .f)` | | **Input** | `walk(.x, .f)` | `walk2(.x, .y, .f)` | `pwalk(.l, .f)` | ## Filtering and finding with predicates purrr provides a number of functions that work with predicate functions. Predicate functions take a vector and return either `TRUE` or `FALSE`, with examples including `is.character()` and `\(x) any(is.na(x))`. You typically use them to filter or find; for example, you could use them to locate the first element of a list that's a character vector, or only keep the columns in a data frame that have missing values. purrr comes with a bunch of helpers to make predicate functions easier to use: - `detect(.x, .p)` returns the value of the first element in `.x` where `.p` is `TRUE`. - `detect_index(.x, .p)` returns the position of the first element in `.x` where `.p` is `TRUE`. - `keep(.x, .p)` returns all elements from `.x` where `.p` evaluates to `TRUE`. - `discard(.x, .p)` returns all elements from `.x` where `.p` evaluates to `FALSE`. - `every(.x, .p)` returns `TRUE` if `.p` returns `TRUE` for every element in `.x`. - `some(.x, .p)` returns `TRUE` if `.p` returns `TRUE` for at least one element in `.x`. - `none(.x, .p)` returns `TRUE` if `.p` returns `FALSE` for all elements in `.x`. - `head_while(.x, .p)` returns elements from the beginning of `.x` while `.p` is `TRUE`, stopping at the first `FALSE`. - `tail_while(.x, .p)` returns elements from the end of `.x` while `.p` is `TRUE`, stopping at the first `FALSE`. You'll typically use these functions with lists, since you can usually rely on vectorization for simpler vectors. ```{r} x <- list( a = letters[1:10], b = 1:10, c = runif(15) ) x |> detect(is.character) x |> detect_index(is.numeric) x |> keep(is.numeric) |> str() x |> discard(is.numeric) |> str() x |> every(\(x) length(x) > 10) x |> some(\(x) length(x) > 10) x |> none(\(x) length(x) == 0) ``` purrr/src/0000755000176200001440000000000015166146732012226 5ustar liggesuserspurrr/src/map.h0000644000176200001440000000072114326707000013140 0ustar liggesusers#ifndef MAP_H #define MAP_H extern "C" { SEXP map_impl(SEXP env, SEXP ffi_type, SEXP progress, SEXP ffi_n, SEXP names, SEXP i); SEXP pmap_impl(SEXP env, SEXP ffi_type, SEXP progress, SEXP ffi_n, SEXP names, SEXP i, SEXP call_names, SEXP ffi_call_n); } #endif purrr/src/coerce.c0000644000176200001440000000741415063325731013632 0ustar liggesusers#define R_NO_REMAP #include #include #include #include "conditions.h" void cant_coerce(SEXP from, SEXP to, int i) { const char* to_friendly; switch(TYPEOF(to)) { case INTSXP: to_friendly = "an integer"; break; case REALSXP: to_friendly = "a double"; break; case STRSXP: to_friendly = "a string"; break; case LGLSXP: to_friendly = "a logical"; break; case RAWSXP: to_friendly = "a raw vector"; break; default: to_friendly = Rf_type2char(TYPEOF(to)); } Rf_errorcall( R_NilValue, "Can't coerce from %s to %s.", rlang_obj_type_friendly_full(from, false, false), to_friendly ); } int real_to_logical(double x, SEXP from, SEXP to, int i) { if (R_IsNA(x)) { return NA_LOGICAL; } else if (x == 0) { return 0; } else if (x == 1) { return 1; } else { cant_coerce(from, to, i); return 0; } } int real_to_integer(double x, SEXP from, SEXP to, int i) { if (R_IsNA(x)) { return NA_INTEGER; } int out = x; if (out == x) { return out; } else { cant_coerce(from, to, i); return 0; } } int integer_to_logical(double x, SEXP from, SEXP to, int i) { if (x == NA_INTEGER) { return NA_LOGICAL; } else if (x == 0) { return 0; } else if (x == 1) { return 1; } else { cant_coerce(from, to, i); return 0; } } double logical_to_real(int x) { return (x == NA_LOGICAL) ? NA_REAL : x; } double integer_to_real(int x) { return (x == NA_INTEGER) ? NA_REAL : x; } void deprecate_to_char(const char* type_char) { SEXP type = PROTECT(Rf_mkString(type_char)); SEXP fun = PROTECT(Rf_lang3(Rf_install(":::"), Rf_install("purrr"), Rf_install("deprecate_to_char"))); SEXP call = PROTECT(Rf_lang2(fun, type)); Rf_eval(call, R_GlobalEnv); UNPROTECT(3); } SEXP logical_to_char(int x, SEXP from, SEXP to, int i) { if (x == NA_LOGICAL) { return NA_STRING; } else { cant_coerce(from, to, i); return 0; } } void set_vector_value(SEXP to, int i, SEXP from, int j) { switch(TYPEOF(to)) { case LGLSXP: switch(TYPEOF(from)) { case LGLSXP: LOGICAL(to)[i] = LOGICAL(from)[j]; break; case INTSXP: LOGICAL(to)[i] = integer_to_logical(INTEGER(from)[j], from, to, i); break; case REALSXP: LOGICAL(to)[i] = real_to_logical(REAL(from)[j], from, to, i); break; default: cant_coerce(from, to, i); } break; case INTSXP: switch(TYPEOF(from)) { case LGLSXP: INTEGER(to)[i] = LOGICAL(from)[j]; break; case INTSXP: INTEGER(to)[i] = INTEGER(from)[j]; break; case REALSXP: INTEGER(to)[i] = real_to_integer(REAL(from)[j], from, to, i); break; default: cant_coerce(from, to, i); } break; case REALSXP: switch(TYPEOF(from)) { case LGLSXP: REAL(to)[i] = logical_to_real(LOGICAL(from)[j]); break; case INTSXP: REAL(to)[i] = integer_to_real(INTEGER(from)[j]); break; case REALSXP: REAL(to)[i] = REAL(from)[j]; break; default: cant_coerce(from, to, i); } break; case STRSXP: switch(TYPEOF(from)) { case LGLSXP: SET_STRING_ELT(to, i, logical_to_char(LOGICAL(from)[j], from, to, i)); break; case STRSXP: SET_STRING_ELT(to, i, STRING_ELT(from, j)); break; default: cant_coerce(from, to, i); } break; case VECSXP: SET_VECTOR_ELT(to, i, from); break; case RAWSXP: switch(TYPEOF(from)) { case RAWSXP: RAW(to)[i] = RAW(from)[j]; break; default: cant_coerce(from, to, i); } break ; default: cant_coerce(from, to, i); } } SEXP coerce_impl(SEXP x, SEXP type_) { int n = Rf_length(x); SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_))); SEXP out = PROTECT(Rf_allocVector(type, n)); for (int i = 0; i < n; ++i) { set_vector_value(out, i, x, i); } UNPROTECT(1); return out; } purrr/src/utils.c0000644000176200001440000000376115166122162013530 0ustar liggesusers#define R_NO_REMAP #include #include #include #if (defined(R_VERSION) && R_VERSION < R_Version(4, 5, 0)) SEXP R_getVarEx(SEXP symbol, SEXP rho, Rboolean inherits, SEXP ifnotfound) { SEXP out; if (inherits) { out = Rf_findVar(symbol, rho); } else { out = Rf_findVarInFrame(rho, symbol); } if (out == R_UnboundValue) { return ifnotfound; } if (out == R_MissingArg) { const char *name = CHAR(PRINTNAME(symbol)); Rf_error("argument \"%s\" is missing, with no default", name); } if (TYPEOF(out) == PROMSXP) { PROTECT(out); out = Rf_eval(out, R_BaseEnv); UNPROTECT(1); } return out; } SEXP R_getVar(SEXP symbol, SEXP rho, Rboolean inherits) { SEXP out = R_getVarEx(symbol, rho, inherits, R_UnboundValue); if (out == R_UnboundValue) { const char *name = CHAR(PRINTNAME(symbol)); Rf_error("object '%s' not found", name); } return out; } #endif SEXP sym_protect(SEXP x) { if (TYPEOF(x) == LANGSXP || TYPEOF(x) == SYMSXP) { SEXP quote_prim = Rf_eval(Rf_install("quote"), R_BaseEnv); return(Rf_lang2(quote_prim, x)); } else { return x; } } bool is_vector(SEXP x) { switch (TYPEOF(x)) { case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case VECSXP: return true; default: return false; } } SEXP list6(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x) { PROTECT(s); s = Rf_cons(s, Rf_list5(t, u, v, w, x)); UNPROTECT(1); return s; } SEXP lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y) { PROTECT(s); s = Rf_lcons(s, list6(t, u, v, w, x, y)); UNPROTECT(1); return s; } SEXP list7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y) { PROTECT(s); s = Rf_cons(s, list6(t, u, v, w, x, y)); UNPROTECT(1); return s; } SEXP lang8(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y, SEXP z) { PROTECT(s); s = Rf_lcons(s, list7(t, u, v, w, x, y, z)); UNPROTECT(1); return s; } purrr/src/every-some-none.c0000644000176200001440000000545015163460322015415 0ustar liggesusers#define R_NO_REMAP #include #include #include #include "conditions.h" /** * Is `x` a scalar logical? * * Notably we bypass the class and any attributes, i.e. `structure(TRUE, foo = * "bar", class = "my-class")` does count for these purrr functions for * historical reasons. We also ignore any R level `length()` method, but that * would be incredibly rare to see here. */ static inline bool is_scalar_logicalish(SEXP x) { return TYPEOF(x) == LGLSXP && Rf_xlength(x) == 1; } /** * C loop for `every()`, `some()`, and `none()` * * Uses `vctrs_vec_compat()` at the R level so that we can use `vec_size()` to * compute `n`, while also using `[[` to extract elements, which is consistent * with `map()`. */ static SEXP satisfies_predicate( SEXP env, SEXP ffi_n, SEXP ffi_i, int initial, int early_stop ) { const int n = INTEGER_ELT(ffi_n, 0); int* p_i = INTEGER(ffi_i); static SEXP call = NULL; if (call == NULL) { SEXP x_sym = Rf_install(".x"); SEXP p_sym = Rf_install(".p"); SEXP i_sym = Rf_install("i"); // Constructs a call of the form .p(.x[[i]], ...) SEXP x_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, x_sym, i_sym)); call = Rf_lang3(p_sym, x_i_sym, R_DotsSymbol); R_PreserveObject(call); UNPROTECT(1); } // Number of arguments within `call` to force. // Same as `map()`. const int force = 1; int out = initial; for (int i = 0; i < n; ++i) { *p_i = i + 1; if (i % 1024 == 0) { R_CheckUserInterrupt(); } SEXP elt_sexp = PROTECT(R_forceAndCall(call, force, env)); if (!is_scalar_logicalish(elt_sexp)) { // We don't pass `.purrr_error_call` through `.Call()` so we can avoid // evaluating it when it isn't needed, so we have to retrieve it when // required. SEXP error_call = PROTECT(Rf_eval(Rf_install(".purrr_error_call"), env)); r_abort_call( error_call, "`.p()` must return a single `TRUE`, `FALSE`, or `NA`, not %s.", rlang_obj_type_friendly_full(elt_sexp, true, false) ); } const int elt = LOGICAL_ELT(elt_sexp, 0); UNPROTECT(1); if (elt == early_stop) { // Early exit out = !initial; break; } if (elt == NA_LOGICAL) { // Propagate `NA`, but keep going out = NA_LOGICAL; } } *p_i = 0; return Rf_ScalarLogical(out); } SEXP every_impl(SEXP ffi_env, SEXP ffi_n, SEXP ffi_i) { return satisfies_predicate(ffi_env, ffi_n, ffi_i, /*initial=*/ true, /*early_stop=*/ false); } SEXP some_impl(SEXP ffi_env, SEXP ffi_n, SEXP ffi_i) { return satisfies_predicate(ffi_env, ffi_n, ffi_i, /*initial=*/ false, /*early_stop=*/ true); } SEXP none_impl(SEXP ffi_env, SEXP ffi_n, SEXP ffi_i) { return satisfies_predicate(ffi_env, ffi_n, ffi_i, /*initial=*/ true, /*early_stop=*/ true); } purrr/src/coerce.h0000644000176200001440000000025313426303100013614 0ustar liggesusers#ifndef COERCE_H #define COERCE_H // Set value of to[i] to from[j], coercing vectors using usual rules. void set_vector_value(SEXP to, int i, SEXP from, int j); #endif purrr/src/conditions.h0000644000176200001440000000143414350561730014543 0ustar liggesusers#ifndef CONDITIONS_H #define CONDITIONS_H #include void __attribute__ ((noreturn)) stop_bad_type(SEXP x, const char* expected, const char* what, const char* arg) __attribute__((noreturn)); void __attribute__ ((noreturn)) stop_bad_element_type(SEXP x, R_xlen_t index, const char* expected, const char* what, const char* arg) __attribute__((noreturn)); void __attribute__ ((noreturn)) stop_bad_element_length(SEXP x, R_xlen_t index, R_xlen_t expected_length, const char* what, const char* arg, bool recycle) __attribute__((noreturn)); SEXP current_env(void); void __attribute__ ((noreturn)) r_abort(const char* fmt, ...); void __attribute__ ((noreturn)) r_abort_call(SEXP env, const char* fmt, ...); const char* rlang_obj_type_friendly_full(SEXP x, bool value, bool length); #endif purrr/src/transpose.c0000644000176200001440000000544213426303100014372 0ustar liggesusers#define R_NO_REMAP #include #include #include "conditions.h" #include "utils.h" SEXP transpose_impl(SEXP x, SEXP names_template) { if (TYPEOF(x) != VECSXP) { stop_bad_type(x, "a list", NULL, ".l"); } int n = Rf_length(x); if (n == 0) { return Rf_allocVector(VECSXP, 0); } int has_template = !Rf_isNull(names_template); SEXP x1 = VECTOR_ELT(x, 0); if (!Rf_isVector(x1)) { stop_bad_element_type(x1, 1, "a vector", NULL, NULL); } int m = has_template ? Rf_length(names_template) : Rf_length(x1); // Create space for output SEXP out = PROTECT(Rf_allocVector(VECSXP, m)); SEXP names1 = PROTECT(Rf_getAttrib(x, R_NamesSymbol)); for (int j = 0; j < m; ++j) { SEXP xj = PROTECT(Rf_allocVector(VECSXP, n)); if (!Rf_isNull(names1)) { Rf_setAttrib(xj, R_NamesSymbol, names1); } SET_VECTOR_ELT(out, j, xj); UNPROTECT(1); } SEXP names2 = has_template ? names_template : Rf_getAttrib(x1, R_NamesSymbol); if (!Rf_isNull(names2)) { Rf_setAttrib(out, R_NamesSymbol, names2); } // Fill output for (int i = 0; i < n; ++i) { SEXP xi = VECTOR_ELT(x, i); if (!Rf_isVector(xi)) { stop_bad_element_type(xi, i + 1, "a vector", NULL, NULL); } // find mapping between names and index. Use -1 to indicate not found SEXP names_i = Rf_getAttrib(xi, R_NamesSymbol); SEXP index; if (!Rf_isNull(names2) && !Rf_isNull(names_i)) { index = PROTECT(Rf_match(names_i, names2, 0)); // Rf_match returns 1-based index; convert to 0-based for C for (int i = 0; i < m; ++i) { INTEGER(index)[i] = INTEGER(index)[i] - 1; } } else { index = PROTECT(Rf_allocVector(INTSXP, m)); int mi = Rf_length(xi); if (m != mi) { Rf_warningcall(R_NilValue, "Element %d must be length %d, not %d", i + 1, m, mi); } for (int i = 0; i < m; ++i) { INTEGER(index)[i] = (i < mi) ? i : -1; } } int* pIndex = INTEGER(index); for (int j = 0; j < m; ++j) { int pos = pIndex[j]; if (pos == -1) continue; switch(TYPEOF(xi)) { case LGLSXP: SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarLogical(LOGICAL(xi)[pos])); break; case INTSXP: SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarInteger(INTEGER(xi)[pos])); break; case REALSXP: SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarReal(REAL(xi)[pos])); break; case STRSXP: SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarString(STRING_ELT(xi, pos))); break; case VECSXP: SET_VECTOR_ELT(VECTOR_ELT(out, j), i, VECTOR_ELT(xi, pos)); break; default: stop_bad_type(xi, "a vector", "Transposed element", NULL); } } UNPROTECT(1); } UNPROTECT(2); return out; } purrr/src/utils.h0000644000176200001440000000074515166122162013534 0ustar liggesusers#ifndef UTILS_H #define UTILS_H #include #include #if (defined(R_VERSION) && R_VERSION < R_Version(4, 5, 0)) SEXP R_getVarEx(SEXP symbol, SEXP rho, Rboolean inherits, SEXP ifnotfound); SEXP R_getVar(SEXP symbol, SEXP rho, Rboolean inherits); #endif SEXP sym_protect(SEXP x); bool is_vector(SEXP x); SEXP lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y); SEXP lang8(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y, SEXP z); #endif purrr/src/conditions.c0000644000176200001440000001140615063325731014537 0ustar liggesusers#define R_NO_REMAP #include #include "backports.h" #include "utils.h" #include SEXP current_env(void) { static SEXP call = NULL; if (!call) { // `sys.frame(sys.nframe())` doesn't work because `sys.nframe()` // returns the number of the frame in which evaluation occurs. It // doesn't return the number of frames on the stack. So we'd need // to evaluate it in the last frame on the stack which is what we // are looking for to begin with. We use instead this workaround: // Call `sys.frame()` from a closure to push a new frame on the // stack, and use negative indexing to get the previous frame. ParseStatus status; SEXP code = PROTECT(Rf_mkString("sys.frame(-1)")); SEXP parsed = PROTECT(R_ParseVector(code, -1, &status, R_NilValue)); SEXP body = VECTOR_ELT(parsed, 0); SEXP fn = PROTECT(R_mkClosure(R_NilValue, body, R_BaseEnv)); call = Rf_lang1(fn); R_PreserveObject(call); UNPROTECT(3); } return Rf_eval(call, R_BaseEnv); } void r_abort0(SEXP env, char* buf) { SEXP message = PROTECT(Rf_mkString(buf)); SEXP fn = PROTECT( Rf_lang3(Rf_install("::"), Rf_install("rlang"), Rf_install("abort")) ); SEXP call = PROTECT(Rf_lang3(fn, message, env)); SEXP node = CDDR(call); SET_TAG(node, Rf_install("call")); Rf_eval(call, R_BaseEnv); while (1); // No return } #define BUFSIZE 8192 void r_abort(const char* fmt, ...) { char buf[BUFSIZE]; va_list dots; va_start(dots, fmt); vsnprintf(buf, BUFSIZE, fmt, dots); va_end(dots); buf[BUFSIZE - 1] = '\0'; SEXP env = PROTECT(current_env()); r_abort0(env, buf); } void r_abort_call(SEXP env, const char* fmt, ...) { char buf[BUFSIZE]; va_list dots; va_start(dots, fmt); vsnprintf(buf, BUFSIZE, fmt, dots); va_end(dots); buf[BUFSIZE - 1] = '\0'; r_abort0(env, buf); } const char* rlang_obj_type_friendly_full(SEXP x, bool value, bool length) { const char* (*rlang_ptr)(SEXP x, bool value, bool length) = NULL; if (rlang_ptr == NULL) { rlang_ptr = (const char* (*)(SEXP, bool, bool)) R_GetCCallable("rlang", "rlang_obj_type_friendly_full"); } return rlang_ptr(x, value, length); } void stop_bad_type(SEXP x, const char* expected, const char* what, const char* arg) { SEXP fn = Rf_lang3(Rf_install(":::"), Rf_install("purrr"), Rf_install("stop_bad_type")); SEXP call = Rf_lang5(PROTECT(fn), PROTECT(sym_protect(x)), PROTECT(Rf_mkString(expected)), what ? PROTECT(Rf_mkString(what)) : R_NilValue, arg ? PROTECT(Rf_mkString(arg)) : R_NilValue); PROTECT(call); SEXP node = CDR(CDR(CDR(call))); SET_TAG(node, Rf_install("what")); node = CDR(node); SET_TAG(node, Rf_install("arg")); SEXP env = PROTECT(current_env()); Rf_eval(call, env); while (1); // No return } void stop_bad_element_type(SEXP x, R_xlen_t index, const char* expected, const char* what, const char* arg) { SEXP fn = Rf_lang3(Rf_install(":::"), Rf_install("purrr"), Rf_install("stop_bad_element_type")); SEXP call = Rf_lang6(PROTECT(fn), PROTECT(sym_protect(x)), PROTECT(Rf_ScalarReal(index)), PROTECT(Rf_mkString(expected)), what ? PROTECT(Rf_mkString(what)) : R_NilValue, arg ? PROTECT(Rf_mkString(arg)) : R_NilValue); PROTECT(call); SEXP node = CDR(CDR(CDR(CDR(call)))); SET_TAG(node, Rf_install("what")); node = CDR(node); SET_TAG(node, Rf_install("arg")); SEXP env = PROTECT(current_env()); Rf_eval(call, env); while (1); // No return } void stop_bad_element_length(SEXP x, R_xlen_t index, R_xlen_t expected_length, const char* what, const char* arg, bool recycle) { SEXP fn = Rf_lang3(Rf_install(":::"), Rf_install("purrr"), Rf_install("stop_bad_element_length")); SEXP call = lang7(PROTECT(fn), PROTECT(sym_protect(x)), PROTECT(Rf_ScalarReal(index)), PROTECT(Rf_ScalarReal(expected_length)), what ? PROTECT(Rf_mkString(what)) : R_NilValue, arg ? PROTECT(Rf_mkString(arg)) : R_NilValue, PROTECT(Rf_ScalarLogical(recycle))); PROTECT(call); SEXP node = CDR(CDR(CDR(CDR(call)))); SET_TAG(node, Rf_install("what")); node = CDR(node); SET_TAG(node, Rf_install("arg")); node = CDR(node); SET_TAG(node, Rf_install("recycle")); SEXP env = PROTECT(current_env()); Rf_eval(call, env); while (1); // No return } purrr/src/init.c0000644000176200001440000000345315166122162013331 0ustar liggesusers#include #include #include // for NULL #include // Compile with `-fvisibility=hidden -DHAVE_VISIBILITY_ATTRIBUTE` if you link to this library #include #define export attribute_visible extern #include "cleancall.h" extern void unbound_init(void); /* .Call calls */ extern SEXP coerce_impl(SEXP, SEXP); extern SEXP pluck_impl(SEXP, SEXP, SEXP, SEXP); extern SEXP flatten_impl(SEXP); extern SEXP every_impl(SEXP, SEXP, SEXP); extern SEXP some_impl(SEXP, SEXP, SEXP); extern SEXP none_impl(SEXP, SEXP, SEXP); extern SEXP map_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP map2_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP pmap_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); extern SEXP transpose_impl(SEXP, SEXP); extern SEXP vflatten_impl(SEXP, SEXP); static const R_CallMethodDef CallEntries[] = { CLEANCALL_METHOD_RECORD, {"coerce_impl", (DL_FUNC) &coerce_impl, 2}, {"pluck_impl", (DL_FUNC) &pluck_impl, 4}, {"flatten_impl", (DL_FUNC) &flatten_impl, 1}, {"every_impl", (DL_FUNC) &every_impl, 3}, {"some_impl", (DL_FUNC) &some_impl, 3}, {"none_impl", (DL_FUNC) &none_impl, 3}, {"map_impl", (DL_FUNC) &map_impl, 6}, {"map2_impl", (DL_FUNC) &map2_impl, 6}, {"pmap_impl", (DL_FUNC) &pmap_impl, 8}, {"transpose_impl", (DL_FUNC) &transpose_impl, 2}, {"vflatten_impl", (DL_FUNC) &vflatten_impl, 2}, {"purrr_eval", (DL_FUNC) &Rf_eval, 2}, {NULL, NULL, 0} }; export void R_init_purrr(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); cleancall_init(); unbound_init(); } purrr/src/Makevars0000644000176200001440000000003514326706774013725 0ustar liggesusersPKG_CFLAGS = $(C_VISIBILITY) purrr/src/backports.c0000644000176200001440000000070515063325731014356 0ustar liggesusers#define R_NO_REMAP #include #include #include #if defined(R_VERSION) && R_VERSION < R_Version(3, 2, 0) SEXP Rf_installChar(SEXP x) { return Rf_install(CHAR(x)); } #endif #if defined(R_VERSION) && R_VERSION < R_Version(4, 5, 0) SEXP R_mkClosure(SEXP formals, SEXP body, SEXP env) { SEXP fun = Rf_allocSExp(CLOSXP); SET_FORMALS(fun, formals); SET_BODY(fun, body); SET_CLOENV(fun, env); return fun; } #endif purrr/src/pluck.c0000644000176200001440000002267415166122162013512 0ustar liggesusers#define R_NO_REMAP #include #include #include #include #include "backports.h" #include "coerce.h" #include "conditions.h" #include "utils.h" static int check_double_index_finiteness(double val, SEXP index, int i, bool strict); static int check_double_index_length(double val, int n, int i, bool strict); static int check_character_index(SEXP string, int i, bool strict); static int check_names(SEXP names, int i, bool strict); static int check_s4_slot(SEXP val, SEXP index_i, bool strict); static int check_obj_length(SEXP n, bool strict); int obj_length(SEXP x, bool strict); SEXP obj_names(SEXP x, bool strict); // S3 objects must implement a `length()` method in the case of a // numeric index and a `names()` method for the character case int find_offset(SEXP x, SEXP index, int i, bool strict) { int n = obj_length(x, strict); if (n < 0) { return -1; } int index_n = Rf_length(index); if (index_n != 1) { stop_bad_element_length(index, i + 1, 1, "Index", NULL, false); } switch (TYPEOF(index)) { case INTSXP: case REALSXP: { int n_protect = 0; double val; if (TYPEOF(index) == INTSXP) { // Coerce instead of cast to standardise missing value index = PROTECT(Rf_coerceVector(index, REALSXP)); ++n_protect; } val = REAL(index)[0]; if (check_double_index_finiteness(val, index, i, strict)) { goto numeric_index_error; } if (val < 0) { val = n + val + 1; } if (check_double_index_length(val, n, i, strict)) { goto numeric_index_error; } UNPROTECT(n_protect); return val - 1; numeric_index_error: UNPROTECT(n_protect); return -1; } case STRSXP: { // Protection is needed because names could be generated in the S3 case SEXP names = PROTECT(obj_names(x, strict)); if (check_names(names, i, strict)) { UNPROTECT(1); return -1; } SEXP string = STRING_ELT(index, 0); if (check_character_index(string, i, strict)) { UNPROTECT(1); return -1; } const char* val = Rf_translateCharUTF8(string); int n_names = Rf_length(names); for (int j = 0; j < n_names; ++j) { if (STRING_ELT(names, j) == NA_STRING) { continue; } const char* names_j = Rf_translateCharUTF8(STRING_ELT(names, j)); if (strcmp(names_j, val) == 0) { UNPROTECT(1); return j; } } if (strict) { r_abort("Can't find name `%s` in vector.", val); } else { UNPROTECT(1); return -1; } } default: stop_bad_element_type(index, i + 1, "a character or numeric vector", "Index", NULL); } } SEXP extract_vector(SEXP x, SEXP index_i, int i, bool strict) { int offset = find_offset(x, index_i, i, strict); if (offset < 0) { return R_NilValue; } if (Rf_isObject(x)) { // We check `offset` pass the original index to support unordered // vector classes SEXP extract_call = PROTECT(Rf_lang3(Rf_install("[["), x, index_i)); SEXP out = Rf_eval(extract_call, R_GlobalEnv); UNPROTECT(1); return out; } switch (TYPEOF(x)) { case LGLSXP: return Rf_ScalarLogical(LOGICAL(x)[offset]); case INTSXP: return Rf_ScalarInteger(INTEGER(x)[offset]); case REALSXP: return Rf_ScalarReal(REAL(x)[offset]); case STRSXP: return Rf_ScalarString(STRING_ELT(x, offset)); case VECSXP: return VECTOR_ELT(x, offset); case RAWSXP: return Rf_ScalarRaw(RAW(x)[offset]) ; case CPLXSXP: return Rf_ScalarComplex(COMPLEX_ELT(x, offset)); default: r_abort( "Internal error: found in extract_vector()", Rf_type2char(TYPEOF(x)) ); } return R_NilValue; } static SEXP unbound = NULL; void unbound_init(void) { unbound = Rf_install(".__purrr_unbound__."); } SEXP extract_env(SEXP x, SEXP index_i, int i, bool strict) { if (TYPEOF(index_i) != STRSXP) { stop_bad_element_type(index_i, i + 1, "a string", "Index", NULL); } if (Rf_length(index_i) != 1) { stop_bad_element_length(index_i, i + 1, 1, "Index", NULL, false); } SEXP index = STRING_ELT(index_i, 0); if (check_character_index(index, i, strict)) { return R_NilValue; } SEXP sym = Rf_installChar(index); if (!strict) { return R_getVarEx(sym, x, FALSE, R_NilValue); } SEXP out = R_getVarEx(sym, x, FALSE, unbound); if (out == unbound) { r_abort( "Can't find object `%s` in environment.", Rf_translateCharUTF8(Rf_asChar(index_i)) ); } return out; } SEXP extract_s4(SEXP x, SEXP index_i, int i, bool strict) { if (TYPEOF(index_i) != STRSXP) { stop_bad_element_type(index_i, i + 1, "a string", "Index", NULL); } if (Rf_length(index_i) != 1) { stop_bad_element_length(index_i, i + 1, 1, "Index", NULL, false); } SEXP index = STRING_ELT(index_i, 0); if (check_character_index(index, i, strict)) { return R_NilValue; } if (check_s4_slot(x, index_i, strict)) { return R_NilValue; } SEXP sym = Rf_installChar(index); return Rf_getAttrib(x, sym); } SEXP extract_fn(SEXP x, SEXP clo) { SEXP expr = PROTECT(Rf_lang2(clo, x)); SEXP out = Rf_eval(expr, R_GlobalEnv); UNPROTECT(1); return out; } static bool is_function(SEXP x) { switch (TYPEOF(x)) { case CLOSXP: case BUILTINSXP: case SPECIALSXP: return true; default: return false; } } SEXP pluck_impl(SEXP x, SEXP index, SEXP missing, SEXP strict_arg) { if (TYPEOF(index) != VECSXP) { stop_bad_type(index, "a list", NULL, "where"); } PROTECT_INDEX idx; PROTECT_WITH_INDEX(x, &idx); int n = Rf_length(index); bool strict = Rf_asLogical(strict_arg); for (int i = 0; i < n; ++i) { SEXP index_i = VECTOR_ELT(index, i); if (is_function(index_i)) { x = extract_fn(x, index_i); REPROTECT(x, idx); continue; } // Assume all S3 objects implement the vector interface if (Rf_isObject(x) && TYPEOF(x) != S4SXP) { x = extract_vector(x, index_i, i, strict); REPROTECT(x, idx); continue; } switch (TYPEOF(x)) { case NILSXP: if (strict) { r_abort("Can't pluck from NULL at level %d.", i + 1); } find_offset(x, index_i, i, strict); // Leave the indexing loop early goto end; case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case STRSXP: case RAWSXP: case VECSXP: x = extract_vector(x, index_i, i, strict); REPROTECT(x, idx); break; case ENVSXP: x = extract_env(x, index_i, i, strict); REPROTECT(x, idx); break; case S4SXP: x = extract_s4(x, index_i, i, strict); REPROTECT(x, idx); break; default: r_abort( "Can't pluck from %s at level %d.", rlang_obj_type_friendly_full(x, true, false), i + 1 ); } } end: UNPROTECT(1); return x == R_NilValue ? missing : x; } /* Type checking */ static int check_double_index_finiteness(double val, SEXP index, int i, bool strict) { if (R_finite(val)) { return 0; } if (strict) { r_abort( "Index %d must be finite, not %s.", i + 1, Rf_translateCharUTF8(Rf_asChar(index)) ); } else { return -1; } } static int check_double_index_length(double val, int n, int i, bool strict) { if (val == 0) { if (strict) { r_abort("Index %d is zero.", i + 1); } else { return -1; } } else if (val < 0) { if (strict) { // Negative values have already been subtracted from end r_abort( "Negative index %d must be greater than or equal to %d, not %.0f.", i + 1, -n, val - n - 1 ); } else { return -1; } } else if (val > n) { if (strict) { r_abort( "Index %d exceeds the length of plucked object (%.0f > %d).", i + 1, val, n ); } else { return -1; } } return 0; } static int check_character_index(SEXP string, int i, bool strict) { if (string == NA_STRING) { if (strict) { r_abort("Index %d can't be NA.", i + 1); } else { return -1; } } // "" matches nothing const char* val = CHAR(string); if (val[0] == '\0') { if (strict) { r_abort("Index %d can't be an empty string (\"\").", i + 1); } else { return -1; } } return 0; } static int check_names(SEXP names, int i, bool strict) { if (TYPEOF(names) == STRSXP) { return 0; } if (strict) { r_abort("Index %d is attempting to pluck from an unnamed vector using a string name.", i + 1); } else { return -1; } } static int check_s4_slot(SEXP val, SEXP index_i, bool strict) { if (R_has_slot(val, index_i)) { return 0; } if (strict) { r_abort( "Can't find slot `%s`.", Rf_translateCharUTF8(Rf_asChar(index_i)) ); } else { return -1; } } static int check_obj_length(SEXP n, bool strict) { if (TYPEOF(n) != INTSXP || Rf_length(n) != 1) { if (strict) { r_abort("Length of S3 object must be a scalar integer."); } else { return -1; } } return 0; } int obj_length(SEXP x, bool strict) { if (!Rf_isObject(x)) { return Rf_length(x); } SEXP length_call = PROTECT(Rf_lang2(Rf_install("length"), x)); SEXP n = PROTECT(Rf_eval(length_call, R_GlobalEnv)); if (check_obj_length(n, strict)) { UNPROTECT(2); return -1; } UNPROTECT(2); return INTEGER(n)[0]; } SEXP obj_names(SEXP x, bool strict) { if (!Rf_isObject(x)) { return Rf_getAttrib(x, R_NamesSymbol); } SEXP names_call = PROTECT(Rf_lang2(Rf_install("names"), x)); SEXP names = Rf_eval(names_call, R_GlobalEnv); UNPROTECT(1); return names; } purrr/src/map.c0000644000176200001440000001201615063325731013141 0ustar liggesusers#define R_NO_REMAP #include #include #include #include "coerce.h" #include "conditions.h" #include "utils.h" // Including before "cleancall.h" because we want to register // exiting handlers ourselves, rather than letting cli register them for us. #include #include "cleancall.h" static void cb_progress_done(void* bar_ptr) { SEXP bar = (SEXP)bar_ptr; cli_progress_done(bar); R_ReleaseObject(bar); } // call must involve i SEXP call_loop(SEXP env, SEXP call, SEXPTYPE type, SEXP progress, int n, SEXP names, int* p_i, int force) { SEXP bar = cli_progress_bar(n, progress); R_PreserveObject(bar); r_call_on_exit((void (*)(void*)) cb_progress_done, (void*) bar); SEXP out = PROTECT(Rf_allocVector(type, n)); Rf_setAttrib(out, R_NamesSymbol, names); for (int i = 0; i < n; ++i) { *p_i = i + 1; if (CLI_SHOULD_TICK) { cli_progress_set(bar, i); } if (i % 1024 == 0) { R_CheckUserInterrupt(); } SEXP res = PROTECT(R_forceAndCall(call, force, env)); if (type != VECSXP && Rf_length(res) != 1) { Rf_errorcall(R_NilValue, "Result must be length 1, not %i.", Rf_length(res)); } set_vector_value(out, i, res, 0); UNPROTECT(1); } *p_i = 0; UNPROTECT(1); return out; } SEXP map_impl(SEXP env, SEXP ffi_type, SEXP progress, SEXP ffi_n, SEXP names, SEXP i) { static SEXP call = NULL; if (call == NULL) { SEXP x_sym = Rf_install(".x"); SEXP f_sym = Rf_install(".f"); SEXP i_sym = Rf_install("i"); // Constructs a call like f(x[[i]], ...) - don't want to substitute // actual values for f or x, because they may be long, which creates // bad tracebacks() SEXP x_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, x_sym, i_sym)); call = Rf_lang3(f_sym, x_i_sym, R_DotsSymbol); R_PreserveObject(call); UNPROTECT(1); } SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0))); int n = INTEGER_ELT(ffi_n, 0); int* p_i = INTEGER(i); int force = 1; return call_loop( env, call, type, progress, n, names, p_i, force ); } SEXP map2_impl(SEXP env, SEXP ffi_type, SEXP progress, SEXP ffi_n, SEXP names, SEXP i) { static SEXP call = NULL; if (call == NULL) { SEXP x_sym = Rf_install(".x"); SEXP y_sym = Rf_install(".y"); SEXP f_sym = Rf_install(".f"); SEXP i_sym = Rf_install("i"); // Constructs a call like f(x[[i]], y[[i]], ...) SEXP x_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, x_sym, i_sym)); SEXP y_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, y_sym, i_sym)); call = Rf_lang4(f_sym, x_i_sym, y_i_sym, R_DotsSymbol); R_PreserveObject(call); UNPROTECT(2); } SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0))); int n = INTEGER_ELT(ffi_n, 0); int* p_i = INTEGER(i); int force = 2; return call_loop( env, call, type, progress, n, names, p_i, force ); } SEXP pmap_impl(SEXP env, SEXP ffi_type, SEXP progress, SEXP ffi_n, SEXP names, SEXP i, SEXP call_names, SEXP ffi_call_n) { // Construct call like f(.l[[1]][[i]], .l[[2]][[i]], ...) // // Currently accessing S3 vectors in a list like .l[[c(1, i)]] will not // preserve the class (cf. #358). // // We construct the call backwards because can only add to the front of a // linked list. That makes PROTECTion tricky because we need to update it // each time to point to the start of the linked list. SEXP l_sym = Rf_install(".l"); SEXP f_sym = Rf_install(".f"); SEXP i_sym = Rf_install("i"); SEXP call = Rf_lang1(R_DotsSymbol); PROTECT_INDEX call_shelter; PROTECT_WITH_INDEX(call, &call_shelter); bool has_call_names = call_names != R_NilValue; const SEXP* v_call_names = has_call_names ? STRING_PTR_RO(call_names) : NULL; int call_n = INTEGER_ELT(ffi_call_n, 0); for (int j = call_n - 1; j >= 0; --j) { // Construct call like .l[[j]][[i]] SEXP j_val = PROTECT(Rf_ScalarInteger(j + 1)); SEXP l_j_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, l_sym, j_val)); SEXP l_j_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, l_j_sym, i_sym)); call = Rf_lcons(l_j_i_sym, call); REPROTECT(call, call_shelter); if (has_call_names) { const char* call_name = CHAR(v_call_names[j]); if (call_name[0] != '\0') { SET_TAG(call, Rf_install(call_name)); } } UNPROTECT(3); } call = Rf_lcons(f_sym, call); REPROTECT(call, call_shelter); SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0))); int n = INTEGER_ELT(ffi_n, 0); int* p_i = INTEGER(i); int force = call_n; SEXP out = call_loop( env, call, type, progress, n, names, p_i, force ); UNPROTECT(1); return out; } purrr/src/flatten.c0000644000176200001440000000727613716720045014035 0ustar liggesusers#define R_NO_REMAP #include #include #include "coerce.h" #include "conditions.h" #include "utils.h" const char* objtype(SEXP x) { return Rf_type2char(TYPEOF(x)); } SEXP flatten_impl(SEXP x) { if (TYPEOF(x) != VECSXP) { stop_bad_type(x, "a list", NULL, ".x"); } int m = Rf_length(x); // Determine output size and check type int n = 0; int has_names = 0; SEXP x_names = PROTECT(Rf_getAttrib(x, R_NamesSymbol)); for (int j = 0; j < m; ++j) { SEXP x_j = VECTOR_ELT(x, j); if (!is_vector(x_j) && x_j != R_NilValue) { stop_bad_element_type(x_j, j + 1, "a vector", NULL, ".x"); } n += Rf_length(x_j); if (!has_names) { if (!Rf_isNull(Rf_getAttrib(x_j, R_NamesSymbol))) { // Sub-element is named has_names = 1; } else if (Rf_length(x_j) == 1 && !Rf_isNull(x_names)) { // Element is a "scalar" and has name in parent SEXP name = STRING_ELT(x_names, j); if (name != NA_STRING && strcmp(CHAR(name), "") != 0) has_names = 1; } } } SEXP out = PROTECT(Rf_allocVector(VECSXP, n)); SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); if (has_names) Rf_setAttrib(out, R_NamesSymbol, names); int i = 0; for (int j = 0; j < m; ++j) { SEXP x_j = VECTOR_ELT(x, j); int n_j = Rf_length(x_j); SEXP names_j = PROTECT(Rf_getAttrib(x_j, R_NamesSymbol)); int has_names_j = !Rf_isNull(names_j); for (int k = 0; k < n_j; ++k, ++i) { switch(TYPEOF(x_j)) { case LGLSXP: SET_VECTOR_ELT(out, i, Rf_ScalarLogical(LOGICAL(x_j)[k])); break; case INTSXP: SET_VECTOR_ELT(out, i, Rf_ScalarInteger(INTEGER(x_j)[k])); break; case REALSXP: SET_VECTOR_ELT(out, i, Rf_ScalarReal(REAL(x_j)[k])); break; case CPLXSXP: SET_VECTOR_ELT(out, i, Rf_ScalarComplex(COMPLEX(x_j)[k])); break; case STRSXP: SET_VECTOR_ELT(out, i, Rf_ScalarString(STRING_ELT(x_j, k))); break; case RAWSXP: SET_VECTOR_ELT(out, i, Rf_ScalarRaw(RAW(x_j)[k])); break; case VECSXP: SET_VECTOR_ELT(out, i, VECTOR_ELT(x_j, k)); break; default: Rf_error("Internal error: `flatten_impl()` should have failed earlier"); } if (has_names) { if (has_names_j) { SET_STRING_ELT(names, i, has_names_j ? STRING_ELT(names_j, k) : Rf_mkChar("")); } else if (n_j == 1) { SET_STRING_ELT(names, i, !Rf_isNull(x_names) ? STRING_ELT(x_names, j) : Rf_mkChar("")); } } if (i % 1024 == 0) R_CheckUserInterrupt(); } UNPROTECT(1); } UNPROTECT(3); return out; } SEXP vflatten_impl(SEXP x, SEXP type_) { if (TYPEOF(x) != VECSXP) { stop_bad_type(x, "a list", NULL, ".x"); } int m = Rf_length(x); SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_))); // Determine output size and type int n = 0; int has_names = 0; for (int j = 0; j < m; ++j) { SEXP x_j = VECTOR_ELT(x, j); n += Rf_length(x_j); if (!has_names && !Rf_isNull(Rf_getAttrib(x_j, R_NamesSymbol))) { has_names = 1; } } SEXP out = PROTECT(Rf_allocVector(type, n)); SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); if (has_names) Rf_setAttrib(out, R_NamesSymbol, names); UNPROTECT(1); int i = 0; for (int j = 0; j < m; ++j) { SEXP x_j = VECTOR_ELT(x, j); int n_j = Rf_length(x_j); SEXP names_j = PROTECT(Rf_getAttrib(x_j, R_NamesSymbol)); int has_names_j = !Rf_isNull(names_j); for (int k = 0; k < n_j; ++k, ++i) { set_vector_value(out, i, x_j, k); if (has_names) SET_STRING_ELT(names, i, has_names_j ? STRING_ELT(names_j, k) : Rf_mkChar("")); if (i % 1024 == 0) R_CheckUserInterrupt(); } UNPROTECT(1); } UNPROTECT(1); return out; } purrr/src/cleancall.h0000644000176200001440000000267515063325731014321 0ustar liggesusers#ifndef CLEANCALL_H #define CLEANCALL_H #include #include #include #ifdef __cplusplus extern "C" { #endif // -------------------------------------------------------------------- // Internals // -------------------------------------------------------------------- typedef union {void* p; DL_FUNC fn;} fn_ptr; #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); DL_FUNC R_ExternalPtrAddrFn(SEXP s); #endif // -------------------------------------------------------------------- // API for packages that embed cleancall // -------------------------------------------------------------------- // The R API does not have a setter for external function pointers SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot); void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p); #define CLEANCALL_METHOD_RECORD \ {"cleancall_call", (DL_FUNC) &cleancall_call, 2} SEXP cleancall_call(SEXP args, SEXP env); void cleancall_init(void); // -------------------------------------------------------------------- // Public API // -------------------------------------------------------------------- #define R_CLEANCALL_SUPPORT 1 SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data); void r_call_on_exit(void (*fn)(void* data), void* data); void r_call_on_early_exit(void (*fn)(void* data), void* data); #ifdef __cplusplus } #endif #endif purrr/src/backports.h0000644000176200001440000000041015063325731014354 0ustar liggesusers#ifndef BACKPORTS_H #define BACKPORTS_H #include #if defined(R_VERSION) && R_VERSION < R_Version(3, 2, 0) SEXP Rf_installChar(SEXP); #endif #if defined(R_VERSION) && R_VERSION < R_Version(4, 5, 0) SEXP R_mkClosure(SEXP, SEXP, SEXP); #endif #endif purrr/src/cleancall.c0000644000176200001440000001021215166122162014273 0ustar liggesusers#define R_NO_REMAP #include #include "cleancall.h" #include "utils.h" #if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0)) SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) { fn_ptr ptr; ptr.fn = p; return R_MakeExternalPtr(ptr.p, tag, prot); } DL_FUNC R_ExternalPtrAddrFn(SEXP s) { fn_ptr ptr; ptr.p = R_ExternalPtrAddr(s); return ptr.fn; } #endif // The R API does not have a setter for function pointers SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) { fn_ptr tmp; tmp.fn = p; return R_MakeExternalPtr(tmp.p, tag, prot); } void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p) { fn_ptr ptr; ptr.fn = p; R_SetExternalPtrAddr(s, ptr.p); } // Initialised at load time with the `.Call` primitive SEXP cleancall_fns_dot_call = NULL; static SEXP callbacks = NULL; void cleancall_init(void) { cleancall_fns_dot_call = R_getVar(Rf_install(".Call"), R_BaseEnv, TRUE); callbacks = R_NilValue; } struct eval_args { SEXP call; SEXP env; }; static SEXP eval_wrap(void* data) { struct eval_args* args = (struct eval_args*) data; return Rf_eval(args->call, args->env); } SEXP cleancall_call(SEXP args, SEXP env) { SEXP call = PROTECT(Rf_lcons(cleancall_fns_dot_call, args)); struct eval_args data = { call, env }; SEXP out = r_with_cleanup_context(&eval_wrap, &data); UNPROTECT(1); return out; } // Preallocate a callback static void push_callback(SEXP stack) { SEXP top = CDR(stack); SEXP early_handler = PROTECT(Rf_allocVector(LGLSXP, 1)); SEXP fn_extptr = PROTECT(cleancall_MakeExternalPtrFn(NULL, R_NilValue, R_NilValue)); SEXP data_extptr = PROTECT(R_MakeExternalPtr(NULL, early_handler, R_NilValue)); SEXP cb = Rf_cons(Rf_cons(fn_extptr, data_extptr), top); SETCDR(stack, cb); UNPROTECT(3); } struct data_wrapper { SEXP (*fn)(void* data); void *data; SEXP callbacks; int success; }; static void call_exits(void* data) { // Remove protecting node. Don't remove the preallocated callback on // the top as it might contain a handler when something went wrong. SEXP top = CDR(callbacks); // Restore old stack struct data_wrapper* state = data; callbacks = (SEXP) state->callbacks; // Handlers should not jump while (top != R_NilValue) { SEXP cb = CAR(top); top = CDR(top); void (*fn)(void*) = (void (*)(void*)) R_ExternalPtrAddrFn(CAR(cb)); void *data = (void*) R_ExternalPtrAddr(CDR(cb)); int early_handler = LOGICAL(R_ExternalPtrTag(CDR(cb)))[0]; // Check for empty pointer in preallocated callbacks if (fn) { if (!early_handler || !state->success) fn(data); } } } static SEXP with_cleanup_context_wrap(void *data) { struct data_wrapper* cdata = data; SEXP ret = cdata->fn(cdata->data); cdata->success = 1; return ret; } SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data) { // Preallocate new stack before changing `callbacks` to avoid // leaving the global variable in a bad state if alloc fails SEXP new = PROTECT(Rf_cons(R_NilValue, R_NilValue)); push_callback(new); SEXP old = callbacks; callbacks = new; struct data_wrapper state = { fn, data, old, 0 }; SEXP out = R_ExecWithCleanup(with_cleanup_context_wrap, &state, &call_exits, &state); UNPROTECT(1); return out; } static void call_save_handler(void (*fn)(void *data), void* data, int early) { if (Rf_isNull(callbacks)) { fn(data); Rf_error("Internal error: Exit handler pushed outside " "of an exit context"); } SEXP cb = CADR(callbacks); // Update pointers cleancall_SetExternalPtrAddrFn(CAR(cb), (DL_FUNC) fn); R_SetExternalPtrAddr(CDR(cb), data); LOGICAL(R_ExternalPtrTag(CDR(cb)))[0] = early; // Preallocate the next callback in case the allocator jumps push_callback(callbacks); } void r_call_on_exit(void (*fn)(void* data), void* data) { call_save_handler(fn, data, /* early = */ 0); } void r_call_on_early_exit(void (*fn)(void* data), void* data) { call_save_handler(fn, data, /* early = */ 1); } purrr/NAMESPACE0000644000176200001440000001130515166123011012637 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as_mapper,character) S3method(as_mapper,default) S3method(as_mapper,list) S3method(as_mapper,numeric) S3method(print,purrr_function_compose) S3method(print,purrr_function_partial) S3method(print,purrr_rate_backoff) S3method(print,purrr_rate_delay) S3method(rate_sleep,purrr_rate_backoff) S3method(rate_sleep,purrr_rate_delay) export("%>%") export("%||%") export("pluck<-") export(accumulate) export(accumulate2) export(array_branch) export(array_tree) export(as_mapper) export(as_vector) export(assign_in) export(attr_getter) export(auto_browse) export(chuck) export(compact) export(compose) export(cross) export(cross2) export(cross3) export(cross_df) export(detect) export(detect_index) export(discard) export(discard_at) export(done) export(every) export(exec) export(flatten) export(flatten_chr) export(flatten_dbl) export(flatten_df) export(flatten_dfc) export(flatten_dfr) export(flatten_int) export(flatten_lgl) export(flatten_raw) export(has_element) export(head_while) export(imap) export(imap_chr) export(imap_dbl) export(imap_dfc) export(imap_dfr) export(imap_int) export(imap_lgl) export(imap_raw) export(imap_vec) export(imodify) export(in_parallel) export(insistently) export(invoke) export(invoke_map) export(invoke_map_chr) export(invoke_map_dbl) export(invoke_map_df) export(invoke_map_dfc) export(invoke_map_dfr) export(invoke_map_int) export(invoke_map_lgl) export(invoke_map_raw) export(is_atomic) export(is_bare_atomic) export(is_bare_character) export(is_bare_double) export(is_bare_integer) export(is_bare_list) export(is_bare_logical) export(is_bare_numeric) export(is_bare_vector) export(is_character) export(is_double) export(is_empty) export(is_formula) export(is_function) export(is_integer) export(is_list) export(is_logical) export(is_null) export(is_rate) export(is_scalar_atomic) export(is_scalar_character) export(is_scalar_double) export(is_scalar_integer) export(is_scalar_list) export(is_scalar_logical) export(is_scalar_vector) export(is_vector) export(iwalk) export(keep) export(keep_at) export(lift) export(lift_dl) export(lift_dv) export(lift_ld) export(lift_lv) export(lift_vd) export(lift_vl) export(list_along) export(list_assign) export(list_c) export(list_cbind) export(list_flatten) export(list_merge) export(list_modify) export(list_rbind) export(list_simplify) export(list_transpose) export(lmap) export(lmap_at) export(lmap_if) export(map) export(map2) export(map2_chr) export(map2_dbl) export(map2_df) export(map2_dfc) export(map2_dfr) export(map2_int) export(map2_lgl) export(map2_raw) export(map2_vec) export(map_at) export(map_chr) export(map_dbl) export(map_depth) export(map_df) export(map_dfc) export(map_dfr) export(map_if) export(map_int) export(map_lgl) export(map_raw) export(map_vec) export(modify) export(modify2) export(modify_at) export(modify_depth) export(modify_if) export(modify_in) export(modify_tree) export(negate) export(none) export(partial) export(pluck) export(pluck_depth) export(pluck_exists) export(pmap) export(pmap_chr) export(pmap_dbl) export(pmap_df) export(pmap_dfc) export(pmap_dfr) export(pmap_int) export(pmap_lgl) export(pmap_raw) export(pmap_vec) export(possibly) export(prepend) export(pwalk) export(quietly) export(rate_backoff) export(rate_delay) export(rate_reset) export(rate_sleep) export(rbernoulli) export(rdunif) export(reduce) export(reduce2) export(rep_along) export(rerun) export(safely) export(set_names) export(simplify) export(simplify_all) export(slowly) export(some) export(splice) export(tail_while) export(transpose) export(update_list) export(vec_depth) export(walk) export(walk2) export(when) export(zap) import(rlang) import(vctrs) importFrom(cli,cli_progress_bar) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(rlang,"%||%") importFrom(rlang,done) importFrom(rlang,exec) importFrom(rlang,is_atomic) importFrom(rlang,is_bare_atomic) importFrom(rlang,is_bare_character) importFrom(rlang,is_bare_double) importFrom(rlang,is_bare_integer) importFrom(rlang,is_bare_list) importFrom(rlang,is_bare_logical) importFrom(rlang,is_bare_numeric) importFrom(rlang,is_bare_vector) importFrom(rlang,is_character) importFrom(rlang,is_double) importFrom(rlang,is_empty) importFrom(rlang,is_formula) importFrom(rlang,is_function) importFrom(rlang,is_integer) importFrom(rlang,is_list) importFrom(rlang,is_logical) importFrom(rlang,is_null) importFrom(rlang,is_scalar_atomic) importFrom(rlang,is_scalar_character) importFrom(rlang,is_scalar_double) importFrom(rlang,is_scalar_integer) importFrom(rlang,is_scalar_list) importFrom(rlang,is_scalar_logical) importFrom(rlang,is_scalar_vector) importFrom(rlang,is_vector) importFrom(rlang,rep_along) importFrom(rlang,set_names) importFrom(rlang,zap) useDynLib(purrr, .registration = TRUE) purrr/LICENSE0000644000176200001440000000005315063325731012434 0ustar liggesusersYEAR: 2023 COPYRIGHT HOLDER: purrr authors purrr/NEWS.md0000644000176200001440000011524615166146602012542 0ustar liggesusers# purrr 1.2.2 * Fixes for CRAN checks (@ErdaradunGaztea, #1256). # purrr 1.2.1 * Tweaks for compatibility with upcoming vctrs 0.7.0. # purrr 1.2.0 ## Breaking changes * All functions and arguments deprecated in purrr 0.3.0 have now been removed. This includes `%@%`, `accumulate_right()`, `at_depth()`, `cross_d()`, `cross_n()`, `reduce2_right()`, and `reduce_right()`. * All functions that were soft-deprecated in purrr 1.0.0 are now fully deprecated. They will be removed in a future release. This includes: `invoke_*()`, `lift_*()`, `cross*()`, `prepend()`, `splice()`, `rbernoulli()`, `rdunif()`, `when()`, `update_list()`, `*_raw()`, `vec_depth()`. * `map_chr()` no longer from logical, integer, or double to strings. * `every()`, `some()`, and `none()` now require that `.p` return logical scalar `TRUE`, `FALSE`, or `NA`. Previously, `NA` was allowed to be a non-logical `NA`, and would be coerced to a logical `NA`. ## Minor improvements and bug fixes * New "getting started" vignette, `vignette("purrr")` (#915, @ogolovkina). * `every()`, `some()`, and `none()` are now more performant. They are now as fast as or faster than their equivalent `any(map_lgl())` or `all(map_lgl())` calls (#1036, @ErdaradunGaztea). * `as_mapper.default()` optimized by removing special named argument handling for primitive functions (@mtcarsalot, #1088). * `list_flatten()` gains an `is_node` parameter taking a predicate function that determines whether an input element is a node or a leaf (@salim-b, #1179). * `in_parallel()` now accepts objects, including helper functions, supplied to `...` for all locally-defined functions (#1208). * `in_parallel()` now works in conjunction with string and list values supplied to the `.progress` argument of map functions (#1203). * `map()`, `map2()`, and `pmap()` now automatically set the correct environment so that `format` strings to access to local variables (@jcolt45, #1078). * `map_vec()` no longer fails on empty named lists (#1206). # purrr 1.1.0 * purrr now requires R >= 4.1, so we can rely on the base pipe and lambda syntax (#1177). * purrr gains `in_parallel()` to support parallel and distributed maps, powered by {mirai}. See `?in_parallel` for more details (@shikokuchuo, #1163, #1185). # purrr 1.0.4 # purrr 1.0.3 * Varies fixed to bring purrr back into compliance with R CMD check (@shikokuchuo, @jayhesselberth). * Added missing `imap_vec()` (#1084) * `list_transpose()` now asserts that it does not work on data frames (@KimLopezGuell, #1141, #1149), and inspects all elements to determine the correct template if not provided by the user (#1128, @krlmlr). # purrr 1.0.2 * Fixed valgrind issue. * Deprecation infrastructure in `map_chr()` now has much less overhead leading to improved performance (#1089). * purrr now requires R 3.5.0. # purrr 1.0.1 * As of purrr 1.0.0, the `map()` family of functions wraps all errors generated by `.f` inside an wrapper error that tracks the iteration index. As of purrr 1.0.1, this error now has a custom class (`purrr_error_indexed`), `location` and `name` fields, and is documented in `?purrr_error_indexed` (#1027). * `map()` errors with named inputs also report the name of the element that errored. * Fixed an issue where progress bars weren't being closed when user interrupts or errors were encountered during a `map()` call (#1024). * Fixed an invalid C signature for `pluck()` (#1018). * Set `Biarch: true` to build purrr on 32-bit Windows on R < 4.2.0 (#1017). # purrr 1.0.0 ## Breaking changes ### Core purpose refinements * `cross()` and all its variants have been deprecated in favour of `tidyr::expand_grid()`. These functions were slow and buggy and we no longer think they are the right approach to solving this problem. See #768 for more information. * `update_list()` (#858) and `rerun()` (#877), and the use of tidyselect with `map_at()` and friends (#874) have been deprecated. These functions use some form of non-standard evaluation which we now believe is a poor fit for purrr. * The `lift_*` family of functions has been deprecated. We no longer believe these to be a good fit for purrr because they rely on a style of function manipulation that is very uncommon in R code (#871). * `prepend()`, `rdunif()`, `rbernoulli()`, `when()`, and `list_along()` have all been deprecated (#925). It's now clear that they don't align with the core purpose of purrr. * `splice()` is deprecated because we no longer believe that automatic splicing makes for good UI. Instead use `list2()` + `!!!` or `list_flatten()` (#869). ### Mapping * Use of map functions with expressions, calls, and pairlists has been deprecated (#961). * All map `_raw()` variants have been deprecated because they are of limited use and you can now use `map_vec()` instead (#903). * In `map_chr()`, automatic conversion from logical, integer, and double to character is now deprecated. Use an explicit `as.character()` if needed (#904). * Errors from `.f` are now wrapped in an additional class that gives information about where the error occurred (#945). ### Deprecation next steps * `as_function()` and the `...f` argument to `partial()` are no longer supported. They have been defunct for quite some time. * Soft deprecated functions: `%@%`, `reduce_right()`, `reduce2_right()`, `accumulate_right()` are now fully deprecated. Similarly, the `.lazy`, `.env`, and `.first` arguments to `partial()`, and the `.right` argument to `detect()` and `detect_index()` are fully deprecated. Removing elements with `NULL` in `list_modify()` and `list_merge()` is now fully deprecated. * `is_numeric()` and `is_scalar_numeric()` have been removed. They have been deprecated since purrr 0.2.3 (Sep 2017). * `invoke_*()` is now deprecated. It was superseded in 0.3.0 (Jan 2019) and 3.5 years later, we have decided to deprecate it as part of the API refinement in the 1.0.0 release. * `map_call()` has been removed. It was made defunct in 0.3.0 (Jan 2019). ## New features * `*_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). * Some mapping functions have now a `.progress` argument to create a progress bar. See `?progress_bars` (#149). * 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). * purrr now uses the base pipe (`|>`) and anonymous function short hand (`\(x)`), in all examples. This means that examples will no longer work in R 4.0 and earlier so in those versions of R, the examples are automatically converted to a regular section with a note that they might not work (#936). * When map functions fail, they now report the element they failed at (#945). * New `modify_tree()` for recursively modifying nested data structures (#720). ### Flattening and simplification * New `list_c()`, `list_rbind()`, and `list_cbind()` make it easy to `c()`, `rbind()`, or `cbind()` all of the elements in a list. * 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 using vctrs. New arguments `simplify` and `ptype` allow you to control the details of simplification (#774, #809). * `flatten()` and friends are superseded in favour of `list_flatten()`, `list_c()`, `list_cbind()`, and `list_rbind()`. * `*_dfc()` and `*_dfr()` have been superseded in favour of using the appropriate map function along with `list_rbind()` or `list_cbind()` (#912). * `simplify()`, `simplify_all()`, and `as_vector()` have been superseded in favour of `list_simplify()`. It provides a more consistent definition of simplification (#900). * `transpose()` has been superseded in favour of `list_transpose()` (#875). It has built-in simplification. ### Tidyverse consistency * `_lgl()`, `_int()`, `_int()`, and `_dbl()` now use the same (strict) coercion methods as vctrs (#904). This means that: * `map_chr(TRUE, identity)`, `map_chr(0L, identity)`, and `map_chr(1L, identity)` are deprecated because we now believe that converting a logical/integer/double to a character vector should require an explicit coercion. * `map_int(1.5, identity)` now fails because we believe that silently truncating doubles to integers is dangerous. But note that `map_int(1, identity)` still works since no numeric precision is lost. * `map_int(c(TRUE, FALSE), identity)`, `map_dbl(c(TRUE, FALSE), identity)`, `map_lgl(c(1L, 0L), identity)` and `map_lgl(c(1, 0), identity)` now succeed because 1/TRUE and 0/FALSE should be interchangeable. * `map2()`, `modify2()`, and `pmap()` now use tidyverse recycling rules where vectors of length 1 are recycled to any size but all others must have the same length (#878). * `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 (#818). * `pluck()` now requires indices to be length 1 (#813). It also now reports the correct type if you supply an unexpected index. * `pluck()` now accepts negative integers, indexing from the right (#603). * `pluck()` and `chuck()` now fail if you provide named inputs to ... (#788). * `pluck()` no longer replaces 0-length vectors with `default`; it now only applies absent and `NULL` components (#480). * `pluck<-`/`assign_in()` can now modify non-existing locations (#704). ### Setting with NULL * `pluck<-`/`assign_in()` now sets elements to `NULL` rather than removing them (#636). Now use the explicit `zap()` if you want to remove elements. * `modify()`, `modify2()`, and `modify_if()` now correctly handle `NULL`s in replacement values (#655, #746, #753). * `list_modify()`'s interface has been standardised. Modifying with `NULL` now always creates a `NULL` in the output (#810) ### `list_` functions * New `list_assign()` which is similar to `list_modify()` but doesn't work recursively (#822). * `list_modify()` no longer recurses into data frames (and other objects built on top of lists that are fundamentally non-list like) (#810). You can revert to the previous behaviour by setting `.is_node = is.list`. ## Minor improvements and bug fixes * `capture_output()` correctly uses `conditionMessage()` instead of directly interrogating the `message` field (#1010). * `modify()` no longer works with calls or pairlists. * `modify_depth()` is no longer a generic. This makes it more consistent with `map_depth()`. * `map_depth()` and `modify_depth()` have a new `is_node` argument that allows you to control what counts as a level. The default uses `vec_is_list()` to avoid recursing into rich S3 objects like linear models or data.frames (#958, #920). * `map_depth()` and `modify_depth()` now correctly recurse at depth 1. * `as_mapper()` is now around twice as fast when used with character, integer, or list (#820). * `possibly()` now defaults `otherwise` to NULL. * `modify_if(.else)` is now actually evaluated for atomic vectors (@mgirlich, #701). * `lmap_if()` correctly handles `.else` functions (#847). * `every()` now correctly propagates missing values using the same rules as `&&` (#751). Internally, it has become a wrapper around `&&`. This makes it consistent with `&&` and also with `some()` which has always been a wrapper around `||` with the same propagation rules. * `every()` and `some()` now properly check the return value of their predicate function. It must now return a `TRUE`, `FALSE`, or `NA`. * Greatly improved performance of functions created with `partial()` (#715). Their invocation is now as fast as for functions creating manually. * `partial()` no longer inlines the function in the call stack. This fixes issues when `partial()` is used with `lm()` for instance (#707). # purrr 0.3.5 * Fixes for CRAN checks. # purrr 0.3.4 * Fixed issue in `list_modify()` that prevented lists from being removed with `zap()` (@adamroyjones, #777). * Added documentation for exporting functions created with purrr adverb (@njtierney, #668). See `?faq-adverbs-export`. * Added `none()`, which tests that a predicate is false for all elements (the opposite of `every()`) (@AliciaSchep, #735). # purrr 0.3.3 * Maintenance release. * The documentation of `map()` and its variants has been improved by @surdina as part of the Tidyverse Developer Day (@surdina, #671). * purrr now depends on R 3.2 or greater. # purrr 0.3.2 * Fix protection issues reported by rchk. # purrr 0.3.1 * `reduce()` now forces arguments (#643). * Fixed an issue in `partial()` with generic functions (#647). * `negate()` now works with generic functions and functions with early returns. * `compose()` now works with generic functions again (#629, #639). Its set of unit tests was expanded to cover many edge cases. * `prepend()` now works with empty lists (@czeildi, #637) # purrr 0.3.0 ## Breaking changes * `modify()` and variants are now wrapping `[[<-` instead of `[<-`. This change increases the genericity of these functions but might cause different behaviour in some cases. For instance, the `[[<-` for data frames is stricter than the `[<-` method and might throw errors instead of warnings. This is the case when assigning a longer vector than the number of rows. `[<-` truncates the vector with a warning, `[[<-` fails with an error (as is appropriate). * `modify()` and variants now return the same type as the input when the input is an atomic vector. * All functionals taking predicate functions (like `keep()`, `detect()`, `some()`) got stricter. Predicate functions must now return a single `TRUE` or `FALSE`. This change is meant to detect problems early with a more meaningful error message. ## Plucking * New `chuck()` function. This is a strict variant of `pluck()` that throws errors when an element does not exist instead of returning `NULL` (@daniel-barnett, #482). * New `assign_in()` and `pluck<-` functions. They modify a data structure at an existing pluck location. * New `modify_in()` function to map a function at a pluck location. * `pluck()` now dispatches properly with S3 vectors. The vector class must implement a `length()` method for numeric indexing and a `names()` method for string indexing. * `pluck()` now supports primitive functions (#404). ## Mapping * New `.else` argument for `map_if()` and `modify_if()`. They take an alternative function that is mapped over elements of the input for which the predicate function returns `FALSE` (#324). * `reduce()`, `reduce2()`, `accumulate()`, and `accumulate2()` now terminate early when the function returns a value wrapped with `done()` (#253). When an empty `done()` is returned, the value at the last iteration is returned instead. * Functions taking predicates (`map_if()`, `keep()`, `some()`, `every()`, `keep()`, etc) now fail with an informative message when the return value is not `TRUE` or `FALSE` (#470). This is a breaking change for `every()` and `some()` which were documented to be more liberal in the values they accepted as logical (any vector was considered `TRUE` if not a single `FALSE` value, no matter its length). These functions signal soft-deprecation warnings instead of a hard failure. Edit (purr 0.4.0): `every()` and `some()` never issued deprecation warnings because of a technical issue. We didn't fix the warnings in the end, and using predicates returning `NA` is no longer considered deprecated. If you need to use `every()` and `some()` in contexts where `NA` propagation is unsafe, e.g. in `if ()` conditions, make sure to use safe predicate functions like `is_true()`. * `modify()` and variants are now implemented using `length()`, `[[`, and `[[<-` methods. This implementation should be compatible with most vector classes. * New `modify2()` and `imodify()` functions. These work like `map()` and `imap()` but preserve the type of `.x` in the return value. * `pmap()` and `pwalk()` now preserve class for inputs of `factor`, `Date`, `POSIXct` and other atomic S3 classes with an appropriate `[[` method (#358, @mikmart). * `modify()`, `modify_if()` and `modify_at()` now preserve the class of atomic vectors instead of promoting them to lists. New S3 methods are provided for character, logical, double, and integer classes (@t-kalinowski, #417). * By popular request, `at_depth()` has been brought back as `map_depth()`. Like `modify_depth()`, it applies a function at a specified level of a data structure. However, it transforms all traversed vectors up to `.depth` to bare lists (#381). * `map_at()`, `modify_at()` and `lmap_at()` accept negative values for `.at`, ignoring elements at those positions. * `map()` and `modify()` now work with calls and pairlists (#412). * `modify_depth()` now modifies atomic leaves as well. This makes `modify_depth(x, 1, fn)` equivalent to `modify(x, fn)` (#359). * New `accumulate2()` function which is to `accumulate()` what `reduce2()` is to `reduce()`. ## Rates * New `rate_backoff()` and `rate_delay()` functions to create rate objects. You can pass rates to `insistently()`, `slowly()`, or the lower level function `rate_sleep()`. This will cause a function to wait for a given amount of time with exponential backoff (increasingly larger waiting times) or for a constant delay. * `insistently(f)` modifies a function, `f`, so that it is repeatedly called until it succeeds (@richierocks, @ijlyttle). `slowly()` modifies a function so that it waits for a given amount of time between calls. ## `partial()` The interface of `partial()` has been simplified. It now supports quasiquotation to control the timing of evaluation, and the `rlang::call_modify()` syntax to control the position of partialised arguments. * `partial()` now supports empty `... = ` argument to specify the position of future arguments, relative to partialised ones. This syntax is borrowed from (and implemented with) `rlang::call_modify()`. To prevent partial matching of `...` on `...f`, the latter has been renamed to `.f`, which is more consistent with other purrr function signatures. * `partial()` now supports quasiquotation. When you unquote an argument, it is evaluated only once at function creation time. This is more flexible than the `.lazy` argument since you can control the timing of evaluation for each argument. Consequently, `.lazy` is soft-deprecated (#457). * Fixed an infinite loop when partialised function is given the same name as the original function (#387). * `partial()` now calls `as_closure()` on primitive functions to ensure argument matching (#360). * The `.lazy` argument of `partial()` is soft-deprecated in favour of quasiquotation: ```r # Before partial(fn, u = runif(1), n = rnorm(1), .lazy = FALSE) # After partial(fn, u = !!runif(1), n = !!rnorm(1)) # All constant partial(fn, u = !!runif(1), n = rnorm(1)) # First constant ``` ## Minor improvements and fixes * The tibble package is now in Suggests rather than Imports. This brings the hard dependency of purrr to just rlang and magrittr. * `compose()` now returns an identity function when called without inputs. * Functions created with `compose()` now have the same formal parameters as the first function to be called. They also feature a more informative print method that prints all composed functions in turn (@egnha, #366). * New `.dir` argument in `compose()`. When set to `"forward"`, the functions are composed from left to right rather than right to left. * `list_modify()` now supports the `zap()` sentinel (reexported from rlang) to remove elements from lists. Consequently, removing elements with the ambiguous sentinel `NULL` is soft-deprecated. * The requirements of `list_modify()` and `list_merge()` have been relaxed. Previously it required both the modified lists and the inputs to be either named or unnamed. This restriction now only applies to inputs in `...`. When inputs are all named, they are matched to the list by name. When they are all unnamed, they are matched positionally. Otherwise, this is an error. * Fixed ordering of names returned by `accumulate_right()` output. They now correspond to the order of inputs. * Fixed names of `accumulate()` output when `.init` is supplied. * `compose()` now supports composition with lambdas (@ColinFay, #556) * Fixed a `pmap()` crash with empty lists on the Win32 platform (#565). * `modify_depth` now has `.ragged` argument evaluates correctly to `TRUE` by default when `.depth < 0` (@cderv, #530). * `accumulate()` now inherits names from their first input (@AshesITR, #446). * `attr_getter()` no longer uses partial matching. For example, if an `x` object has a `labels` attribute but no `label` attribute, `attr_getter("label")(x)` will no longer extract the `labels` attribute (#460, @huftis). * `flatten_dfr()` and `flatten_dfc()` now aborts if dplyr is not installed. (#454) * `imap_dfr()` now works with `.id` argument is provided (#429) * `list_modify()`, `update_list()` and `list_merge()` now handle duplicate duplicate argument names correctly (#441, @mgirlich). * `map_raw`, `imap_raw`, `flatten_raw`, `invoke_map_raw`, `map2_raw` and `pmap_raw` added to support raw vectors. (#455, @romainfrancois) * `flatten()` now supports raw and complex elements. * `array_branch()` and `array_tree()` now retain the `dimnames()` of the input array (#584, @flying-sheep) * `pluck()` no longer flattens lists of arguments. You can still do it manually with `!!!`. This change is for consistency with other dots-collecting functions of the tidyverse. * `map_at()`, `lmap_at()` and `modify_at()` now supports selection using `vars()` and `tidyselect` (@ColinFay, #608). Note that for now you need to import `vars()` from dplyr or call it qualified like `dplyr::vars()`. It will be reexported from rlang in a future release. * `detect()` now has a .default argument to specify the value returned when nothing is detected (#622, @ColinFay). ## Life cycle ### `.dir` arguments We have standardised the purrr API for reverse iteration with a common `.dir` argument. * `reduce_right()` is soft-deprecated and replaced by a new `.dir` argument of `reduce()`: ```{r} # Before: reduce_right(1:3, f) # After: reduce(1:3, f, .dir = "backward") ``` Note that the details of the computation have changed. Whereas `reduce_right()` computed `f(f(3, 2), 1)`, it now computes `f(1, f(2, 3))`. This is the standard way of reducing from the right. To produce the exact same reduction as `reduce_right()`, simply reverse your vector and use a left reduction: ```{r} # Before: reduce_right(1:3, f) # After: reduce(rev(1:3), f) ``` * `reduce2_right()` is soft-deprecated without replacement. It is not clear what algorithmic properties should a right reduction have in this case. Please reach out if you know about a use case for a right reduction with a ternary function. * `accumulate_right()` is soft-deprecated and replaced by the new `.dir` argument of `accumulate()`. Note that the algorithm has slightly changed: the accumulated value is passed to the right rather than the left, which is consistent with a right reduction. ```{r} # Before: accumulate_right(1:3, f) # After: accumulate(1:3, f, .dir = "backward") ``` * The `.right` argument of `detect()` and `detect_index()` is soft-deprecated and renamed to `.dir` for consistency with other functions and clarity of the interface. ```{r} # Before detect(x, f, .right = TRUE) # After detect(x, f, .dir = "backward") ``` ### Simplification of `partial()` The interface of `partial()` has been simplified (see more about `partial()` below): * The `.lazy` argument of `partial()` is soft-deprecated in favour of quasiquotation. * We had to rename `...f` to `.f` in `partial()` in order to support `... = ` argument (which would otherwise partial-match on `...f`). This also makes `partial()` more consistent with other purrr function signatures. ### Retirement of `invoke()` `invoke()` and `invoke_map()` are retired in favour of `exec()`. Note that retired functions are no longer under active development, but continue to be maintained indefinitely in the package. * `invoke()` is retired in favour of the `exec()` function, reexported from rlang. `exec()` evaluates a function call built from its inputs and supports tidy dots: ```r # Before: invoke(mean, list(na.rm = TRUE), x = 1:10) # After exec(mean, 1:10, !!!list(na.rm = TRUE)) ``` Note that retired functions are not removed from the package and will be maintained indefinitely. * `invoke_map()` is retired without replacement because it is more complex to understand than the corresponding code using `map()`, `map2()` and `exec()`: ```r # Before: invoke_map(fns, list(args)) invoke_map(fns, list(args1, args2)) # After: map(fns, exec, !!!args) map2(fns, list(args1, args2), function(fn, args) exec(fn, !!!args)) ``` ### Other lifecycle changes * `%@%` is soft-deprecated, please use the operator exported in rlang instead. The latter features an interface more consistent with `@` as it uses NSE, supports S4 fields, and has an assignment variant. * Removing elements from lists using `NULL` in `list_modify()` is soft-deprecated. Please use the new `zap()` sentinel reexported from rlang instead: ```{r} # Before: list_modify(x, foo = NULL) # After: list_modify(x, foo = zap()) ``` This change is motivated by the ambiguity of `NULL` as a deletion sentinel because `NULL` is also a valid value in lists. In the future, `NULL` will set an element to `NULL` rather than removing the element. * `rerun()` is now in the questioning stage because we are no longer convinced NSE functions are a good fit for purrr. Also, `rerun(n, x)` can just as easily be expressed as `map(1:n, ~ x)` (with the added benefit of being passed the current index as argument to the lambda). * `map_call()` is defunct. # purrr 0.2.5 * This is a maintenance release following the release of dplyr 0.7.5. # purrr 0.2.4 * Fixes for R 3.1. # purrr 0.2.3 ## Breaking changes We noticed the following issues during reverse dependencies checks: * If `reduce()` fails with this message: ``Error: `.x` is empty, and no `.init` supplied``, this is because `reduce()` now returns `.init` when `.x` is empty. Fix the problem by supplying an appropriate argument to `.init`, or by providing special behaviour when `.x` has length 0. * The type predicates have been migrated to rlang. Consequently the `bare-type-predicates` documentation topic is no longer in purrr, which might cause a warning if you cross-reference it. ## Dependencies purrr no longer depends on lazyeval or Rcpp (or dplyr, as of the previous version). This makes the dependency graph of the tidyverse simpler, and makes purrr more suitable as a dependency of lower-level packages. There have also been two changes to eliminate name conflicts between purrr and dplyr: * `order_by()`, `sort_by()` and `split_by()` have been removed. `order_by()` conflicted with `dplyr::order_by()` and the complete family doesn't feel that useful. Use tibbles instead (#217). * `contains()` has been renamed to `has_element()` to avoid conflicts with dplyr (#217). ## pluck() The plucking mechanism used for indexing into data structures with `map()` has been extracted into the function `pluck()`. Plucking is often more readable to extract an element buried in a deep data structure. Compare this syntax-heavy extraction which reads non-linearly: ``` accessor(x[[1]])$foo ``` to the equivalent pluck: ``` x |> pluck(1, accessor, "foo") ``` ## Map helpers * `as_function()` is now `as_mapper()` because it is a transformation that makes sense primarily for mapping functions, not in general (#298). `.null` has been renamed to `.default` to better reflect its intent (#298). `.default` is returned whenever an element is absent or empty (#231, #254). `as_mapper()` sanitises primitive functions by transforming them to closures with standardised argument names (using `rlang::as_closure()`). For instance `+` is transformed to `function(.x, .y) .x + .y`. This results in proper argument matching so that `map(1:10, partial(`-`, .x = 5))` produces `list(5 - 1, 5 - 2, ...)`. * Recursive indexing can now extract objects out of environments (#213) and S4 objects (#200), as well as lists. * `attr_getter()` makes it possible to extract from attributes like `map(list(iris, mtcars), attr_getter("row.names"))`. * The argument list for formula-functions has been tweaked so that you can refer to arguments by position with `..1`, `..2`, and so on. This makes it possible to use the formula shorthand for functions with more than two arguments (#289). * `possibly()`, `safely()` and friends no longer capture interrupts: this means that you can now terminate a mapper using one of these with Escape or Ctrl + C (#314) ## Map functions * All map functions now treat `NULL` the same way as an empty vector (#199), and return an empty vector if any input is an empty vector. * All `map()` functions now force their arguments in the same way that base R does for `lapply()` (#191). This makes `map()` etc easier to use when generating functions. * A new family of "indexed" map functions, `imap()`, `imap_lgl()` etc, provide a short-hand for `map2(x, names(x))` or `map2(x, seq_along(x))` (#240). * The data frame suffix `_df` has been (soft) deprecated in favour of `_dfr` to more clearly indicate that it's a row-bind. All variants now also have a `_dfc` for column binding (#167). (These will not be terribly useful until `dplyr::bind_rows()`/`dplyr::bind_cols()` have better semantics for vectors.) ## Modify functions A new `modify()` family returns the same output of the type as the input `.x`. This is in contrast to the `map()` family which always returns a list, regardless of the input type. The modify functions are S3 generics. However their default methods should be sufficient for most classes since they rely on the semantics of `[<-`. `modify.default()` is thus a shorthand for `x[] <- map(x, f)`. * `at_depth()` has been renamed to `modify_depth()`. * `modify_depth()` gains new `.ragged` argument, and negative depths are now computed relative to the deepest component of the list (#236). ## New functions * `auto_browse(f)` returns a new function that automatically calls `browser()` if `f` throws an error (#281). * `vec_depth()` computes the depth (i.e. the number of levels of indexing) or a vector (#243). * `reduce2()` and `reduce2_right()` make it possible to reduce with a 3 argument function where the first argument is the accumulated value, the second argument is `.x`, and the third argument is `.y` (#163). * `list_modify()` extends `stats::modifyList()` to replace by position if the list is not named.(#201). `list_merge()` operates similarly to `list_modify()` but combines instead of replacing (#322). * The legacy function `update_list()` is basically a version of `list_modify` that evaluates formulas within the list. It is likely to be deprecated in the future in favour of a tidyeval interface such as a list method for `dplyr::mutate()`. ## Minor improvements and bug fixes * Thanks to @dchiu911, the unit test coverage of purrr is now much greater. * All predicate functions are re-exported from rlang (#124). * `compact()` now works with standard mapper conventions (#282). * `cross_n()` has been renamed to `cross()`. The `_n` suffix was removed for consistency with `pmap()` (originally called `map_n()` at the start of the project) and `transpose()` (originally called `zip_n()`). Similarly, `cross_d()` has been renamed to `cross_df()` for consistency with `map_df()`. * `every()` and `some()` now return `NA` if present in the input (#174). * `invoke()` uses a more robust approach to generate the argument list (#249) It no longer uses lazyeval to figure out which environment a character `f` comes from. * `is_numeric()` and `is_scalar_numeric()` are deprecated because they don't test for what you might expect at first sight. * `reduce()` now throws an error if `.x` is empty and `.init` is not supplied. * Deprecated functions `flatmap()`, `map3()`, `map_n()`, `walk3()`, `walk_n()`, `zip2()`, `zip3()`, `zip_n()` have been removed. * `pmap()` coerces data frames to lists to avoid the expensive `[.data.frame` which provides security that is unneeded here (#220). * `rdunif()` checks its inputs for validity (#211). * `set_names()` can now take a function to transform the names programmatically (#276), and you can supply names in `...` to reduce typing even more more (#316). `set_names()` is now powered by `rlang::set_names()`. * `safely()` now actually uses the `quiet` argument (#296). * `transpose()` now matches by name if available (#164). You can override the default choice with the new `.names` argument. * The function argument of `detect()` and `detect_index()` have been renamed from `.p` to `.f`. This is because they have mapper semantics rather than predicate semantics. # purrr 0.2.2.1 This is a compatibility release with dplyr 0.6.0. * All data-frame based mappers have been removed in favour of new functions and idioms in the tidyverse. `dmap()`, `dmap_at()`, `dmap_if()`, `invoke_rows()`, `slice_rows()`, `map_rows()`, `by_slice()`, `by_row()`, and `unslice()` have been moved to purrrlyr. This is a bit of an aggressive change but it allows us to make the dependencies much lighter. # purrr 0.2.2 * Fix for dev tibble support. * `as_function()` now supports list arguments which allow recursive indexing using either names or positions. They now always stop when encountering the first NULL (#173). * `accumulate` and `reduce` correctly pass extra arguments to the worker function. # purrr 0.2.1 * `as_function()` gains a `.null` argument that for character and numeric values allows you to specify what to return for null/absent elements (#110). This can be used with any map function, e.g. `map_int(x, 1, .null = NA)` * `as_function()` is now generic. * New `is_function()` that returns `TRUE` only for regular functions. * Fix crash on GCC triggered by `invoke_rows()`. # purrr 0.2.0 ## New functions * There are two handy infix functions: * `x %||% y` is shorthand for `if (is.null(x)) y else x` (#109). * `x %@% "a"` is shorthand for `attr(x, "a", exact = TRUE)` (#69). * `accumulate()` has been added to handle recursive folding. It is shorthand for `Reduce(f, .x, accumulate = TRUE)` and follows a similar syntax to `reduce()` (#145). A right-hand version `accumulate_right()` was also added. * `map_df()` row-binds output together. It's the equivalent of `plyr::ldply()` (#127) * `flatten()` is now type-stable and always returns a list. To return a simpler vector, use `flatten_lgl()`, `flatten_int()`, `flatten_dbl()`, `flatten_chr()`, or `flatten_df()`. * `invoke()` has been overhauled to be more useful: it now works similarly to `map_call()` when `.x` is NULL, and hence `map_call()` has been deprecated. `invoke_map()` is a vectorised complement to `invoke()` (#125), and comes with typed variants `invoke_map_lgl()`, `invoke_map_int()`, `invoke_map_dbl()`, `invoke_map_chr()`, and `invoke_map_df()`. * `transpose()` replaces `zip2()`, `zip3()`, and `zip_n()` (#128). The name more clearly reflects the intent (transposing the first and second levels of list). It no longer has fields argument or the `.simplify` argument; instead use the new `simplify_all()` function. * `safely()`, `quietly()`, and `possibly()` are experimental functions for working with functions with side-effects (e.g. printed output, messages, warnings, and errors) (#120). `safely()` is a version of `try()` that modifies a function (rather than an expression), and always returns a list with two components, `result` and `error`. * `list_along()` and `rep_along()` generalise the idea of `seq_along()`. (#122). * `is_null()` is the snake-case version of `is.null()`. * `pmap()` (parallel map) replaces `map_n()` (#132), and has typed-variants suffixed `pmap_lgl()`, `pmap_int()`, `pmap_dbl()`, `pmap_chr()`, and `pmap_df()`. * `set_names()` is a snake-case alternative to `setNames()` with stricter equality checking, and more convenient defaults for pipes: `x |> set_names()` is equivalent to `setNames(x, x)` (#119). ## Row based functionals We are still figuring out what belongs in dplyr and what belongs in purrr. Expect much experimentation and many changes with these functions. * `map()` now always returns a list. Data frame support has been moved to `map_df()` and `dmap()`. The latter supports sliced data frames as a shortcut for the combination of `by_slice()` and `dmap()`: `x |> by_slice(dmap, fun, .collate = "rows")`. The conditional variants `dmap_at()` and `dmap_if()` also support sliced data frames and will recycle scalar results to the slice size. * `map_rows()` has been renamed to `invoke_rows()`. As other rows-based functionals, it collates results inside lists by default, but with column collation this function is equivalent to `plyr::mdply()`. * The rows-based functionals gain a `.to` option to name the output column as well as a `.collate` argument. The latter allows to collate the output in lists (by default), on columns or on rows. This makes these functions more flexible and more predictable. ## Bug fixes and minor changes * `as_function()`, which converts formulas etc to functions, is now exported (#123). * `rerun()` is correctly scoped (#95) * `update_list()` can now modify an element called `x` (#98). * `map*()` now use custom C code, rather than relying on `lapply()`, `mapply()` etc. The performance characteristics are very similar, but it allows us greater control over the output (#118). * `map_lgl()` now has second argument `.f`, not `.p` (#134). ## Deprecated functions * `flatmap()` -> use `map()` followed by the appropriate `flatten()`. * `map_call()` -> `invoke()`. * `map_n()` -> `pmap()`; `walk_n()` -> `pwalk()`. * `map3(x, y, z)` -> `map_n(list(x, y, z))`; `walk3(x, y, z) -> `pwalk(list(x, y, z))` purrr/inst/0000755000176200001440000000000015166146731012413 5ustar liggesuserspurrr/inst/doc/0000755000176200001440000000000015166146731013160 5ustar liggesuserspurrr/inst/doc/other-langs.Rmd0000644000176200001440000000403215163460322016036 0ustar liggesusers--- title: "Functional programming in other languages" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Functional programming in other languages} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- purrr draws inspiration from many related tools: * List operations defined in the Haskell [prelude][haskell] * Scala's [list methods][scala]. * Functional programming libraries for javascript: [underscore.js](http://underscorejs.org), [lodash](https://lodash.com) and [lazy.js](http://danieltao.com/lazy.js/). * [rlist](https://renkun-ken.github.io/rlist/), another R package to support working with lists. Similar goals but somewhat different philosophy. However, the goal of purrr is not to try and simulate a purer functional programming language in R; we don't want to implement a second-class version of Haskell in R. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R: * Instead of point free (tacit) style, we use the pipe, `|>`, to write code that can be read from left to right. * Instead of currying, we use `...` to pass in extra arguments. * Before R 4.1, anonymous functions were verbose, so we provided a convenient shorthand. For unary functions, `~ .x + 1` is equivalent to `function(.x) .x + 1`. Now we recommend using the function shorthand notation introduced in R 4.1, where `\(x) x + 1` is equivalent to `function(x) x + 1`. * R is weakly typed, so we need `map` variants that describe the output type (like `map_int()`, `map_dbl()`, etc) because we don't know the return type of `.f`. * R has named arguments, so instead of providing different functions for minor variations (e.g. `detect()` and `detectLast()`) we use a named argument, `.right`. Type-stable functions are easy to reason about so additional arguments will never change the type of the output. [scala]:https://www.scala-lang.org/api/current/index.html [haskell]:http://hackage.haskell.org/package/base-4.7.0.1/docs/Prelude.html#g:11 purrr/inst/doc/purrr.html0000644000176200001440000010142315166146731015221 0ustar liggesusers Get started with purrr

Get started with purrr

Introduction

purrr helps you write cleaner, more maintainable R code through functional programming concepts. But what is functional programming? At its core, it’s an approach to programming that emphasizes using functions to transform data, similar to how you might use a series of tools to process raw materials into a final product. Instead of writing loops and modifying data step by step, functional programming encourages you to think about your data transformations as a series of function applications. This notion is rather abstract, but we believe mastering functional programming makes your code clearer and less prone to errors. You’ll hopefully get some sense of that by the end of this vignette!

This vignette discusses two of the most important parts of purrr: map functions and predicate functions.

library(purrr)

Map: A better way to loop

map()1 provides a more compact way to apply functions to each element of a vector, returning a list:

x <- 1:3

triple <- function(x) x * 3
out <- map(x, triple)
str(out)
#> List of 3
#>  $ : num 3
#>  $ : num 6
#>  $ : num 9

Or written with the pipe:

x |>
  map(triple) |>
  str()
#> List of 3
#>  $ : num 3
#>  $ : num 6
#>  $ : num 9

This is equivalent to a for loop:

out <- vector("list", 3)
for (i in seq_along(x)) {
  out[[i]] <- triple(x[[i]])
}
str(out)
#> List of 3
#>  $ : num 3
#>  $ : num 6
#>  $ : num 9

Even on its own, there are some benefits to map(): once you get used to the syntax, it’s a very compact way to express the idea of transforming a vector, returning one output element for each input element. But there are several other reasons to use map(), which we’ll explore in the following sections:

  • Progress bars
  • Parallel computing
  • Output variants
  • Input variants

Progress bars

For long-running jobs, like web scraping, model fitting, or data processing, it’s really useful to get a progress bar that helps you estimate how long you’ll need to wait. Progress bars are easy to enable in purrr: just set .progress = TRUE. It’s hard to illustrate progress bars in a vignette, but you can try this example interactively:

out <- map(1:100, \(i) Sys.sleep(0.5), .progress = TRUE)

Learn more about progress bars in ?progress_bars.

Parallel computing

By default, map() runs only in your current R session. But you can easily opt in to spreading your task across multiple R sessions, and hence multiple cores with in_parallel(). This can give big performance improvements if your task is primarily bound by compute performance.

purrr’s parallelism is powered by mirai, so to begin, you need to start up a number of background R sessions, called daemons:

mirai::daemons(6)

(You only need to do this once per session.)

Now you can easily convert your map() call to run in parallel:

out <- map(1:5, in_parallel(\(i) Sys.sleep(0.5)))

It’s important to realize that this parallelism works by spreading computation across clean R sessions. That means that code like this will not work, because the worker daemons won’t have a copy of my_lm():

my_lm <- function(formula, data) {
  Sys.sleep(0.5)
  lm(formula, data)
}
by_cyl <- split(mtcars, mtcars$cyl)
out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df)))
#> Error in `map()`:
#> ℹ In index: 1.
#> ℹ With name: 4.
#> Caused by error in `my_lm()`:
#> ! could not find function "my_lm"

You can resolve this by passing additional data along to in_parallel():

out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df), my_lm = my_lm))

Learn more about parallel computing in ?in_parallel.

Output variants

purrr functions are type-stable, which means it’s easy to predict what type of output they return, e.g., map() always returns a list. But what if you want a different type of output? That’s where the output variants come into play:

  • There are four variants for the four most important types of atomic vector:

    • map_lgl() returns a logical vector.
    • map_int() returns an integer vector.
    • map_dbl() returns a numeric (double) vector.
    • map_chr() returns a character vector.

  • For all other types of vector (like dates, date-times, factors, etc.), there’s map_vec(). It’s a little harder to precisely describe the output type, but if your function returns a length-1 vector of type “fooâ€, then the output of map_vec() will be a length-n vector of type “fooâ€.

  • modify() returns output with the same type as the input. For example, if the input is a data frame, the output will also be a data frame.

  • walk() returns the input (invisibly); it’s useful when you’re calling a function purely for its side effects, for example, generating plots or saving files.

purrr, like many tidyverse functions, is designed to help you solve complex problems by stringing together simple pieces. This is particularly natural to do with the pipe. For example, the following code splits mtcars into one data frame for each value of cyl, fits a linear model to each subset, computes the model summary, and then extracts the R-squared:

mtcars |>
  split(mtcars$cyl) |> # from base R
  map(\(df) lm(mpg ~ wt, data = df)) |>
  map(summary) |>
  map_dbl(\(x) x$r.squared)
#>         4         6         8 
#> 0.5086326 0.4645102 0.4229655

Input variants

map() and friends all iterate over a single list, making it poorly suited for some problems. For example, how would you find a weighted mean when you have a list of observations and a list of weights? Imagine we have the following data:

xs <- map(1:8, ~ runif(10))
xs[[1]][[1]] <- NA
ws <- map(1:8, ~ rpois(10, 5) + 1)

We could use map_dbl() to compute unweighted means:

map_dbl(xs, mean)
#> [1]        NA 0.3940217 0.6221505 0.4176722 0.4016500 0.5058472 0.5201613
#> [8] 0.5138508

But there’s no way to use map() to compute a weighted mean because we need to call weighted.mean(xs[[1]], ws[[1]]), weighted.mean(xs[[2]], ws[[2]]), etc. That’s the job of map2():

map2_dbl(xs, ws, weighted.mean)
#> [1]        NA 0.3793082 0.6352953 0.4286744 0.4067268 0.5487410 0.4804650
#> [8] 0.4702240

Note that the arguments that vary for each call come before the function and arguments that are constant come after the function:

map2_dbl(xs, ws, weighted.mean, na.rm = TRUE)
#> [1] 0.5647890 0.3793082 0.6352953 0.4286744 0.4067268 0.5487410 0.4804650
#> [8] 0.4702240

But we generally recommend using an anonymous function instead, as this makes it very clear where each argument is going:

map2_dbl(xs, ws, \(x, w) weighted.mean(x, w, na.rm = TRUE))

There are two important variants of map2(): pmap() which can take any number of varying arguments (passed as a list), and imap() which iterates over the values and indices of a single vector. Learn more in their documentation.

Combinatorial explosion

What makes purrr particularly special is that all of the above features (progress bars, parallel computing, output variants, and input variants) can be combined any way that you choose. The combination of inputs (prefixes) and outputs (suffixes) forms a matrix, and you can use .progress or in_parallel() with any of them:

Output type Single input (.x) Two inputs (.x, .y) Multiple inputs (.l)
List map(.x, .f) map2(.x, .y, .f) pmap(.l, .f)
Logical map_lgl(.x, .f) map2_lgl(.x, .y, .f) pmap_lgl(.l, .f)
Integer map_int(.x, .f) map2_int(.x, .y, .f) pmap_int(.l, .f)
Double map_dbl(.x, .f) map2_dbl(.x, .y, .f) pmap_dbl(.l, .f)
Character map_chr(.x, .f) map2_chr(.x, .y, .f) pmap_chr(.l, .f)
Vector map_vec(.x, .f) map_vec(.x, .y, .f) map_vec(.l, .f)
Input walk(.x, .f) walk2(.x, .y, .f) pwalk(.l, .f)

Filtering and finding with predicates

purrr provides a number of functions that work with predicate functions. Predicate functions take a vector and return either TRUE or FALSE, with examples including is.character() and \(x) any(is.na(x)). You typically use them to filter or find; for example, you could use them to locate the first element of a list that’s a character vector, or only keep the columns in a data frame that have missing values.

purrr comes with a bunch of helpers to make predicate functions easier to use:

  • detect(.x, .p) returns the value of the first element in .x where .p is TRUE.
  • detect_index(.x, .p) returns the position of the first element in .x where .p is TRUE.
  • keep(.x, .p) returns all elements from .x where .p evaluates to TRUE.
  • discard(.x, .p) returns all elements from .x where .p evaluates to FALSE.
  • every(.x, .p) returns TRUE if .p returns TRUE for every element in .x.
  • some(.x, .p) returns TRUE if .p returns TRUE for at least one element in .x.
  • none(.x, .p) returns TRUE if .p returns FALSE for all elements in .x.
  • head_while(.x, .p) returns elements from the beginning of .x while .p is TRUE, stopping at the first FALSE.
  • tail_while(.x, .p) returns elements from the end of .x while .p is TRUE, stopping at the first FALSE.

You’ll typically use these functions with lists, since you can usually rely on vectorization for simpler vectors.

x <- list(
  a = letters[1:10],
  b = 1:10,
  c = runif(15)
)

x |> detect(is.character)
#>  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
x |> detect_index(is.numeric)
#> [1] 2

x |> keep(is.numeric) |> str()
#> List of 2
#>  $ b: int [1:10] 1 2 3 4 5 6 7 8 9 10
#>  $ c: num [1:15] 0.279 0.215 0.649 0.563 0.772 ...
x |> discard(is.numeric) |> str()
#> List of 1
#>  $ a: chr [1:10] "a" "b" "c" "d" ...

x |> every(\(x) length(x) > 10)
#> [1] FALSE
x |> some(\(x) length(x) > 10)
#> [1] TRUE
x |> none(\(x) length(x) == 0)
#> [1] TRUE

  1. You might wonder why this function is called map(). What does it have to do with depicting physical features of land or sea 🗺? In fact, the meaning comes from mathematics where map refers to “an operation that associates each element of a given set with one or more elements of a second setâ€. This makes sense here because map() defines a mapping from one vector to another. And “map†also has the nice property of being short, which is useful for such a fundamental building block.↩︎

purrr/inst/doc/other-langs.html0000644000176200001440000001534715166146723016304 0ustar liggesusers Functional programming in other languages

Functional programming in other languages

purrr draws inspiration from many related tools:

  • List operations defined in the Haskell prelude

  • Scala’s list methods.

  • Functional programming libraries for javascript: underscore.js, lodash and lazy.js.

  • rlist, another R package to support working with lists. Similar goals but somewhat different philosophy.

However, the goal of purrr is not to try and simulate a purer functional programming language in R; we don’t want to implement a second-class version of Haskell in R. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R:

  • Instead of point free (tacit) style, we use the pipe, |>, to write code that can be read from left to right.

  • Instead of currying, we use ... to pass in extra arguments.

  • Before R 4.1, anonymous functions were verbose, so we provided a convenient shorthand. For unary functions, ~ .x + 1 is equivalent to function(.x) .x + 1. Now we recommend using the function shorthand notation introduced in R 4.1, where \(x) x + 1 is equivalent to function(x) x + 1.

  • R is weakly typed, so we need map variants that describe the output type (like map_int(), map_dbl(), etc) because we don’t know the return type of .f.

  • R has named arguments, so instead of providing different functions for minor variations (e.g. detect() and detectLast()) we use a named argument, .right. Type-stable functions are easy to reason about so additional arguments will never change the type of the output.

purrr/inst/doc/base.html0000644000176200001440000010664215166146723014772 0ustar liggesusers purrr <-> base R

purrr <-> base R

Introduction

This vignette compares purrr’s functionals to their base R equivalents, focusing primarily on the map family and related functions. This helps those familiar with base R understand better what purrr does, and shows purrr users how you might express the same ideas in base R code. We’ll start with a rough overview of the major differences, give a rough translation guide, and then show a few examples.

library(purrr)
library(tibble)

Key differences

There are two primary differences between the base apply family and the purrr map family: purrr functions are named more consistently, and more fully explore the space of input and output variants.

  • purrr functions consistently use . as prefix to avoid inadvertently matching arguments of the purrr function, instead of the function that you’re trying to call. Base functions use a variety of techniques including upper case (e.g. lapply(X, FUN, ...)) or require anonymous functions (e.g. Map()).

  • All map functions are type stable: you can predict the type of the output using little information about the inputs. In contrast, the base functions sapply() and mapply() automatically simplify making the return value hard to predict.

  • The map functions all start with the data, followed by the function, then any additional constant argument. Most base apply functions also follow this pattern, but mapply() starts with the function, and Map() has no way to supply additional constant arguments.

  • purrr functions provide all combinations of input and output variants, and include variants specifically for the common two argument case.

Direct translations

The following sections give a high-level translation between base R commands and their purrr equivalents. See function documentation for the details.

Map functions

Here x denotes a vector and f denotes a function

Output Input Base R purrr
List 1 vector lapply() map()
List 2 vectors mapply(), Map() map2()
List >2 vectors mapply(), Map() pmap()
Atomic vector of desired type 1 vector vapply() map_lgl() (logical), map_int() (integer), map_dbl() (double), map_chr() (character), map_vec() (other vectors)
Atomic vector of desired type 2 vectors mapply(), Map(), then is.*() to check type map2_lgl() (logical), map2_int() (integer), map2_dbl() (double), map2_chr() (character), map2_vec() (other vectors)
Atomic vector of desired type >2 vectors mapply(), Map(), then is.*() to check type pmap_lgl() (logical), pmap_int() (integer), pmap_dbl() (double), pmap_chr() (character), pmap_vec() (other vectors)
Side effect only 2 vectors loops walk2()
Side effect only 1 vector loops walk()
Side effect only >2 vectors loops pwalk()
Data frame (rbind outputs) 1 vector lapply() then rbind() map() then list_rbind()
Data frame (rbind outputs) 2 vectors mapply()/Map() then rbind() map2() then list_rbind()
Data frame (rbind outputs) >2 vectors mapply()/Map() then rbind() pmap() then list_rbind()
Data frame (cbind outputs) 1 vector lapply() then cbind() map() then list_cbind()
Data frame (cbind outputs) 2 vectors mapply()/Map() then cbind() map2() then list_cbind()
Data frame (cbind outputs) >2 vectors mapply()/Map() then cbind() pmap() then list_cbind()
Any Vector and its names l/s/vapply(X, function(x) f(x, names(x))) or mapply/Map(f, x, names(x)) imap(), imap_*() (lgl, dbl, chr, and etc. just like for map(), map2(), and pmap())
Any Selected elements of the vector l/s/vapply(X[index], FUN, ...) map_if(), map_at()
List Recursively apply to list within list rapply() map_depth()
List List only lapply() lmap(), lmap_at(), lmap_if()

Extractor shorthands

Since a common use case for map functions is list extracting components, purrr provides a handful of shortcut functions for various uses of [[.

Input base R purrr
Extract by name lapply(x, `[[`, "a") map(x, "a")
Extract by position lapply(x, `[[`, 3) map(x, 3)
Extract deeply lapply(x, \(y) y[[1]][["x"]][[3]]) map(x, list(1, "x", 3))
Extract with default value lapply(x, function(y) tryCatch(y[[3]], error = function(e) NA)) map(x, 3, .default = NA)

Predicates

Here p, a predicate, denotes a function that returns TRUE or FALSE indicating whether an object fulfills a criterion, e.g. is.character().

Description base R purrr
Find a matching element Find(p, x) detect(x, p),
Find position of matching element Position(p, x) detect_index(x, p)
Do all elements of a vector satisfy a predicate? all(sapply(x, p)) every(x, p)
Does any elements of a vector satisfy a predicate? any(sapply(x, p)) some(x, p)
Does a list contain an object? any(sapply(x, identical, obj)) has_element(x, obj)
Keep elements that satisfy a predicate x[sapply(x, p)] keep(x, p)
Discard elements that satisfy a predicate x[!sapply(x, p)] discard(x, p)
Negate a predicate function function(x) !p(x) negate(p)

Other vector transforms

Description base R purrr
Accumulate intermediate results of a vector reduction Reduce(f, x, accumulate = TRUE) accumulate(x, f)
Recursively combine two lists c(X, Y), but more complicated to merge recursively list_merge(), list_modify()
Reduce a list to a single value by iteratively applying a binary function Reduce(f, x) reduce(x, f)

Examples

Varying inputs

One input

Suppose we would like to generate a list of samples of 5 from normal distributions with different means:

means <- 1:4

There’s little difference when generating the samples:

  • Base R uses lapply():

    set.seed(2020)
samples <- lapply(means, rnorm, n = 5, sd = 1)
str(samples)
#> List of 4
#>  $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797
#>  $ : num [1:5] 2.72 2.94 1.77 3.76 2.12
#>  $ : num [1:5] 2.15 3.91 4.2 2.63 2.88
#>  $ : num [1:5] 5.8 5.704 0.961 1.711 4.058

  • purrr uses map():

    set.seed(2020)
samples <- map(means, rnorm, n = 5, sd = 1)
str(samples)
#> List of 4
#>  $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797
#>  $ : num [1:5] 2.72 2.94 1.77 3.76 2.12
#>  $ : num [1:5] 2.15 3.91 4.2 2.63 2.88
#>  $ : num [1:5] 5.8 5.704 0.961 1.711 4.058

Two inputs

Lets make the example a little more complicated by also varying the standard deviations:

means <- 1:4
sds <- 1:4

  • This is relatively tricky in base R because we have to adjust a number of mapply()’s defaults.

    set.seed(2020)
samples <- mapply(
  rnorm, 
  mean = means, 
  sd = sds, 
  MoreArgs = list(n = 5), 
  SIMPLIFY = FALSE
)
str(samples)
#> List of 4
#>  $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797
#>  $ : num [1:5] 3.44 3.88 1.54 5.52 2.23
#>  $ : num [1:5] 0.441 5.728 6.589 1.885 2.63
#>  $ : num [1:5] 11.2 10.82 -8.16 -5.16 4.23

    Alternatively, we could use Map() which doesn’t simplify, but also doesn’t take any constant arguments, so we need to use an anonymous function:

    samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds)

    In R 4.1 and up, you could use the shorter anonymous function form:

    samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds)

  • Working with a pair of vectors is a common situation so purrr provides the map2() family of functions:

    set.seed(2020)
samples <- map2(means, sds, rnorm, n = 5)
str(samples)
#> List of 4
#>  $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797
#>  $ : num [1:5] 3.44 3.88 1.54 5.52 2.23
#>  $ : num [1:5] 0.441 5.728 6.589 1.885 2.63
#>  $ : num [1:5] 11.2 10.82 -8.16 -5.16 4.23

Any number of inputs

We can make the challenge still more complex by also varying the number of samples:

ns <- 4:1

  • Using base R’s Map() becomes more straightforward because there are no constant arguments.

    set.seed(2020)
samples <- Map(rnorm, mean = means, sd = sds, n = ns)
str(samples)
#> List of 4
#>  $ : num [1:4] 1.377 1.302 -0.098 -0.13
#>  $ : num [1:3] -3.59 3.44 3.88
#>  $ : num [1:2] 2.31 8.28
#>  $ : num 4.47

  • In purrr, we need to switch from map2() to pmap() which takes a list of any number of arguments.

    set.seed(2020)
samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm)
str(samples)
#> List of 4
#>  $ : num [1:4] 1.377 1.302 -0.098 -0.13
#>  $ : num [1:3] -3.59 3.44 3.88
#>  $ : num [1:2] 2.31 8.28
#>  $ : num 4.47

Outputs

Given the samples, imagine we want to compute their means. A mean is a single number, so we want the output to be a numeric vector rather than a list.

  • There are two options in base R: vapply() or sapply(). vapply() requires you to specific the output type (so is relatively verbose), but will always return a numeric vector. sapply() is concise, but if you supply an empty list you’ll get a list instead of a numeric vector.

    # type stable
medians <- vapply(samples, median, FUN.VALUE = numeric(1L))
medians
#> [1] 0.6017626 3.4411470 5.2946304 4.4694671

# not type stable
medians <- sapply(samples, median)

  • purrr is little more compact because we can use map_dbl().

    medians <- map_dbl(samples, median)
medians
#> [1] 0.6017626 3.4411470 5.2946304 4.4694671

What if we want just the side effect, such as a plot or a file output, but not the returned values?

  • In base R we can either use a for loop or hide the results of lapply.

    # for loop
for (s in samples) {
  hist(s, xlab = "value", main = "")
}

# lapply
invisible(lapply(samples, function(s) {
  hist(s, xlab = "value", main = "")
}))

  • In purrr, we can use walk().

    walk(samples, ~ hist(.x, xlab = "value", main = ""))

Pipes

You can join multiple steps together with the pipe:

set.seed(2020)
means |>
  map(rnorm, n = 5, sd = 1) |>
  map_dbl(median)
#> [1] -0.09802317  2.72057350  2.87673977  4.05830349

The pipe is particularly compelling when working with longer transformations. For example, the following code splits mtcars up by cyl, fits a linear model, extracts the coefficients, and extracts the first one (the intercept).

mtcars |>
  split(mtcars$cyl) |> 
  map(\(df) lm(mpg ~ wt, data = df))|> 
  map(coef) |> 
  map_dbl(1)
#>        4        6        8 
#> 39.57120 28.40884 23.86803
purrr/inst/doc/base.Rmd0000644000176200001440000003510615163460322014533 0ustar liggesusers--- title: "purrr <-> base R" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{purrr <-> base R} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 4.5, fig.align = "center" ) options(tibble.print_min = 6, tibble.print_max = 6) ``` # Introduction This vignette compares purrr's functionals to their base R equivalents, focusing primarily on the map family and related functions. This helps those familiar with base R understand better what purrr does, and shows purrr users how you might express the same ideas in base R code. We'll start with a rough overview of the major differences, give a rough translation guide, and then show a few examples. ```{r setup} library(purrr) library(tibble) ``` ## Key differences There are two primary differences between the base apply family and the purrr map family: purrr functions are named more consistently, and more fully explore the space of input and output variants. - purrr functions consistently use `.` as prefix to avoid [inadvertently matching arguments](https://adv-r.hadley.nz/functionals.html#argument-names) of the purrr function, instead of the function that you're trying to call. Base functions use a variety of techniques including upper case (e.g. `lapply(X, FUN, ...)`) or require anonymous functions (e.g. `Map()`). - All map functions are type stable: you can predict the type of the output using little information about the inputs. In contrast, the base functions `sapply()` and `mapply()` automatically simplify making the return value hard to predict. - The map functions all start with the data, followed by the function, then any additional constant argument. Most base apply functions also follow this pattern, but `mapply()` starts with the function, and `Map()` has no way to supply additional constant arguments. - purrr functions provide all combinations of input and output variants, and include variants specifically for the common two argument case. ## Direct translations The following sections give a high-level translation between base R commands and their purrr equivalents. See function documentation for the details. ### `Map` functions Here `x` denotes a vector and `f` denotes a function | Output | Input | Base R | purrr | |------------------|------------------|------------------|-------------------| | List | 1 vector | `lapply()` | `map()` | | List | 2 vectors | `mapply()`, `Map()` | `map2()` | | List | \>2 vectors | `mapply()`, `Map()` | `pmap()` | | Atomic vector of desired type | 1 vector | `vapply()` | `map_lgl()` (logical), `map_int()` (integer), `map_dbl()` (double), `map_chr()` (character), `map_vec()` (other vectors) | | Atomic vector of desired type | 2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `map2_lgl()` (logical), `map2_int()` (integer), `map2_dbl()` (double), `map2_chr()` (character), `map2_vec()` (other vectors) | | Atomic vector of desired type | \>2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `pmap_lgl()` (logical), `pmap_int()` (integer), `pmap_dbl()` (double), `pmap_chr()` (character), `pmap_vec()` (other vectors) | | Side effect only | 2 vectors | loops | `walk2()` | | Side effect only | 1 vector | loops | `walk()` | | Side effect only | \>2 vectors | loops | `pwalk()` | | Data frame (`rbind` outputs) | 1 vector | `lapply()` then `rbind()` | `map()` then `list_rbind()` | | Data frame (`rbind` outputs) | 2 vectors | `mapply()`/`Map()` then `rbind()` | `map2()` then `list_rbind()` | | Data frame (`rbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `rbind()` | `pmap()` then `list_rbind()` | | Data frame (`cbind` outputs) | 1 vector | `lapply()` then `cbind()` | `map()` then `list_cbind()` | | Data frame (`cbind` outputs) | 2 vectors | `mapply()`/`Map()` then `cbind()` | `map2()` then `list_cbind()` | | Data frame (`cbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `cbind()` | `pmap()` then `list_cbind()` | | Any | Vector and its names | `l/s/vapply(X, function(x) f(x, names(x)))` or `mapply/Map(f, x, names(x))` | `imap()`, `imap_*()` (`lgl`, `dbl`, `chr`, and etc. just like for `map()`, `map2()`, and `pmap()`) | | Any | Selected elements of the vector | `l/s/vapply(X[index], FUN, ...)` | `map_if()`, `map_at()` | | List | Recursively apply to list within list | `rapply()` | `map_depth()` | | List | List only | `lapply()` | `lmap()`, `lmap_at()`, `lmap_if()` | ### Extractor shorthands Since a common use case for map functions is list extracting components, purrr provides a handful of shortcut functions for various uses of `[[`. | Input | base R | purrr | |-------------------|--------------------------|---------------------------| | Extract by name | `` lapply(x, `[[`, "a") `` | `map(x, "a")` | | Extract by position | `` lapply(x, `[[`, 3) `` | `map(x, 3)` | | Extract deeply | `lapply(x, \(y) y[[1]][["x"]][[3]])` | `map(x, list(1, "x", 3))` | | Extract with default value | `lapply(x, function(y) tryCatch(y[[3]], error = function(e) NA))` | `map(x, 3, .default = NA)` | ### Predicates Here `p`, a predicate, denotes a function that returns `TRUE` or `FALSE` indicating whether an object fulfills a criterion, e.g. `is.character()`. | Description | base R | purrr | |-----------------------------|--------------------|-----------------------| | Find a matching element | `Find(p, x)` | `detect(x, p)`, | | Find position of matching element | `Position(p, x)` | `detect_index(x, p)` | | Do all elements of a vector satisfy a predicate? | `all(sapply(x, p))` | `every(x, p)` | | Does any elements of a vector satisfy a predicate? | `any(sapply(x, p))` | `some(x, p)` | | Does a list contain an object? | `any(sapply(x, identical, obj))` | `has_element(x, obj)` | | Keep elements that satisfy a predicate | `x[sapply(x, p)]` | `keep(x, p)` | | Discard elements that satisfy a predicate | `x[!sapply(x, p)]` | `discard(x, p)` | | Negate a predicate function | `function(x) !p(x)` | `negate(p)` | ### Other vector transforms | Description | base R | purrr | |-----------------------------|--------------------|-----------------------| | Accumulate intermediate results of a vector reduction | `Reduce(f, x, accumulate = TRUE)` | `accumulate(x, f)` | | Recursively combine two lists | `c(X, Y)`, but more complicated to merge recursively | `list_merge()`, `list_modify()` | | Reduce a list to a single value by iteratively applying a binary function | `Reduce(f, x)` | `reduce(x, f)` | ## Examples ### Varying inputs #### One input Suppose we would like to generate a list of samples of 5 from normal distributions with different means: ```{r} means <- 1:4 ``` There's little difference when generating the samples: - Base R uses `lapply()`: ```{r} set.seed(2020) samples <- lapply(means, rnorm, n = 5, sd = 1) str(samples) ``` - purrr uses `map()`: ```{r} set.seed(2020) samples <- map(means, rnorm, n = 5, sd = 1) str(samples) ``` #### Two inputs Lets make the example a little more complicated by also varying the standard deviations: ```{r} means <- 1:4 sds <- 1:4 ``` - This is relatively tricky in base R because we have to adjust a number of `mapply()`'s defaults. ```{r} set.seed(2020) samples <- mapply( rnorm, mean = means, sd = sds, MoreArgs = list(n = 5), SIMPLIFY = FALSE ) str(samples) ``` Alternatively, we could use `Map()` which doesn't simplify, but also doesn't take any constant arguments, so we need to use an anonymous function: ```{r} samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds) ``` In R 4.1 and up, you could use the shorter anonymous function form: ```{r} samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds) ``` - Working with a pair of vectors is a common situation so purrr provides the `map2()` family of functions: ```{r} set.seed(2020) samples <- map2(means, sds, rnorm, n = 5) str(samples) ``` #### Any number of inputs We can make the challenge still more complex by also varying the number of samples: ```{r} ns <- 4:1 ``` - Using base R's `Map()` becomes more straightforward because there are no constant arguments. ```{r} set.seed(2020) samples <- Map(rnorm, mean = means, sd = sds, n = ns) str(samples) ``` - In purrr, we need to switch from `map2()` to `pmap()` which takes a list of any number of arguments. ```{r} set.seed(2020) samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm) str(samples) ``` ### Outputs Given the samples, imagine we want to compute their means. A mean is a single number, so we want the output to be a numeric vector rather than a list. - There are two options in base R: `vapply()` or `sapply()`. `vapply()` requires you to specific the output type (so is relatively verbose), but will always return a numeric vector. `sapply()` is concise, but if you supply an empty list you'll get a list instead of a numeric vector. ```{r} # type stable medians <- vapply(samples, median, FUN.VALUE = numeric(1L)) medians # not type stable medians <- sapply(samples, median) ``` - purrr is little more compact because we can use `map_dbl()`. ```{r} medians <- map_dbl(samples, median) medians ``` What if we want just the side effect, such as a plot or a file output, but not the returned values? - In base R we can either use a for loop or hide the results of `lapply`. ```{r, fig.show='hide'} # for loop for (s in samples) { hist(s, xlab = "value", main = "") } # lapply invisible(lapply(samples, function(s) { hist(s, xlab = "value", main = "") })) ``` - In purrr, we can use `walk()`. ```{r, fig.show='hide'} walk(samples, ~ hist(.x, xlab = "value", main = "")) ``` ### Pipes You can join multiple steps together with the pipe: ```{r} set.seed(2020) means |> map(rnorm, n = 5, sd = 1) |> map_dbl(median) ``` The pipe is particularly compelling when working with longer transformations. For example, the following code splits `mtcars` up by `cyl`, fits a linear model, extracts the coefficients, and extracts the first one (the intercept). ```{r} mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df))|> map(coef) |> map_dbl(1) ``` purrr/inst/doc/purrr.R0000644000176200001440000000555215166146731014464 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----------------------------------------------------------------------------- library(purrr) ## ----------------------------------------------------------------------------- x <- 1:3 triple <- function(x) x * 3 out <- map(x, triple) str(out) ## ----------------------------------------------------------------------------- x |> map(triple) |> str() ## ----------------------------------------------------------------------------- out <- vector("list", 3) for (i in seq_along(x)) { out[[i]] <- triple(x[[i]]) } str(out) ## ----------------------------------------------------------------------------- # out <- map(1:100, \(i) Sys.sleep(0.5), .progress = TRUE) ## ----------------------------------------------------------------------------- # mirai::daemons(6) ## ----------------------------------------------------------------------------- mirai::daemons(sync = TRUE) ## ----------------------------------------------------------------------------- out <- map(1:5, in_parallel(\(i) Sys.sleep(0.5))) ## ----------------------------------------------------------------------------- try({ my_lm <- function(formula, data) { Sys.sleep(0.5) lm(formula, data) } by_cyl <- split(mtcars, mtcars$cyl) out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df))) }) ## ----------------------------------------------------------------------------- out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df), my_lm = my_lm)) ## ----------------------------------------------------------------------------- mirai::daemons(0) ## ----------------------------------------------------------------------------- mtcars |> split(mtcars$cyl) |> # from base R map(\(df) lm(mpg ~ wt, data = df)) |> map(summary) |> map_dbl(\(x) x$r.squared) ## ----------------------------------------------------------------------------- xs <- map(1:8, ~ runif(10)) xs[[1]][[1]] <- NA ws <- map(1:8, ~ rpois(10, 5) + 1) ## ----------------------------------------------------------------------------- map_dbl(xs, mean) ## ----------------------------------------------------------------------------- map2_dbl(xs, ws, weighted.mean) ## ----------------------------------------------------------------------------- map2_dbl(xs, ws, weighted.mean, na.rm = TRUE) ## ----------------------------------------------------------------------------- # map2_dbl(xs, ws, \(x, w) weighted.mean(x, w, na.rm = TRUE)) ## ----------------------------------------------------------------------------- x <- list( a = letters[1:10], b = 1:10, c = runif(15) ) x |> detect(is.character) x |> detect_index(is.numeric) x |> keep(is.numeric) |> str() x |> discard(is.numeric) |> str() x |> every(\(x) length(x) > 10) x |> some(\(x) length(x) > 10) x |> none(\(x) length(x) == 0) purrr/inst/doc/base.R0000644000176200001440000000574115166146723014225 0ustar liggesusers## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 4.5, fig.align = "center" ) options(tibble.print_min = 6, tibble.print_max = 6) ## ----setup-------------------------------------------------------------------- library(purrr) library(tibble) ## ----------------------------------------------------------------------------- means <- 1:4 ## ----------------------------------------------------------------------------- set.seed(2020) samples <- lapply(means, rnorm, n = 5, sd = 1) str(samples) ## ----------------------------------------------------------------------------- set.seed(2020) samples <- map(means, rnorm, n = 5, sd = 1) str(samples) ## ----------------------------------------------------------------------------- means <- 1:4 sds <- 1:4 ## ----------------------------------------------------------------------------- set.seed(2020) samples <- mapply( rnorm, mean = means, sd = sds, MoreArgs = list(n = 5), SIMPLIFY = FALSE ) str(samples) ## ----------------------------------------------------------------------------- samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds) ## ----------------------------------------------------------------------------- samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds) ## ----------------------------------------------------------------------------- set.seed(2020) samples <- map2(means, sds, rnorm, n = 5) str(samples) ## ----------------------------------------------------------------------------- ns <- 4:1 ## ----------------------------------------------------------------------------- set.seed(2020) samples <- Map(rnorm, mean = means, sd = sds, n = ns) str(samples) ## ----------------------------------------------------------------------------- set.seed(2020) samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm) str(samples) ## ----------------------------------------------------------------------------- # type stable medians <- vapply(samples, median, FUN.VALUE = numeric(1L)) medians # not type stable medians <- sapply(samples, median) ## ----------------------------------------------------------------------------- medians <- map_dbl(samples, median) medians ## ----fig.show='hide'---------------------------------------------------------- # for loop for (s in samples) { hist(s, xlab = "value", main = "") } # lapply invisible(lapply(samples, function(s) { hist(s, xlab = "value", main = "") })) ## ----fig.show='hide'---------------------------------------------------------- walk(samples, ~ hist(.x, xlab = "value", main = "")) ## ----------------------------------------------------------------------------- set.seed(2020) means |> map(rnorm, n = 5, sd = 1) |> map_dbl(median) ## ----------------------------------------------------------------------------- mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df))|> map(coef) |> map_dbl(1) purrr/inst/doc/purrr.Rmd0000644000176200001440000002410215163460322014765 0ustar liggesusers--- title: "Get started with purrr" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Get started with purrr} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ## Introduction purrr helps you write cleaner, more maintainable R code through functional programming concepts. But what is functional programming? At its core, it's an approach to programming that emphasizes using functions to transform data, similar to how you might use a series of tools to process raw materials into a final product. Instead of writing loops and modifying data step by step, functional programming encourages you to think about your data transformations as a series of function applications. This notion is rather abstract, but we believe mastering functional programming makes your code clearer and less prone to errors. You'll hopefully get some sense of that by the end of this vignette! This vignette discusses two of the most important parts of purrr: map functions and predicate functions. ```{r} library(purrr) ``` ## Map: A better way to loop `map()`[^1] provides a more compact way to apply functions to each element of a vector, returning a list: [^1]: You might wonder why this function is called `map()`. What does it have to do with depicting physical features of land or sea 🗺? In fact, the meaning comes from mathematics where map refers to "an operation that associates each element of a given set with one or more elements of a second set". This makes sense here because `map()` defines a mapping from one vector to another. And "map" also has the nice property of being short, which is useful for such a fundamental building block. ```{r} x <- 1:3 triple <- function(x) x * 3 out <- map(x, triple) str(out) ``` Or written with the pipe: ```{r} x |> map(triple) |> str() ``` This is equivalent to a for loop: ```{r} out <- vector("list", 3) for (i in seq_along(x)) { out[[i]] <- triple(x[[i]]) } str(out) ``` Even on its own, there are some benefits to `map()`: once you get used to the syntax, it's a very compact way to express the idea of transforming a vector, returning one output element for each input element. But there are several other reasons to use `map()`, which we'll explore in the following sections: - Progress bars - Parallel computing - Output variants - Input variants ### Progress bars For long-running jobs, like web scraping, model fitting, or data processing, it's really useful to get a progress bar that helps you estimate how long you'll need to wait. Progress bars are easy to enable in purrr: just set `.progress = TRUE`. It's hard to illustrate progress bars in a vignette, but you can try this example interactively: ```{r} #| eval: false out <- map(1:100, \(i) Sys.sleep(0.5), .progress = TRUE) ``` Learn more about progress bars in `?progress_bars`. ### Parallel computing By default, `map()` runs only in your current R session. But you can easily opt in to spreading your task across multiple R sessions, and hence multiple cores with `in_parallel()`. This can give big performance improvements if your task is primarily bound by compute performance. purrr's parallelism is powered by mirai, so to begin, you need to start up a number of background R sessions, called **daemons**: ```{r} #| eval: false mirai::daemons(6) ``` ```{r} #| echo: false mirai::daemons(sync = TRUE) ``` (You only need to do this once per session.) Now you can easily convert your `map()` call to run in parallel: ```{r} out <- map(1:5, in_parallel(\(i) Sys.sleep(0.5))) ``` It's important to realize that this parallelism works by spreading computation across clean R sessions. That means that code like this will not work, because the worker daemons won't have a copy of `my_lm()`: ```{r} #| error: true my_lm <- function(formula, data) { Sys.sleep(0.5) lm(formula, data) } by_cyl <- split(mtcars, mtcars$cyl) out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df))) ``` You can resolve this by passing additional data along to `in_parallel()`: ```{r} out <- map(by_cyl, in_parallel(\(df) my_lm(mpg ~ disp, data = df), my_lm = my_lm)) ``` Learn more about parallel computing in `?in_parallel`. ```{r} #| echo: false mirai::daemons(0) ``` ### Output variants purrr functions are type-stable, which means it's easy to predict what type of output they return, e.g., `map()` always returns a list. But what if you want a different type of output? That's where the output variants come into play: - There are four variants for the four most important types of atomic vector: - `map_lgl()` returns a logical vector. - `map_int()` returns an integer vector. - `map_dbl()` returns a numeric (double) vector. - `map_chr()` returns a character vector. - For all other types of vector (like dates, date-times, factors, etc.), there's `map_vec()`. It's a little harder to precisely describe the output type, but if your function returns a length-1 vector of type "foo", then the output of `map_vec()` will be a length-n vector of type "foo". - `modify()` returns output with the same type as the input. For example, if the input is a data frame, the output will also be a data frame. - `walk()` returns the input (invisibly); it's useful when you're calling a function purely for its side effects, for example, generating plots or saving files. purrr, like many tidyverse functions, is designed to help you solve complex problems by stringing together simple pieces. This is particularly natural to do with the pipe. For example, the following code splits `mtcars` into one data frame for each value of `cyl`, fits a linear model to each subset, computes the model summary, and then extracts the R-squared: ```{r} mtcars |> split(mtcars$cyl) |> # from base R map(\(df) lm(mpg ~ wt, data = df)) |> map(summary) |> map_dbl(\(x) x$r.squared) ``` ### Input variants `map()` and friends all iterate over a single list, making it poorly suited for some problems. For example, how would you find a weighted mean when you have a list of observations and a list of weights? Imagine we have the following data: ```{r} xs <- map(1:8, ~ runif(10)) xs[[1]][[1]] <- NA ws <- map(1:8, ~ rpois(10, 5) + 1) ``` We could use `map_dbl()` to compute unweighted means: ```{r} map_dbl(xs, mean) ``` But there's no way to use `map()` to compute a weighted mean because we need to call `weighted.mean(xs[[1]], ws[[1]])`, `weighted.mean(xs[[2]], ws[[2]])`, etc. That's the job of `map2()`: ```{r} map2_dbl(xs, ws, weighted.mean) ``` Note that the arguments that vary for each call come before the function and arguments that are constant come after the function: ```{r} map2_dbl(xs, ws, weighted.mean, na.rm = TRUE) ``` But we generally recommend using an anonymous function instead, as this makes it very clear where each argument is going: ```{r} #| eval: false map2_dbl(xs, ws, \(x, w) weighted.mean(x, w, na.rm = TRUE)) ``` There are two important variants of `map2()`: `pmap()` which can take any number of varying arguments (passed as a list), and `imap()` which iterates over the values and indices of a single vector. Learn more in their documentation. ### Combinatorial explosion What makes purrr particularly special is that all of the above features (progress bars, parallel computing, output variants, and input variants) can be combined any way that you choose. The combination of inputs (prefixes) and outputs (suffixes) forms a matrix, and you can use `.progress` or `in_parallel()` with any of them: | Output type | Single input (`.x`) | Two inputs (`.x`, `.y`) | Multiple inputs (`.l`) | |-----------------|-----------------|-------------------|--------------------| | **List** | `map(.x, .f)` | `map2(.x, .y, .f)` | `pmap(.l, .f)` | | **Logical** | `map_lgl(.x, .f)` | `map2_lgl(.x, .y, .f)` | `pmap_lgl(.l, .f)` | | **Integer** | `map_int(.x, .f)` | `map2_int(.x, .y, .f)` | `pmap_int(.l, .f)` | | **Double** | `map_dbl(.x, .f)` | `map2_dbl(.x, .y, .f)` | `pmap_dbl(.l, .f)` | | **Character** | `map_chr(.x, .f)` | `map2_chr(.x, .y, .f)` | `pmap_chr(.l, .f)` | | **Vector** | `map_vec(.x, .f)` | `map_vec(.x, .y, .f)` | `map_vec(.l, .f)` | | **Input** | `walk(.x, .f)` | `walk2(.x, .y, .f)` | `pwalk(.l, .f)` | ## Filtering and finding with predicates purrr provides a number of functions that work with predicate functions. Predicate functions take a vector and return either `TRUE` or `FALSE`, with examples including `is.character()` and `\(x) any(is.na(x))`. You typically use them to filter or find; for example, you could use them to locate the first element of a list that's a character vector, or only keep the columns in a data frame that have missing values. purrr comes with a bunch of helpers to make predicate functions easier to use: - `detect(.x, .p)` returns the value of the first element in `.x` where `.p` is `TRUE`. - `detect_index(.x, .p)` returns the position of the first element in `.x` where `.p` is `TRUE`. - `keep(.x, .p)` returns all elements from `.x` where `.p` evaluates to `TRUE`. - `discard(.x, .p)` returns all elements from `.x` where `.p` evaluates to `FALSE`. - `every(.x, .p)` returns `TRUE` if `.p` returns `TRUE` for every element in `.x`. - `some(.x, .p)` returns `TRUE` if `.p` returns `TRUE` for at least one element in `.x`. - `none(.x, .p)` returns `TRUE` if `.p` returns `FALSE` for all elements in `.x`. - `head_while(.x, .p)` returns elements from the beginning of `.x` while `.p` is `TRUE`, stopping at the first `FALSE`. - `tail_while(.x, .p)` returns elements from the end of `.x` while `.p` is `TRUE`, stopping at the first `FALSE`. You'll typically use these functions with lists, since you can usually rely on vectorization for simpler vectors. ```{r} x <- list( a = letters[1:10], b = 1:10, c = runif(15) ) x |> detect(is.character) x |> detect_index(is.numeric) x |> keep(is.numeric) |> str() x |> discard(is.numeric) |> str() x |> every(\(x) length(x) > 10) x |> some(\(x) length(x) > 10) x |> none(\(x) length(x) == 0) ``` purrr/README.md0000644000176200001440000000561015163460322012707 0ustar liggesusers # purrr purrr website [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/purrr)](https://cran.r-project.org/package=purrr) [![Codecov test coverage](https://codecov.io/gh/tidyverse/purrr/graph/badge.svg)](https://app.codecov.io/gh/tidyverse/purrr) [![R-CMD-check](https://github.com/tidyverse/purrr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/tidyverse/purrr/actions/workflows/R-CMD-check.yaml) ## Overview purrr enhances R’s functional programming (FP) toolkit by providing a complete and consistent set of tools for working with functions and vectors. If you’ve never heard of FP before, the best place to start is the family of `map()` functions which allow you to replace many for loops with code that is both more succinct and easier to read. The best place to learn about the `map()` functions is the [iteration chapter](https://r4ds.hadley.nz/iteration) in R for Data Science. ## Installation ``` r # The easiest way to get purrr is to install the whole tidyverse: install.packages("tidyverse") # Alternatively, install just purrr: install.packages("purrr") # Or the the development version from GitHub: # install.packages("pak") pak::pak("tidyverse/purrr") ``` ## Cheatsheet ## Usage The following example uses purrr to solve a fairly realistic problem: split a data frame into pieces, fit a model to each piece, compute the summary, then extract the R2. ``` r library(purrr) mtcars |> split(mtcars$cyl) |> # from base R map(\(df) lm(mpg ~ wt, data = df)) |> map(summary) |> map_dbl("r.squared") #> 4 6 8 #> 0.5086326 0.4645102 0.4229655 ``` This example illustrates some of the advantages of purrr functions over the equivalents in base R: - The first argument is always the data, so purrr works naturally with the pipe. - All purrr functions are type-stable. They always return the advertised output type (`map()` returns lists; `map_dbl()` returns double vectors), or they throw an error. - All `map()` functions accept functions (named, anonymous, and lambda), character vector (used to extract components by name), or numeric vectors (used to extract by position). There are two less obvious advantages: - All `map()` functions have `.progress` argument so that you can easily track the progress of long running jobs. - All `map()` functions work with `in_parallel()` to easily spread computation across multiple cores on your computer, or multiple machines over the network. purrr/build/0000755000176200001440000000000015166146731012535 5ustar liggesuserspurrr/build/vignette.rds0000644000176200001440000000044115166146731015073 0ustar liggesusers‹…Q=oƒ0u€€T5R¤Î^;„_PuŠèÐ¥Š:tu‚ –ül#Ô­¼¥‡±+ˆ*uà|ïïÞ;ü–#„"”¬#ÅÆ{)|» epnÏÄÐâ$*o•m¨>p"k3£³¶ÓZ;bÙ¿süpxÄã$|òü}ÙÉ‹eJŽ[­jM„`²ÆLb§€G…ŽÔÔø†»'j±±D[ZážÙ»ÉWr™³ÛXÁƒþÜïŒÏ'ÃŽYŽH§=BþÜø!Ý»ËSúãü§žDV~ìZ+NÅÔ“IÉ8 ^™ýñ˱ôé*ÜiKe~Óö™~ôJ^ eZõE»þÂ0 _׎.œ˜à(yE,)Þá‘( ï€©ª:purrr/man/0000755000176200001440000000000015166146732012212 5ustar liggesuserspurrr/man/pipe.Rd0000644000176200001440000000033014326706774013437 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reexport-pipe.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} \usage{ lhs \%>\% rhs } \description{ Pipe operator } \keyword{internal} purrr/man/negate.Rd0000644000176200001440000000262715163460322013742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-negate.R \name{negate} \alias{negate} \title{Negate a predicate function so it selects what it previously rejected} \usage{ negate(.p) } \arguments{ \item{.p}{A predicate function (i.e. a function that returns either \code{TRUE} or \code{FALSE}) specified in one of the following ways: \itemize{ \item A named function, e.g. \code{is.character}. \item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}. \item A formula, e.g. \code{~ all(.x < 0)}. Use \code{.x} to refer to the first argument. No longer recommended. }} } \value{ A new predicate function. } \description{ Negating a function changes \code{TRUE} to \code{FALSE} and \code{FALSE} to \code{TRUE}. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ x <- list(x = 1:10, y = rbernoulli(10), z = letters) x |> keep(is.numeric) |> names() x |> keep(negate(is.numeric)) |> names() # Same as x |> discard(is.numeric) } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/attr_getter.Rd0000644000176200001440000000212413426303100015001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck.R \name{attr_getter} \alias{attr_getter} \title{Create an attribute getter function} \usage{ attr_getter(attr) } \arguments{ \item{attr}{An attribute name as string.} } \description{ \code{attr_getter()} generates an attribute accessor function; i.e., it generates a function for extracting an attribute with a given name. Unlike the base R \code{attr()} function with default options, it doesn't use partial matching. } \examples{ # attr_getter() takes an attribute name and returns a function to # access the attribute: get_rownames <- attr_getter("row.names") get_rownames(mtcars) # These getter functions are handy in conjunction with pluck() for # extracting deeply into a data structure. Here we'll first # extract by position, then by attribute: obj1 <- structure("obj", obj_attr = "foo") obj2 <- structure("obj", obj_attr = "bar") x <- list(obj1, obj2) pluck(x, 1, attr_getter("obj_attr")) # From first object pluck(x, 2, attr_getter("obj_attr")) # From second object } \seealso{ \code{\link[=pluck]{pluck()}} } purrr/man/rerun.Rd0000644000176200001440000000254014326706774013642 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-rerun.R \name{rerun} \alias{rerun} \title{Re-run expressions multiple times} \usage{ rerun(.n, ...) } \arguments{ \item{.n}{Number of times to run expressions} \item{...}{Expressions to re-run.} } \value{ A list of length \code{.n}. Each element of \code{...} will be re-run once for each \code{.n}. There is one special case: if there's a single unnamed input, the second level list will be dropped. In this case, \code{rerun(n, x)} behaves like \code{replicate(n, x, simplify = FALSE)}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because we believe that NSE functions are not a good fit for purrr. Also, \code{rerun(n, x)} can just as easily be expressed as \verb{map(1:n, \\(i) x)} \code{rerun()} is a convenient way of generating sample data. It works similarly to \code{\link{replicate}(..., simplify = FALSE)}. } \examples{ # old 5 |> rerun(rnorm(5)) |> str() # new 1:5 |> map(\(i) rnorm(5)) |> str() # old 5 |> rerun(x = rnorm(5), y = rnorm(5)) |> map_dbl(\(l) cor(l$x, l$y)) # new 1:5 |> map(\(i) list(x = rnorm(5), y = rnorm(5))) |> map_dbl(\(l) cor(l$x, l$y)) } \keyword{internal} purrr/man/keep_at.Rd0000644000176200001440000000264015163460322014102 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/keep.R \name{keep_at} \alias{keep_at} \alias{discard_at} \title{Keep/discard elements based on their name/position} \usage{ keep_at(x, at) discard_at(x, at) } \arguments{ \item{x}{A list or atomic vector.} \item{at}{A logical, integer, or character vector giving the elements to select. Alternatively, a function that takes a vector of names, and returns a logical, integer, or character vector of elements to select. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is installed, you can use \code{vars()} and tidyselect helpers to select elements.} } \description{ \code{keep_at()} and \code{discard_at()} are similar to \code{[} or \code{dplyr::select()}: they return the same type of data structure as the input, but only containing the requested elements. (If you're looking for a function similar to \code{[[} see \code{\link[=pluck]{pluck()}}/\code{\link[=chuck]{chuck()}}). } \examples{ x <- c(a = 1, b = 2, cat = 10, dog = 15, elephant = 5, e = 10) x |> keep_at(letters) x |> discard_at(letters) # Can also use a function x |> keep_at(\(x) nchar(x) == 3) x |> discard_at(\(x) nchar(x) == 3) } \seealso{ \code{\link[=keep]{keep()}}/\code{\link[=discard]{discard()}} to keep/discard elements by value. } purrr/man/flatten.Rd0000644000176200001440000000375514334365317014146 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/superseded-flatten.R \name{flatten} \alias{flatten} \alias{flatten_lgl} \alias{flatten_int} \alias{flatten_dbl} \alias{flatten_chr} \alias{flatten_dfr} \alias{flatten_dfc} \alias{flatten_df} \title{Flatten a list of lists into a simple vector} \usage{ flatten(.x) flatten_lgl(.x) flatten_int(.x) flatten_dbl(.x) flatten_chr(.x) flatten_dfr(.x, .id = NULL) flatten_dfc(.x) } \arguments{ \item{.x}{A list to flatten. The contents of the list can be anything for \code{flatten()} (as a list is returned), but the contents must match the type for the other functions.} } \value{ \code{flatten()} returns a list, \code{flatten_lgl()} a logical vector, \code{flatten_int()} an integer vector, \code{flatten_dbl()} a double vector, and \code{flatten_chr()} a character vector. \code{flatten_dfr()} and \code{flatten_dfc()} return data frames created by row-binding and column-binding respectively. They require dplyr to be installed. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} These functions were superseded in purrr 1.0.0 because their behaviour was inconsistent. Superseded functions will not go away, but will only receive critical bug fixes. \itemize{ \item \code{flatten()} has been superseded by \code{\link[=list_flatten]{list_flatten()}}. \item \code{flatten_lgl()}, \code{flatten_int()}, \code{flatten_dbl()}, and \code{flatten_chr()} have been superseded by \code{\link[=list_c]{list_c()}}. \item \code{flatten_dfr()} and \code{flatten_dfc()} have been superseded by \code{\link[=list_rbind]{list_rbind()}} and \code{\link[=list_cbind]{list_cbind()}} respectively. } } \examples{ x <- map(1:3, \(i) sample(4)) x # was x |> flatten_int() |> str() # now x |> list_c() |> str() x <- list(list(1, 2), list(3, 4)) # was x |> flatten() |> str() # now x |> list_flatten() |> str() } \keyword{internal} purrr/man/as_vector.Rd0000644000176200001440000000275614334365317014476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/superseded-simplify.R \name{as_vector} \alias{as_vector} \alias{simplify} \alias{simplify_all} \title{Coerce a list to a vector} \usage{ as_vector(.x, .type = NULL) simplify(.x, .type = NULL) 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 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".} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} These functions were superseded in purrr 1.0.0 in favour of \code{list_simplify()} which has more consistent semantics based on vctrs principles: \itemize{ \item \code{as_vector(x)} is now \code{list_simplify(x)} \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)} } Superseded functions will not go away, but will only receive critical bug fixes. } \examples{ # was as.list(letters) |> as_vector("character") # now as.list(letters) |> list_simplify(ptype = character()) # was: list(1:2, 3:4, 5:6) |> as_vector(integer(2)) # now: list(1:2, 3:4, 5:6) |> list_c(ptype = integer()) } \keyword{internal} purrr/man/possibly.Rd0000644000176200001440000000314415163460322014336 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-possibly.R \name{possibly} \alias{possibly} \title{Wrap a function to return a value instead of an error} \usage{ possibly(.f, otherwise = NULL, quiet = TRUE) } \arguments{ \item{.f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} \item{otherwise}{Default value to use when an error occurs.} \item{quiet}{Hide errors (\code{TRUE}, the default), or display them as they occur?} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ Create a modified version of \code{.f} that return a default value (\code{otherwise}) whenever an error occurs. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ # To replace errors with a default value, use possibly(). list("a", 10, 100) |> map_dbl(possibly(log, NA_real_)) # The default, NULL, will be discarded with `list_c()` list("a", 10, 100) |> map(possibly(log)) |> list_c() } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/has_element.Rd0000644000176200001440000000062314326706774014773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/detect.R \name{has_element} \alias{has_element} \title{Does a list contain an object?} \usage{ has_element(.x, .y) } \arguments{ \item{.x}{A list or atomic vector.} \item{.y}{Object to test for} } \description{ Does a list contain an object? } \examples{ x <- list(1:10, 5, 9.9) x |> has_element(1:10) x |> has_element(3) } purrr/man/map_depth.Rd0000644000176200001440000001265315163460322014440 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map-depth.R \name{map_depth} \alias{map_depth} \alias{modify_depth} \title{Map/modify elements at given depth} \usage{ map_depth(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL) modify_depth(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL) } \arguments{ \item{.x}{A list or atomic vector.} \item{.depth}{Level of \code{.x} to map on. Use a negative value to count up from the lowest level of the list. \itemize{ \item \code{map_depth(x, 0, fun)} is equivalent to \code{fun(x)}. \item \code{map_depth(x, 1, fun)} is equivalent to \code{x <- map(x, fun)} \item \code{map_depth(x, 2, fun)} is equivalent to \verb{x <- map(x, \\(y) map(y, fun))} }} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. Use \code{.x} to refer to the first argument. No longer recommended. \item A string, integer, or list, e.g. \code{"idx"}, \code{1}, or \code{list("idx", 1)} which are shorthand for \verb{\\(x) pluck(x, "idx")}, \verb{\\(x) pluck(x, 1)}, and \verb{\\(x) pluck(x, "idx", 1)} respectively. Optionally supply \code{.default} to set a default value if the indexed element is \code{NULL} or does not exist. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.ragged}{If \code{TRUE}, will apply to leaves, even if they're not at depth \code{.depth}. If \code{FALSE}, will throw an error if there are no elements at depth \code{.depth}.} \item{.is_node}{A predicate function that determines whether an element is a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The default value, \code{NULL}, treats simple lists as nodes and everything else (including richer objects like data frames and linear models) as leaves, using \code{\link[vctrs:obj_is_list]{vctrs::obj_is_list()}}. To recurse into all objects built on lists use \code{\link[=is.list]{is.list()}}.} } \description{ \code{map_depth()} calls \code{map(.y, .f)} on all \code{.y} at the specified \code{.depth} in \code{.x}. \code{modify_depth()} calls \code{modify(.y, .f)} on \code{.y} at the specified \code{.depth} in \code{.x}. } \examples{ # map_depth() ------------------------------------------------- # Use `map_depth()` to recursively traverse nested vectors and map # a function at a certain depth: x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6)) x |> str() x |> map_depth(2, \(y) paste(y, collapse = "/")) |> str() # Equivalent to: x |> map(\(y) map(y, \(z) paste(z, collapse = "/"))) |> str() # When ragged is TRUE, `.f()` will also be passed leaves at depth < `.depth` x <- list(1, list(1, list(1, list(1, 1)))) x |> str() x |> map_depth(4, \(x) length(unlist(x)), .ragged = TRUE) |> str() x |> map_depth(3, \(x) length(unlist(x)), .ragged = TRUE) |> str() x |> map_depth(2, \(x) length(unlist(x)), .ragged = TRUE) |> str() x |> map_depth(1, \(x) length(unlist(x)), .ragged = TRUE) |> str() x |> map_depth(0, \(x) length(unlist(x)), .ragged = TRUE) |> str() # modify_depth() ------------------------------------------------- l1 <- list( obj1 = list( prop1 = list(param1 = 1:2, param2 = 3:4), prop2 = list(param1 = 5:6, param2 = 7:8) ), obj2 = list( prop1 = list(param1 = 9:10, param2 = 11:12), prop2 = list(param1 = 12:14, param2 = 15:17) ) ) # In the above list, "obj" is level 1, "prop" is level 2 and "param" # is level 3. To apply sum() on all params, we map it at depth 3: l1 |> modify_depth(3, sum) |> str() # modify() lets us pluck the elements prop1/param2 in obj1 and obj2: l1 |> modify(c("prop1", "param2")) |> str() # But what if we want to pluck all param2 elements? Then we need to # act at a lower level: l1 |> modify_depth(2, "param2") |> str() # modify_depth() can be with other purrr functions to make them operate at # a lower level. Here we ask pmap() to map paste() simultaneously over all # elements of the objects at the second level. paste() is effectively # mapped at level 3. l1 |> modify_depth(2, \(x) pmap(x, paste, sep = " / ")) |> str() } \seealso{ \code{\link[=modify_tree]{modify_tree()}} for a recursive version of \code{modify_depth()} that allows you to apply a function to every leaf or every node. Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_if}()}, \code{\link{modify}()}, \code{\link{pmap}()} Other modify variants: \code{\link{modify}()}, \code{\link{modify_tree}()} } \concept{map variants} \concept{modify variants} purrr/man/invoke.Rd0000644000176200001440000000652414326706774014010 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-invoke.R \name{invoke} \alias{invoke} \alias{invoke_map} \alias{invoke_map_lgl} \alias{invoke_map_int} \alias{invoke_map_dbl} \alias{invoke_map_chr} \alias{invoke_map_raw} \alias{invoke_map_dfr} \alias{invoke_map_dfc} \alias{invoke_map_df} \title{Invoke functions.} \usage{ invoke(.f, .x = NULL, ..., .env = NULL) invoke_map(.f, .x = list(NULL), ..., .env = NULL) invoke_map_lgl(.f, .x = list(NULL), ..., .env = NULL) invoke_map_int(.f, .x = list(NULL), ..., .env = NULL) invoke_map_dbl(.f, .x = list(NULL), ..., .env = NULL) invoke_map_chr(.f, .x = list(NULL), ..., .env = NULL) invoke_map_raw(.f, .x = list(NULL), ..., .env = NULL) invoke_map_dfr(.f, .x = list(NULL), ..., .env = NULL) invoke_map_dfc(.f, .x = list(NULL), ..., .env = NULL) } \arguments{ \item{.f}{For \code{invoke}, a function; for \code{invoke_map} a list of functions.} \item{.x}{For \code{invoke}, an argument-list; for \code{invoke_map} a list of argument-lists the same length as \code{.f} (or length 1). The default argument, \code{list(NULL)}, will be recycled to the same length as \code{.f}, and will call each function with no arguments (apart from any supplied in \code{...}.} \item{...}{Additional arguments passed to each function.} \item{.env}{Environment in which \code{\link[=do.call]{do.call()}} should evaluate a constructed expression. This only matters if you pass as \code{.f} the name of a function rather than its value, or as \code{.x} symbols of objects rather than their values.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} These functions were superded in purrr 0.3.0 and deprecated in purrr 1.0.0. \itemize{ \item \code{invoke()} is deprecated in favour of the simpler \code{exec()} function reexported from rlang. \code{exec()} evaluates a function call built from its inputs and supports \link[rlang:dyn-dots]{dynamic dots}: \if{html}{\out{
}}\preformatted{# Before: invoke(mean, list(na.rm = TRUE), x = 1:10) # After exec(mean, 1:10, !!!list(na.rm = TRUE)) }\if{html}{\out{
}} \item \code{invoke_map()} is deprecated because it's harder to understand than the corresponding code using \code{map()}/\code{map2()} and \code{exec()}: \if{html}{\out{
}}\preformatted{# Before: invoke_map(fns, list(args)) invoke_map(fns, list(args1, args2)) # After: map(fns, exec, !!!args) map2(fns, list(args1, args2), \\(fn, args) exec(fn, !!!args)) }\if{html}{\out{
}} } } \examples{ # was invoke(runif, list(n = 10)) invoke(runif, n = 10) # now exec(runif, n = 10) # was args <- list("01a", "01b") invoke(paste, args, sep = "-") # now exec(paste, !!!args, sep = "-") # was funs <- list(runif, rnorm) funs |> invoke_map(n = 5) funs |> invoke_map(list(list(n = 10), list(n = 5))) # now funs |> map(exec, n = 5) funs |> map2(list(list(n = 10), list(n = 5)), function(f, args) exec(f, !!!args)) # or use pmap + a tibble df <- tibble::tibble( fun = list(runif, rnorm), args = list(list(n = 10), list(n = 5)) ) df |> pmap(function(fun, args) exec(fun, !!!args)) # was list(m1 = mean, m2 = median) |> invoke_map(x = rcauchy(100)) # now list(m1 = mean, m2 = median) |> map(function(f) f(rcauchy(100))) } \keyword{internal} purrr/man/imap.Rd0000644000176200001440000000466415163460322013430 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/imap.R \name{imap} \alias{imap} \alias{imap_lgl} \alias{imap_chr} \alias{imap_int} \alias{imap_dbl} \alias{imap_vec} \alias{iwalk} \title{Apply a function to each element of a vector, and its index} \usage{ imap(.x, .f, ...) imap_lgl(.x, .f, ...) imap_chr(.x, .f, ...) imap_int(.x, .f, ...) imap_dbl(.x, .f, ...) imap_vec(.x, .f, ...) iwalk(.x, .f, ...) } \arguments{ \item{.x}{A list or atomic vector.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{paste}. \item An anonymous function, e.g. \verb{\\(x, idx) x + idx} or \code{function(x, idx) x + idx}. \item A formula, e.g. \code{~ .x + .y}. Use \code{.x} to refer to the current element and \code{.y} to refer to the current index. No longer recommended. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} } \value{ A vector the same length as \code{.x}. } \description{ \code{imap(x, ...)}, an indexed map, is short hand for \code{map2(x, names(x), ...)} if \code{x} has names, or \code{map2(x, seq_along(x), ...)} if it does not. This is useful if you need to compute on both the value and the position of an element. } \examples{ imap_chr(sample(10), paste) imap_chr(sample(10), \(x, idx) paste0(idx, ": ", x)) iwalk(mtcars, \(x, idx) cat(idx, ": ", median(x), "\n", sep = "")) } \seealso{ Other map variants: \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{modify}()}, \code{\link{pmap}()} } \concept{map variants} purrr/man/rdunif.Rd0000644000176200001440000000126314326706774013777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-utils.R \name{rdunif} \alias{rdunif} \title{Generate random sample from a discrete uniform distribution} \usage{ rdunif(n, b, a = 1) } \arguments{ \item{n}{Number of samples to draw.} \item{a, b}{Range of the distribution (inclusive).} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because it's not related to the core purpose of purrr. } \examples{ table(rdunif(1e3, 10)) table(rdunif(1e3, 10, -5)) } \keyword{internal} purrr/man/partial.Rd0000644000176200001440000000656315063325731014141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-partial.R \name{partial} \alias{partial} \title{Partially apply a function, filling in some arguments} \usage{ partial(.f, ...) } \arguments{ \item{.f}{a function. For the output source to read well, this should be a named function.} \item{...}{named arguments to \code{.f} that should be partially applied. Pass an empty \verb{... = } argument to specify the position of future arguments relative to partialised ones. See \code{\link[rlang:call_modify]{rlang::call_modify()}} to learn more about this syntax. These dots support quasiquotation. If you unquote a value, it is evaluated only once at function creation time. Otherwise, it is evaluated each time the function is called.} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ Partial function application allows you to modify a function by pre-filling some of the arguments. It is particularly useful in conjunction with functionals and other function operators. } \details{ \code{partial()} creates a function that takes \code{...} arguments. Unlike \code{\link[=compose]{compose()}} and other function operators like \code{\link[=negate]{negate()}}, it doesn't reuse the function signature of \code{.f}. This is because \code{partial()} explicitly supports NSE functions that use \code{substitute()} on their arguments. The only way to support those is to forward arguments through dots. Other unsupported patterns: \itemize{ \item It is not possible to call \code{partial()} repeatedly on the same argument to pre-fill it with a different expression. \item It is not possible to refer to other arguments in pre-filled argument. } } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ # Partial is designed to replace the use of anonymous functions for # filling in function arguments. Instead of: compact1 <- function(x) discard(x, is.null) # we can write: compact2 <- partial(discard, .p = is.null) # partial() works fine with functions that do non-standard # evaluation my_long_variable <- 1:10 plot2 <- partial(plot, my_long_variable) plot2() plot2(runif(10), type = "l") # Note that you currently can't partialise arguments multiple times: my_mean <- partial(mean, na.rm = TRUE) my_mean <- partial(my_mean, na.rm = FALSE) try(my_mean(1:10)) # The evaluation of arguments normally occurs "lazily". Concretely, # this means that arguments are repeatedly evaluated across invocations: f <- partial(runif, n = rpois(1, 5)) f f() f() # You can unquote an argument to fix it to a particular value. # Unquoted arguments are evaluated only once when the function is created: f <- partial(runif, n = !!rpois(1, 5)) f f() f() # By default, partialised arguments are passed before new ones: my_list <- partial(list, 1, 2) my_list("foo") # Control the position of these arguments by passing an empty # `... = ` argument: my_list <- partial(list, 1, ... = , 2) my_list("foo") } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/modify_tree.Rd0000644000176200001440000000324315063325731015003 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/modify-tree.R \name{modify_tree} \alias{modify_tree} \title{Recursively modify a list} \usage{ modify_tree( x, ..., leaf = identity, is_node = NULL, pre = identity, post = identity ) } \arguments{ \item{x}{A list.} \item{...}{Reserved for future use. Must be empty} \item{leaf}{A function applied to each leaf.} \item{is_node}{A predicate function that determines whether an element is a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The default value, \code{NULL}, treats simple lists as nodes and everything else (including richer objects like data frames and linear models) as leaves, using \code{\link[vctrs:obj_is_list]{vctrs::obj_is_list()}}. To recurse into all objects built on lists use \code{\link[=is.list]{is.list()}}.} \item{pre, post}{Functions applied to each node. \code{pre} is applied on the way "down", i.e. before the leaves are transformed with \code{leaf}, while \code{post} is applied on the way "up", i.e. after the leaves are transformed.} } \description{ \code{modify_tree()} allows you to recursively modify a list, supplying functions that either modify each leaf or each node (or both). } \examples{ x <- list(list(a = 2:1, c = list(b1 = 2), b = list(c2 = 3, c1 = 4))) x |> str() # Transform each leaf x |> modify_tree(leaf = \(x) x + 100) |> str() # Recursively sort the nodes sort_named <- function(x) { nms <- names(x) if (!is.null(nms)) { x[order(nms)] } else { x } } x |> modify_tree(post = sort_named) |> str() } \seealso{ Other modify variants: \code{\link{map_depth}()}, \code{\link{modify}()} } \concept{modify variants} purrr/man/when.Rd0000644000176200001440000000334315063325731013437 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-when.R \name{when} \alias{when} \title{Match/validate a set of conditions for an object and continue with the action associated with the first valid match.} \usage{ when(., ...) } \arguments{ \item{.}{the value to match against} \item{...}{formulas; each containing a condition as LHS and an action as RHS. named arguments will define additional values.} } \value{ The value resulting from the action of the first valid match/condition is returned. If no matches are found, and no default is given, NULL will be returned. Validity of the conditions are tested with \code{isTRUE}, or equivalently with \code{identical(condition, TRUE)}. In other words conditions resulting in more than one logical will never be valid. Note that the input value is always treated as a single object, as opposed to the \code{ifelse} function. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because it's not related to the core purpose of purrr. You can pull your code out of a pipe and use regular \code{if}/\verb{else} statements instead. \code{when()} is a flavour of pattern matching (or an if-else abstraction) in which a value is matched against a sequence of condition-action sets. When a valid match/condition is found the action is executed and the result of the action is returned. } \examples{ 1:10 |> when( sum(.) <= 50 ~ sum(.), sum(.) <= 100 ~ sum(.)/2, ~ 0 ) # now x <- 1:10 if (sum(x) < 10) { sum(x) } else if (sum(x) < 100) { sum(x) / 2 } else { 0 } } \keyword{internal} purrr/man/splice.Rd0000644000176200001440000000210214326706774013760 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-splice.R \name{splice} \alias{splice} \title{Splice objects and lists of objects into a list} \usage{ splice(...) } \arguments{ \item{...}{Objects to concatenate.} } \value{ A list. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because we no longer believe that this style of implicit/automatic splicing is a good idea; instead use \code{rlang::list2()} + \verb{!!!} or \code{\link[=list_flatten]{list_flatten()}}. \code{splice()} splices all arguments into a list. Non-list objects and lists with a S3 class are encapsulated in a list before concatenation. } \examples{ inputs <- list(arg1 = "a", arg2 = "b") # splice() concatenates the elements of inputs with arg3 splice(inputs, arg3 = c("c1", "c2")) |> str() list(inputs, arg3 = c("c1", "c2")) |> str() c(inputs, arg3 = c("c1", "c2")) |> str() } \keyword{internal} purrr/man/compose.Rd0000644000176200001440000000332214326706774014153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-compose.R \name{compose} \alias{compose} \title{Compose multiple functions together to create a new function} \usage{ compose(..., .dir = c("backward", "forward")) } \arguments{ \item{...}{Functions to apply in order (from right to left by default). Formulas are converted to functions in the usual way. \link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your functions are stored in a list, you can splice that in with \verb{!!!}.} \item{.dir}{If \code{"backward"} (the default), the functions are called in the reverse order, from right to left, as is conventional in mathematics. If \code{"forward"}, they are called from left to right.} } \value{ A function } \description{ Create a new function that is the composition of multiple functions, i.e. \code{compose(f, g)} is equivalent to \code{function(...) f(g(...))}. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ not_null <- compose(`!`, is.null) not_null(4) not_null(NULL) add1 <- function(x) x + 1 compose(add1, add1)(8) fn <- compose(\(x) paste(x, "foo"), \(x) paste(x, "bar")) fn("input") # Lists of functions can be spliced with !!! fns <- list( function(x) paste(x, "foo"), \(x) paste(x, "bar") ) fn <- compose(!!!fns) fn("input") } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/progress_bars.Rd0000644000176200001440000000500315063325731015344 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progress-bars.R \name{progress_bars} \alias{progress_bars} \title{Progress bars in purrr} \description{ purrr's map functions have a \code{.progress} argument that you can use to create a progress bar. \code{.progress} can be: \itemize{ \item \code{FALSE}, the default: does not create a progress bar. \item \code{TRUE}: creates a basic unnamed progress bar. \item A string: creates a basic progress bar with the given name. \item A named list of progress bar parameters, as described below. } It's good practice to name your progress bars, to make it clear what calculation or process they belong to. We recommend keeping the names under 20 characters, so the whole progress bar fits comfortably even on on narrower displays. \subsection{Progress bar parameters}{ \itemize{ \item \code{clear}: whether to remove the progress bar from the screen after termination. Defaults to \code{TRUE}. \item \code{format}: format string. This overrides the default format string of the progress bar type. It must be given for the \code{custom} type. Format strings may contain R expressions to evaluate in braces. They support cli \link[cli:pluralization]{pluralization}, and \link[cli:inline-markup]{styling} and they can contain special \link[cli:progress-variables]{progress variables}. \item \code{format_done}: format string for successful termination. By default the same as \code{format}. \item \code{format_failed}: format string for unsuccessful termination. By default the same as \code{format}. \item \code{name}: progress bar name. This is by default the empty string and it is displayed at the beginning of the progress bar. \item \code{show_after}: numeric scalar. Only show the progress bar after this number of seconds. It overrides the \code{cli.progress_show_after} global option. \item \code{type}: progress bar type. Currently supported types are: \itemize{ \item \code{iterator}: the default, a for loop or a mapping function, \item \code{tasks}: a (typically small) number of tasks, \item \code{download}: download of one file, \item \code{custom}: custom type, \code{format} must not be \code{NULL} for this type. The default display is different for each progress bar type. } } } \subsection{Further documentation}{ purrr's progress bars are powered by cli, so see \href{https://cli.r-lib.org/articles/progress.html}{Introduction to progress bars in cli} and \href{https://cli.r-lib.org/articles/progress-advanced.html}{Advanced cli progress bars} for more details. } } purrr/man/list_assign.Rd0000644000176200001440000000422215063325731015012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/list-modify.R \name{list_assign} \alias{list_assign} \alias{list_modify} \alias{list_merge} \title{Modify a list} \usage{ list_assign(.x, ..., .is_node = NULL) list_modify(.x, ..., .is_node = NULL) list_merge(.x, ..., .is_node = NULL) } \arguments{ \item{.x}{List to modify.} \item{...}{New values of a list. Use \code{zap()} to remove values. These values should be either all named or all unnamed. When inputs are all named, they are matched to \code{.x} by name. When they are all unnamed, they are matched by position. \link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your replacement values are stored in a list, you can splice that in with \verb{!!!}.} \item{.is_node}{A predicate function that determines whether an element is a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The default value, \code{NULL}, treats simple lists as nodes and everything else (including richer objects like data frames and linear models) as leaves, using \code{\link[vctrs:obj_is_list]{vctrs::obj_is_list()}}. To recurse into all objects built on lists use \code{\link[=is.list]{is.list()}}.} } \description{ \itemize{ \item \code{list_assign()} modifies the elements of a list by name or position. \item \code{list_modify()} modifies the elements of a list recursively. \item \code{list_merge()} merges the elements of a list recursively. } \code{list_modify()} is inspired by \code{\link[utils:modifyList]{utils::modifyList()}}. } \examples{ x <- list(x = 1:10, y = 4, z = list(a = 1, b = 2)) str(x) # Update values str(list_assign(x, a = 1)) # Replace values str(list_assign(x, z = 5)) str(list_assign(x, z = NULL)) str(list_assign(x, z = list(a = 1:5))) # Replace recursively with list_modify(), leaving the other elements of z alone str(list_modify(x, z = list(a = 1:5))) # Remove values str(list_assign(x, z = zap())) # Combine values with list_merge() str(list_merge(x, x = 11, z = list(a = 2:5, c = 3))) # All these functions support dynamic dots features. Use !!! to splice # a list of arguments: l <- list(new = 1, y = zap(), z = 5) str(list_assign(x, !!!l)) } purrr/man/map_dfr.Rd0000644000176200001440000000630215063325731014104 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/superseded-map-df.R \name{map_dfr} \alias{map_dfr} \alias{map_df} \alias{map_dfc} \alias{imap_dfr} \alias{imap_dfc} \alias{map2_dfr} \alias{map2_dfc} \alias{map2_df} \alias{pmap_dfr} \alias{pmap_dfc} \alias{pmap_df} \title{Functions that return data frames} \usage{ map_dfr(.x, .f, ..., .id = NULL) map_dfc(.x, .f, ...) imap_dfr(.x, .f, ..., .id = NULL) imap_dfc(.x, .f, ...) map2_dfr(.x, .y, .f, ..., .id = NULL) map2_dfc(.x, .y, .f, ...) pmap_dfr(.l, .f, ..., .id = NULL) pmap_dfc(.l, .f, ...) } \arguments{ \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 variable will be created. Only applies to \verb{_dfr} variant.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} These \code{\link[=map]{map()}}, \code{\link[=map2]{map2()}}, \code{\link[=imap]{imap()}}, and \code{\link[=pmap]{pmap()}} variants return data frames by row-binding or column-binding the outputs together. The functions were superseded in purrr 1.0.0 because their names suggest they work like \verb{_lgl()}, \verb{_int()}, etc which require length 1 outputs, but actually they return results of any size because the results are combined without any size checks. Additionally, they use \code{dplyr::bind_rows()} and \code{dplyr::bind_cols()} which require dplyr to be installed and have confusing semantics with edge cases. Superseded functions will not go away, but will only receive critical bug fixes. Instead, we recommend using \code{map()}, \code{map2()}, etc with \code{\link[=list_rbind]{list_rbind()}} and \code{\link[=list_cbind]{list_cbind()}}. These use \code{\link[vctrs:vec_bind]{vctrs::vec_rbind()}} and \code{\link[vctrs:vec_bind]{vctrs::vec_cbind()}} under the hood, and have names that more clearly reflect their semantics. } \examples{ # map --------------------------------------------- # Was: mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df)) |> map_dfr(\(mod) as.data.frame(t(as.matrix(coef(mod))))) # Now: mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df)) |> map(\(mod) as.data.frame(t(as.matrix(coef(mod))))) |> list_rbind() # for certain pathological inputs `map_dfr()` and `map_dfc()` actually # both combine the list by column df <- data.frame( x = c(" 13", " 15 "), y = c(" 34", " 67 ") ) # Was: map_dfr(df, trimws) map_dfc(df, trimws) # But list_rbind()/list_cbind() fail because they require data frame inputs try(map(df, trimws) |> list_rbind()) # Instead, use modify() to apply a function to each column of a data frame modify(df, trimws) # map2 --------------------------------------------- ex_fun <- function(arg1, arg2){ col <- arg1 + arg2 x <- as.data.frame(col) } arg1 <- 1:4 arg2 <- 10:13 # was map2_dfr(arg1, arg2, ex_fun) # now map2(arg1, arg2, ex_fun) |> list_rbind() # was map2_dfc(arg1, arg2, ex_fun) # now map2(arg1, arg2, ex_fun) |> list_cbind() } \keyword{internal} purrr/man/prepend.Rd0000644000176200001440000000222214326706774014141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-prepend.R \name{prepend} \alias{prepend} \title{Prepend a vector} \usage{ prepend(x, values, before = NULL) } \arguments{ \item{x}{the vector to be modified.} \item{values}{to be included in the modified vector.} \item{before}{a subscript, before which the values are to be appended. If \code{NULL}, values will be appended at the beginning even for \code{x} of length 0.} } \value{ A merged vector. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because it's not related to the core purpose of purrr. This is a companion to \code{\link[=append]{append()}} to help merging two lists or atomic vectors. \code{prepend()} is a clearer semantic signal than \code{c()} that a vector is to be merged at the beginning of another, especially in a pipe chain. } \examples{ x <- as.list(1:3) x |> append("a") x |> prepend("a") x |> prepend(list("a", "b"), before = 3) prepend(list(), x) } \keyword{internal} purrr/man/as_mapper.Rd0000644000176200001440000000360015063325731014441 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map-mapper.R \name{as_mapper} \alias{as_mapper} \alias{as_mapper.character} \alias{as_mapper.numeric} \alias{as_mapper.list} \title{Convert an object into a mapper function} \usage{ as_mapper(.f, ...) \method{as_mapper}{character}(.f, ..., .null, .default = NULL) \method{as_mapper}{numeric}(.f, ..., .null, .default = NULL) \method{as_mapper}{list}(.f, ..., .null, .default = NULL) } \arguments{ \item{.f}{A function, formula, or vector (not necessarily atomic). If a \strong{function}, it is used as is. If a \strong{formula}, e.g. \code{~ .x + 2}, it is converted to a function. No longer recommended. If \strong{character vector}, \strong{numeric vector}, or \strong{list}, it is converted to an extractor function. Character vectors index by name and numeric vectors index by position; use a list to index by position and name at different levels. If a component is not present, the value of \code{.default} will be returned.} \item{...}{Additional arguments passed on to methods.} \item{.default, .null}{Optional additional argument for extractor functions (i.e. when \code{.f} is character, integer, or list). Returned when value is absent (does not exist) or empty (has length 0). \code{.null} is deprecated; please use \code{.default} instead.} } \description{ \code{as_mapper} is the powerhouse behind the varied function specifications that most purrr functions allow. It is an S3 generic. The default method forwards its arguments to \code{\link[rlang:as_function]{rlang::as_function()}}. } \examples{ as_mapper(\(x) x + 1) as_mapper(1) as_mapper(c("a", "b", "c")) # Equivalent to function(x) x[["a"]][["b"]][["c"]] as_mapper(list(1, "a", 2)) # Equivalent to function(x) x[[1]][["a"]][[2]] as_mapper(list(1, attr_getter("a"))) # Equivalent to function(x) attr(x[[1]], "a") as_mapper(c("a", "b", "c"), .default = NA) } purrr/man/rmd/0000755000176200001440000000000015063325731012766 5ustar liggesuserspurrr/man/rmd/indexed-error.Rmd0000644000176200001440000000674315063325731016213 0ustar liggesusersThe `purrr_error_indexed` class is thrown by [map()], [map2()], [pmap()], and friends. It wraps errors thrown during the processing on individual elements with information about the location of the error. # Structure `purrr_error_indexed` has three important fields: - `location`: the location of the error as a single integer. - `name`: the name of the location as a string. If the element was not named, `name` will be `NULL` - `parent`: the original error thrown by `.f`. Let's see this in action by capturing the generated condition from a very simple example: ```{r} f <- function(x) { rlang::abort("This is an error") } cnd <- rlang::catch_cnd(map(c(1, 4, 2), f)) class(cnd) cnd$location cnd$name print(cnd$parent, backtrace = FALSE) ``` If the input vector is named, `name` will be non-`NULL`: ```{r} cnd <- rlang::catch_cnd(map(c(a = 1, b = 4, c = 2), f)) cnd$name ``` # Handling errors (This section assumes that you're familiar with the basics of error handling in R, as described in [Advanced R](https://adv-r.hadley.nz/conditions.html).) This error chaining is really useful when doing interactive data analysis, but it adds some extra complexity when handling errors with `tryCatch()` or `withCallingHandlers()`. Let's see what happens by adding a custom class to the error thrown by `f()`: ```{r} #| error: true f <- function(x) { rlang::abort("This is an error", class = "my_error") } map(c(1, 4, 2, 5, 3), f) ``` This doesn't change the visual display, but you might be surprised if you try to catch this error with `tryCatch()` or `withCallingHandlers()`: ```{r} #| error: true tryCatch( map(c(1, 4, 2, 5, 3), f), my_error = function(err) { # use NULL value if error NULL } ) withCallingHandlers( map(c(1, 4, 2, 5, 3), f), my_error = function(err) { # throw a more informative error abort("Wrapped error", parent = err) } ) ``` That's because, as described above, the error that `map()` throws will always have class `purrr_error_indexed`: ```{r} tryCatch( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) { print("Hello! I am now called :)") } ) ``` In order to handle the error thrown by `f()`, you'll need to use `rlang::cnd_inherits()` on the parent error: ```{r} #| error: true tryCatch( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) { if (rlang::cnd_inherits(err, "my_error")) { NULL } else { rlang::cnd_signal(err) } } ) withCallingHandlers( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) { if (rlang::cnd_inherits(err, "my_error")) { abort("Wrapped error", parent = err) } } ) ``` (The `tryCatch()` approach is suboptimal because we're no longer just handling errors, but also rethrowing them. The rethrown errors won't work correctly with (e.g.) `recover()` and `traceback()`, but we don't currently have a better approach. In the future we expect to [enhance `try_fetch()`](https://github.com/r-lib/rlang/issues/1534) to make this easier to do 100% correctly). Finally, if you just want to get rid of purrr's wrapper error, you can resignal the parent error: ```{r} #| error: true withCallingHandlers( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) { rlang::cnd_signal(err$parent) } ) ``` Because we are resignalling an error, it's important to use `withCallingHandlers()` and not `tryCatch()` in order to preserve the full backtrace context. That way `recover()`, `traceback()`, and related tools will continue to work correctly. purrr/man/update_list.Rd0000644000176200001440000000230114326706774015017 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/list-modify.R \name{update_list} \alias{update_list} \title{Update a list with formulas} \usage{ update_list(.x, ...) } \arguments{ \item{.x}{List to modify.} \item{...}{New values of a list. Use \code{zap()} to remove values. These values should be either all named or all unnamed. When inputs are all named, they are matched to \code{.x} by name. When they are all unnamed, they are matched by position. \link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your replacement values are stored in a list, you can splice that in with \verb{!!!}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{update_list()} was deprecated in purrr 1.0.0, because we no longer believe that functions that use NSE are a good fit for purrr. \code{update_list()} handles formulas and quosures that can refer to values existing within the input list. This function is deprecated because we no longer believe that functions that use tidy evaluation are a good fit for purrr. } \keyword{internal} purrr/man/lmap.Rd0000644000176200001440000000647115063325731013434 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lmap.R \name{lmap} \alias{lmap} \alias{lmap_if} \alias{lmap_at} \title{Apply a function to list-elements of a list} \usage{ lmap(.x, .f, ...) lmap_if(.x, .p, .f, ..., .else = NULL) lmap_at(.x, .at, .f, ...) } \arguments{ \item{.x}{A list or data frame.} \item{.f}{A function that takes a length-1 list and returns a list (of any length.)} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.p}{A single predicate function, a formula describing such a predicate function, or a logical vector of the same length as \code{.x}. Alternatively, if the elements of \code{.x} are themselves lists of objects, a string indicating the name of a logical element in the inner lists. Only those elements where \code{.p} evaluates to \code{TRUE} will be modified.} \item{.else}{A function applied to elements of \code{.x} for which \code{.p} returns \code{FALSE}.} \item{.at}{A logical, integer, or character vector giving the elements to select. Alternatively, a function that takes a vector of names, and returns a logical, integer, or character vector of elements to select. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is installed, you can use \code{vars()} and tidyselect helpers to select elements.} } \value{ A list or data frame, matching \code{.x}. There are no guarantees about the length. } \description{ \code{lmap()}, \code{lmap_at()} and \code{lmap_if()} are similar to \code{map()}, \code{map_at()} and \code{map_if()}, except instead of mapping over \code{.x[[i]]}, they instead map over \code{.x[i]}. This has several advantages: \itemize{ \item It makes it possible to work with functions that exclusively take a list. \item It allows \code{.f} to access the attributes of the encapsulating list, like \code{\link[=names]{names()}}. \item It allows \code{.f} to return a larger or small list than it receives changing the size of the output. } } \examples{ set.seed(1014) # Let's write a function that returns a larger list or an empty list # depending on some condition. It also uses the input name to name the # output maybe_rep <- function(x) { n <- rpois(1, 2) set_names(rep_len(x, n), paste0(names(x), seq_len(n))) } # The output size varies each time we map f() x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10]) x |> lmap(maybe_rep) |> str() # We can apply f() on a selected subset of x x |> lmap_at(c("a", "d"), maybe_rep) |> str() # Or only where a condition is satisfied x |> lmap_if(is.character, maybe_rep) |> str() } \seealso{ Other map variants: \code{\link{imap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{modify}()}, \code{\link{pmap}()} } \concept{map variants} purrr/man/map2.Rd0000644000176200001440000000740115163460322013331 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map2.R \name{map2} \alias{map2} \alias{map2_lgl} \alias{map2_int} \alias{map2_dbl} \alias{map2_chr} \alias{map2_vec} \alias{walk2} \title{Map over two inputs} \usage{ map2(.x, .y, .f, ..., .progress = FALSE) map2_lgl(.x, .y, .f, ..., .progress = FALSE) map2_int(.x, .y, .f, ..., .progress = FALSE) map2_dbl(.x, .y, .f, ..., .progress = FALSE) map2_chr(.x, .y, .f, ..., .progress = FALSE) map2_vec(.x, .y, .f, ..., .ptype = NULL, .progress = FALSE) walk2(.x, .y, .f, ..., .progress = FALSE) } \arguments{ \item{.x, .y}{A pair of vectors, usually the same length. If not, a vector of length 1 will be recycled to the length of the other.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function. \item An anonymous function, e.g. \verb{\\(x, y) x + y} or \code{function(x, y) x + y}. \item A formula, e.g. \code{~ .x + .y}. Use \code{.x} to refer to the current element of \code{x} and \code{.y} to refer to the current element of \code{y}. No longer recommended. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.progress}{Whether to show a progress bar. Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} for more 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; \code{.f()} can return anything. \item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, 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. The return value of \code{.f()} is ignored. } Any errors thrown by \code{.f} will be wrapped in an error with class \link{purrr_error_indexed}. } \description{ These functions are variants of \code{\link[=map]{map()}} that iterate over two arguments at a time. } \examples{ x <- list(1, 1, 1) y <- list(10, 20, 30) map2(x, y, \(x, y) x + y) # Or just map2(x, y, `+`) # Split into pieces, fit model to each piece, then predict by_cyl <- mtcars |> split(mtcars$cyl) mods <- by_cyl |> map(\(df) lm(mpg ~ wt, data = df)) map2(mods, by_cyl, predict) } \seealso{ Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{modify}()}, \code{\link{pmap}()} } \concept{map variants} purrr/man/purrr-package.Rd0000644000176200001440000000162715063325731015244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/package-purrr.R \docType{package} \name{purrr-package} \alias{purrr} \alias{purrr-package} \title{purrr: Functional Programming Tools} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} A complete and consistent functional programming toolkit for R. } \seealso{ Useful links: \itemize{ \item \url{https://purrr.tidyverse.org/} \item \url{https://github.com/tidyverse/purrr} \item Report bugs at \url{https://github.com/tidyverse/purrr/issues} } } \author{ \strong{Maintainer}: Hadley Wickham \email{hadley@posit.co} (\href{https://orcid.org/0000-0003-4757-117X}{ORCID}) Authors: \itemize{ \item Lionel Henry \email{lionel@posit.co} } Other contributors: \itemize{ \item Posit Software, PBC (\href{https://ror.org/03wc8by49}{ROR}) [copyright holder, funder] } } \keyword{internal} purrr/man/cross.Rd0000644000176200001440000001103315063325731013622 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-cross.R \name{cross} \alias{cross} \alias{cross2} \alias{cross3} \alias{cross_df} \title{Produce all combinations of list elements} \usage{ cross(.l, .filter = NULL) cross2(.x, .y, .filter = NULL) cross3(.x, .y, .z, .filter = NULL) cross_df(.l, .filter = NULL) } \arguments{ \item{.l}{A list of lists or atomic vectors. Alternatively, a data frame. \code{cross_df()} requires all elements to be named.} \item{.filter}{A predicate function that takes the same number of arguments as the number of variables to be combined.} \item{.x, .y, .z}{Lists or atomic vectors.} } \value{ \code{cross2()}, \code{cross3()} and \code{cross()} always return a list. \code{cross_df()} always returns a data frame. \code{cross()} returns a list where each element is one combination so that the list can be directly mapped over. \code{cross_df()} returns a data frame where each row is one combination. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} These functions were deprecated in purrr 1.0.0 because they are slow and buggy, and we no longer think they are the right approach to solving this problem. Please use \code{tidyr::expand_grid()} instead. Here is an example of equivalent usages for \code{cross()} and \code{expand_grid()}: \if{html}{\out{
}}\preformatted{data <- list( id = c("John", "Jane"), sep = c("! ", "... "), greeting = c("Hello.", "Bonjour.") ) # With deprecated `cross()` data |> cross() |> map_chr(\\(...) paste0(..., collapse = "")) # With `expand_grid()` tidyr::expand_grid(!!!data) |> pmap_chr(paste) }\if{html}{\out{
}} } \details{ \code{cross2()} returns the product set of the elements of \code{.x} and \code{.y}. \code{cross3()} takes an additional \code{.z} argument. \code{cross()} takes a list \code{.l} and returns the cartesian product of all its elements in a list, with one combination by element. \code{cross_df()} is like \code{cross()} but returns a data frame, with one combination by row. \code{cross()}, \code{cross2()} and \code{cross3()} return the cartesian product is returned in wide format. This makes it more amenable to mapping operations. \code{cross_df()} returns the output in long format just as \code{expand.grid()} does. This is adapted to rowwise operations. When the number of combinations is large and the individual elements are heavy memory-wise, it is often useful to filter unwanted combinations on the fly with \code{.filter}. It must be a predicate function that takes the same number of arguments as the number of crossed objects (2 for \code{cross2()}, 3 for \code{cross3()}, \code{length(.l)} for \code{cross()}) and returns \code{TRUE} or \code{FALSE}. The combinations where the predicate function returns \code{TRUE} will be removed from the result. } \examples{ # We build all combinations of names, greetings and separators from our # list of data and pass each one to paste() data <- list( id = c("John", "Jane"), greeting = c("Hello.", "Bonjour."), sep = c("! ", "... ") ) data |> cross() |> map(lift(paste)) # cross() returns the combinations in long format: many elements, # each representing one combination. With cross_df() we'll get a # data frame in long format: crossing three objects produces a data # frame of three columns with each row being a particular # combination. This is the same format that expand.grid() returns. args <- data |> cross_df() # In case you need a list in long format (and not a data frame) # just run as.list() after cross_df() args |> as.list() # This format is often less practical for functional programming # because applying a function to the combinations requires a loop out <- vector("character", length = nrow(args)) for (i in seq_along(out)) out[[i]] <- invoke("paste", map(args, i)) out # It's easier to transpose and then use invoke_map() args |> transpose() |> map_chr(\(x) exec(paste, !!!x)) # Unwanted combinations can be filtered out with a predicate function filter <- function(x, y) x >= y cross2(1:5, 1:5, .filter = filter) |> str() # To give names to the components of the combinations, we map # setNames() on the product: x <- seq_len(3) cross2(x, x, .filter = `==`) |> map(setNames, c("x", "y")) # Alternatively we can encapsulate the arguments in a named list # before crossing to get named components: list(x = x, y = x) |> cross(.filter = `==`) } \seealso{ \code{\link[=expand.grid]{expand.grid()}} } \keyword{internal} purrr/man/array-coercion.Rd0000644000176200001440000000371014326706774015424 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/arrays.R \name{array-coercion} \alias{array-coercion} \alias{array_branch} \alias{array_tree} \title{Coerce array to list} \usage{ array_branch(array, margin = NULL) array_tree(array, margin = NULL) } \arguments{ \item{array}{An array to coerce into a list.} \item{margin}{A numeric vector indicating the positions of the indices to be to be enlisted. If \code{NULL}, a full margin is used. If \code{numeric(0)}, the array as a whole is wrapped in a list.} } \description{ \code{array_branch()} and \code{array_tree()} enable arrays to be used with purrr's functionals by turning them into lists. The details of the coercion are controlled by the \code{margin} argument. \code{array_tree()} creates an hierarchical list (a tree) that has as many levels as dimensions specified in \code{margin}, while \code{array_branch()} creates a flat list (by analogy, a branch) along all mentioned dimensions. } \details{ When no margin is specified, all dimensions are used by default. When \code{margin} is a numeric vector of length zero, the whole array is wrapped in a list. } \examples{ # We create an array with 3 dimensions x <- array(1:12, c(2, 2, 3)) # A full margin for such an array would be the vector 1:3. This is # the default if you don't specify a margin # Creating a branch along the full margin is equivalent to # as.list(array) and produces a list of size length(x): array_branch(x) |> str() # A branch along the first dimension yields a list of length 2 # with each element containing a 2x3 array: array_branch(x, 1) |> str() # A branch along the first and third dimensions yields a list of # length 2x3 whose elements contain a vector of length 2: array_branch(x, c(1, 3)) |> str() # Creating a tree from the full margin creates a list of lists of # lists: array_tree(x) |> str() # The ordering and the depth of the tree are controlled by the # margin argument: array_tree(x, c(3, 1)) |> str() } purrr/man/list_simplify.Rd0000644000176200001440000000261115063325731015362 0ustar liggesusers% 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{...}{These dots are for future extensions and must be empty.} \item{strict}{What should happen if simplification fails? If \code{TRUE} (the default) 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.} } \value{ A vector the same length as \code{x}. } \description{ Simplification maintains a one-to-one correspondence between the input and output, implying that each element of \code{x} must contain a one element vector or a one-row data frame. If you don't want to maintain this correspondence, then you probably want either \code{\link[=list_c]{list_c()}}/\code{\link[=list_rbind]{list_rbind()}} or \code{\link[=list_flatten]{list_flatten()}}. } \examples{ list_simplify(list(1, 2, 3)) # Only works when vectors are length one and have compatible types: try(list_simplify(list(1, 2, 1:3))) try(list_simplify(list(1, 2, "x"))) # Unless you strict = FALSE, in which case you get the input back: list_simplify(list(1, 2, 1:3), strict = FALSE) list_simplify(list(1, 2, "x"), strict = FALSE) } purrr/man/faq-adverbs-export.Rd0000644000176200001440000000247714326706774016232 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/faq.R \name{faq-adverbs-export} \alias{faq-adverbs-export} \title{Best practices for exporting adverb-wrapped functions} \description{ Exporting functions created with purrr adverbs in your package requires some precautions because the functions will contain internal purrr code. This means that creating them once and for all when the package is built may cause problems when purrr is updated, because a function that the adverb uses might no longer exist. Instead, either create the modified function once per session on package load or wrap the call within another function every time you use it: \itemize{ \item Using the \code{\link[=.onLoad]{.onLoad()}} hook: \if{html}{\out{
}}\preformatted{#' My function #' @export insist_my_function <- function(...) "dummy" my_function <- function(...) \{ # Implementation \} .onLoad <- function(lib, pkg) \{ insist_my_function <<- purrr::insistently(my_function) \} }\if{html}{\out{
}} \item Using a wrapper function: \if{html}{\out{
}}\preformatted{my_function <- function(...) \{ # Implementation \} #' My function #' @export insist_my_function <- function(...) \{ purrr::insistently(my_function)(...) \} }\if{html}{\out{
}} } } \keyword{internal} purrr/man/pluck.Rd0000644000176200001440000001011715163460322013606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck.R \name{pluck} \alias{pluck} \alias{pluck<-} \alias{pluck_exists} \title{Safely get or set an element deep within a nested data structure} \usage{ pluck(.x, ..., .default = NULL) pluck(.x, ...) <- value pluck_exists(.x, ...) } \arguments{ \item{.x, x}{A vector or environment} \item{...}{A list of accessors for indexing into the object. Can be an positive integer, a negative integer (to index from the right), a string (to index into names), or an accessor function (except for the assignment variants which only support names and positions). If the object being indexed is an S4 object, accessing it by name will return the corresponding slot. \link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your accessors are stored in a list, you can splice that in with \verb{!!!}.} \item{.default}{Value to use if target is \code{NULL} or absent.} \item{value}{A value to replace in \code{.x} at the pluck location. Use \code{zap()} to instead remove the element.} } \description{ \code{pluck()} implements a generalised form of \code{[[} that allow you to index deeply and flexibly into data structures. (If you're looking for an equivalent of \code{[}, see \code{\link[=keep_at]{keep_at()}}.) \code{pluck()} always succeeds, returning \code{.default} if the index you are trying to access does not exist or is \code{NULL}. (If you're looking for a variant that errors, try \code{\link[=chuck]{chuck()}}.) \verb{pluck<-()} is the assignment equivalent, allowing you to modify an object deep within a nested data structure. \code{pluck_exists()} tells you whether or not an object exists using the same rules as pluck (i.e. a \code{NULL} element is equivalent to an absent element). } \details{ \itemize{ \item You can pluck or chuck with standard accessors like integer positions and string names, and also accepts arbitrary accessor functions, i.e. functions that take an object and return some internal piece. This is often more readable than a mix of operators and accessors because it reads linearly and is free of syntactic cruft. Compare: \code{accessor(x[[1]])$foo} to \code{pluck(x, 1, accessor, "foo")}. \item These accessors never partial-match. This is unlike \code{$} which will select the \code{disp} object if you write \code{mtcars$di}. } } \examples{ # Let's create a list of data structures: obj1 <- list("a", list(1, elt = "foo")) obj2 <- list("b", list(2, elt = "bar")) x <- list(obj1, obj2) # pluck() provides a way of retrieving objects from such data # structures using a combination of numeric positions, vector or # list names, and accessor functions. # Numeric positions index into the list by position, just like `[[`: pluck(x, 1) # same as x[[1]] # Index from the back pluck(x, -1) # same as x[[2]] pluck(x, 1, 2) # same as x[[1]][[2]] # Supply names to index into named vectors: pluck(x, 1, 2, "elt") # same as x[[1]][[2]][["elt"]] # By default, pluck() consistently returns `NULL` when an element # does not exist: pluck(x, 10) try(x[[10]]) # You can also supply a default value for non-existing elements: pluck(x, 10, .default = NA) # The map() functions use pluck() by default to retrieve multiple # values from a list: map_chr(x, 1) map_int(x, c(2, 1)) # pluck() also supports accessor functions: my_element <- function(x) x[[2]]$elt pluck(x, 1, my_element) pluck(x, 2, my_element) # Even for this simple data structure, this is more readable than # the alternative form because it requires you to read both from # right-to-left and from left-to-right in different parts of the # expression: my_element(x[[1]]) # If you have a list of accessors, you can splice those in with `!!!`: idx <- list(1, my_element) pluck(x, !!!idx) } \seealso{ \itemize{ \item \code{\link[=attr_getter]{attr_getter()}} for creating attribute getters suitable for use with \code{pluck()} and \code{chuck()}. \item \code{\link[=modify_in]{modify_in()}} for applying a function to a plucked location. \item \code{\link[=keep_at]{keep_at()}} is similar to \code{pluck()}, but retain the structure of the list instead of converting it into a vector. } } purrr/man/map_raw.Rd0000644000176200001440000000160215063325731014120 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map-raw.R \name{map_raw} \alias{map_raw} \alias{map2_raw} \alias{imap_raw} \alias{pmap_raw} \alias{flatten_raw} \title{Functions that return raw vectors} \usage{ map_raw(.x, .f, ...) map2_raw(.x, .y, .f, ...) imap_raw(.x, .f, ...) pmap_raw(.l, .f, ...) flatten_raw(.x) } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} These functions were deprecated in purrr 1.0.0 because they are of limited use and you can now use \code{\link[=map_vec]{map_vec()}} instead. They are variants of \code{\link[=map]{map()}}, \code{\link[=map2]{map2()}}, \code{\link[=imap]{imap()}}, \code{\link[=pmap]{pmap()}}, and \code{\link[=flatten]{flatten()}} that return raw vectors. } \keyword{internal} purrr/man/list_flatten.Rd0000644000176200001440000000517315063325731015171 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/list-flatten.R \name{list_flatten} \alias{list_flatten} \title{Flatten a list} \usage{ list_flatten( x, ..., is_node = NULL, name_spec = "{outer}_{inner}", name_repair = c("minimal", "unique", "check_unique", "universal") ) } \arguments{ \item{x}{A list.} \item{...}{These dots are for future extensions and must be empty.} \item{is_node}{A predicate function that determines whether an element is a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The default value, \code{NULL}, treats simple lists as nodes and everything else (including richer objects like data frames and linear models) as leaves, using \code{\link[vctrs:obj_is_list]{vctrs::obj_is_list()}}. To recurse into all objects built on lists use \code{\link[=is.list]{is.list()}}.} \item{name_spec}{If both inner and outer names are present, control how they are combined. Should be a glue specification that uses variables \code{inner} and \code{outer}.} \item{name_repair}{One of \code{"minimal"}, \code{"unique"}, \code{"universal"}, or \code{"check_unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for the meaning of these options.} } \value{ A list of the same type as \code{x}. The list might be shorter if \code{x} contains empty lists, the same length if it contains lists of length 1 or no sub-lists, or longer if it contains lists of length > 1. } \description{ Flattening a list removes a single layer of internal hierarchy, i.e. it inlines elements that are lists leaving non-lists alone. } \examples{ x <- list(1, list(2, 3), list(4, list(5))) x |> list_flatten() |> str() x |> list_flatten() |> list_flatten() |> str() # Flat lists are left as is list(1, 2, 3, 4, 5) |> list_flatten() |> str() # Empty lists will disappear list(1, list(), 2, list(3)) |> list_flatten() |> str() # Another way to see this is that it reduces the depth of the list x <- list( list(), list(list()) ) x |> pluck_depth() x |> list_flatten() |> pluck_depth() # Use name_spec to control how inner and outer names are combined x <- list(x = list(a = 1, b = 2), y = list(c = 1, d = 2)) x |> list_flatten() |> names() x |> list_flatten(name_spec = "{outer}") |> names() x |> list_flatten(name_spec = "{inner}") |> names() # Set `is_node = is.list` to also flatten richer objects built on lists like # data frames and linear models df <- data.frame(x = 1:3, y = 4:6) x <- list( a_string = "something", a_list = list(1:3, "else"), a_df = df ) x |> list_flatten(is_node = is.list) # Note that objects that are already "flat" retain their classes list_flatten(df, is_node = is.list) } purrr/man/rate_sleep.Rd0000644000176200001440000000143414326706774014633 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rate.R \name{rate_sleep} \alias{rate_sleep} \alias{rate_reset} \title{Wait for a given time} \usage{ rate_sleep(rate, quiet = TRUE) rate_reset(rate) } \arguments{ \item{rate}{A \link[=rate_backoff]{rate} object determining the waiting time.} \item{quiet}{If \code{FALSE}, prints a message displaying how long until the next request.} } \description{ If the rate's internal counter exceeds the maximum number of times it is allowed to sleep, \code{rate_sleep()} throws an error of class \code{purrr_error_rate_excess}. } \details{ Call \code{rate_reset()} to reset the internal rate counter to 0. } \seealso{ \code{\link[=rate_backoff]{rate_backoff()}}, \code{\link[=insistently]{insistently()}} } \keyword{internal} purrr/man/reexports.Rd0000644000176200001440000000503414326706774014543 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reexport-rlang.R \docType{import} \name{reexports} \alias{reexports} \alias{set_names} \alias{exec} \alias{zap} \alias{\%||\%} \alias{done} \alias{rep_along} \alias{is_bare_list} \alias{is_bare_atomic} \alias{is_bare_vector} \alias{is_bare_double} \alias{is_bare_integer} \alias{is_bare_numeric} \alias{is_bare_character} \alias{is_bare_logical} \alias{is_list} \alias{is_atomic} \alias{is_vector} \alias{is_integer} \alias{is_double} \alias{is_character} \alias{is_logical} \alias{is_null} \alias{is_function} \alias{is_scalar_list} \alias{is_scalar_atomic} \alias{is_scalar_vector} \alias{is_scalar_double} \alias{is_scalar_character} \alias{is_scalar_logical} \alias{is_scalar_integer} \alias{is_empty} \alias{is_formula} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{rlang}{\code{\link[rlang:op-null-default]{\%||\%}}, \code{\link[rlang]{done}}, \code{\link[rlang]{exec}}, \code{\link[rlang:type-predicates]{is_atomic}}, \code{\link[rlang:bare-type-predicates]{is_bare_atomic}}, \code{\link[rlang:bare-type-predicates]{is_bare_character}}, \code{\link[rlang:bare-type-predicates]{is_bare_double}}, \code{\link[rlang:bare-type-predicates]{is_bare_integer}}, \code{\link[rlang:bare-type-predicates]{is_bare_list}}, \code{\link[rlang:bare-type-predicates]{is_bare_logical}}, \code{\link[rlang:bare-type-predicates]{is_bare_numeric}}, \code{\link[rlang:bare-type-predicates]{is_bare_vector}}, \code{\link[rlang:type-predicates]{is_character}}, \code{\link[rlang:type-predicates]{is_double}}, \code{\link[rlang]{is_empty}}, \code{\link[rlang]{is_formula}}, \code{\link[rlang]{is_function}}, \code{\link[rlang:type-predicates]{is_integer}}, \code{\link[rlang:type-predicates]{is_list}}, \code{\link[rlang:type-predicates]{is_logical}}, \code{\link[rlang:type-predicates]{is_null}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_atomic}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_character}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_double}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_integer}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_list}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_logical}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_vector}}, \code{\link[rlang:type-predicates]{is_vector}}, \code{\link[rlang]{rep_along}}, \code{\link[rlang]{set_names}}, \code{\link[rlang]{zap}}} }} purrr/man/quietly.Rd0000644000176200001440000000264215163460322014170 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-quietly.R \name{quietly} \alias{quietly} \title{Wrap a function to capture side-effects} \usage{ quietly(.f) } \arguments{ \item{.f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ Create a modified version of \code{.f} that captures side-effects along with the return value of the function and returns a list containing the \code{result}, \code{output}, \code{messages} and \code{warnings}. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ f <- function() { print("Hi!") message("Hello") warning("How are ya?") "Gidday" } f() f_quiet <- quietly(f) str(f_quiet()) } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/auto_browse.Rd0000644000176200001440000000302015163460322015014 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-auto-browse.R \name{auto_browse} \alias{auto_browse} \title{Wrap a function so it will automatically \code{browse()} on error} \usage{ auto_browse(.f) } \arguments{ \item{.f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ A function wrapped with \code{auto_browse()} will automatically enter an interactive debugger using \code{\link[=browser]{browser()}} when ever it encounters an error. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ # For interactive usage, auto_browse() is useful because it automatically # starts a browser() in the right place. f <- function(x) { y <- 20 if (x > 5) { stop("!") } else { x } } if (interactive()) { map(1:6, auto_browse(f)) } } \seealso{ Other adverbs: \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/map_if.Rd0000644000176200001440000001021215163460322013717 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map-if-at.R \name{map_if} \alias{map_if} \alias{map_at} \title{Apply a function to each element of a vector conditionally} \usage{ map_if(.x, .p, .f, ..., .else = NULL) map_at(.x, .at, .f, ..., .progress = FALSE) } \arguments{ \item{.x}{A list or atomic vector.} \item{.p}{A single predicate function, a formula describing such a predicate function, or a logical vector of the same length as \code{.x}. Alternatively, if the elements of \code{.x} are themselves lists of objects, a string indicating the name of a logical element in the inner lists. Only those elements where \code{.p} evaluates to \code{TRUE} will be modified.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. Use \code{.x} to refer to the first argument. No longer recommended. \item A string, integer, or list, e.g. \code{"idx"}, \code{1}, or \code{list("idx", 1)} which are shorthand for \verb{\\(x) pluck(x, "idx")}, \verb{\\(x) pluck(x, 1)}, and \verb{\\(x) pluck(x, "idx", 1)} respectively. Optionally supply \code{.default} to set a default value if the indexed element is \code{NULL} or does not exist. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.else}{A function applied to elements of \code{.x} for which \code{.p} returns \code{FALSE}.} \item{.at}{A logical, integer, or character vector giving the elements to select. Alternatively, a function that takes a vector of names, and returns a logical, integer, or character vector of elements to select. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is installed, you can use \code{vars()} and tidyselect helpers to select elements.} \item{.progress}{Whether to show a progress bar. Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} for more details.} } \description{ The functions \code{map_if()} and \code{map_at()} take \code{.x} as input, apply the function \code{.f} to some of the elements of \code{.x}, and return a list of the same length as the input. \itemize{ \item \code{map_if()} takes a predicate function \code{.p} as input to determine which elements of \code{.x} are transformed with \code{.f}. \item \code{map_at()} takes a vector of names or positions \code{.at} to specify which elements of \code{.x} are transformed with \code{.f}. } } \examples{ # Use a predicate function to decide whether to map a function: iris |> map_if(is.factor, as.character) |> str() # Specify an alternative with the `.else` argument: iris |> map_if(is.factor, as.character, .else = as.integer) |> str() # Use numeric vector of positions select elements to change: iris |> map_at(c(4, 5), is.numeric) |> str() # Use vector of names to specify which elements to change: iris |> map_at("Species", toupper) |> str() } \seealso{ Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{modify}()}, \code{\link{pmap}()} } \concept{map variants} purrr/man/pluck_depth.Rd0000644000176200001440000000136514326707000014774 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck-depth.R \name{pluck_depth} \alias{pluck_depth} \alias{vec_depth} \title{Compute the depth of a vector} \usage{ pluck_depth(x, is_node = NULL) } \arguments{ \item{x}{A vector} \item{is_node}{Optionally override the default criteria for determine an element can be recursed within. The default matches the behaviour of \code{pluck()} which can recurse into lists and expressions.} } \value{ An integer. } \description{ The depth of a vector is how many levels that you can index/pluck into it. \code{pluck_depth()} was previously called \code{vec_depth()}. } \examples{ x <- list( list(), list(list()), list(list(list(1))) ) pluck_depth(x) x |> map_int(pluck_depth) } purrr/man/insistently.Rd0000644000176200001440000000552515163460322015064 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-insistently.R \name{insistently} \alias{insistently} \title{Transform a function to wait then retry after an error} \usage{ insistently(f, rate = rate_backoff(), quiet = TRUE) } \arguments{ \item{f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} \item{rate}{A \link[=rate-helpers]{rate} object. Defaults to jittered exponential backoff.} \item{quiet}{Hide errors (\code{TRUE}, the default), or display them as they occur?} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ \code{insistently()} takes a function and modifies it to retry after given amount of time whenever it errors. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ # For the purpose of this example, we first create a custom rate # object with a low waiting time between attempts: rate <- rate_delay(0.1) # insistently() makes a function repeatedly try to work risky_runif <- function(lo = 0, hi = 1) { y <- runif(1, lo, hi) if(y < 0.9) { stop(y, " is too small") } y } # Let's now create an exponential backoff rate with a low waiting # time between attempts: rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005, max_times = 4) # Modify your function to run insistently. insistent_risky_runif <- insistently(risky_runif, rate, quiet = FALSE) set.seed(6) # Succeeding seed insistent_risky_runif() set.seed(3) # Failing seed try(insistent_risky_runif()) # You can also use other types of rate settings, like a delay rate # that waits for a fixed amount of time. Be aware that a delay rate # has an infinite amount of attempts by default: rate <- rate_delay(0.2, max_times = 3) insistent_risky_runif <- insistently(risky_runif, rate = rate, quiet = FALSE) try(insistent_risky_runif()) # insistently() and possibly() are a useful combination rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005) possibly_insistent_risky_runif <- possibly(insistent_risky_runif, otherwise = -99) set.seed(6) possibly_insistent_risky_runif() set.seed(3) possibly_insistent_risky_runif() } \seealso{ \code{\link[httr:RETRY]{httr::RETRY()}} is a special case of \code{\link[=insistently]{insistently()}} for HTTP verbs. Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/figures/0000755000176200001440000000000015063325731013650 5ustar liggesuserspurrr/man/figures/lifecycle-questioning.svg0000644000176200001440000000171413710503502020665 0ustar liggesuserslifecyclelifecyclequestioningquestioning purrr/man/figures/lifecycle-stable.svg0000644000176200001440000000167413710503502017577 0ustar liggesuserslifecyclelifecyclestablestable purrr/man/figures/lifecycle-experimental.svg0000644000176200001440000000171613710503502021017 0ustar liggesuserslifecyclelifecycleexperimentalexperimental purrr/man/figures/lifecycle-deprecated.svg0000644000176200001440000000171213710503502020416 0ustar liggesuserslifecyclelifecycledeprecateddeprecated purrr/man/figures/lifecycle-superseded.svg0000644000176200001440000000171314326706774020506 0ustar liggesusers lifecyclelifecyclesupersededsuperseded purrr/man/figures/logo.png0000644000176200001440000020167015063325731015324 0ustar liggesusers‰PNG  IHDRðÞ«h cHRMz&€„ú€èu0ê`:˜pœºQ<bKGDÿÿÿ ½§“tIMEç ) j5¡Š€IDATxÚìýw€%Çuß‹ª»oœœóæŒMX`‘#  ÁŠ")Y¶~þY¶Ÿ¬÷,YÏ’%+ØJ&E%€sIÈailÎy'Ç›º»ÞÕÕ]Ý÷Þ™Ù iKgöNßîêª:uÎùžï9%¸ÜþÉ´¡õÍæ?¯þ3Ð üðCÀ8¾{ê'ÝÕËí5ñ“îÀåvñ-!¸ýÀ/¿ , >; |øKà€¾ð² ÿì·Ëü3Þ ámÞü”ö­Õö|Ñ^äŸÝvY€F›!¸pðo;Ì_õ€Ç?¾á²ÿ¬¶Ëü3Öæò:à_ÚÏóV³ÀCÀŸ; —ùg­]àŸ‘–ÜnàÃÀ'€UyëÓÀߟŽè/ òÏF³Ò¸Ün†ðæQ~î¿t\‚Û77¯\àPléÊ05RúI¿úå¶@»¬Š›!¸p  z+ûGzdxåÿ(ÃemüÓÜ. ðOaK˜Ë+Q¦òÏ¡LçG›¾ü/à%ýáeAþék—ø§¨%·¸R­ÿ uéð)àÓÀIýáeAþéi—ø§¤›Þˆ ÝÂâRJ|ß$–e#ÄEMõNàOi¸,Ä?-í²ÿ„›!¸؆òs߉"fœwÓ‚›Éd¸æê›Ées<ñô#ÌÎÎ`YÖÅr ø.Ê?~ x]äŸp»,À?¡–0—— ¨AQ!/¨ù¾‚µk6òÁ{>Êëo»Û¶yâ©ð™û>ÉK/?‡ç¹qQ‚<†brý°[xY2í²ÿ˜[Bp[€÷¿ l¾Ð{j­Û×;À;ßþÞõŽÑ×;@¥\AJeBðÍï<À¾üw=vX–u1¯rø+àïQ\kಠÿ¸Ûeþ16CxSÀí(?÷õÁ¿Ï»)ÁõhllæŽ×½…Ýûˬ[» x®‹ïûH)BóùÈу|ñ¿ã›ß~€±ñá‹õ%ð4*.ýu`. ñ³]àCKhÝMÀ¿Þ‡ÒÀçÝ´ÆM¥R\uåõ|èÞqýu·‘Ëåð}_ýçEÂk6˲ð<——ví೟ÿ$?õŠÅÂÅúÇà(A~ ðá² ÿ8ÚeþGluÒü>,½Ð{*dV®XÃûßóîzÃÛiiiGâ#H)Ãÿ„U¿¡Ìç¹¹Y}üa>{ÿ'yõµCú"ùð\N[ü±µËüÔj¤ùý*°ýBï§ÍåÎÎÞúæ÷ñžw~ˆÁe1¥aM!6ÿf °þ)„àÜð¾öÍ/ðÀCŸåÄÉ£X–@ˆ‹ò÷|Õ^äKß. ð%n‰4¿Q~î],œæW³is9Ÿoà–ïàïÿ(¯¸˲‘Ò®ŠÒ²,T™Ð¦Ö÷Bàû^(Ðíã _þ[¾û½¯295~±þ±‡ 7ý1—ÓÿÑÚe¾D­Fšß¿@¥ù]PÂÒž>¶í°yãU|ðž_æÆëo'›Í‚(PR| -[ù²Z€M¬å+ Ë„ßÆuËì|á>{ß'yö¹Ç(•KëÏ¥-îärÚâ%m—ø"[4¿¿ÂE¤ùiÕ’¡•¼ïÝ?Ç›ïz7ímxž†…T32nka­Z»Þ|žþžã8LOOñý~“û¾øiöî{5xîE™Õ§ˆÒê/ òŵË|-‘æ÷fà×€ëQÙCçÝ´ŸÛÖÖÉ›ï|ï{÷/°léÊÐŒV&s2~›ÐhJ“fsòúHC+SÚü€eÙœ={’¿úyúÚ}œ9{òbµ1ÀËÀÿF%KLè/ ò…µË|-‘æw-Qš_þBî§4›Íqãõ·óÁ{~™­›¯Á¶m)èfüØ÷}öíû¾øi¾ÿÃo233u±þq•®øG¨ôÅËi‹Ø. ðy´i~G¥ùõ\Èý4JlYÖoáïÿ(·Ý|' ù<ßiEÝ:™Ç&-Rkè¸\%}eY³óõ” —Ë%žyîq>wÿ'ÙùÂÓT*•‹ÕÈ“Di‹/ë/ òâÛe^d3„·•æ÷¯¸ˆ4?)}|_28°„w½ãC¼íî÷ÓÝÕ‹ï{hyÒ(sM¶bñ]-ú³¤¬šÔ´¤ðÎ;Öþ÷äÔ8ßýÞ×ø—ÿ–C‡÷] ÿøÊ7þ.§-žW»,À ´i~¿ÜÊE¥ùy´4·qçÞÎ=ïý+W¬HhÜH«ši`¥Y“±ÝðÛ¡ z(€Ê©êKm™šá§*"ˆ°8qꟻÿSßüÎ c©Kàï@¥->Äå´ÅEµË\§ÕHóûUTš_Ó…ÜOû¹ét†k·ß̇?ðq®¾ê;h]¥M•°€)WµüSSPLbFò:uOß@«ê{õ6ZÏ3»¢üco|׫/4Ü÷ÅO§}üaææf/EÚâwPñãËi‹ ´Ëœh5Òü>ŠJó¸Ð{jŠâšÕ¸÷}¿Ä^÷ššZcÚ5.À‘`%)‘@MÓVJ‰mÛuþ憘Òࢦ°'7…$ñ#Þ¢kmÛ¢P(¸O<ýˆó¹û?ÅË»v\ª´ÅÏ¡]—Óë´Ë´i~ïFiÝ-zO­u{{úyÇ[ïåoÿ ý}ƒ±,!óÚ$Àd mtM¤Š*o(¡³m;¼¿Ö„qå[55o-AÖ÷37~2¯µ,‹±ñ¾ùíøÒƒÏÑc¹Di‹‰âX_N[L´ËLÍ4¿_îà¤ù½þ¶7sïû?Êúµ›ÂL-íi|;¼‡þ©ÍêätiáÕÀ•ïû1.´h†E€˜:¥‰çó¡µ!åR]¡ÚÑ÷$R«àè1•¶ø­ï<ÀØøÈņ|¢´Åop9m1lÿ¬¸Fšß¿B¥ùµ^ÈýªÓü>Îu×ÞB&™Ë@•™Ü¡¦É¬®!¢ izkM[ÿK(„êù^ ” )Eàsǫȯ¶Â~ÖcxÕÒàBDi‹Ÿ»ï“<ñô#—*mñë(A~šËi‹ÿ<8!¸}¨"éæi~çÝÌ4¿{Þûîzã;imiªH(ýÐœUÍä5ŸÄüâ¨YB„—/ÍXp:2 ÙY–„Öžë'€+S˜D´Iš7nŠG÷Z}ÍL[üÑcßås_ø¯í~éR¥-þ=ª"È?ë´ÅvœHó{;Ñi~4fšßÛî~?ï}×Ï14¸,æ7ÆÍáx‘q'L¡®%À"ä+'9W‰’l©ôsè'×ö]“Mw«þ»6£Å¯úþ|1f(1ÉΞºTi‹_@ø'•¶ø3-À ÁÕi~ÿØp¡÷Ôi~ýKxÏ;?ÌÛßz=Ý}ø¾‡ïË*¿/ÐÈ?Ôf´ú,žMd<È|jð³ŽÇ„\F¿žÇ‚Ö¡'ó>J€wÌŠ61£Ï AžwÓ"šRÿ¶ª6Ž‰Éq¾óðCÜ÷…Osðð¾ðº‹hG‰ÒOé–ùgV€i~o :ÍϹûi?·¹¹;ïx÷¾ï—X½j}ð·8xT|`2¡"ÓÚ$+T qì 5k !® ÿ;?‘€”ñðÙoó3¥ý,ã>~èûGC½Õϸ–Žðs­ÙMsºVBpüľüà?ðµo}‘‘‘³—â´Å¨"{¡ÐkàgSæ8‘æw%*áà]\tš_:HóûÛ¯ºT*†KjåÇš(³©=<'Â>óÕ¶JôØøûù™ÔQ×ü0Ì$¥‰G!$“bY–QH/2¡MW¢–9]ûóêw5Mh³æøzžÇ«¯=Ïçîÿ>ñ=æææ.EÚâ·Q´ÌÇùM[ü™à„¹<„Jóû%.:ÍÖ¬¾‚¼ï£¼ñŽ·ÒÔÔÖ¡JæåêV; Þ!0˜X&Zœð¥ùÅøT_·–¦ÕüæK!”öô}3û¨Úr0Qis3øjMË‚ft­º^‘ûQÎhY…¹)žxê>÷…¿áåWv^Š´ÅQ¢´Å=úßAþ™`Cx›Q§ùýk`ë…Þ/–æ÷¶{y÷;>D_ï üß(Tª‘²öÂ4}a *6¼@‡ÌÄÿ­¿/¬([÷ ßßôÕWÍÍEàûIશI«ý`%\~Uf•‰èÏt‹@½ZU2Eâõ+…¤-Ž óo‰/=øYŽ?Ä%H[<@”¶xNøÓ.È?ÕœHó»è4¿ô…Ü/–æwû›ùàû™õë6&Zœß›tAc–¯q¿¤¿XàZä0×ÕÄ¢¾¦–2˜Å8)DçMë°46Q•Ÿ\K€Í·Ô(ÅPÎs}m¡Š>j?/>¦+B`ø=z€/=ø|ã;1þÏ0mñ§R€æòFTšßû¹$i~×ñá|‚®»•t:Ö¡:Ÿp¬¾¾ÖÂh†‘×æYÕ¹i]¿x¡p‰1G»Ô”HÍ µ±Éƒ–‘™úµªžO_Oà4—ÚŸx®>écÞ¡ ¾a[à{^|yŸ¹ïS<ñô)‹ëÏ¥->ÃOqÚâO•×HóûÔi~Ë.ôžašßò5Üó¾_àMw¾“¶ÖΚU1¢ïh_°úoõ4°ù¼d¶N½ÜÙª{Cœ‘UÅ+®Õ"0KÖ ?Eñ_ týMeþÑLîö™µ¹%9î §&Ö+$~`VÛÌÎÎðÈcó¹ûÿš×ö¼|©Òÿ•¶xPøÓ$È?5œHó{*Íoû…ö1žæ÷^Þ÷n•æçþžeГær=Xÿ-¼y¸ÀêZßø=þœzg‰è‚¨Caì·†olt\&€$‚IÓ*øßúYQõ4}5Âœ‡z~sÒ?Õþs­{Ÿ°i!:mÁÈÈi¾ú/ñå‡>ljS—$mq7QÚâ˜þð§AâœHó»‘(Í/{!÷ Óüryn½ù |ø¿ÌÆ+¶i~>¾ XÁ±ºOÕ~®)°ójMMÞ4ŸE~qü>é5ÿn~¤ºZXÄ?«!ÀúG°½$Lhóžµ(™áT;Û¨:ü“|³j¦¹Eš¸¾¼ð\ƒK_9 Bb °„Åþƒ{ùüÿ†ï~ÿëLMM\Š´ÅG‰ÒKð“⟘×HóûTš_ç…ÜO eÙlÞt5º÷—¹å¦;Èçòxf±tȨºEôý`@ª„Y"e݇êbéûÖþU"Cta<3)ÀÉuUÍÚš/f¬>“˜œ|·x¢F’ƒ§Í;¶Õ~îB~z}¡4MZ“+~a,•ÀâãË(Ú–‰à4‰ç_x†ÏÜ÷×<³ã‰K•¶ø*mñyý²?)Aþ± p4?}šß%Hó[Á{ßýó¼åMï¡££ßó@„~Ì¡ ‘–L‚7¾¯ú5Þ§‡Qâ‡1Só0²HCU÷½Öæ` y-äY_¬RÖfÆ‘ ò†«B2‰{ՉὩ#À‹ù¾ è_ôØ^˜Ÿë‹‘Hä&«Ó'yøßä¾/þ-ûìãÊÑN¥-Óþ¸ùÇ*À‰4¿7¡ÂBŸæ×ÚÁ]w¾“{Þó‹,_¶:Š7.@r1ÓQÕ™Ç8\°a~­Sÿ$~ |eh–ª BgوЮ‰K%ÞCý=nÔ`ø´Á³MúbŒîYËìÕ߯…/,Àf«c½‚Ú–A’’ü]¢s‹/dþ£>kºkuí¯(üesæìiúêçyèë÷söì©K‘¶ø*mñKi‹?N!þ±p"Ío;ÊÏ}›æ—Érýu·ñÁ{>ÆÖÍÛI9©Xš_81Õ–]ø{òè$Ý1‘@›b‚YÁânÀ¢jµ€°H°¢ëôwêjÄËßÖC³/V8ÓTÜà™6Z«1ÑÏ7 ¼(¹T*ñô³ò¹û?Åó/>s©ÒïG¥-îÒþc ò?Ê'·(ÍïŠ ½§Nóëïâ]oû oË=tw÷ççÆÍÅØ$h­VÅâóc…g¢1b‚K©˜MZ«F‚bfãÄ3qb_7Þg~mT+„EÌHŽÝ-rDàÿš UòÙÕqé……:iÔâj­鄸6áCõÇGia3ÆmÎhíó tµÌÉÉQ¾óðW¸ÿËÏ¡ÃûK’¶ø€¿å9mñ’ p"Í{+æ×Ê^ÿ6îyÏ/²jå:"–SÜl5ÿ÷-«ý¸È4–†¦K„oj,@_Feúoµ„ z~ò½˜÷º*f˜ Òˆ$¨•|·zþhý>ê§Äï-‹ p²ïõ–Ó¥1“ƒ7­2÷…¡…!®mM߸Þñª¨°“%UÚâCŸãkß|€‘Ñs«%QÚâWÒ/µ_2N¤ùmE¥ù½›Kæ·ýê›øнãš«o"å¤p]·æõõ‰ÕB®>óBI‰H‡Õ(fè”D‰ †5[·µ>¯%¨õ„7ú[uiY“Ä=/x#ƒœÔšõA§Ú@Tügt]ýð¥ÖÆõBiz.”®Þœ4J]ÛÇUì7!ðåû>¯¼öŸ»ÿÓ<úø÷™+\²´Å?žà§-^´×Hóû¥à¿Á ½§Nó[½r÷¼÷#Üñº·ÐÜÜ¢ÌBùÂói“ùÄ£l×p?N‰%Tî«W”RâË tŽ´Î;½>òIkkäøuÕèq\€#­ °þ— uÇc¬µ+FÖf^©TCý/‹zÂ%óGs{Ó¯?–U 0çØidÌÐYhAÄ 2óùäÑv¨ér`[‚B±ÀãO>Âgïÿ4/ïz!X+?}i‹Ü›„à6æ·õB冀nOwo{Ë=¼ómˆæÕhB¡Íra­WKóªÏ½0›ƒ ‚P‘6±-˶ð™R‚çųޡ=Ï£R©¨UË"•JáØ)¢x§‰ÌÖ™y¨ÐV”!ëêM­‰„Pš!õ¥þ#^;ŽTJ<ã ó}I¹\ “Aôø'«t¨4ÌxÀ²,*• •JÛ¶pœtøî¶åÞŠ¬JMÔòËåRJ2™ŒQ4?^+rjYµÖÑw97~cW}æ›ß~/>øYŽ?Œ¸4i‹|†K¶xAœHó»åçÞÁE¦ù544qû­oâÞ÷ýë×nŠ…vô„ÔJô^ˆêXk'½àÌã7©ô'ŽrüÄQe|JDoÏ +–¯øÉSÇxáÅgxuÏKœ9s’¹Â,ŽíÐÙÑÍÚ5WpÕ¶XµbŽ“BŸh>ÃLEܳïUÆƆÑÅš›[Ø°n³ÚD´€ñÓjóY099Îî½» ò ¬\±Žî®>Į̀R¹È«¯½H©T “Érņ+Éf2¡L/íz–ÇŸü‡ï§X,p÷›ÞÍ;Þú~¤”9zˆ“§Ž…ý\¾l5ý}CáxŸ1z)ÒŸ"J[,À… ñyK5Òüþ% an½·Pf©c§¸zÛ |àžrý5·’Édo¹F6ID® B—çiÉ8o¼ÅMÃä5¶eóÈ£ßáÿåïcY¶ð<—·¾ù}ü_¿ñûؖ͹‘Ó|éÁà[ßyS§Oຕà>Q„êßþ2í]ÜzóùÀû?ÊŠåkêžlày.Ÿþ»?åG}Ûvð}ͯæÿàoiÈ7FfsðîQÚ`àåÙ6ûîæ7~ó`*-þŸã÷yÛÝïó]×— l!ÓÓ“üÞþ_=v! §»Ÿ?ÿ“ϳdh9gΞâSóÇ|ûᇘšž žç²vÍT,Uðíï>ħÿþÏÂóˆõ_ü'~ \)óÝï~…OÿÝÿâðÑxžÒ˜ƒKƒÓ mÎœ9ÍùíÃÄÄ8Rú¬_»™?ýŸÿ@kK;‡ìç/>ù?xì‰ï177̹Ï-7ÝaÄœMáM¢íZx-¢ƒñ‚y‘ûeFô: Ø]’psÉò¥«øõ_ýMî¸íM|æþ¿æɧt1i‹Š÷%ð5ÐõÌÐúæóN[\”×HóûyTLwùùö\7½ˆW,[ÃûÞý ¼ù.ušŸëºxžW%¸ºÍgÕkµsVõ¤›•3Ú\@*¥@3!<<Ïevv€=û^áþø·ØùÂSÄ},õ»m˜Y£cÃ|ù¡àÅ—Ÿã×þÕorãõ·×õ×=×¥R)ãû>žï©M!?„aìA†(‘¾ ÍÖh¬=¤¤|µÔ©ÊÄ-#„ X*ây##çøÝßÿ ~ôØw±,c;F?u],‹t:ƒë–ñ}eÖK¤ôxð+ŸåOÿüw™™™Æ²,ÇQçÛvh´¦ÓiP©”‘RR(Δ9ºŸßú_ã¥];°-Çqa³Â]Q ••Ølkc ‘‰o–é‰k[-¼&4(ƒÝ°Åð¥mÛ\}Õõ¬_·‰>ö0Ÿ½ÿÓ¼¶û¢Òó¨<÷ÛˆN[<¨åm1‚¼ ÂÛ@”æw h~‡i~=¼åÍïå=ïü0ƒýK‘‚`·žß$¾$³:”‘àY€_%äét6-WÊ8¸‡ßþïÿžW^{+¨jÑÚÒNww/¹lžÙ¹Î;ÍÔô ¹¿‚ƒ‡öòß~ÿ?ð_þãpýµ·1ìÄÆa0›æÃ}"½,l4 U›&)„b½éç8¶C:•Ö¯…ïy‹¾ôàßóèã‡|eÏsA˜®YŽòIMØs+ì|áiþêSÈììLì0s)%¾ç…âá8NàN¨×õ<É© þì¯~/^õlOQ\}é 1Ú¥±UxÏb> S±ÿ›AÝ‘Rˆ@˜ã) ÿðÉå¸û®wqõ¶øê7¾È_ù'O¿´ºø÷Àݨ´Åû€±År]N¤ùÝ€òs/Išß-7¿‘Ý«Òü„xn&‰yÈóÞ[~ýøfí{©gi3Z¢vö¸¿”NgbføÈÈYþôÏ—W_{ §§Ÿ·½ù}ÜrÓèí ÉP.•8qê(ßä›|óÛ_ O¨·m›3gNð'ÿûwè_ÂÐಘÿ[/ëI—À©FÝÍkr=Õü®eÛID;ÝùÂS|ãÛ_îíÓÕÕË–W³dÉr¤”lX·IõפR&Ü!˜œç³÷}Š‘Ña,Kièõk7²ní&šššI9)r¹&'DZm›×ß~7¿ðáÉÊkMí‡0XञeYÏí|ŠsçN#„`ÉÐ2>ö‘_ãæï ©©™d{…ì+Þ²‚‰Éq¾òµû( d2YÞñÖ{¸÷}ehp)Ž“2€ÌÚµ·'¸I7Ǽ‡1rB ­°¬@ëû¡\‹ªï)tõªõüƯÿ6o¸ýÍ|æ¾OñìŽ'(—˪‘màu¨œQþñ Cë›%TkãP€k¤ù}%¼kηºésé’ÜóÞ_äo½‡ÎÎn<ÏSfiØádXB]‹OR=M41ÁIZ¸“l)Ýâ÷´ °ÃFU¦ÅvÒ±MÁu•)¹rù~ó7~Ÿõk7Qq+xžNJPï®bÌ7^ÿ:¤„ßú_c||4œÔïýàë¼õî÷±~í¦Ðç¿Ð¶/˜¼.L¶0ÊÝ s8¸)%o¾ó]üûû_ijjÅ÷½ qsÒŽùÆ‚C‡÷!¥Ï@ÿ¿ùÿÛ¯º>t‰¤t17KXë¡üÔÉÉq&'Çq‡¼ÿ—øøGÿÙL6x¶‹›ó˜Üàçd½&ÌZß!¼`Ý¥D5õ’„&r57Þ÷¤m;ÜpÝ­bÓ[´Å×ðý N[l~UÄ1L[LšÕT¥ù½ ø2ð‡\ ðjß©µµàcüåÿú<¿ô ÿšÎŽ®kY¶e©äúÌxüT&·ÖZ~®þžþ{r!TÓìDøŸ©¥tËd2üÂÏýK݄֯ë¹Á»ÄÙP¦‰wÃu·ñö·Ü>OÁðèY}üáí\l«¦G½®3Š5ïc[v„Ý Ô¬\±–ÿÒ¯ÓÜÜj$Ü›„ÎyN6ÇIñsüWo».Þ8`Tÿ|ßgÛÖkùù~œL:V 5I;¾ïãy^¡Ð BoŠfÈqž4~úÁÆä£S3¥”HkŽÅº-„å ,°B®@ø Háy ¼ëí÷ð'ÿã¯ùØ/þjÈ×_¸_uÛð›ÀW- dvh}3V ¼p-ð×(4ìf. GWéTš;n¿›?ýÿã?þûße劵Š,!£=LƒzðC¡ ¯%lóR”cŸ›fiy2vòäsãϬžnÝ|ßgÝšMÜ|áæL¾K2NmYwßõnzºû"-!%;ž’Ù¹ηÕây7÷—k±’´õs÷]ïfpp©QÜÞ¤0š!œêqY½j=wÜ~·±¡jpЩ71k_Õ#I&•áŠõ[ùÞ¾ö}jz’³çN³|éj¼óؘëbø=ýÝÝýôõ†§0jw§–e‘¼¯ã¤X³úŠ°H¾Úx#¡Kn¦ñgû .£µµõÈx‘ƒúoϤ4æWÍm<Ü÷ÿeÔ¡à3-˜DtÒ¤Ò´vx_E9 âÈa9Qn©{†'Ím7ßÉ–MÛùöÃ_å _ú;ÙczgkE¡ûv‡ ¬¹,¥Äó=ZšÛxÓßÁ‡?ð1Ö­Qé¾ê¼šÀN|G‘‚ßééyÄ´–mëx`D ¬UñBÏü©ŸWýùˆ­ir'׬m;455.é—WÓ>£ÉT!²Á…ªzß\©”Ÿ½ÀˆzÍžÏûWÓÄL&6H)éhï$Ÿo b8U¿^K§3twõ…qçxŸ4ÿXá «ê»»z´Ûä‹×©òî¿Õ}4¹ª¿1L ¥xT¥gÆ4zÒUÑ‹B+%}^{Ôëninåž÷ü<7^w_zè3|ý›_ Ò/8ìÔë$ç.ÐÌ4¿›¯}¿ðáÁõ×Üžæ·07Y-ÂÝð6ªŒž×´Ú”¶B¡M §i2ÍJÒÂMÈüš¥&¤óWbï*ntDTBccŽã„ìû>¥bñB&î¥årù8u>%olÛ&“ÉÄC2Dr¦ÌR‰°lD ,—ËcÛvHÞ¨7§d‡áÇ´l¸qZj±h+BßÇ÷ýj³UØQzˆðÂÎêÌ´ðÙ–¥.‘ªtO”ÔÞ(áš%7h<¥„¡Á%üê¯ü¯»õ.>{ß_+Úè¦-žZ›Të×mâç?øqÞtç;iin¡RY˜þ( Ó#Üᤄ4¹Z“bNºæäÌ—Ho¶$ûƼ6Ù"…]ßTÕ\YýÓ4¥kõG—;]sÉ´/,æfq §öø$ ó#ÖèkƒÍ+ب‚ ÚòªÕwmGážØ–KX–ÂLd<*Y_§ng®!ý•å…”ÆfÄÿ}×|‹à•ÜÀj yMøÝê&b_{m©õk±eÓÕ¬YµÇŸüŸ½ÿS¼üÊóF¢ÆâÆ¢XÓ{{xÏ»>Ä=ïý– }ª«×”Yl¢p‰]UÍGÕw’GsèÉ0…Y±{ìðßf¿«vè˜Gÿ&z>uÜôç:Ö eiU§æK…°v—º‡E.{þuýê¿,èÏÓtMKªæ0oÿðUÒW5;ꯔ ö±îûi \ÿÛÒ'6ÊÐ] ¦5Ö)£–e$?›¿¾dYË€Wnx¶Rƒ\ ÷K*0žŽ‰£üTØQ&“å ¯+Û®¼–o|ë¾øà?pìÄa,wšÄ‚,¥$—ËóÆ;ÞÊ/~øWØxÅÖ``_jžšKõ¨õIõ'Ó¼©!4`‘VM½›¯"EµÆ®×'bà›î¿N/LúçúK#£çbIéTšÖÖvãÝ«€ïùóX 5Ìÿ‹ÔèÉyZÈÔÔÄ‚ã½ {žÇ­7¿ßýþ¹\6,t¾¼”D8¥Ú «U=ˆÉÉØFº`›/D 0U—Ù !E;°N1«w>÷¬5s…Yµ½ª?Ç ÃkŸÀu]Ú‹ç{8¶ÊÐijj¦»«7ÖwMò×m®0K¹\B46×–Lö™ëº’ª¶j}h øLx8bêPe$‰Úãj¾~Nló@†•QdÀnVüÀñª>¼íÂ…&s¸Ø ¤RÊ09$Ør"‰›$6}cD9ÉZc×ÒÊf÷"¡–©åKWòïíÿƶ>óù¿ªI$2Û"0lIcC™L&¾ƒ%&5Æ2 ÞQ›Ì‘ÀÅÿ3¯_¬ðBD±m;–ך`a‡(_Dàˆkê$aÄœžd§\·ÌÑ£‡Bs3¹ðjÝK‡Œ^~egŒ 08°”ÎŽžPàlÛ¦©±9þ½© &'Çm¾ž=w*¦å/´%ë$z-ëØÁJ†ãmò¾ ÅÚkjzMèð#V–¹q©KâUFep:F윪€—†J¨ƒ~‰ XØ®z^½ÞúFß´ÕµÐ<™(»¾wTUÔ÷=Ǧ¹©yÞqÒmQA( So¢kÁýQÙ‰”^¸jëûê?íB/Vx«ÙS"d“Uë:ML²¯ªÙ;Ñn›¤„§žù!SSã @¨¶ù'8¶ÍK/?˃{Œ GpåÖkihhŒ&òèéém“Sã>²^´\·R©È³;ÂxÙ’.ɹ®¯Y`ÅjviWFÓjõØT2qÖTí{×èuk°¹BM¬A©è†aŒ7@W@ÖÊóÕ†eÕsô,ÂM/" ¨Ÿ2Ö »,ÖŠºàâ>1ؾªéNZhî¬2"sÙ7Mç z~„Xǵ^õâZˆ¤dNRì÷ZfY¼üÊó|ï‘o&ŽÌL† d®MLŽqßÿ†Ba.ÜÔZ[Û¹é†×W)+–­&•J‡Ú¥\.ñØ“ßï“ [_gÛ6O?û(O>ýÃjž²ˆÛ”4“â¿E\; …ÄVÉñ22UC­x>Ï«² ë7@¢Ã°pè[Çßr½Ilî„J!”Æ¢4S9¥YZ“ÖQk±Ÿ2ᚘ#fº-Z˜“¥æk%ÀµýÒƒ¥,QuðÂÁØD!£‹Ã]âæxí;Õ£â‚ݯþj¡úä§ÿ˜gž{ Û²c1Ã辪^±XàSû§<·ó‰¨ Ÿïsó ¯gýÚM1<Á÷}Ö¬¾‚®ÎîXøãÑÇVϲZ_¹¯¾ö"ÿû/ÿ;SS1š‹—æ·‚ µ°t k0n¾ À|–)°ææl¢üU„‰i6Kª‹í©¹òäæÛªßÆ\Æ…6 ¢ÆK2©õ¬ý_Sëšl ¬ùÖµ>[¸]PÂB8¨JZmn){^ûÁ¦¯2Oˆõ"Ú…Ý, ˆE}2ý¼j4ýäécüß¿óë<ð•Ï2=3…mYØ–­þs„eqäè~ÿþîûâ§CAõ<þ¥|àý%ÎTi—þ¾!®¾êFcsTévø'ÿüè[”JElÛÆ „yzf’¯ëKüæýUöí\.G£xI)JëbÃ@óÇǣѹÔóT0‹oXæ: Ú„‘´öA oi@39öŸUéH|¿R}¾–a†›XV‹m„¯þ‹œõTJ£ÿB‡‹4oÜ ,,f”Ïû´òJ_†æ³ô“y™ÑùAæÙBB¨Dÿ<«KÙ’@Ùüd…j6—”’T*ÍàÀŽ=È©ÓÇøÿà?óµo}‰k¯¾‰eKV’Îd˜˜ãµ=»xú™qüÄ‘PƒhäùW>öÿc] }£ø¤¾Šw¼õ^žxòA%åÓ9z€ÿòÛÿ†Í¯fÍê äs ŒðÚž—Ø»ïŠÅ"BÞò¦÷rnø ?zì;¡)­‹í-n‚©zoýïhW”@Ë×jžÄÏ÷ã_ÍÍ?ZøUNRðS•E Li‹ ÷+|Y™±ž&&Éõ!H„ÖŒÂêõ“¿öB$ÌkÕì¸_-Xäf»X–€Ð×"fãGþlÔ}+؉t‡efVƒ_ ¸‹„8©Ek…”¢ê/jŒÍòN‹k‹C¡ ÓÁô¿ÌEº“Áe!SŸØ€ƒâFùµÑë oB$µëÂï÷Y“}©½ÈüÀÌý­ÿô‡Ü}×{H§³áûø¾û¢ãwZ·n¾†ßþ­?åÝïøP"%2ݵ¦BpÏ{?Â/äßÒÜÜV JˆeÇŠ¸556óÁ÷Œÿðï~‡ŽŽN²Ùž§6×­¨œcYýþžçá¹^°á¸ºzeÕøÔ=|釕Uô³Zx¡Y *nÆŸ­úë†î†¬;[×_š¾¥î«¦„‹!ŽHWEB†•§xÎ2zs[°‚ÿ”=i\1÷K%æ(³:É)ˆþ‹¶mb'i“ç'‹ÓÀ"ÒÀšáR+|¢…À8@³ÉüÂpO¨¨7áõ´tU¨p‘ï^‹5ßs’ÍóÜ tÌïsÛ-wòí‡b÷ž—™˜£˜«Ž“¢¥¹•Õ«Ösûmo涛ßV$‰LIQÕ!„/¥´Òé ¿øáÅæWñÐ×>ÏK/?ÇøÄXh§SiÚۻزéjî¾ë]lÛzN*ïù¬]s7Ýðú°fsWg/ϯTÉû¯¸28mA•†]¿v“ZZ :jrl¤”ôt÷qÓ ¯Sÿr™-ÔZ€ÉÄ„t*ÍUW^Ï@ÿ„°ð<—åËVãK/<":eX#´ªB”8n)™ØŒŠ ý …G}'á„÷‰š…Yì]¢¬‚è!ˆ[ѳ}?Þ2ý5il Ú×­½&£hÁü$ÝoBK Q<ƾªñŒ`s\ôñfLVÊx¾pÝÇ_¤¹NUÿ÷¼ïx¾O6“ãÎ;ÞÆ­7½³çNqúì)¦§'‘@ss+½=ôöô“ËåñƒR0õÞÃè¥ÿmY×_{ Û®¼–Ó§OrúÌ ¦¦'ZšÛè狼«—”“Âó½U•¼áõoçŽÛß‚e[¡¿§“MlK¥ò¥Ri>ñÑ_ž>.%âžW/ΨϾï³ýªÙ¶õ:ƒ´APŒ¾vüÒü~SS ÿá×ÿ[hÙéºW¾/±- ?Ø`lÛƶ£"îzcñTÃ3MtøÃÁïAø]©‘íØZð /[‡Š¤Âm‚O¡IsµSßD·Dx¨MÔ·P{kÁŽŠDc­û»xlù¼A,Œzñsâ"ðÁdB™l)}¿¤V÷ ÉB\Ëï­fxUûžæóµIh“Uû+•J14¸Œ¥KVD·tQr_¥J‹¥É8r·N‚)´Dh榜K†–³léÊèz_-ßócg$K)qll;ÐbÑrôñU¥[5’­ßG¾1‰6a‹Tʮǚk&ñ®©T´ô|Û1³°b!B¡ OZ°,¥:5NçÕñgeK¼ˆØ!|ˆ±°@z‘O®–¸êß£Í ùž T´Í˜ýSUW%R'|„è´9öÿˆ|>&ºÞÃ"LðÚÔÌh3K)¸¤&Äü&«Jš£‘ïø zÕÕykã—›,#aY™@´ “Ù<¿7 ¹éItO“W-¥ëšüZ•:Rµ.U™aÙ‘ådt9B¾!ÚýãU“ãœü½:ôVûïñé‰c%ÛH½‹YÐ$æ¨ ¿öi­–²j×$¢Xš¡¥"œ§dßõ†]+¤(„®®õªÚTO, WR¶ $Qy1íü5ð"âƒ&ÂÔ¾IäU-úÈŒ–馶¨^0áÍÃ{ÿã»A¤íçš M­IZT3¬%Óª·x«´› m÷‡cœ‰2®öˆõ¯z†ïã)K…&|_”š€n¡o•’1ï™$0˜Ÿ'‰0õQëZõœµÕ`jùèTÀÚÉíFü–¦mö:ØaÎ9q,YpPh©6UÞÈа"|zÕx'çUJIäþVû±¡)- ó_øU=”‹Ô”,Àu5˜!¼‘»¡M¡êIQüd+05½¸Ù,ªZÿݪ%l"ð{¤Ò 5 TÔ á˜ï²° k¬Çƒ®ãㆻ®¨z–Jm‡jjuC§,Æ›pò´ÒlZÈb O´°¤Œ6ÏB^j©AÌ©ebë÷®¥µk¾¿rD²hœbîéZÓóÑc÷¤F_5Ÿ+bB±ÉoÞ3ˆ›1hÌäØHiÖ`K*d¢b¼º¦ÚOE[ºDä¨÷Ò°DÂ_•2ȦjW­åÿÖ¬¤±¢ã{«®Š¡ êÁ–a²p`˜WCšÏZЯSÛ|0¹²ê¯,ðíäs«7¶úc¯ Ð+ÊtDTp]¥F$#ó,ÒæaW¤ª;&œÚÜîZ-9—õ,%“M}*|ù|µi­ÕügsC:a‰T;SšHáÅ®3çCÃabÒæ±¥ú÷ZG™šcÓg2N·Œ_o ¼1ö,Z~/À®Ñ¢¬#í%$‚ù_ùÀžïUù)ÉgÄͶ¤J1s0Ò@æs«wÎÅ›4ž#ƒÒ.‹=Þ#JÈ«MÏù|tÛÄE,¡Äô‰MÿWÔ¸§ úië÷¨­¹õf¨?IDõ÷ü›…™\QõÖ"¢„Öêc|̳ÆÇ@ûžTtJ‰h+BYÚÚ“á0»¬³,i!5…SÊ+‘ºÀb ÷t–\âIZgq³8Fï¥æB¹Fq%ùÖѽuÆÀü‰ÉvѬ…×Ü‘ÍIôe=#ž5â/bÂÃSD0~íW{6I ™š5˜S;>$e<Iø~Û‹¾QÇŸ0a¼TÄ¿“ +™”I½Ë›Ç±ú¾Î·®f¹ÅŒEs³ m¸º œŒiäø&áÇ8Á¦6®E©¿©Ö6+AiTaY¸~DÆðƒçèðZÒŒ®LÅŸkEîŽÎ‹79iaôÂèE½7­ãӕ̉›ÆµÞ5 4kÒŒR,Ô.X€“À•ÄæBÄ@?kj#õƒúERMÒ|FRS…;o0‚I4N„_Àˆ(¢^¸Aär9– ­5[*•&›Í‡B¬n©˜;1$”(LRoë®kí,kjÄè3mFªÏý÷ ê‚&‡®Ûd‰ÚÙ-Z+G¡¾x¹¡$:®âÏ*ÏN í”ÌZxíÔ£ÕjÒI5 .¨a=Õ[sÚc0cø`£Dƒ™‰¤ïanüu_+Ñ=fõ6Ý_ Üjµó++«_Nû©Z¼ŠÄÒÇP„;c´H’«M¤×Ç|65GÌ<6ohŒ²~¦eN$ÕZ¼Ä –T*>Wn¹†OþÙcïÓÜÜ¢6³†²Y>t ‚b<·*¤f–{ µ_„+DÀ•ëo,š½"ò˃MÍ2WnÐ߆[lƒŒ\r², )Rø~¥ê>óXóµùLnKIA`š}«aoÅÖUt…¤k¤©¤ýˆ ¥+kÈÄ}LÖ–©«ïOíQfõ}#t:úÐÕ¹¶¸²²è)B!BQ*}Œ €ÆîkšÕ2@:¥yGüž÷Ù ‹„WèžÅþ®:ænG0k/æóÌgf³9òùÆPû˜ß‰-¾peGah?ŠM K}õ15‹)Ȧðš3¡ßÊ ž‰~}h—˲#)4Æ(¼[`>[–.´¯5üüe¥bsS/î»X†Öùgf˜)ª)eY>R üõUkŶÔxx¾mÜOG?‚# •ŒÃÇûGëß×2þmÖ]“U÷ŠæXÍg´GVÑbÚ¢5°o ¥ÉE2`‚‰ y" ;ïËÚæB-ó(‰9›Sm F2{( ã~æ„׊'Í×2ÂAç…e¨Î(‰ç––e¥£&öã^ÉɬfIó iÃœŽ ‹É¶ôÅT ¤Ö –᪋ñ-Hr1ë”èDð|­…‘$X艩%°ŠøüšïêKD¬ì”ˆ€aá{¤ô±ítÍEkšÔzÇW4JzON`”NíÒÉ"qUàU=­\c…Èk„RG¯Gfæc™™ØïKG•Sòý¸€„Ö˜ñÝä}t"ƒDY"译¸›Í¿˲41"ªƒ áÅ ?",ea Âòµæü›õF†¯ÜJUÎÜ4#ëÊÜ õº1 .„é¶ —¤Õm¬ÊÀH?8ð¸ÎM5xµP¡–Ù¥Ž@@–ñ²¡M\÷éF?´IùÀqÍßÉã}5üv!¢âp†o›x\ô¹FÕµ™í{¸~Ï󙘧©¹•ÆÆõ*ÚL Ö@Ô'Sð¢sì”b \¿~Ñ÷…gU„µæ:    ÐßÛ¨Wv7Þ7mI¨S鵄Öæ9e ‰Œ›kJ[`:ÍP÷E zhòe¬g ÃÒ¸i´6<úX0£¸·°«6a€ÒBh`_Ú|}™ ˜šW»¢æiµ-›è†ó·…XÀôÔgÎœ¤\©Ídiim#•J䯞§e-`#c”¤*tÕܤÏj™~JëE9Û #I-[B'ÙðZKÙd¨¡éVÈ¿#ý07Ô­””ùæû8ŽM±Päر£ìØù ·ÝþFšÂ>(ÔS¨£VªLz½ÁÔÞuj`ò}Ï«‰yMÖûÖ¾¹jn-Ov¨7æŠæiÅÏ!:Ä凙hõ¬ówsÄR5 {¶2%RB$DÑ÷ Î;2CŒ±¨f\hž)¢µ^s$4.F`n‡•DDxïoêc©"qËb1mq&´ŒS(Éçrœ<~ÇqHg2444ÒÝÝK:› Ç76N²Ú èX›¤Ya–X–ÎÖYìK‰0|"‚„äóÌÏ|_•éc¢»Æ‰tZã&bÀÃ##<þè#ïºÌÌÎàz.žëÒÓ×OsS‡÷ï"ÉâV*=²¥ËW±nÃVV¬\MKK Ë´Xˆ;,‘¿£62{²þ!}•„à$,±D´#¶˜êšÇáïñŠêÐh ã›áª„!˜››eÇŽgxþù”‹FGΰw÷QF‡Çhnmá¶×ÝŒ>SÓã<ýÌ;~„%K–’Í牒ô±¨Iÿ0 IhÄ9)ÄR;–™\q~MkJÍ>3OL_·Vxª×ÙqŽOX-í½˜~ÇHAá÷4РæÄÏÄR|u3–› çÅ=fLc暇¥b]¬I¶Ð„ãÛz혊ªz"|F#ù‹m‹àT:M¥\Æ÷}2™ ¶mS.8p`¾TG{(ƒÅìÌ{^}‘\®‘¶övÛ!“É!,uÔˆÒ6m½š×Ýþz&§ÆÙµëENŸ:t}†Ï¥»»[‡“"•Î ƒÚ¤V¡7n'Öçäû +2-ª}êdh*¹Û«u_øÉ{Ô3§k™ñølõ³b\Õs ´ðÆ7x]ŸË ';˜??ôg“BZe:ÇúiÔƒ®ão«ëŒuš¤b €Õô‰¬o3¿ø|öáE°ÄqR466R˜%›Ê0S*2=9ÎÈðY,˦µ£ŸJ¥H©\Dâ199Ɖã‡hni ʬ²ÕQŸN&C’€^¨Þz' N,0>®ßÉj†•9X -s‡ˆâÀÆ2©q¶ñôÌO=ó8‡à•]ûø446àË,ï|Ï=¬[·ž'ŸxŒ•«VáØö¼º‡rÁå“ñçÜ|ÛíÜzëm†h¤‹®ÀUí´°,'ÒÊ‹U<$‹ªÙo¦­R⇣×nIÍ{i´ZR­þøAhȼ‡Þèý˜’úGíw‹Ü¦…–H-³¶–FM³ï‡‚¶5Gƒz¤¤zmA–òyV¯^ƒçzLŒ16:‚ïy,_¾’±sg˜¡£k€ÉéIæ¦gq+phïnFÎŒròÄ1::;¹þ†[hlh£‚“J€–ZL ôЈµ>«Æ vR‰m% ‹Cm·Ð4áñßj¿J7½³ì|þþì/þ€GÕy¼BÖ®[Ãê5+¹ù–Ûèëíç;ßù6÷þ³¦æfØñüK´6 ¥µ•µkÖÒÑÓC&+I–í „ÓßX†§ÝGcnTÒ¯Ñõ¡„1´WW«Œb±š-å“J¥mÆÎǮӟÏG®g=Ì×ê3¿˜w‘‡~±Ù?CÛÆ¢ú;(î¾jfb±oýÜÚB,cÏMöYÔ¡¿àˆLçó‰ýšÍnéÊü' ]ï_ú,ZIkS®[&ŸÏ“Îd¹òªkX¶|+V­¡³§s#c Ž0:vŽÒ¬b M¦93|ÛNQ˜+ÐÔÜB*Æv”©hVXˆ‚üñ¢ÜA/Bÿ§5ruAÌV|ùÄ{Z;žŠ;Ÿª[ C·EÄ•¯˜MgùÁ£?BâÓÖ¦˜XWo¿†æ––¯^Ç57ÞÊéS'9tp?O>ñ(û÷½ÄȹIF'Îáz““SLÏÌÒÑÙECc#«V­¡³«Ûv°-'fÒ dP3WJß‹¥¹k#õ~¯ D@H›Œ/¬Øû×-391Æ~„ÉauÞoO#+W.åºë®có¦­45·àùíí¼ïÞÑÝ×çÿö¯hon¡R†×ö¼JCc#gÏeùÊ47·`ÙŽS]A3LÍ ‚m ¤c‡Vˆ–b1HùƦ¨ÿVkáÍ×Ì2ÀÚ½ÑÚ[×ݪÏZsà‡@d¾GnƒÚL¬0ßZÝË2¾ý®øåq÷)ù,ˆª˜ç$«ÏDjŠ÷]`~1±æµ¨kY3¨L´] ñç˜ÚZ–c² û%±<Ï_²th©:»&  a‘rR8©étš5k׳jõZ–¯\Í /<Ís;_`׫Ï11y*e sÓ¬\sýCLNM’Íæ°m‡ÆæV,i H ‰|fá{>¾Þì©=‘óÅUë-ºªÐBÈ´Rñ`ßw–M&“å¡äë_ý]í¬X1È[o¹ƒ¾~,[ÇzÕi„Û·_ÏsÏ=;Ý{9qì$  ³LÏd¡¿o0ð¾çQ©”•›!¬ŠªHDÁBojF¨)ùÎÚ¬®fûÔÆ ¡_ ƒ£am'~Çó¼8Bó]M2‡YÀö#ý1Ê´Ñe…ÕÂŽ,„°/Á}=¯’Dú#£/S,–AÂ÷˜§¥¥!'E&›3L@I„‡v@½TÀ$¼Õ[Œ‹âøbÔ È7L?X@^—´8sæX>é¬ÅÜìMMmäó dsYrù|øÏS¬¤ÖÖvÞð†7´`®Pbph ë7l ©±[' ô<Åu¶°m’,[ƒLÊXЉ –eU±œj.’,ªšRÀ“Ò‹ò—}Š‘ºtODÒð<7LãP°B­×†ÚLœ@Eê„>©OàûêÀ3%tÉÚᇢ•Âª%™n™òŠüĆ×ÀIPG Àµprm…5ºDòï^Ø5¤Ú0Ìeà7B3á}Íá|´îy °mÛ´wtR*—87z–ñ‰qFGGé훡¥¥%Z–ÝA¿¥¹…M®dõÊõ¬]½…Ç~ô}F†ÏòÊK;8~ä Û®ºž®«º˜š#›Í“kh ©´QfT§Òã„õ“kyPµLõ4MuˆÃÜ ¼Ø¨§OŸàÛßø:;Ÿ†ëoºš‰‰1ŽåÙYàØæz.› cѦ)®7ƒ´¢¹ÛD§zR‰¶hR­u&QMp! KZ– íB§+„yÊRDg4…ëð›ÐŠ©#8qâÍÍÍLMMqèÐV¬\IkkkÌGÄJ!ì鬅“JQ(Ìáùk×®g|lŒ—_zÉÉQJå Ã#g™šžÄõ¼P[åòyå;N:ÒÉ f–ž/N-ä¤FN‚¨£…Ä7@Ÿr¹È·¾ý5Ž9ÈðÙafffñ¥ÏÆMkظñ ®ºú:úúñ<ŸRÙŶƒYP¸¾¯w€ 6sìøaæŠ3ÌÌeøÆ7¿Êö«¯££³‡ÆÆ›‚>h3Rõ¬âºx¾ e«eÙvÄ;ÃGÊÈdÓÇ™ê9q]· |Ò–†öM=Ï O2,—K¸^ Ë*âKÅÄÓÂé¤R¤S)\·Âøø8žç1<2Œô%#Ãçxåå—Aú e—,${vï!•ÉðÒ«¯ h?­MMœ8}–õWldõÊ•466ÐØØ@6›¦R)3==ÍìÌ4]]´µµ‘ÉdhinQ›P 6 ‰ X(“ÉfƒÍE è455’Ë5`.„:ÙQÆjgK<,Okk!úsTyU‹™ºâL3³œR]ñEJmqhfŸq6°?¾,%+%RÙ ²âÑÜÜBÿÀ™L6¶è¾¡%,G¨t-p‡l&K¹\fÛ¶íLMNðÜÎ3LÎLòÚžW™š™eÕªµ¬Y³žT*M©XP;hC–í ª+èÁÒï&±ƒ bì¨zÃ,ZSóš'%ªõ#G—4 òv¥ï1ªÒÌêa×U®‚Wq)»ª(|*¥R©°oß>:Âò%KhkoãìðYŽ?RvŠl*ËÎçžcøÜ9&§g8yú,H˜™¢07Ksk+Í­­Ø–ÍhÊfìÌYŽž8Ík¯î¦¥©a Òø~™ææf°¹\Ž¡%K°Ó6–mÑÖÒÎ@ÿK†–NgÈfsž[dtxŠ¦ÆfÊ• :¡¢R)ÓØPqÇIkº:ÄhêA0†2:}PV­-+ðõÝH˨3Pr“ûajÙQ„磅]R§X*!ŒŒœ£\,²tÙòXÀZ)á;ŠƒíX 2;ƒ'Ž“ææ[nÇr,^xþ9*®Ëé3§˜åøñ£lß~K—.Ã*ð¥OCS[RÑZØ$Yšï]%¬ææc–¯˜BÑ®≘¥F¥ŒØYÅâGŽâÌɳ9tKX¬Zµ†×Ý~‡ ³³“Ɔ€X‚t*äÑŠà kß—ÌÌL351•J3[*01>Å+»_¦µµ®ž^•\)áËŒ2¥ej×R¹D¹)'$DÚ¶\)#„`tl–cÇŽ±ëå<ùä#¬Z¹Ž;ßx7ËW¬"—Ͼ«}<Ï£T*„ñxÏó™¡P(ÐÜÒÆÌìO?÷CËq]›†|´´432:NڶɤSø•²ÒÈ3sä3yÒ yf Zš›°±©”=f¦Fðý ããSæ ôÐÖÖJ!›eù²LOMR(xìÑG¹òÊmÌÌÎà¹.¹lŽþ¾š››±„døÜ9::;ñ}(— :r’Ɔ<=]]œ9sŠ¡%+hln “J´/¯DF†±ÿØú1þ­B{ñD-” ,¡ßÎÅ"Š¥ Ê~ln#"“gñ%`AÅ­vÒôt÷b!8yì(££Ãd³™è2+…ÀìyB¯iÙŽ4·v239†oxÃÝÌÎβwïnÊå…Ù ŠÅY~ô£Yî¾ûíôööã¹eJ…ò Í` r{}ˆ*1øÕAûZ±Iß—¡Ï$%ÁáY&jhK³D¡×-Q*e|l”ñ± ›Y¿~ Ž¢¯w€k¶ß@:• À÷}lË¢âVp]%$)ÇaûU×rìØAÆÆ&9|ø ©”ÍÉÓÇyfÇ?uŒw¿ó^:;ºA…܃Í1•r°m‹r¹Œ/%¾[ Ã]npî°¶J¥2©”ƒã8œ8qœ‡þ&§NaÓÆkÈå(‹ ›Í",[q)•°X.•˜››åø±#Æ&G9KKCž[aÃÆÍt÷ôÓÒÒLWwŸ¢±îYÄ¢47yHfIÅs²“&³©U$à‚Œ:!ƒ°SD9 ”Œ>ó|*­,JKEffg@ª¢g™l–ήnp˜»•¨¦‹kÁ±m›Æ–6*ž‡W(póM¯gff–“'36v†™© J¥‡ §·Ïó˜ž H+ˆhÇÓ§ªÚ¶Àõª+oÔgÕv-’©‡®[Ás]Ré4–esôØ>÷¹`|b˜Þ¾6º»{hjjdzzšk®½ž Wl&É*ôܲI§-„•FPke ]¼ù®w0|n„cGŽ³lÉR¤œ>Ã\¡ÀC_÷½ë^š›”ïlÛ*ñ?оžë†„ _‚çz8)x·m›L&ÍÄä$/>ÿ<_þÒýìßw€ÍWnãÚën¤p \\®ç"|5^år™¹Ù9&''صë%N8Êøä$¾ôÙóÚ^v>»PàZCc#Ós÷éjì@V|Ò™F,,ré4û÷¿ÍWl P,QªTpÝ2ýäò,[¶œt:ÃìÌ4«WlféÒ~NŸ>N{{ííd29J¥é´Ãó/î`×˯áº.ãSôôw2´¼)K”ÊŽ8ÎÉãg8~ø$`qõÕW3;3‰ç»Ø©³Ó³444°u˦§Æ¦¥¹µëÖ³q 446«è"È]W(¹DV.ÚVHUŸ!æ:†ÊAñF„ªf"ý@¡™5®< Š‰chn}M2ä¢8›ÍÒÒÚÂý{9~ì0í­í  ‘É>°”èSÉ"„ ¼0ØÞÑM¥R¦©¥•×½þN{ôû>$©”Ë ÓLMO°óùgYµb ¹lŽ¹™)lÛ&›kŒ4q0¨!•PFÙ:IÁ4ÃÉ8£IRý]©jéZÈ©T†‘Ñ&''hjl¤³³þþ>ff¦Ù¼ùJÖoØHCc !Ì´@“JcYÒ0AKK+]ÝäÒT*%œ\m-´µ´±óùgضå*6mÜ‚m%V„…ëV( X¶M*Áõº›üní7‹%þê/þœ/Þ?¹|Ž·¼í-\wý-twuqæÌYEI¥8;<ÂìÌ 6’“'Oðä“O±ÿ>GH¶nÛʹá1Ž:¬´P*pÝ í­´¶µ±eËfÛ¢TtY³j ëÖ¯ÇI¥éêꢫ³Ïu˶mã¤Riåß;H_â¤R E²Ù,¶c377ÆŸ}ßgjj‚T:ÍÇ233˳Ïì`xø·½îfN9ÁÓ;žetd[¦èho'I³k×K´··ÐÜÜÌly–Ññ1f¦§ÙŸO!$:4ÁÚ i>ÓŠëù,_±„ ßÐ@6“¥©¥-D¤DÚNT›ÂbÉÐ[XŠ'ô„ HDbT’&JuÓl¬è¨Åö±±^òáCùÚWàøñ8ŽàŠ+Ö±|ÙjŠ…ÍÍ-äò Aˆ…Pk†«@¨êŒÂrƒ‘G.—çê«®ãÀþ}œ8y¿äјkbnvŽá³§8uòWlؤúŠ…[)«%¨R2…“Jã8år™Ù™Ò™ år…r¹‚ãØÜ}÷[È74ÐÖÞÊ ×]Oss3?üÁøÒ_£whœMC®³gÎ033ÃääìÇó$]¹,9‘#›rRÐÔÔ„+‹9ºŸçžÛAWgW_}Ú°íÓSÓ¼ñ®»hniC`‘Ífhlj¦½£ Uû8[-ŸU>«F±<óTDB5cùÕs/+­P(033ž˜nÆâ¤MHi˜ÑñJ{ú^–e‘Ë520gnvŠ††F¦¦§8røããcŒÌÃó=—P,–W A¿RPÄpáäÿx¸È7 géÂoÚ|UææGqÁ(Ç4HðUÜÓ÷*LLŽóÒ‹;élïdÃú ¤Ò6Ë—¯aõêuì~mW  s+#…R&€™+ªú©È ¾[$“ɲiãf¬{Ž?þ“ÿÉK/ï¯(¦[GKù\>$KèꆞçR)—@ˆÀTWï•Íd)•J”ŠEÊå RBSS#k×­cåªU<¸C‡0=5Å£>e9ÌÍÍñòÎ ôõãHÉèøN*Gkk+í456qöܺ»»éíï#×Ð@oo×]{-Ë–,Qþ­N„n€ìK©Y'¾™ uj¸‰š¬Fÿu¨Ç²SÁOGÑ}ˆ|C#™lNP¢§··RazzšÂÜår™ƒÒÓÓR2::ʲ¡!NŸ8IÙ-3W(ÐÒÒE[{+­-ìÙ³‡gž}LÕ-+V8uòØ°uËV:Ú»(W*´µu033M¾!OKK;™LVÕ›6ȉ%=u6¬À@%‡y®šÈÇ’Eãõ÷S,–¥µ( l ·ì’ÍæXµj £#ÃŒ×ØêV‚*X-¶TÕ=…e“Ë7`[pÍ5×ÓÒÜ̧þúÏ™œgvnš††F†GÎQ(αeó•444 eßayï`dœÔLIó•<Õ¦H ^¼ï#½2Ò÷˜žždÇsÏð¥/Çq`vvŽÓ§Fhn8ͺu›Xºt–Š ØÜói:äP˜›cb|‚õëÖQöJà[øhiïäÔÙ³;~Œ¡Á!5A¶£r~‘8?¬Mi$x®K¡0G:“Á÷%…BÉÉ öìÝÍÁƒûxu×Kœ;;L¥"87:NÃdžÖÖVJ®K&ß@[Wn¹Œðîw½›¶ö6ééí!—ÍbÙ– o¥ÓaÿCgO VúÊÚ$PÔ0ÖìºH¡ê6‡®Nx+¸ÚÃI¥ŒS­€¼â›®ã¤Bþ±m§T˜«©ˆÐ××çù¸n…r©ŒíØœ9}šcÇŽ"¥ä‡?ü!»^z•«–sÍ5×0==I.›'i •ÊqèàAûyä‡?¤¥µ•¾ž~FGGhniææ›océÒa‘ËçHt¨œ®±ð€ ®²©•¢@§š…dúì%`)¡¡!O{{{ö¼Æ©S')føÜF’Bès ¶qÍ°ŽFk!à9ûpÅÆͼ÷½à _ü<Åâ“TÊeåÌ©SÜrËí´·w`;šglœP¨Ë½¢ésÚ×UêV*ª:bÀÇšš`bbŒññ1&&ÆH9)Zš[ÉáCûikkç•—w±{ï^:ÆÈð 9 …"HÁÄøûøÇT¡ºAÌ_òÆü[*•"ŸË³yãV=ÆÁý‡ñ<É\¥B:×@Åóygw)GÅlgfg)æÔⵂ£T<ž*—K¾`ã{e^Ùõ ÇåàÁý>rˆ£‡ÐÑÚÂäÌ,¥b‰©É úú‡èÄI9,]2Ȇ5«¹jÛV¬X¦êyŠ6Dƒâ*¢¹$ žfŽw]ˆ>`a;H!ðƒäÈØ •ºÄ«ŠëWÐEèBÊft¬Œã4*S>ã‡üqí¶u÷ô²eë•H$×\{Ï>ó “S#LNŽ12œcff†eËWP,9uæ$/¼ðÃÃÃLŒqôða†G‡q›ñ±Q6nÚ‚ô%kÖn ¯o€ÖÖ6GàznX.9e ­[#²f]‰è ýÓ Þ#Ò¾Kœ…˜\‹`Ý™annŽl6OgW¢N +d”V¹ï5R:éÚ‹L%ËÇ÷\®¾êZ¾ô¥Ï33;MG{àsâøž{î)¶l½Šžž^<_âùÓ”KÊ¥"¹†f s³xn…R¹D±0G¥¤*„LOªšÖ³Å9æJò áššdbbœBa.4©ÝJ™Ww½Ha¶ÌôÔ å²Ëèè$ÂØv½}=466³þŠõ455£y¯&‚8_–¾O6×ÀÒå+éìêáŠCGxé…Wð\Ÿ¶Ž6rtut¨CÖ¤ïÉ ¥&ܱlÇüG%4§Odïî=ìÜùï»tv¶‘rl>L¥â2‰‡gÙÈ´Eow7=,íïáÚë®ãÚk·ÓÕÕ‰ãØ!óMÊHûiŒ**P=¿ŒÒ?Zh…T1pßW…Âøº!|28ˆ=fËFH/\Æ“Œõd& h!V¹Ô¾ï)DÙŽøÙa¶ôèèçïzž§ˆ+ûöîá‡?ú!MÍ´¶´òòK/P.–ȤÒOÒØÜHsS#LMNòðw¿“’¸nǶ˜˜§¯¯×óÈd.á.fp6d°è…!ÐZ©iëÐâ39ÜàEv/—J s,ZÊäÄ##c:x˜Õë6)¾¨1ÈõZH¨wuåk ËAHYRaýº+¸rÛU<õä㌒N§˜˜grj‚'ž~œžîƒP窳{=·B6•&Ÿo ƒóžç‚”ÌUJ>v_J–-_Mcc™L†T*ÅáC'IٹƥB‰T*Eç’^š››9uâ$’½´v·±|ùZ6oÜÂôô,MMMLMM*pÆópRYâg%ÕFÄvœÌÍÌÑÞ¦Êù~‘%Ë(”‹ì>°›%CC¬\±št:CSS#Åb Ïó±:¥ô%…¹9NŸ:Åß|ú“¼üòKŒOLÉ8ø^ ¤ä†ë¯Åó$O<þ8m=¬»b-¯¿åv¶o½–Á¡!RéTÉ#B*¡Nž4ÄTud%SE”×,Qa˜¡$,…Ÿ˜_“€°Um jÄÖXKQÒ‹és*-î¿à& 黸nÛ¶I§3lÚ¼•uë¯@#ÃçèêéfzbŠæ¦fNž:IÅõYºl)'O§··×+³ëÕ|ïûßÀ÷|ººúÙýê.6nÙJsSMMMHÛ(ë7,LƒC$~ nô¹`!yZ¼7õ=IÊqH¥Ò´4·ÒÕÕeÄó°È¬Q Ãèh°ƒ§3yl;ÅÛÞú°cÇ3ø2‡ô}Ž=È¡#‘¾O{{žå±lp s³sÌÎM3=7…”’%Kééꧯwˆ´“Bú.–pèë]ÂÐ’!fçæedl„Ñ‘QŽŸ<Ž,K®¹îÎœ9Éøä0Ùl–¥K·P*Iç73°d5«×³råj–.YJ6›#“ΑJe°íTHòŸ÷í S”À—ëègûÕÛùÖÒ¯óò®—ÙûÚ>ÖmÚHO[–eãzi$©TŠ¹B™¹Y$P(Ì199É#?ø><ò0å¹Yš›ð=U·Ì‚é™J¥ ƒý¬Z³œí×ÜÀïzW¬ßH*ÖGÇW ŸUÓjÒ ~(4‹AKu¦/#¿7ä§×XÆRØQ¤>1Ðéãù†F%Šl„¶ª”T‚°¡€b¾çaëg[Bqìƒc‚<ß 2½l‡øÈG?ιӧ™žœfïÞÝ<÷ÜJ¥23Ó³LdFéë拾½›ý÷òð÷¾Á`ß <ĪÏrÝõ7±nÝúzzÕÆZÕ–„)ZÌãO¥¼”, s>|HùzB‘9„µ¸ª ±Î'â°ÂŠï{êoN*KS¼áŽ»™ššf||¤døì),KR,–ÙýêAÚ{›™›~‘ɉ) ³m]Í8Žäì¹ãTJ%¦&&%ŸÏ1==ÃÙ…¶NÎ3ëÎR˜+€+éîꤻ³›É©I†–ÑÛÝOsS+Ùl†ë®¿‘+WÓÞÙA.—#—ÍÓÔÜ‚mÙ8Ž¢;Z¶K¯×¢¬µ°¤¥Rñòù<7ß|-/ïz‘S'O€ðiÊäiooGúÅR‰¼e“J9¤Ó¯¾ú*ó©Oã Ÿ–Öf|Ïcé²eä2YNŸ9ÉÜì,K–,ãÀÁƒ”Je†–,ãŽ7¾…mWmW$/¢‘×®²a1imb/j¶ -^+ÇVÌó½HY3=#R×3 ¤KUo®ç…ëu iú'}ÕŠ{½dùr ³³tvw±fÝ:vïÞÍð¹sÌÍÍqðà>¤/iiì £­ ß÷™™áµ}¯ml`ßýÜ~Ëm ô’ÍfI§5øWKpÍMuRÍb}àKêH)èbÍŠõìÛ¿‡¹Ù"¶m³|Å º{z±-'VŠd¡E,BJZB˜ƒI–^…r©€“rp]ÆƦ J¤“ÍÐØ܆[ñp]…þ9vš%CËÙ~ÍvzÛ{H[ip%“#Ã<¿ãÎÒÜ’Ãq8 iþÞ^ò™ ƒƒ,_²’u«7°tÉ º:{X³ö šššÉd³\uÕµ¬]»žææšššihh!ÊÙR)l'=¯ðÊdV‰TÕ&}¯`=ª4m6›ctì§Îœ`zzœ½{"€eË—ÑÐ؈eYŒŒŒpêôYöïÛÏ7¾öu …9¶\¹•µk×Í6R,*.ssS3›7oãŽ;îâ}ï½—+·^ÍàÐ¥EP\ß( DÜŽªWø@ òbJð˜ï¯ëu%ï—\α¿‡:H†ÿ–§Ø\ܨŒÜ“ ŸaøPÿ]§¿§Xs/ÀŠHJƶmòù<,[¶” ÖÓÒÒÌÙsg°m›žž^šZÉçÈåsttt’Îæ8}ö4¯ì~•¶æVÒ©¤ÓiÒ™4qÓØ̤³2Œê³ÍΞfç O_|IÛ±éêîÂ÷]Ž9B:íÐÜÜ8n@XX8ne™¥XÂê!¦Y ÂvpÒ*®ÊzRd}ÞÞ>Š¥"Ï<û$CƒËèì袩±‰ŽŽ.¶n½’ÎÎ.@ú§§¦8x`?Ë{”lΡµ­%LNM3;;ÍìÜ {ö¿Jwgý=C4·´Ò?8DSS CxžG¾¡æ¦Æ@b[N¬ÂaDÒ“‹ƒ!¦5° rMrî‘ÎdhkëdÍêõ<ýÌ ÌÍVÈf=ff¦©T*Œòò+¯ñ…û¿ÂÈ™ÓÌÍÎN§¹zûv:Û»ÈfS¼´cãcãÜy×›yË[ÞFGgÙlV•Ö׶†™*KTUV–úpRK/¦iá5Yr&[.Vl JÛ(§:?ÖDÄÍ~èÄÌûÄ aŸbEÑ‘‡£LjJÙÅó|Ú;:¸®ãzÖ¬]ˉãÇxìñG±l×uÉçimo'Å鳧9vâ0Ÿ»ÿØ~ÕÕlÞ´•Ææ<Ÿ|¾Q±¥Z¢f X‡D“´Þ…ÚâÊÊÚ--­4ä(Šd²Ù §Ë£$‹‰ÅiŠµM³À”$yê½C*•#Õ’cË–mT*Nœ8Æ«¯½L¥RaÙҼ鮷²zÍ:*•2)Ç&“ÉÄdWW7ƒCK¸þÆ›ñ}Éèèˆ2ûƒS¹\æ¶Ù7ÒÒÒF*•!ÍÑÞÞI*• ÞKĬŠdlÙ÷‚ Á"Æ!¶‚#ʧQ“*4¡¥ã8466166Jkk[·lâµ½GÈe3,]¶”±±QýÆC<õìsÈbŠÂÜ,m­Í¼î wÒÕÛÏ£Oï Ÿ‚¡%Ëø¥~‚íÛ¯ ãÁ¶He³JkB«5›o¼[ø3tíC'ÿ1ÕÌ9\ØâŠÏyí² ÇÒl¥HCɪªŽêïû ÞpÜÄŽî…žª7!u­:UÑßѲ,ÒA\ÀQ ­­žî^V¬\Íw¿û-öí?H[[E¯Œïº45µÐÔÜÀìô$û÷ï¡P˜!›ÏÐÞÖA¹R¦©©Yå‰}²H€p±1]œ/Ê„\F{s#Ã#ÌÌΒΤioo£­½ékÿÂx°t wÎzÚ 3e/˜žÐ Žµ´Òé]Ýô÷b[6K–,cÙ²4·´Í敆ö=•¥ãû”]7@z3¤3y2Ù< M¤R)2ÁiŠM-­tu÷ÑÑÕKGW­m¤Rép±#â›Nòwí7©|å¸y{ÇÄb5M½J¥„[Q¦t*•¢¹¥s£ŒLO1=1I¡0ÇðØ0Ãã£LOÍ°vÕZº:;ikk¥ì•yùÕט+¸ÜûÞwò®w¾‹5k×)>´2“] l9Ž£­+0c'/$–¾ªZǪ$þÂBÑW«O4 ÇS&í·H€£gDÌ©Ïì:c¯A¡è^Õübí¡î+uYžÐý¶l; ‘ *• ¹\Žõ6ÒÙÙÅÌì O?÷,­-­tuv±zÕjÛfzbœ™éi†GGèêꢭµ•b±d–¥ˆ +D P7˲ÙùâSìxþT¥•”o9•ŠK__?Ÿ¶Öv•[!]„Œ^2B–­ð÷êZL‘©£²m|UüÚä• ËJTGŒvtvs]G§*ÙbëJ†~[‰/>lË Î´‘ kI㹕ÀŒ Xc:}P.n1Æ®[€»*S‚z7ž/ÃzOô|5©Ž…[.srïAŠÅ"O ?Å®æW¸úškèïä艔ŠE{»™™aãú5¼þuod˦+Ôbµl3åÍ‘¾g#£ ¶Ç&j.£R;f5’:#°˜å>ÃDžMÁ5«e*Mä…÷N6Œž¦é»ÑxÏêuèW ®½"† iI1RiaéŠD*M.•ÂN¥(ÎÍ)™°m¶mÛƆ °Ò)v¾ô"ŽcÑßÛCc¾‰Æ†fF'Ç9xø¶%h¾³‘†¦¦¦¦Tý´l® 0D‘ð•ëµEh`ŸeKW±eóv&ÇÇ™ Â,K/×HŒ¶u phçW•‘1m¤` ?`Þ¨RŸBûh„µ¥D¥›…eÙ8©LÚ‰|£ö`PñR+ –ë~Ì×jÖB6h­kõïC˜ýÄ ¬/¨‚!„ÅO=E¡P ³£á3g™œœfnnŽ3'O‘Ée)Sb¢0ÁÒ¥ÜóÞ÷ò¦;ïdp T¥Íäpc±la°m«J€ký[$Â=¦&t¾fj²Z‹Tÿn °­¨È¹Ö¨2`~)«,ªd9ÿs«-½€˜i_MçT­ñ­ Öæ´²êÒd2„%(—K “É°bÙ2ŠÅ"çNŸadl”ÆÆF„S“TÜ"ÃgOqîìYzûúÉç(—K8¶M*•©Š£+r“ÅΞfÇóO^: ì{.³s³Ø–ESSéLÛI… ¬À'–Bà{~ „"¤µi¶“Y‚$¢½iXÝ ÌW=IÞó– «f(>³­ž!l„­®‚L:¹Aùª2ü_e®„eAyâŸ.¨fU2üà]’š;®‚Ÿº*‡9AæAbªÄ‹¤R©0:6ÉSO>C¹0«(›@cg)'…J»öÙ¾åJ>úá°lɲ T¬']™Ò²,EaÔÂ{·­€ÞW„Ò@) ¡®ƒD×CxâÑݪÍ,áRX–AôX%¼ÊMñS#Î×LÚDbNÐLOŒUýB xDÑ ÊÃBÀõîiÙØNŠl.:í¢¥¹¾ïƒœ:uŠÇŸzŒ³çÎÒÐÐ@c>O¹,H§š>Ç#?ø.7Ýôz–.]F¡PBXi2ét˜ºªû}i™XêMUÌkz $¿¨™.ú‰³ÌBj&[Fó¶Dtn°Öšf›U£JÈê\?S•²‰€¤h²¿ê$éEi^_!}Õ]H@ T­,Õ;¼>¼w¢F³ß‹€ÛI©d ߧ§«‹©ÉIöïÞ­&Ʊéïì¦"$½}}|è`åò•tuw«ê‹Á‹ê°‚ê#H½ÀDj‡º,Øé‘Á QèŶ…ÑhóØÌÚD¬ñ¥……:F'Üü´ßkü©y§è™ñgI"t:1†9.¥©•EÄo‘và÷ Mz‰ã¤I¥Òøž¯(¯ÁfÓ××ÏwÜÅþ{9{êçÎ!“N“ÏåÉe³œî$Z;J0½`nƒjÁA|š¿ „…í88©T0ÿ•J‘ææ¶]¹-[¯$—ÏrüÄQ¦¦¦˜˜œ)˜››ãG=ÊØÄ8–%(§~ª;GJg±mqçÄöt&­Ó锊m&&=s–"µËTÀ“Ô‡™éÉÁ¨ág ËVAüÀÎò}7¼Nx=MÎã3-DTi†A±p…ɪ˜Kµüà€ªGÂŒ3“Bs.ŒCª°Ò¶+·pæÌ)ææf8thŠµëÖrÍöíd²™lÒJD¬¨îƒYI‚ "ˆÆÂz‰Á¸y¾· ¯•œ—¸6“aø©ö˜V'M-®}pt˜cd7‰ßKôŠ¸OË‹2×â}Dáªx‚}Ò“Ð÷´Aî“Ð!D FøÁÀào~óÛ™œœdr|Š\¾AÕÇann†½{_CÈõ´¶u0W(СO,Ãç-Üœ5ª<22B¹\fÉÒ%´¶¶P(TL³N®Ä°"HÞvœÀWS7\x²v¨E¤z)uìGõ¹6õõÑŽ»“Ôœú }œ‡¹!øf¦Œˆj)Å„¹Ž™|?}J[.óÂó/pôÈéêìdn®€ç{¬^³Þ¾~QUÏv0Ϭ”hn0¡™ìy±¥à&uäë)ìÀ¶ìy7´zóG¿!#:6é—ÆÆ^g^i #ÉÐ÷[\Eì{Úœ¯¶„P £òƒm;i)ý´p̤ÖëÆ ›øµ_ûÜy相æškXµj¥RsgNrß}˃ÞÇÙ3'q+%Ê¥b`½j°›cQqàÞî^Z[Ú™ššÀvhjj$ßØ4¢þ%'\-`³ƒZ "%)˜„¦r|éØq5Q¤ú4{}]t¼‡/ƒ….¢Å§ø±~¬$J2¦+C3Dº´=òw ÎèdSid•  lOWgGNðÚîÝœ>=ÂÌ\ËNóöw½‹-[·¢ Ìë 3“ÎÔÔò±ømr¬´Ê Ç$(•zÚ79žU›¯ ›ùlÓ I"¯ñ‰Ó=7-+IÔõÚ «è3sÓ km)Dœ96(_WÐ÷Õ&´@•{ןþ»y}ìL<ÖžÏgY½f k×®A‹sç†ql‡á±ŠssLŽOÒÓÓCKKSH"²,›Ï?ÉŽçŸXpn5s¶íÐÑÖA¥RÆu+444Ï7Dû¢ˆ›8óý§}äpFb‚™ÄµZ(ÜDu­´ %µlr·X”›êynÁ÷½I‚Ø´7¯.4槷‡‹$¤¾Qmú×(®WíGñpÛIÑÕÕÃÍ7ÞJ©\fbr PêöíÝÏÜ\!ð›2Ùœ:z%1æ¾Áü2eA ¨®l ´Œ%‚ϪÇ.ÙtÿC«$ÐÞÒŠêÔ¿¤àÖ45ö~ÕFY'v•KéãËJŒC ç_âÕîwl¼#¼CõWßC_©Á>U³9øOGHðT¨S/Ziÿ‰`L'šÔ0«7t›+®¸‚Wl¤©©‰öæFÒ)›ás§ùÆ7¾Ê±ãGƒwTéÉEšÐ‹¢R¦ÓizzûÈçóLNN‘J¥Éå`*0-jù †¿ü[oiv,¶hD æóY €1)¼@€ôÁÉšünž÷ZzP¤ <ÛuݼçzyËÖ•¤*ĉ¥±c›Í @ +yÖ¥Q(sB£ÊÝÓüd!,æf‹H)Éær´vtR”’³gÏ’Ë)úªmOv+6Í7ŽY<ÁÿºÁYO6ªßž§KþFY=µLc=—z}釮Q2ñÞŒ§Ö¢MFÿ–aAúŸiÌ  €Ø0û˜Õ@Mw'ô„¥±J4bsN"Ÿ;€ÍÕ®µ°0»¾w8:Q_çP‡/C.ŸgõêÕœ={šÉÉ'ƒ'+ŒŒæ|—l6ÏÊUëÎ+Œ´8Û)@,ÛÚÚiooÏÊÑ…ÊtBBõ"Õ_¯>hk¾‰«~|Ò׌À³R„Ô“@ä›Wè?Õóü Ôâk£ N½ñl-°zlÌ4‘!bÿŽ4Sm`GkßWE ZÚTÚ"R’Íåéd÷¡ÃT\78»È ™U¡Ö50ýYµà$©„Õ±Rß—¡V¬e½˜›‚Ž0賂LŠ¦9ÿ¾WÆsKÔJ;U&§v×óŒBõzبïU‡ZGÂlÛVH¦×~ ”‘®±m+·ü*æVt·à˜ÑðŒh¥ÕjF%,é»$›×tŒ:8RTJJÅR˜ü¯Ùc)G3±|,¡->%$Šö­»8Å5ØýÈÊÓ¼ Et·’Siøµ¾¢£@+Û²ÑYgz3Tƒ¿£êØÜÑ'\ס¤±±ËRõÁ»»ºÙ»/ç†Ï ,AÅó\ʦW-rq-²¤ŽçzLÏÎ091N&“&ŸÏS©”Éæ"ªõÕš¸îcÔ¹¡uCæäGš>ù7¿vhG‡P'¿ !ÿEkiåóXDgƪ>MJÅ—Ö¼ûŒ‰T[ ÌöÄ·,Ûöq-—L6K_?Íͭʯ¨AiÛaÿÁƒlÜ°>ìœpÓÏ°-} ¦ ¬l«1öq^rÙtÃ-Dà¢JíÊ¢KÎi Cƒ[±q’šÃl†Ÿ¬eB &2âèè…vm¤DtHÏó–ÅÍ·ÜÎèس³³X–Àõ*œ8yŒéé©€a¨Ž[]L[TÉó=¦§§972Ìôì,ͤ3ÙŒäÖ.ŠÔZèÉ\ÍØbüƈÇLWuŽûg&÷½30LµÓ‚o˜ˆZxõwÃãM©~}ÏSB[×…PWêÔ‚K†ÉfÓ´¶·!,[@hIŽ?®È3^¥ŠÃ¬—–F™Mß.šÁHë) *Jˆ³ €K 3!KʧZáIâó¨ÇØ<²DJ‚’¯.®ë…ϯ¸æ s‹µ  åŠK±X!bL)ᵬTÌR3ý¡ð$£Ä73ê'–m9X"˜çñHBDY°ª9Ɔ q-Ø8Gÿ 7nA`qí57±dpù\š”“flx”Ï=ÍÌôÔ†(‹ô…´µ·ÓÞÑIgg7mí]8N–ŠçázÑ)~Ú‡HúµZ 6òªùóß¡…lÅ„6þÄ÷µ™! ðUj<†ˆZAÚš%4÷º6Ä|™Ul./öÚGRÄuÔ‰Dãßx×]\{Ãu´wµãØ.§Ï§âVŸœ ÊÊšgé&³1Oó…ñ‹üT?B—=Ï­ÈÄòL}yHÐsòÎZ¡WÁóÊáq›Ñ©ÁŽ²ôÏJ¹L¹\A6yé”ï"?Ž£ºmh,0wä8ûÉÚ($d„ÉB^:¡¶4†&E—€IDATé«Ì¡èÎJäH_hÐ Ý û&}ð¼(‰Ä÷}Üà°n[ 39}ขT*U;ºFÕó¡6[!ƒð–ˆ‡¥B,“]SÆÙaÑÚÒD‚’Ñ&Å”­è„èlá$€§­‘ÁÁ!n»ýv¾õ­¯qýõ·°fÕFüÊ^¦'KøR27;ËbÚ⨔€ëzH)¨x% … Á¤E™FúâÚaó‚šÆfx"ZøÊlÕ»·o|ÇACôæ½µ0Ê`÷ \[ã?òYc—}Ž‡ƒjS'Éñ}<¯B<–­¶q•}¥ã›VlbUŒ×"—K‘oÈ!¥O:›¡·¯Û±hok¡»«+Ìéµ,åêØo2ã©Z™1!Ò&³¶"`I}˱’[:£9Ò¿Ò@yõO¢÷¶%B!I¢¿áîFDÞÐfŽ¾^™O€e!¥Â%âÕ#4Ьõàè…#575Øj#.ð<Bt*Áù¼¦_$Xµ¿i1ÏÐ:‘fÔšXɾ®¬ßA›gj·^³j5ÿïý]P.9pø…’J㔾pÒ©ô¼8ƒ‹­9¥5Â}ɺ]‘Ï Ç;¸§lDˆìŠp<}ߧâ©…”£ˆÿ•J%7šüH8` ©{é$qä’t:Ë’Áåض…çyô÷àI•Â©Ybžïa[v,50I¨ޤ¢Í.b§1Z"g"Ú¢c|$í¯cÐ.ƒ¹4/Æf™¦HYJ³Îæ”åXJ–•U§MùÌ"!¨5#5v§º›²Ö²H,!An¯¾¦Ö¸E›£°¯,$‘)×Ôµð†s±B²áš–&Jö ò–·¾“Ó'Oc;6m­m¼úê«xNaAÑ\” ”?T©ø±ü]aYA ¤vQK£Ñ(°ÔfæµÆU¾Rüd6“IT,•(WJˆLNí ~ ¸"ÊšÅF Ò„:E BUÜ6t}ý°oÑü›‹Ï˜xzÜjá[‘é,ÁR;Q~”lL %t­ESˆ£ƒ¿Ê%5nvPWK  z[BN«s—S)‡T:‡未ÃÇ}ÏÀ½‰ZõgS†(srñGU1 tÙ€|© ¥ê7Ø.MC].W(T©ÛR©„°lfŠe¤”¼¶o?™L†µ+W²d` :’•¸ ÖòIkýM›ÑÉë<ß(˜ˆ®úbŽƒö³‰›Ç‰3{Õ¢A…OŒ³ÙŸx±y½ÂÃà L‚ ¹ÝEåù.ÝÝÝØ€ƒ"„*Ü?çN.F/îxÑR¹Ä¡ÃÉçó öõc %¼z×ԋ˶ì˜v ?3X;è{ˆ@{!èÙ*$“N#}We¥å[„ T‡+|ü ,¢_€p°¬@hze•Oh.C+y~üÚP(ñ΋»vÑÖÖÅ¡§™ž+pâÄ):ÚZ9vâo¿ëNú{{ª4¡)@!²l„c×…VW¼þš@ø¾ô#“!&\ê “A¦×±ò¹Õf« 5Ñfé‡IZÈÍp•Þ;NÙÔõ§ƒÒÂÁ²™¼*ÚP.™¡±)Gar\ßæâX˜šžäµ½¯"„`jj5«W®"•JaÛ™€ÁŽ'ˆÌ†,`!djB(®[ „WWS)—‘Ò'“I“J¥‚xcd–k¿NH<×õì™™iÊ•2¥R‰¶Ö2™\,Ì2ªd„~±æ¦&j Êã|yßó´;0¿Î{‘¥nj½T¼ ,cŒÓè§m«Ê„aRGèG>¤.H®„Z}–J¥©¸• NX´ÀÓ”Ðúd¦Æ©˜–%´•kPÿõ´ë㹎Ð<}Ÿr¹ÂéS§9}ö s…YŽ8ÎK»vQ©x:9B:߀£çFiÎ7€ôÊ¡…gÍšÍhSˆµ‰.„2V5‘Cè¸yr )Ðñã_¬Øé32ÐÂz~õš²„YÍ$*¿›Ü_t7U3ÂL€+W­àÐÁ}ÌÌÎËåSòRi`µÏdÓ)J¥"GÀÍdÈ{ Ø–ïy44µ„Ú¶æ ƒ „¨|¯‚ïU˜›åÙgŸ¤0;Ç•W^ÅàÐ š¬á–ËÈDsRð%s…‚½ëµ—&NÓÝÕMG[–•"IæÀ²‘^%4F#«Ã%Zs…Âë{x¾:ÂÓ÷}<Û&“r”é.âê±*‹xžK* H^ÈvŠ-@¡òp;Ûttx-,Ä&,|!¤XùŠ¶ª ÆÕ¿ðþ2Èè‰Ö(´U8‰æÎB±È ÍαTG—X¶…ïùì;pˆ—_~™#‡óÌ‹Ï!m%C?vŠ={ÐÞÛOg6Ïää7^µ•[®»š®¶Ö°Àƒv\jYLu…×”hÁ†4OU—M¹‘ù¬Dý®êì%óá¡hÚz m:BÎB51,šÀ]R8‚V` ±eŠv©ô¸V*™\–u6ðGÿóXÂäÜ(çâó=ßgóÆ­¼÷]÷ÐÏ3:6J¹\¤««›–¦vR©4N*c;A ݸ©¥ß3Κ(S¹â–øÞ÷¿É—¾øYîßO¡X µµ\.G*¥Jθ•RˆVNMNðð÷¾Á_~òÏxôñqîìiV­ZÃÐà²à˜+nâ…¶‹¤ES`$íËpøžÊÑœœ`jj’™éi&''Âbî*s)žq¥ïQ*—˜šš`xø,Ï<û,Ï=·ƒJ¹HcC·R*.GjipÍ  ^MX–Vjþ±Äõ\lË1ªs.þ´=I¦–J`75Ÿ±˜…΄MWK–ÌÍ*“ù“Ÿþ[|è!úúN–݇ŽPò<*R0Uôhéìbùà ©”`õšÜtÝvÚZZB*«æ‹ I ™$RÕ‚[ò C‡úßú bu¬gô»pÍöÒAâþ¸&n„w7ž+¼…Π±ˆ©eøËBY-mmœ;wŽw#…Ëäôø‚s»( P€„燨nX¹ ¨RàKuŽ­iÆêBtµ:aÙ*@ßÚÒF>“Çu=9ȹûϲeó6®¾z;]Ýݸ•2®ëR™™â‹_üxðsœ¥b3§Ï°sçNNœ8ÁÓÏîàð‘#¼çoe ¯—L6øÔ–±{Ë0Ö©|Y¶F8'òù#’ˆòÏœÐOS.CWÇ2²iŽ?AwG'Amp‰rSLMÄ“d¢(A•]ƃ…Ha^OÈOð5€6Š”*q":t;’ËRßö5ó'u ܤÆótW}h~¡…Wñ4®#,›´“âî·¼Už:}Äôɽ Ÿ˜·ˆN?ÆÔä$MM¡Ÿá¤3aI¨ÎGõ|/κÒãŽÄq6nÜÊmûxúÉÇ)•J¤Ói^|q'•J™ëo¸‰–¦f|ÏåÔ铼òêK´µv1=5MKK×\uÍÍ-T*e'‚RUq΄ÆÑýÂرš +8/ºººðü2?|üºÚ[©ÌM11z†»ßò62i×U÷rRi|ßãÕW_á{—ñÑQ¦¦fÀ£§-Ïþ}{صk×]C^!ÔzCb­!ZoìñÂB ‰çVe ¥ç+¼µše„ÎT&RÜR‘¾‡gh ß÷azjš}ûð­o}‡Ý»÷019ÎÔôåb‘ÓÇŽ25;Gÿšu4ŸòÜ 6l\¹Œ7Ýq;K‡±-‹T*M&“V&¦T4ËèÌo³VtVãýÃq1¾ª‰.ZltÚ¥v™„C¢c¯Q(Pÿ[ˆ(2¡f΋¬pƒ}Y™Zp“ÝÕîˆ ï¤\•ß<::â.«¬]³Î~ñÕ¯A ·ë•—˜ž¦·§—b±H±X OésRN&ú¦M Û²eÎØáõàضEss‹2¹,…´ÎÌÌP,Î133ÉñãGikm¥â–Ù±óiöîÛMoÏ ËÙ~õõlݲ 麸å2ä’À‘KˆºË1wïÈ?´Ô™® —ɤ¹æêkXñ­!| G–9tÈã™g»Y½z5]A|Ùb÷ž½<õÔc<¿ã)º:ºéhëdfjÛÌLOñÊ+/³õÊm8é‚*ÉkÛ`Ô ó}_[£`1Ö‚¦:NÄ%¾p!–U-²Ffõ !"¿Øó<ÆÆF8yò8Gç¹ç^䙧ŸäÌ™Ódó ÜrÛ팎pèà~Ò¹,ï¸óV pæÌiÚÚÚ¹fû5ôvw+j¤(i@™ŒÊ4ÄÂT54o-!®½’õÛc{"M‰Qº8Jò7Ckñ¾„} B˜aØMJ|?-µùv+¶P Ú÷\r¹œÝÙÙe7µ´,j&¥3™,MÌÌÎÐÐØH£´¶´R"ÎèÝÏ Â V·ª j²¼ÐDq‡•«Vq×›ïæégž`ffÏ-2Z˜fjrŒ™¹9¦¦Æ9uú„Bç„ÅÍ7ßÆ]w½––6òùÆH¢ÍÙ$G:,ƒ’|ß]2´, ßóX¾l9ÿå?ÿW~ë·“ra–t®‘WöîbÏ¡ýd³J¥Í ->rŒ£ÇQ(•8~â(Ò“\±i £££ŒŽŒâû®ëá¹éL<„cžØ§ûdȾÄTA\¶#À£üµ(Ÿ -hmÖ)Ô9~Mœ  Â%J¥2GŽfÏÞÝx®Ë“Ï<Ó?|×uéè褹¥™[o¾ËvxþÅç9~ì7lÛÆÆ+6033CkKKì:mÖ¢9VRФ8ÖãÛ›øGuF[½÷4^—¸Ð*!Ž\mhËÀä(„;nÎÇ¢BWñp+"“®ç* ɲUŽx6K:“]Œh.&™Ai£U+W315ZZZ‘R2[˜&χñ`}½¦ú¾¦V5XRB&“fõª5Ágùæ·¿F±X¤R.rú̦gf±m¨¸’¼HÓÛ;ÈÛÞö^zûC”T‡bLA¬ |è­QÌ\3±lË +W¬âþÞó ;ø?ŸþKŽŸ=ÆÐÐ2:::)»eöÞËèø(~ÅgllŒî^<·Â±cGéë`ãæ-ÜpÃÍtvõÍç·Â¥óÅÓ&-*‰D ²^^¶í„‰$ú]c…Ù 7\`áj2ˆ‘! •õ©¿â…ŸçŠWà¹fgæضíJn¾ùf:Ú;èééehh)MÍm±]_cÛøBàz‰Á÷c€ŠÙÌMHŸ² c&FTÅ&õiñ0Wrfã>Z U|_JÏ—ž/ 53=Ã7¿ñ-ž|òqöìyJÙ§§¿B*Í–mW²áŠ ¬\º”–¶6Nž>K:•bxd„/¿Ääô4m­môõô’ÏçÉf-„>F*ª«0Q‹z4ÿ"^4`Œ­réüŒrÔ¥³ts D^‘šÖ¦']óäpKT¨ÈŠõW%=ØAfžç{466R©T˜™¹DD Ží`ÛÓÓ³xžÇÐ`3)'E*•1Îô5¿‘¸Oú¾”Ò²´8 êkÃI9á‚C@Ss³µ~ã&Öo¸BñPƒÖpD 6’D‚ï¿Rf¶XdvvŽ©é) …"BBCcžb¡ÄÄÄÇNždýÚµtwuá8³ssT*ÚÛÛhinÁv¬x=%#L¶uË6þÛoÿcãc475177K©X¤¥µ•ÆƦɱQ2CËÌåå'§^lºY*Ê¡Ò-mAľ¥—KL³&›e%WG€Ž[6¾[²‘Ò–Åðð(?úÑ㌟ÀI —­æî·¿L>KÊI±~íZòÙÓSÓŒŽ+A+–-çŠõëY:4Dss ¥J'åà5&À²#jD8n–¦Gêù®·Dëhá$F%XhØà+ËàPµP“‰qÁÓ‹0ò‰u2ÒS©k…'xA}>…ó+uqR¹TEŠªÕE¥,—Ë475ÑÓÕÅé³gikm%“Í«*ò‰Ò®R¥])ó}ÅGõ¥ÄQõ„Oä>ëSét¥Ã̳¶°ÒBº1Ì=d |Ô ONMòè“OrôØñà(˜4¯½ô*Ë–‘ËçilhàôÙsì?p˜B¡ÈÆ ë¨x&&'¹jÛ•lÝ´‰,åH"”]Jl[m2---´´´ ¥¤½½#ÜÍ“W YÖÿÅbæ†v˜o1Ê@sÚEv¨¾R £éÇ5?D>s’§­9åa}'¯ÂîÝûøìg¾À‰Gñü9úX¹viÇáÊM›±,‹B¡ÀT¹B&¦¡!OScŸ›o¼‘ææfZZ[pœ€çª,+F~ˆæß6·í´ïµp3#æ;*WË ”¾P8Mœ,§4m„XáïšöjVBEƒ¥yŸ k+(ÇVŒ1+* C{G'¹\þҘР`šž›¡»»›ƒGqnt„Õ¾dÉ8*Ñøg2\š¦¨gEkÑPJ±ð°ö!øhóÂ7ÒøD }…À¨„L¤G˜ìãî#aPEÀex†kR(BGDJZ››êí£X,Ïå9vâ8–e157ÓO?'%33stw¶ã¦R Ž2:>ÆäÔ,;Ÿ‰Ûo¹‘Š«ÌñL:… „¶c‡š?N|7@ºEÄg“Ó–2óªÃñòb (R †™$˜, p) +F¬‰v”Ÿ¬ßGJÉÔį¾ú?ü]|é²dé'ŸdÕÚutvvÓß×φõüŠ[S33"—ËÑÙÞAggË–-%—Í)îºãTñµCæ—>&G/é£ÏŽ›ýµÇÐÔLÉû¿$¢Ç „Jm@ɪ¯­?_"è—\ªÙSêî x Mj ,õ-Cx¥‰?XH驳Á®„¶ tw™Ö˜|·ZŸ›1w)̱¬n4ÇYb¢ë[k~º®ÚE«£qÖž½A$²ìàXÝè²ÀM ¤²Î²ÙKFBÀÜÌ,Ó“SLMN122NWw7étýcVw CÆ‚Š|=Y:—XFÅÁWʳu1ð<j ;nÐZÃX¹øÒgßý<³s'™…¹Yf¦&qÝ ¥9—¶¦FsYŽRfisk ƒýŒ Ÿ¢wåJºººY·vm€NG©iª:H`†Ú‰zÄ?œ Í\pµšÖ~¶m×Ö&U Ì÷ðñ TüŒ1¨ú{raë  T,røÐAxè+<õÄ㔊e6«Ö®åîw¼ãÿkￃ,»î;Oðs®yÞ¤÷YÞ(x4 試ȦDŠ²-¦{zzf¶{³»1±±;;=Ó1r­–Ô’(CJ$AN@x[ …2(ï²*3+}>ÍÙ?Î9÷Þ÷òUUV‚`ˆ2_¾wß5çwÎÏ|¿ßÛ¶la|l AÈþý¯;%¶Å†‰ …"©”"“¡Úµ¬î×-, 1!N/d·3¬h¿¬¹¦Ð̹ÄA' ÃŽ|DûÂp)@—y_ ÍDÏWÀ´_1jÉPJy¡jW¤d--åd›¦ö1ÒͲ3Q‹t4ë7Ñ…–ɤ±m‹jµ†cÛ” ElÛÁq\ÇíêÒ¬AÄ!žçiq<»Õ22Š¢gE+šzˆæxñŠÖ÷‚¥ënºá¶Î˜oŸD„)7ƒkÁ*0;= Àðà0µjƒc‡XlVȧ-*Ë‹TXΤx÷»ïbÇÎí˜]-Í}vtS¶ ˜' ãR®s·Éœ$‘wNÖN (ÑàL’J®±_¢ÝÅlºÈä B%+C¦gÎóƒ‡æäÙs4›-„å2ºq'Ÿÿâxÿ{ïæø±£œ™šbrb’Ù¹ ds9Þuëm á8©TJgÕ;3¶²caiWU§Ý¥é÷EbÒn¯›\²Neúµºeœ4lŸ›ÝŸ™¹×IOB“ñåZ(ª'lKØHÃIŽ*—j‘»m±¶„M&—Ú]n¬«¹Y¾P@ I½Y£\è¡Ñ¨+´”ïá~™!žKqAÌó<­´ËŠ´Z-}ÊJh,Ôð}Ë„VZÝxír[m(¡@h®§qË…É~‡  ±}Ë8 ÔŒl›žž2µjje•¥¥|¯†k{\˜=K¡è°qã6lÞÌÎ;I§ÒºK\ü¨ü@Õ…ã*¶PbBµë×¾¾†IC{6:ù{7 ] tkÃÜඉГÌÜUfºXb¦]$. ª•*`nf)!WÌ346@¾Çkµ¨ÕëŒ ²yó&vlßNôôª²Y:Ž’TkG"07Ýîõ½JzÝΫÛïÝ®'JÄéy\ IË q>=÷ä£íâaIý¬ô›Ì;ဂЯJ`…a Ñ‹¾â|k²u$ u »[a“Ëf™š>ÇÙóSø~€çµh6êš)´MJ)%¾çáû~brê‹4I¡v^iX/Oøê¸-µ@„:Þôôq”kéæd>F2Ö²ìÈ¥)–JŒøžÞõ}Ò©T¤/ÜÛ[bÛ–aòéå’K±TdÛö|æ3ÿœá‘‘¸† ¤Õ5ÁuÕT›ŽRÑEb¯‹•‚ÌÿM“²5I0’Ùâ‹»Žfb˜ìxÄ ½)ùÅÎÁLîz½ÎÉS§xè‘Çyeï-I:_fbçMlÛ¹å¥e~ô̳xaH¹§×uÉ沌ŒÒSU\ê,¯ÍäöÒ‹ñ8:Im.ïe<š Âö5Q £ù¢Ëe¢»gdîSû"+Û"ãd²­ ñ†{ÄK—n]eŸcÀ¶Á¶Ž£ØHF¥e½­UÖ…ÄÁÄÄ$Ží²°´D6›¡§§Giü†!ïcKc BàµG1_¤P(b;ö%˜6+5Sßä ¢ÙuqÌzghbæÉÅׄn†1\ËJ4¡×÷GȨO‘Ú.ƒ¶E#ž÷k«Ðæw£Ém.MUVT¾&‚ŠÈdÙÌÐMKTÚËŠgÝòi6›—¿¯¬ -¨T«¼´gÕj•|6‡cÛ,--’Íféëë‹I¾çµM>˶€jµ…«ér~Ð"|ÒVš”“ÆàsU<¦.LÁ­¸`"¶CÇ»-ÏG€î^gZA*ƒhy»wß‚mÙò%^yùV–æ±l × i4êÌž_¢Têeã¦mlݾ;v’IgÚ3µ–é2§\9-sc²¬ÉÄÝ%vÞn3úŽDŒÖ­¼ÔözÁFˆ@OS¶ÚŒ¥3“›<Ï0 ñ|Ÿ7Žã¾o|“óçfÔ ´³¤ ýô–Š”2YŠÅ=ålǦ§§—\6K&‰b´@ å­1¥äâÕ;µ H©që«ñF×Þ‘¬Š~OfLÛÊT=»´§)ŒA×ÅÀÔ‘­K<ËÄŲ œ5¡!­1Ü&puÍÛ±è"‰EÀrD¾ªì8oZX* л˜™™æôé %«««äryÕÒVþ)É'uñÙl–Z­¦Dtpo¹–N ÙHi“=fÑ%šd‰‡.·è=M_©C¦]'zª–e‘Ïåزe+##c,.,ðƯ36>‰e[LŒo¢^÷‘¡Ëàè8æ—ضÃa`` -›niã’º\´î d£s·gÓ»'±º¥6¤;ÆÓ¾Û[–…ïy¼üê^NŸ9Ç̉Ã@ˆ›+‚F£Áðð }½ÊmNgRd3Ò©t›·pñØ7ž?ÉR¡ò//o¼7¬ýˆÉ°%q?„ph>ã÷›j Iè¢YL,~±*^çÏ2þ¸2ÞH*@¿+Œ´Ì…eƒNÖ"UsyÝ:Àð½”øa úÙi[mbëë(# –™:s–å•ERnšZµÊÔÔÆÆÇt?À±„Â%ÀH¡ÑN§Sø-OÎŽj¶&` Å<˜ Z-½R Q´t;NHÈ66”y¨¶m“ɤI§Ód2Þwχ8yâÏ>û4ôÙ´i+©ÜŠý}d ¤NëÛ¶%D„eŽoAŒ“M2ªôR½§ÛĹØߺM°Î×ÚaÅ°]´Ñjã0n™éÅÔ Y4|ŸS§N3==£Þ›Ê⊼ëŽ[è¢åyôöõ’ËeééíÁ¶,lÇÆuÜX„}=`S÷’WæW­~!ìuCFucÿ±ío"Š6­µ¿]Ý/+qÏE¨“KÚùNØ¿IŽFÉÂèHª¶ù ƒ tïxAÖ£6aWâdV†x­––ivtþBàkû*wër¡W«+Tn¹ýv^ß÷*µF…M›7ͦ±lCÚ×'¨Ö‘²th•tRšÿJ[ŬFxÛÔAMKË"êtèù> 4ÔŽ¨‹ Ý‘ßoE1Ÿ¥çƒÀÇu]r¹,wÜù.ÆÆ'™_Zá™çŸD„>«µ bö<©TŠtÚ‰ê˜NG=6†OŠvcÐ ‰v·¶½5ɥ꿗kËMÊ`£Þ¶" ¨WO½“D’ºQ4fúðê~@Ú];wî<‡¡ÜSbútH©Xb÷M»ùà=ïËbûÖ-”J%\W=;§­C ¸äyGÞjÑ^ëÛ…×,nßÛ^$’^Ï& NPÏÒ®´ë’7Æ¿ªcXË!¥€F É¢‡Aèƒîh†2Êí˜çf±$ÍÓM¥°4lWXŠ)$Ñb—ërTjN9A³QçèÑ7NØó´Ò„k+… ðiµü(ɃF-9®‹°ml [àû!ž§NPu‚'2À ð±…Ò¦2‰–0R  ‹DQX‚À÷i>®“¢åù§6NE­ÙjpèÈW+4Zós³ŒMR,Ù¼i3==}Aìj†‰¤†¦ ˜^qµáÊ0QÇì˜ÀÉ)°nº[Çg⎚h–¢ ×u¢Ó®šhÎ'ꆡ»%J)iµZ<ôýG¸ï›ßåõ}¯ß€Ð§à*’D©XছnÂqÚ…ó’»o·¤Ø¯eÍb–¼'ë»/kî_Ò/¶8&A5]6 &)i¼+ÚÎ× Ââ{/¢û ¡ò“—Œ¶°4hÃlhÂxlÍì¸WBÛ€ Õl"uÙÕóZëº?—ÏB‡’ Ù¹m'G¢¯·Ÿ¡ááh¥ «vÒ0ðð}Ý¡Á6å$n:…m[ø!¸¶ªó W¨]X“Ó ÍŽzô˜U(JGàŽ0PºÆ¶íøM<¯©„JÊø~@O©¨‘bê&8t˜^Ù‹´( :9!qS)VVW™žcdx”r©Fb÷×rm’„†¶IÒe"_Ý9Ù×Ö7!!ÅFÂÿ$ÙðZ}×Úï11 /ÌdèæyýÀ!Ž=Nui˲¸ã½÷pà »Ø½ûFúúûñ<4Ð#¹óv;çä¤On7äeç[çg:î¯~S·›Ø¾ûvû{<©•u%†n}Ü”<‰h™†t“ü>l)åˆ #“»°Úb­8sãÅ­Á HpÏ÷ðµ;½ž±®wå2YzË=Qƒ­Õ•Ìü¨Îêv]ÇQ«´ëZ‘’K\±„;yFGe =âAÄ2Æî‡b@-„tUw‡acá:ªV„¡Õju—–XX^àȉ×ðuFK#ä²YFF†(–ŠÔêUZÍA´Û$'j»Ë˜Ìšw›t“üj‡ÒÅRuËPv;_¿Ø×™ûl;.H¥¥eÒ™él'•abr’ÛïzŸøè½ ô÷188H&¦åµ"˜¢éÅd®ë¢Àýÿ‹eÖ;N,Ê"wÖ§ÑÀ4ÂJÈ.u`c´Ý^ÓÇ_óDÐöö.›tôG¾È•µ‚÷ cµ€;")d§þ…]®#v§m[ÆìzæÉzÞÔjµ¨U*d22™,~¬Óaw)®o=ÏótŒëtÙa’‰'µ(µ,…cµ-KÕ‚¥j–>`1=3ω“§h6›ú©&åº8 ‹‚™ÙY\Çá¶Ý;X\™Æ×±©7W9sö833SÌÎLa T OÙNk 5_Óƒ;ŽƒãvGž]..ìvíÝA¶è–Q]û™Øý»Üð=f£É©3gÙûêë\˜žf`dŒ›ï¸KòùƒýýQ[O×qI9ª†¯°ÚíŒäõufÎÅÅW“xwNìØf¡07åƒ+R¶i­‰o“7 *Ófñ[Lg½»†ah\cóz’#¶Lÿê0ôI¦¶¢ç/ôâ«KE¡ tèr1ŠÉK`IX‚FóÍb# ¨7ê,./S,–¨V+4¼&Aâ8ʵJ».ÂR¼áZµŠ×jQ,—I§2Ôk5×!JH¥º+y˜ûí K×ÕœÃG?Ð0dii™ã§O°¥:I±˜§·¯—t*­4¬ŸT*£u‡ ›Í°ººÌã>ÆÂÔCÛŽ¤V©Ð AŸßËòâÚÏøøét:1/”ëÜh6˜ž™åüô,ÅBžT*E>›¥P(P,×€0Ù­vÛö–‹[œr»lб–èØé̦c£å…„캲w`~~ïÿàQææHY°²¼ÌÂÒ2[6o¤§T¢d4¿;vDƒŸŽ¶¸è‚%.qͦôß4¼Ö²B˜Ý8ኛ®ˆkêáÝîa§!_ô¼LâÊÒ¡Q;XL¹Ù!RªMÃÖ|eÓe°M9$‘œ3䊨Ôdž®?w.ôíl6A&“Õà¨7+‰%¡T*±k×.2é ÇNeqy‘B.€øøMŸ•åeŽ>Ä… Èçó*–jyÔª†GF±„E­V%•Vt©z½N©ÜÃàཽ}‘6²©‡Y–"ò«˜Ú¥Ùl!…`ÓÆ,,ÍóÊÞ—aƒ·|>OßÕj…¥¥e_HÞ.5Ú&—qóÖëRkC XÛ¶R5š69ÔH+«P'ÕT‚$ B^ß—_|•žÁ2ÛoÞÊâR ãlÙ´‘R±=ÓNXcXÕQb³"oÅ”³:i|—™ZºQœ:žQl‰Î!qKÏ Ñ¶£Ê‹õ%]²ã§.çl¼€¶~_q1Â_'þfíB ™lIæQg­?™/P9#U-ÈçŠ ¯k¦¬k^]Yayi‰ P`~~Žf³A£V£Z© ¥dqa“Çqøð!ææ.P«VXZ8O.“¢T¢V­Ð×?@OÏõz•Z£ @¹ÜG±Ô‹›J108Ä7îfhd4Fmù*«Œ€À±Ö®ë"Ã7Ž¤Ñ¬P(xãÈø^‹ÞrËKKœ;wžåÕU—8wþ ý}ýlØ´‰›nÜÍ»ï~Fƒ‡¾ÿg¦Îðʾװ…dff†{îù96oÙF±XIJlž~qú¥¯pôЊ‰•Ëò‘{?È–»ngbldíîkF˜ìV/UpK¬Ïמ²É†'Ã:3aƒH)ÔNí¡‚4-i5œÿ/QBÓÆ¡d‡Ûeuö‰H©¢+¯ù’÷®ÝXÚ‡ƒˆ°"L¼Ý‘|K6åQª@K&»¯ÎÉÔÅu¦ßÓRjÑ®­¥Š‹ù¿¹W¾P«7XY©¨îëëª/¯,³ÿkX¶Ãââ<ù|ž¥Åõ:õz©©3?vˆJe•|¡ÌêÊ•å T«TWæC‡z£ÊܹlŽ0 qÜ++ËÌ/Ì“Êä8þgNŸbÇθíŽw‘Ïåp]Ï" {¨6-ž×¤¯¯—¾ÞöÜÏJe V©pÓ®ÝTªÎNa¥ºŒ”!=år¹wßu7·ßv“ Ã×MóÀƒ17?ÅÔÙÃxÍ€—_y•oáȱ“Ø–CÃ÷9ºÿudÓ£´h­84ª5nÝ}#¹\>VévïÚ–äKs‚Û‰Æv£Ú¯ª¥†H©Ú„ÊDÌh’o¦³Ú½’jer^panËÌÍ]`iÙã}ﾇ;ï¸ÁÁ5èÓ¦ÜTb¡ê²ëD¯sɸ-ûªµ¬C]ŸîFèˆwÁµb÷îR™ç¸Ì—Ìì«ëè,»%®¾-”Ž½bµ G}ôk&ÜŠ»!ªRc2´Qk×L4nAá',Ëbµ^¡Z«^4)™ë“Ôñ}ÎOŸ×¾¹‡k;œ?wŽl6ËÉSÇ™š:Kµ²ˆ×ªÑhTñšM2¹) åaüV“VЯC­^ÓÇô°m‡T:K©â”zX\\àð‘Ü|óm”Š%!U—Kµ%õZ ´qÓ» eÈO?Šë8ø-šœ:} h¶ªTjËlÚ¸›oº°¸ý¶ÛŽH ;vìàŽ™9^|YÕŽ—–¹07ÑÓÇYž_eyq…‰Í[Ù0>†ßlQ«V¨Õ,/-S©ÔÃMð6#—Ð8·&‹©ñÔÝ&srB®MlY™S‰Eh:äESNèI(0J&I#6Ç÷¼^«ÉãO?ËÓ/½‚ï5±,‹Á¡Q²Ù,ýý} …6„•”¯¥¦w¥”FÃ:εgç•·hQg)dM­Ø²°’ ÚD{w«Êá_¢n, Nô•]ŒW]¿í²ñßUNB]‡Úy58FzÑq ÐH °M ™ZßMWc„méÍI›£“½éTŠõøjë2àl6G:¡Z­`;õFù…9:•Ê*Žm“Jeq5¹ßMe•ü e6o¿™jm‰óç§qÝ SS§)—J*®ò=<˦٨S(”(””‚á¹³g(‹ìܹ»í¦ºŽÉíaqËÍ·²yÓfæçgyé¥XœŸ#•J±ë†)÷ö±÷À>œtŽ;odãäFŠÅ2–Çp®ãðÞ»ï$—Ëpðàë¼òÒó>vS¦*1¹qœþþ^çç©Ô–Ùµ}£##ÜsÏ{¼Ø]ÆEP®s—·u‹‡ºOH1• *¨êÒVÔ4+¹ƒ(}i)@D®-‹T:C¥Raqu…áa Å4›¶o¢·§—êê ½º9SŠ ÃP»ÏvB¿³Ö?#3”‹x‰ëÒjgžLXÅW´ö^uËÞǰȵuj}€5ÐËd2.:®Œëåêóm¢8úÿZQ$bý T.@½/ X¢ÚqRÎÈ! Ô›m[ -¨×ZœŸžfeu•õ,aë2`ß÷Ôé‡!„z£ :^K¡Fl×¥TPÙe)Ùºm##£lßµ‹t:ÃÉǹ0{£ÇÞàÀÁ=òez˃,,^`qi/ BI½^£T*SÕÙìL&«‹ãJ?+•vuùAÝŒÞÞ>ŠÅ…|žíÛ·c;.¶e3>1Éø† öqã®›Èd2Z*ÄW­q‡R±Äß÷>¶nÚÄüì ¯Úφ¡ |èýbb|’ɉ üðGSÈåù_ýú”À\K6W¶djçµí„w7Ï”Á.>D´`%[|˜ïn㢊v™ZSdÈÜâ25? /›!—˲mÃnß}KĹv:\S†„~@‹–Þy¶¿'¯!iЪŒØåJŒ±™…q÷ŽP¶»Ïk!‰ÒÒÚ;Ôv3»×…£ã·Ã%Û¾‡öÅ4>L ³”ýÑt1œP7a‡NÏ*:~ ó9B,¬ˆF¨<›f«ÁÌÌ,µZm=¦¹N”дmÛÔu,!H[6¡Êþ¾Aîyÿ‡¦ÜÓÃØø$Ùl6º1ã“4M—îaÿ;xõå— ¼¡!Ο;ÅÊò ++Êåjµ§OŸ¢¯€É‰jõB¡gDœÔ1nc&fxx„¾¾~@’Ng‘2äæ›nƲœèÆ6š^k˜'”Ò5ÝɉIþÝ¿ûŸøÄ'ÿ3ÓÓLŒ“Ëåèííeó–-H)Äü„°»&°0ÁB¢Ü$aÅ“F’ ˜f¢“åÒåŸ6Ã꨽†aئ©Ê!c0…çy\˜›£T̳mã8Çåä‘*³•Óó‹Üºû&7lTH M ÃÀS9‡0|èÜ »”uB×$”Œ›ºÉä÷$ž‹x+]vá‹gÁÈ°UÿØ -»|Þm€ÚýsŒ÷O6ý3õas^¶eÊDS;©“´–$›Mqçí·pü䫼øòåèõ©R"¨×ªx^‹Þ¾V–©¬® ¥¤ÜÛÏju™í;vñsþ™Lv-”N*¸¥ã: ñá{?ÉàÀ(ßýöýlŸØÅâòœJf¥”¢a:“eey™Ão$“ÎÐÛÛí8„‘x€’s×ÍÍæH¥b…Eý\£‡íûJÒG1Ÿ‚hIM”@JÅ2wÝyF£-S8ru\a\Ú‹ÏÎØE ½àhZAÄÀ Ô×G=i!”NP¢ësèXÑ;åbÌnbbá¸V)T‰ïù¬ÌÍÓ34ÌÐà­VÛ²Ö@%Í1Â0T5PÖè,w\v{i§›Î•ÆM¶bY:O`\Y)Û>;)‘—]vc“+ÃaŒ-Ï$bÉÞS¬ãÐíPÌäó°´Ò‡ %ŠD'0,±d§ƒlóýa lÇV 'a‘rl¼fc]UÇõ.Q ‰0 # Fmu™l¾€ç{ Žp÷ÝïÃu܈ñ’˜vÄÔΆ ¬€]»n¤ô›e2™,K•¦ÎLQ«ÖÈ ¤3ª• ‹ óœ={šT:£Ê:ÂÂ}BݺÔÄ…æYZ¢ç«øŽc㺡Dé;Û± B‡ÙzÙÚåd²Ùž)e€‘µ,û’F–0¦PÃÒ0R@2RÑPn¦ÔÚÓæsa~ûb#)·#ºì6‘û‡ˆ2÷ |÷{rððQ|R(—°-‹þr‘\6˸¦…&°^¯³Z©Î¤É»nï·«›0l•g Å7¢¹~o`jÈhØd¢æk"®e•Æ.v_ôÉkTí­ÄªR³ÀÅ Œ‹óÅD2;ÌwHÃZNt=šS°"•õ>#O”Édp—õd±Ö¥LêN­¬.0·8Mݯãd2äòyn¿ã]lݾ#&LKA ‚@§›­Ï—x¾ª[x^ÀÀÀ¹\žÉ ›IçKXÂfee…¡Aò…<çgγ¸¸ ˜Ê7ÅV¤ˆé:),aãû!-ÏÇB|Í •íSÄ‚×òhÔ›múKF"6ÔMÈcاAÍØÚ wÚv•µ”¿#B'°Œk«&¨ï‡´Zõ†çx^€ï‡‘¦ØzFDü¶»•©¡+Ž©M†>zŒ3çΓN9 ŒŽ±TmðÊkȤ3ô÷õFŸSáÊ@û¾¯ûbÙkŽnîs²&!‘F¤pÝñ¿äçbðN­$ÚA)&v¼È$m嬶Ü@\#Ǩ™$rBÈØö…H˜I ?·¦QkaéçõÀîè›\¥†‡šö¾j|¦!˜‹‹sTª+oÒ,ÔÎU­U"÷4•Jc[®“"›ÍÑÓÛ×ö‰êç‹a¨ÝOÝ|Ã-U*j'½å¦[8¸gNœÀ«û\˜»ÀæÍ[pÓi×¥V­Q,–q]a«rRè‡Z¹2@`!¤ƒ”vԛزmÒ¶¹Ó–eẎë’rSø ƒ Í$ C „ГÈN_Âp:Ý×.d©‡d&…ÀtUh4ý(÷Z-­v»bÅ/ùXŒk©]ýn,(Çq‚€™™–+êÍú¨UŒÓ CzûzÄ`Ž-!BQÜòùœ’,’k1΃F¶"“@“þ@*Ê¢iÛdw¸Úþ˜v}è+by%k¯«kŽÎ]jø¤éìh¢b} i)sú- ¾î¥°Q<¬ÒE‰8!°…@Díu$¡¯BÄ©©3T*•7' -P|ZÏká8.}}ªl­VöløhÔd²Y½ðÚˆ…"%xRÅ›ç« K+a(dU±Td¥º¢šDWVÇu\ÎÏÌP¯U¨×jˆ|x-?JÜärylÇÕ7QJ²¼£¾*Ê«ú¯ê2àÍ!©\oß3„jë’;mgóðNZ]ìFªsQÊÉ2D’ Ú³¬€Œ5¬¢d¯å)H!Û*“Í^Yb¦óÉt-Kµ3i‚@Q3ËÅ"=¥Õz‹Áþ>°†úûرe³RÝÔ­J“׆J‹Ì–±[ÞÙAâbXJÅ¿ú$vÄ[nïì×v !qBÈŸÞvžd)ʶ¬¶g¸öžt›ñ ¢ì•ymˆ+}¾†Ì „…e‹¨Qyôü­v4¾˜8yERx^C2¥b¿~€ï©ùTG½ÜX—¬¬mÛ '+%Í–R ({Èærø¯$A, Ï ‚A 9qLâû>Ž¾h„^ĵm›ñ± ^ß¿¿°ººÂ£=L*æÎ;ßM£Õäüô=å~ÊåÕh̶Éfó‘ )FjWÔ¶T¿5“°RcŽÉšI¥wÛÈ…ípÓºÝÈn»prâX TT½áÑhyQÁ •c>gvängG×f>ãOãiuh`Þòò ­–§]WAo±@#h‘ɦÙ06L>ŸSDèÜ“5”xM)Y§»‹ñÙ°‹,•0ŠvQu1R8G¶Æ=NÆÇæoaâí8äxq x©…FÝ7•@´ô‚†~´óF÷4!¤—™bãÇŠÉÆ#Ž°kî%SÉÒù˲µ¶y ÊŽú|{ʽ«ðf”‘¤Ê@+¦`aq˲!›Ë16¹ÉÉÊ€[­–jàä¦Ú Ú*Hq±›DËK!ؼy “~ãzƒþLšt&ÍjeJ–—+lÝâR.õàFò:&¡¢v9å.Dz/ñêháÓ{'ÐÝÒㄉ°í‹îhÉxÓ¸BÉ×’ßgÕ$VYqR‰[¨ÕÚq|nÊ(Ý]DÙ¾9D†#¢„Kòy9Âè>¶c3·°Èòê*ËóólØ8Ia D*bç¶-LŒë¸?.½©Ý8nâ8ªÛ lÛ‘¦†m÷!6æö6®Õ*Ù`3'¢ðÂüÝ —)Ú’W–èÞ†¥³¥Ê¥h•JõE1,ÛZBˆ\’½Iî˜'& O¼}Á §6)cêæÚÃ(}·^ƒÐ׊)A·¶º'3ÓÓ¬,¯DsåRc]e$+±º§Ri<¯E °aÃFÒ™L”˜IgRdule:0˜l¯í¤tiÃÃZ*éwÐt:Ç>øQÎœ>‰×l±mÛ.fçfxîùg(Ja‘Í(—ËòüÀFø^Të5;©uÑrGrÇ´â]ÇÃMþܵ<“Hd !Z@ª\‘¬ýµš>ž¯&¾)Åضîò ûþÚÎ¥Xq|œ´±‚ˆ)·$a’J»ì?r”§§èì'´ ðCÂc¹RQŠ*]¾3qqµ;Ù¶£d“tÞÁ,K©ÊM„aQ ÓJz –¥væ0¤^¯qøÄ!jꛇ…VÌ”™\¤¤^«‘Íæ¸07ËÐèH¢Ó¼R‰ Ý”f^˜š˜¥];l ×µ à –xB’.ª;aÀ{ßóÎ;ǹóSËeB«Í#ù"apþÜa2:6F©X¢\ì‰ciËÃu]•Uj–ÝvÚv£N^güs¢œ”È4G»¡š¬¶ÉrÚ-÷¼FCĉ• m\ÇÆv,í®/IѽÞ'JbwÞÔRmLòE"i5[³zËeªµ&+•++U6†!·nßF_oa`âK5Q%a, oI%lµ1`E”h/"à C„­›­»šÆ8T¸@,^`ÛÂ/“Ù±›$˜èyÈЗ²,6%%¿Œ ½6TÑaƒôõj'µ¤ÆáƒâöRaÇ-ËÒ"î¦,¥ÃDõDTÕÃNáM ê1 âòÒ27§³—ë4`Ôî*Ap×q9}æ$>ccø~‹j5ÀvTÕ RXVJ¯X7•Dò$rà†ŽN8¹´Zu²Ù7mæØécŒ&âØ© ,VWñ½Žë²°4O©Xfqi‰;ï¸[¹Ù®ú^‰ê}cÙJë¨-.2;h[©Ý@Lz‚HÞ6I—‹Ü/Ñ£V_QrKçX¶ƒã¨ ã:nÔ*#þäÅ,ÝË2íÛÜËdÒLhä’Éþ›äOoO‰Þ2{à $A³Áê… ”ŠE ù<åR¡ã^ˆ¶/—¡e»*¶ ýX8À|¦SË$å 3Ö m¨ŠÙÔ‘ " 5»½£«¾>¾ZÄÌ÷š6&a›á_®ôÍLa™è:föHj¥Y"n*gq¡ ôëVÛýWï·5&" ““åÞ^>ù©ÆReŽÓç#.!|ë啪R(J€Äu\vl»‰|®¨ ÜUˆÇMaiR%Ânáyu}»¸"׌-›l&Ë·¿‹ÁÁAŽ?Æêê ÙtKX”ŠejõÍV“••%jµ*gΞ¢Z¯r×ïƱ]U|e; ή ˜ò’mnšÕG›?:Fñ|?T¼Oßo-¯…”’\.G6›ÒÝ'Žíè„›YÑc`ˆÙ‰"Cˆà~­Cí"’ÂR„’0hóÆ­è™N§Ù09Ž’æê2Âq! YX\ffnžsç§Ù¸a\…(2LMôõ«²‰´Ô¢`0¼jŠî½‘UàYÔ¨,/f†G,£ì}t&Š ‡aðÄ„ê—fA¯ÕdiiÛVüËå t¶í´£d¡ÁÁ«z­Qê05o“”•R°Ö³Óᜌ»R&¾Dy|–E(U‹"/0›È¥ÇåZ~3z¸–¥w”TJï¾>FÛ¶){Éæ º–Êš.†GÝpËƶm¶pS.2ôa ˆ¡Á¾õÐwX®¬àZ®Z™-'%¶ñZM<ßçÙçŸäÀë¯Q*õr×wÑÓÓ£ãÁØè$ãcJ^O>©³âR»y¶ÕÞ`,Y¬7šJ…u=¶£Z”J͵U ‹8ºöl€Bƒ!ŒË¦vžDOžhª-%s>kIðÉŸ“Æ«âHs-ÒSçïjaƒL˦\šÕ:N¹']äÔùjºŽÙ5@+2P@2$ô=¤¹¶Ò¶l‘D %)ŽæÌÔ6¢èÝŒ8NÆ®q.©ÎǨR $RÄƪৱï£Qo°¼²Ìs/¾ÀÒÒ¥RŸøèGéëí½Ì\×»i›mI]‹¶´ñòIˆ#lÝ`^–,Ý%ÓÌ#“=mÀ¶\¤ôtۡĦ¦¿{ye…Ù 3\˜›¹¬ñØåÁôÿL¤¹Ð}Ô5WæI§³”‹ª„308Èæ­ÛU™g¹B³Ù¢§§„ë*uHƒ$›–„’Úˆwè6¸Œê²=¥6ŒMPÈÈçòÒgæÂyl˦R_¥˜Ëã­V“ù¹iV–æi¶ËæÈÑÃì?¸B>GO¡ˆï·t ÇQf¢šV¡a¢{J¾ùZ*¥Ñ[†ô ´$Œm[Q61•rI¹i'ƒmÇâq÷ĪíÂDž€zŽîžÎ>›|B´‹‹v°B´sÈPwàS`ßóY^]eÿ¡78rä8­êƒ“ŒÐ[È3ÔßϦ d³s$ $2àèD¥D¨¼0‹¶XS‡–Hæ`“ño‡õ/8q¦=$ÖO7s%æ낆'vT ÌÜj6[¬®®òÀ?}—‡~ôÕF“M7qÓ®8Ž½ÿbâªC‡ž`šãH)¢)ŠÉµ»½'aÔq·KJ¥×jñü‹Osßý_æä©#—=WX׬nìÒʯz™™¹sÜ°m7=}}œ:yŒÑ±qòù"¹\Nûÿ1ʦ=»˜<—ä‰Å“@¨SŠˆ#6ã¦RY¡R©ðÍïý§OŸ¢å·˜š;ÇLe¼›aóÈBßgêÜ–VVàî;ïfr|ÛQî|«USÚé¸l㪅>jÕ·-™›Nµ©x˜IfQŠÕ¨ÁÑ\Ö&ƒÄ$ëú-:)$tV™Äâb¶”È=MºÞ‰W2G-u\Ä°G=aš­§Îœf~~ÇqIe ”Jl Ëqìô)fççÐF¢ú.lj-]öÑ †Ðe;Q7_}„û|Ù!’»w\Û¶…AW-9Ãè{ÔÇ‚°:ªT ¦§ÎñøãOðÄcO0:>Ä·ÞÂG>ø~R©”3.ßõ/yÞD$ƒPw´,—0Ô˜öÄú†ö"AÁ¨¶×>lËFÚÉÆÑcoðÍï|gž{œZ­Â¥è˜mÇZÏg_CV++L_8ÇJe™Êj•…¹y†‡GÙ²u;ÅBIµá0qJí-zÀÒì²íjÿf%¶,»-›jÙŠ˜Î¤Ù±u'CÃÌ^˜¡Z¯sæìµVƒ­›É¤²”ʽx­–Âœú>o<ÄüüCC£är9lLjn‡Ýc4Bd¤w”ÌRÇ †qVôËV%— o%vYs,«ŒAòQ/[ïnQ¢- ˆ &žLì@DwDZâ,‘´ ¥dqi€¾¾2õ¦ë:ôô291J_o™t:ÍƉ £éëºo•¥ã]ÛŠsž‚r¿=ÏY]§í®K؉Ŀ8»®m%‘pÔw/J–f©ÝZäôù)žxâ ^ß·—ƒ_£xŒŽbÉz½ÁðÈh„…¿Xò2šçK‰d¡eb-aÇE»ÕçBÌžÊ0Zœ¢…NÏ9Sóµm‹™Ùó|ã›_áÏ¿ôGìÛÿjÔj÷J ”ëËW' ¹Ñ¬³ÿ×8yú8Æ·°yÛvnÐ]b@ˆ®'»®ºÄÐ^WbT©ûóbá:ŠìŸËé-÷36:Îì…Nž=Å÷Ÿ|…¥&F&q\‡Õê õZ•ésgðÇå•Wö0¶q’÷¿ïƒlÜ´AÌÊçrmÝ擵â8ó˜„Ñ%Kº¬º"@ô»ž¬”rƒž³²£5jG2þ9žÌÑ1£ã*Ý)°°U ÚM~ ’L&CoŽ” %ÎÏ^ TT¢ôýàûé)—Û\å0ôôD6X€ M«tÛÜæø”â…Í”Qí>/=³0¥#¡KS1¶Y 2qψi MÃ>ü‡äüÌSçÒÓ3†%À±-Îœ=C­V£ õ»ãªB;dÓ„G T¥„í„å C0´°mW÷×5^}Ï,ÛŠ[©%g#°%aržkåÉÊ2O<õßúî×9qòR“j®tØåÁô¿ÊWò¡Èg÷=æg9uæ8¹|­›¶“ÑYßî.@LHÆ9ñ]„ Œ8€‘6@„aٶŸ›žf~~˜œãï»›Û¶2>6ªE¸ÞR×:¥ÎÊ2F•©Tlj'©ÂGá¹ò›0?]ÜhaE¢¶ ªÙ‚ñZqgâÚ±IÞ½²çež|â)ö¼¼—Õj¥Õú‡ééÂ’Í›·ò®»ÞÍØèXdT†FšH…'êØqîÜÖðV‘Œ÷FH¾xÄ×`žG”ÐÄÄó=^~õþôÏoÿã7˜[˜Å´Å½Š±j—ÓÏ ‚¾­@z½ŸLßKË‹ìyùYŽŸ<ÊðÐ(#£´¤èÚ&ÕIãÚÅ0†ÝÈÜ•[iÙºµgÛNma[6AP*•Ù°a3ã“ÔMf/Ìà!=¥^–—.°²2×ôÂI¥X\˜'Ÿ+¨$†c†a¨õ®T¿áx¡!šÌÆÀCdTç‹/,6¯î bÌmaeŽ•¬šÅÁÔJuF7Zß4Ð_nrX–° θåµ<ŸR©È-·ÜÄí·ÞÂÈð0}}d3­R"±1>÷™Oóñ˜‰±1²Ùìš¹ªO¢-D tBÊdÀ#(h"ûlLSò‰!£¬}¹%ë:³¦ùÆ7¿ÂŸüÅÿÅ˯¼€ï{Wk¸xøŸÿ²ËƒiPÔ‹#ÀÀ)`0t%G6FY«UÙûÚ‹<óÜ¥dÃÄ&r¹ÂšL¥*iõ•¸Ñ 3W£GpeµËivÈí”"“Î062ΖÍÛ˜œÜÈÄäFÇ&Ÿ P(…\žt*M¨š!º}i­VS¬*Ï£^¯Ñ¨×„8Ž…6A¨JMR€cÅ^CTà±;Öå%[q3-µ>Å;-]ÿ%'½•¸+fñˆËs–%è„'Z:Û]©Ö(äóZ‰Se’Óš j2áQF¸­bÐÙ•Ð,qÒÍ0)Ú;t)€‚B¶Õ‹Eü]®i[jch6›Ïòò ¯¾þ*üèqþøO¾Äk{÷±iã¼ÀÃrJ¥"ŸúÔÇøÅÏüB¤=žœŸÉÿwÖü£ÜC²Ú8kK´/Ê:/{ŒÑö¬þç8µz•‡y?øÏÿ?úOT*«Wk¸'ÿøÏ^ü$€ÉJÉ7oþà·‘+ý&3 ÇáŽÛÞÃoþú¿æž÷~˜L&a¦U¢Ž§9fe7¥…KI¨ø¾§‰Ðêwf³?8K%aZžêœØl69zô(‡ìgaa‰ZµJ±§¶JðlݺÛ²XXX`ÇöŒ P*÷Ë—•Æ2’IQn¼5ä23Ñ=Œ;Ø- /¿­c»úlH¬ý|©‡l +úúivº­Ê½i4š4uW ÏÛ&›É2ª›"Œ¼?T”˜  „£×!¥mDþ¤Ô…DòíR“4Cü æT']Y‘1|dàÓhÔ˜››§R©ñÔ3Ïsß?|?˜=?G«^gç7°qÛ6n¸a7í¸[o½™ø< ªÙ›Å&”>`* æ^ê¹–ð¢d2ܱŒ*Gûb­bÿ¤5T4Î}^åkÿð·<ÿâÓ4›k1Ü%àëÀ^7/ž9¸˜®LÀÊ\“•¹&zG^ž À.SjJŽ$åîìÔIžxêaN>ÎÈÈ8Cƒ#f‡Š²$‚LЯÞÒÎ ‰ËLÉe>OKI$ÜžJ¹ª×­%Èfsd³Yz{úcqi™Z£¡z$¥\œ”K*å²gï ÌÏÍQ.•Ùºu2 ii"¾cÛ £§Ý{Û²Ñ&ãB~Â{¸H6^«rÛ“8è,hg¹EˆXM1*M™Ï& «Io'ÐêÿŽÎ%´ü0šœŽãà€C¢.uÀÀ”‰Ú]N•,³Û'f´S_Ú€ùE®9fÔùA*Ìýüüjµ¾²çå½<÷ü‹Ø÷©”‹ßjáØ7oåSÿŸüèGؽû& …BªÎÒÆ=D‡ºß>–‡/¶Ô}Žä„ôuÉ/YÞkÇ[–ÅÉSÇùë¯üþWÄGèR×Uo øð?Lƒ2Ü•¹xƒZ“·N²¦€ïû€1`’Ë8Hm“T_”çy¼qxO>õCVV–˜œØDO¹ÏáKÝ8ÔÛ’øYaY+´ˆVéX½ÐŠD‚„И뺄¡’]JÅC©Kf2Y6lÜĆM›(÷ôêú°ƒ”!ÓÓgðýÇr©VjÌÎÎàº.ÕʪŽÓ‰ŒÁql-…¢€î¦ `™¬²d@ûu € ‘¢NN%ÝSc´qÓiãn*­é$¬:Îú¶»yÉĖЋ¤çxAˆc rÙ4™tƒ(JÆÜÞõ9Cˆr¡Ä±ÝDã±øÃÂÐñ:&m¨YDa(Û7Û²V» ‚°++KÌÏÍc ‹gŸŽã'ŽSê+°iëFGÆøíßþmþÕïü·Ü|½ýý W`î`¢¢‘\D…0ø„DnF/¦¦¾n‰DÎE,‘Ø¥£D–~O¨»ùù9¾õ_çÿôÿäÙŸT¬Ëó“/2^þßÀÿ8„†ݧK¥Ã­~øï€WsV+»cûüú¯ü+>ñ±ÏÒÓÓ§Iþ~Œ 2°, HºÑíî*š=†AdÀíàz3)bœn<¡ Ùl27?Ç… ³ÌÍÍràà>*Õ*ËË+TV«” EF†G(—{)•z#ÎR(˜‹Ö².ªëœ\ˆgW]§ÔlcÀÉÌhÒxMC3%ÁãwsЙ⎌Y#(ÎP‡a@³ÙRl)K¹Ð™L6Ò ³„Š;“®#¨r¡¹ŸŽíàù>R*îw·f„I7ÚÈóèD ”:>p"n£\Ká¶M^Ýû2{÷îÁ²Ž?I¥Ra÷Í7191ÉäÄ$Û¶l#›É‚¥Ðu–^Lö80Üd!Öì‚R†Am…‰ sDÕ׳è’*–2T9ôz£Î3Ï?Á}ßü2û¾¶Fné Çð—À_gÌ‹Æ]î6Öõ-†¼ø7Ào ŒúŠF¤‘Jq÷»ÞÏ¿øÃ{ßý!-hDšÒÖ%„%ìÛ_‹ø¸q¾ˆ³ŠÔ¿´jg¨×ëœ??Åòò"¹\žGô(ÿôà÷ô Œ°ur#„‚BAÕ‹3é4¸ç}lÚ´ [KÎÏ Æx`‹@"ÙuOF;p¼ñ&¥s’ðR:®Þ¸xfgŽÃ˜lqœ½m+˜ï0:RŽ£êÜ¥NÖh´.s~A…°B¡Àv\7Õf¨ÆÍLÆ…A×q :L½?Иa‹¦çG]é§gfÙóê+¼úò‹„¡Ï… ‹LÏ\àÖ[nà3¿ðÒ™4#C£ +‘BÚws3% Þ†Ë7ç)µ¤ºÿJXßÒV(È$$X—¹t­Ý²°ÿÐkÜwÿ—yúù'¨×k×ç®ßþU ’piÃ5c]ÐŽøxø!ð ²™+èð`\³0 9uú?ùÎNbtd‚þþ! âˆ+„–Þu;iСA Rœ"Õn¯?[ºÛzl1`]¹:…B¾¾ŠÅ‹KË,,U-‡¡!\'E¡#í:,¯¬(©¥%¦gf)æ ä ]OVÞìL2²&ÝGGjÚ¢v{MR(iXÏ4r­¥†P›:«ÎNK[M6u§%¨ÆW†Ê£±¢ÒÐM¨dÏ`JTÎÂA¼Ä<¯2¼ Ö§Ò¥åĆktÀÚ³àÊXCècês“aä!Tku<Äž—÷ò·ÿð-¾óÃG™Ÿ›¥ÔS¤¯¿Ÿ[o¹…víä†];™#WÈi)¢Ø-6è¹kÚ¨1êNŠŸe)¶˜ ýH4Ou$ÔÈ*ƒâˆp6¶ãpvê _þÚ_ð§ùûz× ®Öx}àGÀ¿þ8k ·›»|ÕÜÅ%pø'à0Œ³Î=iÈ­V“ýöòä3P­V˜ÛH>_Œw.³kèIcµ¹‹j‚$ëÌæØ"b%ö0s“M,m£6Ê•.®›"Îà¦2¤ÓÆGÆðƒ€“g¦h6[¤›•j ”LMÏr~z–B.G!ŸGU>Pè'‡P*ù³ëF½ŠtQ›Tt-QM•X¨´2D\îQ»™éÜÙj%¾/t0„‚0 ¼D¦-EcpΦ6ÝήRŸA'͔ʈe¡ôŸ“¸í6CQŠ‹¡®-Ç´E•i÷½¥•^yå5~øÈ8pøS óLŒŽpûÍ»qSiîýà‡øøG>ÂömÛÉd2¤3iÒ©T¤ð˜uŽNÃ2ÕxÑ2%0SÇ7 RÝ)#ªqZ,-/ñÀƒ÷óûüxòéG©7êëÒáºÈ8€Šqÿ`/ZEo=»nr\9ø’»±‡Jm?Ì¡Ð\½Wr,cÈ««Ë¼´ç^|éi\Çeb|ét†@‹®™ bÒtÕmOÈ€&m(©d̲”!˜ø8±c'³à¹lŽR¹ÄèÈAàS¯×Ùwà0žç±mëNMçÌÔ,ÙLšÀkqúÔf/ÌÏçI)YN D%èLyCé$)â¶Ô», ÄO´+»Ç&É¢ä_’î²1Ps½45/ª9ëK5ÝP?ˆ'³rv,ý{|—#ø¡QÇ2j–SÁÚû®GúŠ«œxj¶å „ƒï‡Ôêu{ôq^yùUªõ:*Ê— öó‰Ÿû÷¼çÝlÚ¸×Qd–L:MtËâƒñ€ÚI 22ÚäkQõBCE@d`F“gŸ’?ø“ÿoÿã×Y\œãà3ÀFe—ÔáÊvÝä¸*†5nuxåZ[(CÎ^Éñ̃Ÿ½0Í3Ïýˆ7ïg ˆ‘‘‰¸ÙÕî©QEhÇ·1@‚8‹²šÂ'#9—vÕC!Tƒër±DOO™¾¾^Ƈ‡Ø¼q#ãc£¬¬¬rèèI¦Î§^¯Óô[TU——H§R¤Òiê:Ž«¤tüÀÇ÷<ƒÈ×Ϙ¾-†LÔã€ÓØÛ`–Õf­vl[èIj˜M‰‘Ô8OÖ] «G)"ª¸Îql,K`[±±Ç;TâÞj¾Ž”VÂø×îBIõƒ BÐòB–WV¹paŽ§Ÿz–ÇŸ|š\.ËŽv’ÍeÙ¾u3ï½û]lÞ0IO¹D:•Ö%A·-Id/c|êÛ ·“ ÒIiKxêóEJ„¦¾qx?ÿåKÀßüýŸqêôq}O¯Ê]®¡âÜÿø[`®Þp͸j6£Ã/ V•~¢kÝßavã 8qòO<õ03³ç§·§ƒÞ­æi&~”PÁ$ºdd@Èä ­ ÿÕ¬¬º˜e‘ÏæÈçrlcóÆ ¸©õFƒéé)¦ÏŸÃͤ™ž›ÇI¹dÜÃCCTuNŸ¢X(v]Ý—X•ÊLöµmt,BæZ¢]-Â[›¸YÇkÒüœHs%ð¸‚Î2Š ‚@‰·YÂŽJc*ù¦ 8*+ÑYÆk7b˲#¼r÷‡j2¾–Bª²ïÀ!Ž?Æ7ü'üá#,zú˜œg ¿‘ÁAî¼íJ¥"ÙLšl&¥éŒ"2ànØæ¤aµ¡ÊÖž’Ú:î·ù«mÛÌ^˜æ«÷}‰ÿôgÿ‘W_ÛsÅ4¿ÄQ›Ûÿø(D•¼VÃ5ãš ØŒ„!‡Àq”[} ØŒ^ɱ̪7êìÛÿ Ï>ÿ8­V“‰± –™@9í;®zA«R$ø­Ñã‰K¦VÛ®¨Ð‰&RFÉdTïc “NÓ×Sfó¦lÚ8ÉÄèsË+4Z-BßÇkù¼úÊ^^}íuB$==e¥aÛ¤'îÛ­ÎÝQ?Nž·qqMÖ9îSÞ1ì-vÄ}}Û”þœü‘RFɉÐk_ûeêÁ-­&„ê€ÐÙÜ+É6ÜWß÷Ùwà {òúác<û–ê5|×¢§\Æ }^‹Á¾>&ÇGéé)kýl+Rp1”É(]wÞ6d*þ·trÎÔ…Ík‘+.Õµ¬®.óÐÃßæþøÿÇ£?DµV¹–8÷ ³üÿ^B%­®8ν¤­¼iGJŒŽ²Ó$ð;À¿D%»®hD2+–ÍÍ7ÝÁ¯}ñ_ò{>B±XŠÌ2’1ípEí.tò˜ÆŽËêo¦m_&ù$õî °ººÂÌÌ ­V‹•ÕU¦ÎOóü˯R«×ƒ€0”8ðžçsû·³k×VŠù»¶måæ]7N»¸Ú]Mž¨®Šèëñµ·é×$°#»©!·á%¤éÇ#¢ŒÇ¡žvœ–zgõ}?ñ¼Û¸®£/$ 2J(a@³Õˆú$¥Ü4ŽŠžéWèîP­Uymÿþé±°¸Ìüü£ÃCŒMŒ`§\6ŒcÙ‚¾~612<¶-KD5ÙäBgkÉÚ0òR —7ÔâxIÛHõˆ¨û¤eº3h#h6¼úÚK|õ¾¿dÏ«ÏÑjµ®¥,4ü*Ö}üøf®?6#aȸ ø·À/Å+=–™ ÙlŽ¼ï#üÚ¯ü+n¹ùΨ…¦‰ãŠ|%$Úå^¤vC“ð?S+N.VÄãLÖ–Í [­¬r~z†ù…EÛaye‰}û2=;K¹XDo;Áѳç¹ãÖ]4[-ÊùŸýØGèïcÃäù\¬˜éyÂQ[”ˆñdÛÚÝÓÙwÇíæÚÖª2&á—.dÜ*||ßÇ÷CÍö H¥Rš¥äFAIa:)e¤C&%ºÉœê6i(––°"‹ÙÙy~ìqö¾ö:Ðò”Í{Û¶022Œm[ ’J¥¢:´:E%(èL~'ìReácµÊvkL¶ŒÛîXÚ°CBСm9˜àè±CÜwÿßðØã±²º|-†Û~xŠ«Ì,_ÉxÓ\èn£#>ž&¦-q´E˲ð}Ÿ£Çñä3°¸8Çøè$¥bÙ¼)n$ð°¦S®S%$'6^c"cm`ö)–t*M?åRI«rŠH¯¸¯¯í[63·¼Ê£Ç™ššæÔ©sX– ã:<ùÌsª‘ùÐ@¤-åADa¢z«é¢ˆ4u]Ýdº-[Œãâx¹Ý(¶D<¬ÐZ!fi Et°móhâ¤Yr½7®7¨&îñ9¨´·‚Ïå¡>ÆC>ÅÔôÊå"™tšRIÑG‡‡ìï#—ËEù|Ý‚3ÊÞ“y¢>Ûß+A 5qîÒˆ-èò—Šsg¸ïþ¿áþä?ðÒËÏâ]Íï%bšßÞÄ8÷RãÇjÀf$Œ8I[<\=mqßK<ûüAÀääfòZ2eM鈸T”TÈŒ²¿ÚÕl£ÂI´±›CÅYðäãM¥SŠž˜N‘Ï碷§ÌÀ@?ƒý<|Œ… s¤B©ÌÜÂ"žßdîÂ:Ìkû_gxhXu”ph‘1ÃÐ'1ê"Ù¡@Íš ':˜¸ŽÔQÍþ2‰Ãó/¼B­01ÞK)åpîüg¦Nó±{?ÊGî½—Ûo»…¾¶‰d0Š°ôPóM)H's†*9£àøR?Dq°çxžOxض‹ã\mPQëՎϵµ{‡aˆ×òÂZ¥ÂÞW_³ž~öYŽ9Ír­ŽÀ"Îsë-7Ò[.âXŸüè‡ ŸÏ¶í kÎ U—M’TŒ!GÊ!&ìA±‡bðEô4Õ}6A Ù»o_ûÆ_ñÜ O¼4¿ûP4¿}æÅ·ÊpÍxKvàäèB[|xÈ£êÇîzeâ-)%SçNóäÓ?äÔéã Ž280%‰º)‚˜‡fÕ‘eŒ·˜`°Ô‘£ªŠX H¹Lšt:C©\¢§\¦P(2>2̆‰1nܹwn#—I31:ÂÂâ"¯ïÛËÊÒ2Í–/-Z-\W‚ ŒZpšrˆiQcš]ëE,‰½‹ä.œ˜¤&œ0#âcGYc KÈȶ¬šdÒ,”‚@Jæææ8uò”ØóâKâÑ=ÉÑ'¢Z©`!øÌ/|’O~ü#,/-!Û¶n¡P(´í¶#®ß¢Ï!ÙÓ¹™k>ñ¢„ªJ–ƒ%lNž>Î_ùù³¿ü=Þ8¼o ìò †‡*•þßQIªópíõÜ«o¹›ñã£-îç©gauu…ɉM”Jå®ï€V¢bc\o½i›¬&˜zh,0 Ž£QQ:vB!\Ý:ÔqT2(JS*Ù¹s;·î¾‘wî$jµ&³³³¬6<æV«œ:§â3áÐj¶¨×„¡$•rñ<¯åa;vÔéŽè´e'·ós׺ֆ3¬Æ¢Êíô}ËÒÍèÔ7D(&“ø Q ©ÓSgùÖw¿Ëw¾ó–W™_ZÅvl²¹,ýýýüóÏþwß}¶­ ;wlgr|Lui¼Œ™ïŒKbíBt‰w"4íQ]§’õ±m‡…Å9¾õÝ¿çÿóàÙç§Ùl\KYh/Šæ÷ÿEA!CxëwÝäø‰°‰ÝØGq@­j[P`uó°«Õ /ï}ž_zÛv˜ßH:ÑèFðC[²*á>›*JGmزM,¼¶mˆ‰ª ^!4[)¦ڶͦؼy©t†J½Á‰7ræØ^zñ%^|aÇŽŸäÕW÷±4¿LO¢õ§ãØÚµ”ø~ÁýÌ—ÇÒ¨f2ÇÙX3’uo™Hð™áû-Ò)W „Q¢Ídƒªµ:ÇOdÏ«¯²gÏxBO/¡a[¤R)¶lÞÄû?pγèctp€”ë®{÷3|‚d%lwdÈúZBI?ñÔÃüþÿo<ðàý,//] üq E6ø÷(òA~r»nrüÄ Ö¸Õ5à9”›ۀܕÏ<عùYž}þqzb±‡¡á1R®±k„‘‰ö™‘–oá;öP…1|+©RؽÕG"/eyè}¡P`b|œ;·ÓS,päÄI•UZÍ&3s‹:xˆƒsþÔ,Ëó˼öú>Þ8|„F­A¥Z,ªÕ:•j|>«QTvÛä60Éx÷¤ígƒî\À<¯ÅÊò F)ÁuU ¬´ªÀ B=ʾC™žžaq~‘t:CoO/…bþ>E-—Ù½ûFR)—\.K>—#íº±lð:žaDÒ„Œ¤_fb_ý£sÜ÷úþä¿ü_|åkÁÙ©Sí»ø• ð5àw¯Ëðö0Üè>ý¤O ÛH$ºlà~ôS@æJe’=Åb½÷Ÿñ+_ømnØyÂÒuPÏCˆÔš‡+´þUòÉd÷> WŒ$V:Ê,æ=’$bJ“×#íf‹Z­Žç{œ:;Å‘7rzê<ßúÞ#œzãA£Eq˜‘Þ!–½D*ä]·ÝÆàÈ(7Þt#…B©³g(—ò|ò'§Q1³œoDÉ-!¢®~* ×Ì|ÏãÜÔ‹Ë•¨6\.—èíí¡åÌÎÍñÔ3ϲ¸´DµRÅ÷}——–ͶÍ[ؾu3ããc”{Ê  “Íd•&ŸTJ ë1àä=4÷L»•øy$äìÔ)¾õ¯ñà÷¿ÍüÂܵ$¨àqT=÷$vÜ·Ûx[° CΟAò]WsÞ26:Éç?÷k|æÓ¿L_?a 2µI<,£4!e›ëmbá)”$ mÝ梚Ÿ€dâ¥=¡äïñÒž=|ûÁ‡9~üû÷ìa gˆM›6s~qZmü&Âvèí$“/ÒW̲²ZáÝwÝÉûßÿnܵ|6«“qVÛ÷„ZPTrª¸âûª†ª2Ñ>‹‹‹¼ðÂ˼øâ ¥’2ÈÞªõÕj•z­ÎÊÒ2AÍçYªTضy3ï½ë]ŒÒÓÓ£%nT£º8 t½Wë¡ŒF„––øÁ#ßå¾õNœ<¦žËչʠ¸ÿ„ÚyÌ‹oGã…·¹Ú²Ó(ªäô¯QD‰+RFлvîæ‹ŸÿüÜ?E±PFJ~ }¥®avà–ÚhG%-ª”ˆz%‰|Ð&¦ÿƒíMZ­ÖH–—WyþÅ™¾À«ûrþÂ6ШT˜žžf¥îa¥óTçeH±w€wß};ÿê·~•m›6hœpH)¥0ß—N§"o Qopöì8ÀÔÔ¯¿¾Ÿr©ÌÐð gÏœçÁGŸÂ“å2ÛnØF®œg¤o€Ð˜›ŸÇó|FGFؾc;“c£J{º\fb|Bî59>”¾j§ºüÆw¤ š|TkÉæ>…Rq’=Ïç…Ÿæ«÷ý%¯î}IÉË®³)X—1ƒb ý ü} ׌·E |©Ñ…¶øðˆ>÷m\‰[H|Ì^˜æ™çŸàÈуôõ044¢cGí·5#“azÑš /±@€&ºöŽ1ÛhÐõd€äD•Ø¶Ðì›4=å"7Þ°‹;n¿G„¼üÒ³¸–EoÓçÎÓl4›`~þ+³çð¼^ 4¾,Ëf~qI©w ÁòjUÁÂßh4šÌÎÌrâØ ^zéEž~êiûÑã<÷ü ì}m?µj‹¹¹yVV*Ûf㦠ÜqÇ­ŒŽ0ÐÛÃÒâs ªûEO/ŸúøGxÏ]w²ab‚\6 Ò™LÔZbðÇñ½‰ïc{˜¢îI¨‘h±hC\ö³Àƒ‡÷ñgþ{üõ—ÿ3'O½)4¿ßþ†7‰æ÷V·ýÜ9;² |uã?ÊÈÞšaâãžž>>þ‘Ïð…ÏýÛ¶l×¥¥°ËûMl©2»¶†NB;ÆäýqÀpc“¤ #«h|fbKªH•ljÕ:O=ù$=ö8Ë+^zñEV+u&·ÞHµ^aiú4ïŒNL°s÷-œ_\bóØ}=e*Õ7ìÜÁøèGžàõ}‡ðƒ›Ÿ£'NrôÈA„íÐß7B±Pfp —á‘A …©lšR¹Do¹D:íP©ÕÈçóLNL°aÃ$Cý¤SilG©~z^ÇNaÙ¶Æ&+ JDhl·T¸åd?]õL|}ïtwJÍ͵,‹sçÏòÍïþ=ÿø½û™¾–87D ¤ÿ>ª„Yƒ·ÿŽÛ9~ê Ö¸Õ%AâߢW< br|¿ôÏ_øÔçŠÔbf‹ÑLŠ3¾Aà£ô‘Õd eˆÐ®jŠÐ £ˆ°oÇ¥žd[´)gêÞ¿ú¥0YZZâØÑcœË²u›W{¦>&PEÓ²L£/)C •¸6«-usôÀxùÕø»¯‰÷<ýfÐüþ… :d^üi4\3~ª ØŒÚâíÀÿ7¶øþ÷}˜_ýÂÅî›nÓJ!¡–¨QÆ›lIÙŽÐjçùÊP"êíÔmÊ8î%$l>¾çѨ7°´ªG£Ù"”’F£N£ÑdµReµR¥R­râÔ)ŽŸ8ÁÄÄ8—˜šš·îÚ…@²²\¡TÊ39>BoO‰ÞžŠù<ËË‹AÀÄÄ$CC8®CJlÇÒÊ%1¸""D}’Dâ¹7`G¯«ÐF{”ŠsmîëÑc‡øúýÃ{••¥6HçŽ&Š ÷{(uŒ7Xÿ“ï6#aÈiT\ü»¨8yݲ·fCîïäç?ñ9>÷™_crb£.aH½Ňz‘P„H"œ’”¸n®ŸÙö³I˜i¬§‰£MÌm¤y GYõ üÏó°l¯Õbqy™B.‡ø,/¯Òh6Ù4>N6“¦ÙTS)—@Sé”kÛIJE½+^n$ê¡Á.êe|""Y¶ ,º1èÎÇkuK”èŸeYÌ^˜á¿÷ ¾õݯ1uî̵츠äþø6* úŽ0\3ÞQ kÜê>à‹ÀÿÜx5Ç3³yã6>ÿ¹ßàcýzÊ} µŸMlµ+'5˜ôÏaØÝe†X£K}S‡rFâ_[iJhî°ùÝlÕ!º¦‡EýôßÇ&JúXj¶,›rI¥u§Ý7ï1ß©t7ñ¢® JeıS˜Å% BßÇqUòIé,ƒ›JÀJE, —l@×­3Ä¥F¬",‰!’hzdøì}í%þî¾/ñìóÓh\ÍoEóû#~‚4¿·j¼c ØŒ„![ÀÝÀ¿C¡º®_ ±[ÏøÐ>Î>÷›Ü°ë–¶]ª«bbÛNKâç¤{ ±š†™ävB $ŒûHìºÕA^wbj­ÕÒÄ÷c5L¡u¦l[†šSXúüU¬ D wÖØqœv±#.ts2q錰QïÒ°†Ô¿ÓgNðo~™‡~ð—æ¯%ÎõPø€ßCuÖôàk¸f¼ã ØŒ„!gŸGÁ2ßÇÈú˜a yp`˜ŸÿÄ/òÏ>õKlÚ¸ šøkÈõmFkѾóÆ„õˆ„oÞi)7=Ô™Üh„*áeHºü©‡š¡êÆäaâØŠ „VDÂB-ªŠŒHÝJ]m^“;õeîšF±©ÄÖ…¹Y¾ÿðw¸ÿÛÇé3'0IÁ«¯¡âÜ A8øY?3 kÜêATƒ¶l¿šã™Nö[7ïä—é·øè½?O¹ÜÕÛc][ 7:ùz¥$쯤cì6©TSO¶JœqÛbý•)’ñ¸éKdÐ6F3Ê$å’Š¶*YÞžM7*#@¤„"Äå8½R‡ñªTT¯×yê™Çø»û¾Ä¾×_! ýËããð%àÏQMÀÏŽñÂϘ›ÑaÈ;‰»-^ÿâÝ8•Jqçíïá ¿ø[Üý®{ÈdrÃh«­I`ÅpAÓ5Ñ413Ì•TLÂ…V n.¢Ý7Ú¬vÑ ª¿*ð„Ÿ[ã1Ẕ޶ºÎHZè&mbê۱˖m#Ã}û÷ò÷÷}‰'Ÿz„Úµuó«ßBqt_67ñgÉpÍø™4`3ºÐø$WM[ )J|øç>Åç?÷/رã&\ÇŽ’Lbí‡èLdi.–í¹Ò2DJ?‘ì“`F´=ªVéRrÜ„Ì Í­ë([ÂèmÅ*”¦L»³ZVW; ¼±³ÛC7õN˲BÉ™³§øöw¿Æ~“¹ùÙk¥ù=ŠsßÖ4¿·jüL° C. \ÿŽk¤-ŽŽŒóÙ_øU>ûé_fdh,‚k^:6‰‘¶MêU‡ 7Ü&֖ܹãÃÉÀlª¦—`¬&bZ|­dË|‡ ÚíMŸ¤ÄI®¹>hψ' Ù,Ëfyyð|ýþ¿åÄÉ£À5ÓüþEó›7/þ,/\7àht¡-þ6ªô´éJ•LüìÚ±›_ýåÿš{?ô òùB¢ó{‡NL[ Ø K³›&ÅÝX•Ê굸ËuàQqîs¼ äÞŽãº_dtÐŽ˜¶¸nÙ[3 m±·§ŸO|ì³|þs¿É–Í*ñìétÑÏ“t™‚K°ùÍQ–Â5´¤ @Q33sŽFùQìÃÄÑꘪë¡,Puà™Ùó|çûøÎ÷1=sþZi~Ï¡h~ÿÄO)Íï­× ø2#aÈebÚâ­Ws,ã>ONlâ ¿ø/øùOþ"ý}ƒm´E3:…âÝWc/bÀÑÏÉܘ=„Jd€ˆv‘;{G1¸9®I†Åòµ* m³RYá±Çâ¾ûÿöÍ¢ùý)ðe~Êi~oÕ¸nÀënõbÚâø•+I[¼e÷|ñ ¿Ã=ïý0…|¾MÞUDÙæXAÒÔŒ/ ™H¨¬*uód,+°,QE-)ÃÞèC ÈäM»ø¾ÇK/?ÇWïû+^Üó̵ÒüP4¿?æBó{«Æu¾‚Ñ…¶øo_äi‹ï{ϽüÊ~‡Ûn¹32n!¤Ö2êzçíñqw#ƒH*Y(÷±&Þ–ÂP‘ ‡7Úu×b›Íy…¡ä؉ÃÜwÿ—ùÁ#¼4¿ï£ÊBOñ¢ù½Uãº_Åè -~ k -öõ òéOýŸýôÙ´q›*%ú)quÕ/8 ,ÒNp’£#j´Q)” mkÒ|¨k»ŽeiàG,{C¢dÎÏd˜/\˜á»ß»Ÿo~ç«šæ×îj_áx • ú6ï@šß[5®ðUŽ.´Å_þ{ÞÚâ/ÿÒoñ‰}†B¡5àJ¥RÈÐÓ€ e°1‰"нyÕ±TcrK'Ÿ¤Ž%¶°A˜ì´NŽ™t2D®4Ä¥¡Z­Êžü¡¦ùí‹o×@óûsà¯xÓüÞªqÝ€¯qt¡-šn‹WM[t—Ûn¹‹_úç¿ÉÍ»ßE>—#—Ë@I•ì+>žïÇR7–á)Ç)‰Â1ÛÂQðK¡Ña2!¤'bĘ04¿}{ø»¯‰gž{Sh~ß@Ñü^3/^7Ük× øM]h‹ÿ#ð \ m1Wà}ï¹—_þüo²ûÆ[q%·j`ÚEöõg$¶åê,pìG]ŒVU¢í‹‘À1Æk œ:}Œo|ó+|ïßeqqîZi~ÓüÞÒþ¹ïôqÝ€ßäÑ…¶ø»À{¹ÚâÐàŸúÄçøô§~‰¡ê:B@&ÆM9ôQÁ U;͈ HÜ?+ÈNÜ(U$ã\›…Å9¾÷ƒoño}…ÓgŽó&ÐüþµóþLÑüÞªqÝ€ £Ã­"¦-n»šã™˜s˦í|öӿ»ïú Èæròy7ÆO÷ÙpH º#hùV½GÇ6qn£Qç©ç~Äßß÷—¼öúËZ.÷ši~ŠyëÆûã× øÇ8: yʈ«¥-Ê”›â–Ýwò©}ŽÝ7ÞNO¹Gõ$N¹8…ÝññIDAT®"$8v*±‡‘ÇC`ë.‰a²ÿà^þþ_≧¡V«¾4¿?ö˜/½n¸?¾q݀߂‘0d‡vÚbúJeÜêB¡È»n¿‡ŸÿÄ/²cë.Ü”K.ŸÁu]lÛÁ¶кX&î #.°mÙœ;wšû¿ó÷<ðÐý\˜»fšß“Ä4¿\7Ü·b\7à·ptÐ?‹¢-¾‹«¤-JÒß?̇Þÿ >xÏÇظa…BŽTÊŶmÛQÐmcÄ¶í°¼²ÈÃ<À7¾ùeŽ8 \Íï AõU®ÓüÞòqÝ€ßâÑáVÓ7^é±’´Å “[ø轟æÎÛßÇÐÐ¥b0¤RiÇ!•Jãy-^zù¾zß_ñòÞç•~ôÕﺳ(ÌòŸ¢0ÌÀuÃ}«Çuþ C¾E[üe®’¶(eHÊM³yÓ.n¾éÝ|àžŸ£T,‘ɤâìÔ)¾ñ­¿å±'Þšß(¶ÐušßOx\7àŸðè -Þ‹Š?ÂÕÒeH:•å¶›ßÍ]w~þ¾~ŽØÏÃ=ÀÌ̹7ƒæ÷(¾Nó{Œëü6´ÅÏ£ú;]mѨi”Ký¤Ri.Ì¿Všß1bšßŒyñºñþäÇu~.´Å üWI[4=–®·¼€JNý1J“ ¸n¸o§q݀߆£ƒ¶x1m±ð‚¡ùý>ªºÐE[¼áMþªÓÄ4¿)óâuã}{ëüS2: y+1mqèmh~ÿ Øk^¼n¸?ãºÿ”Úâ»Q´ÅOså´EEïû=Ýï:Íï§p\7àŸÒ‘0äq·ÅõÒ÷Óü–Ì‹×÷§o\7àŸâÑ…¶ø›ÀËÅi‹çP1îŸsæ÷Ž× ø0.B[üUT UPÙäosæ÷Ž× ø4:h‹þ²ëEñtëpÝpßIãÿÛä0xoákðtEXtSoftwareAdobe ImageReadyqÉe<IEND®B`‚purrr/man/figures/lifecycle-archived.svg0000644000176200001440000000170713710503502020107 0ustar liggesusers lifecyclelifecyclearchivedarchived purrr/man/figures/lifecycle-defunct.svg0000644000176200001440000000170413710503502017747 0ustar liggesuserslifecyclelifecycledefunctdefunct purrr/man/figures/lifecycle-soft-deprecated.svg0000644000176200001440000000172613710503502021374 0ustar liggesuserslifecyclelifecyclesoft-deprecatedsoft-deprecated purrr/man/figures/lifecycle-maturing.svg0000644000176200001440000000170613710503502020147 0ustar liggesuserslifecyclelifecyclematuringmaturing purrr/man/modify.Rd0000644000176200001440000001173615166143356013777 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/modify.R \name{modify} \alias{modify} \alias{modify_if} \alias{modify_at} \alias{modify2} \alias{imodify} \title{Modify elements selectively} \usage{ modify(.x, .f, ...) modify_if(.x, .p, .f, ..., .else = NULL) modify_at(.x, .at, .f, ...) modify2(.x, .y, .f, ...) imodify(.x, .f, ...) } \arguments{ \item{.x}{A vector.} \item{.f}{A function specified in the same way as the corresponding map function.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.p}{A single predicate function, a formula describing such a predicate function, or a logical vector of the same length as \code{.x}. Alternatively, if the elements of \code{.x} are themselves lists of objects, a string indicating the name of a logical element in the inner lists. Only those elements where \code{.p} evaluates to \code{TRUE} will be modified.} \item{.else}{A function applied to elements of \code{.x} for which \code{.p} returns \code{FALSE}.} \item{.at}{A logical, integer, or character vector giving the elements to select. Alternatively, a function that takes a vector of names, and returns a logical, integer, or character vector of elements to select. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is installed, you can use \code{vars()} and tidyselect helpers to select elements.} \item{.y}{A vector, usually the same length as \code{.x}.} } \value{ An object the same class as \code{.x} } \description{ Unlike \code{\link[=map]{map()}} and its variants which always return a fixed object type (list for \code{map()}, integer vector for \code{map_int()}, etc), the \code{modify()} family always returns the same type as the input object. \itemize{ \item \code{modify()} is a shortcut for \verb{x[[i]] <- f(x[[i]]); return(x)}. \item \code{modify_if()} only modifies the elements of \code{x} that satisfy a predicate and leaves the others unchanged. \code{modify_at()} only modifies elements given by names or positions. \item \code{modify2()} modifies the elements of \code{.x} but also passes the elements of \code{.y} to \code{.f}, just like \code{\link[=map2]{map2()}}. \code{imodify()} passes the names or the indices to \code{.f} like \code{\link[=imap]{imap()}} does. \item \code{\link[=modify_in]{modify_in()}} modifies a single element in a \code{\link[=pluck]{pluck()}} location. } } \details{ Since the transformation can alter the structure of the input; it's your responsibility to ensure that the transformation produces a valid output. For example, if you're modifying a data frame, \code{.f} must preserve the length of the input. } \section{Genericity}{ \code{modify()} and variants are generic over classes that implement \code{length()}, \code{[[} and \verb{[[<-} methods. If the default implementation is not compatible for your class, you can override them with your own methods. If you implement your own \code{modify()} method, make sure it satisfies the following invariants: \if{html}{\out{
}}\preformatted{modify(x, identity) === x modify(x, compose(f, g)) === modify(x, g) |> modify(f) }\if{html}{\out{
}} These invariants are known as the functor laws (https://wiki.haskell.org/Functor#Functor_Laws) in computer science. } \examples{ # Convert factors to characters iris |> modify_if(is.factor, as.character) |> str() # Specify which columns to map with a numeric vector of positions: mtcars |> modify_at(c(1, 4, 5), as.character) |> str() # Or with a vector of names: mtcars |> modify_at(c("cyl", "am"), as.character) |> str() list(x = sample(c(TRUE, FALSE), 100, replace = TRUE), y = 1:100) |> list_transpose(simplify = FALSE) |> modify_if("x", \(l) list(x = l$x, y = l$y * 100)) |> list_transpose() # Use modify2() to map over two vectors and preserve the type of # the first one: x <- c(foo = 1L, bar = 2L) y <- c(TRUE, FALSE) modify2(x, y, \(x, cond) if (cond) x else 0L) # Use a predicate function to decide whether to map a function: modify_if(iris, is.factor, as.character) # Specify an alternative with the `.else` argument: modify_if(iris, is.factor, as.character, .else = as.integer) } \seealso{ Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{pmap}()} Other modify variants: \code{\link{map_depth}()}, \code{\link{modify_tree}()} } \concept{map variants} \concept{modify variants} purrr/man/every.Rd0000644000176200001440000000301115163460322013615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/every-some-none.R \name{every} \alias{every} \alias{some} \alias{none} \title{Do every, some, or none of the elements of a list satisfy a predicate?} \usage{ every(.x, .p, ...) some(.x, .p, ...) none(.x, .p, ...) } \arguments{ \item{.x}{A list or vector.} \item{.p}{A predicate function (i.e. a function that returns either \code{TRUE} or \code{FALSE}) specified in one of the following ways: \itemize{ \item A named function, e.g. \code{is.character}. \item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}. \item A formula, e.g. \code{~ all(.x < 0)}. Use \code{.x} to refer to the first argument. No longer recommended. }} \item{...}{Additional arguments passed on to \code{.p}.} } \value{ A logical vector of length 1. } \description{ \itemize{ \item \code{some()} returns \code{TRUE} when \code{.p} is \code{TRUE} for at least one element. \item \code{every()} returns \code{TRUE} when \code{.p} is \code{TRUE} for all elements. \item \code{none()} returns \code{TRUE} when \code{.p} is \code{FALSE} for all elements. } } \examples{ x <- list(0:10, 5.5) x |> every(is.numeric) x |> every(is.integer) x |> some(is.integer) x |> none(is.character) # Missing values are propagated: some(list(NA, FALSE), identity) # If you need to use these functions in a context where missing values are # unsafe (e.g. in `if ()` conditions), make sure to use safe predicates: if (some(list(NA, FALSE), rlang::is_true)) "foo" else "bar" } purrr/man/safely.Rd0000644000176200001440000000367515163460322013766 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-safely.R \name{safely} \alias{safely} \title{Wrap a function to capture errors} \usage{ safely(.f, otherwise = NULL, quiet = TRUE) } \arguments{ \item{.f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} \item{otherwise}{Default value to use when an error occurs.} \item{quiet}{Hide errors (\code{TRUE}, the default), or display them as they occur?} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ Creates a modified version of \code{.f} that always succeeds. It returns a list with components \code{result} and \code{error}. If the function succeeds, \code{result} contains the returned value and \code{error} is \code{NULL}. If an error occurred, \code{error} is an \code{error} object and \code{result} is either \code{NULL} or \code{otherwise}. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ safe_log <- safely(log) safe_log(10) safe_log("a") list("a", 10, 100) |> map(safe_log) |> transpose() # This is a bit easier to work with if you supply a default value # of the same type and use the simplify argument to transpose(): safe_log <- safely(log, otherwise = NA_real_) list("a", 10, 100) |> map(safe_log) |> transpose() |> simplify_all() } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{slowly}()} } \concept{adverbs} purrr/man/list_transpose.Rd0000644000176200001440000000574015063325731015552 0ustar liggesusers% 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{...}{These dots are for future extensions and must be empty.} \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 union of the names of the elements of \code{x}, or if they're not present, the union of the integer indices.} \item{simplify}{Should the result be \link[=list_simplify]{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 element.} \item{ptype}{An optional vector prototype used to control the simplification. 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 element.} } \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 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 \code{n}. It's called transpose because \code{x[["a"]][["b"]]} is equivalent to \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{ # 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() # 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 an 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")) ll |> list_transpose(template = 1) # And specify a default if you want to simplify ll |> list_transpose(template = c("x", "y", "z"), default = NA) } purrr/man/purrr_error_indexed.Rd0000644000176200001440000001203715063325731016561 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map.R \name{purrr_error_indexed} \alias{purrr_error_indexed} \title{Indexed errors (\code{purrr_error_indexed})} \description{ The \code{purrr_error_indexed} class is thrown by \code{\link[=map]{map()}}, \code{\link[=map2]{map2()}}, \code{\link[=pmap]{pmap()}}, and friends. It wraps errors thrown during the processing on individual elements with information about the location of the error. } \section{Structure}{ \code{purrr_error_indexed} has three important fields: \itemize{ \item \code{location}: the location of the error as a single integer. \item \code{name}: the name of the location as a string. If the element was not named, \code{name} will be \code{NULL} \item \code{parent}: the original error thrown by \code{.f}. } Let's see this in action by capturing the generated condition from a very simple example: \if{html}{\out{
}}\preformatted{f <- function(x) \{ rlang::abort("This is an error") \} cnd <- rlang::catch_cnd(map(c(1, 4, 2), f)) class(cnd) #> [1] "purrr_error_indexed" "rlang_error" "error" #> [4] "condition" cnd$location #> [1] 1 cnd$name #> NULL print(cnd$parent, backtrace = FALSE) #> #> Error in `.f()`: #> ! This is an error }\if{html}{\out{
}} If the input vector is named, \code{name} will be non-\code{NULL}: \if{html}{\out{
}}\preformatted{cnd <- rlang::catch_cnd(map(c(a = 1, b = 4, c = 2), f)) cnd$name #> [1] "a" }\if{html}{\out{
}} } \section{Handling errors}{ (This section assumes that you're familiar with the basics of error handling in R, as described in \href{https://adv-r.hadley.nz/conditions.html}{Advanced R}.) This error chaining is really useful when doing interactive data analysis, but it adds some extra complexity when handling errors with \code{tryCatch()} or \code{withCallingHandlers()}. Let's see what happens by adding a custom class to the error thrown by \code{f()}: \if{html}{\out{
}}\preformatted{f <- function(x) \{ rlang::abort("This is an error", class = "my_error") \} map(c(1, 4, 2, 5, 3), f) #> Error in `map()`: #> i In index: 1. #> Caused by error in `.f()`: #> ! This is an error }\if{html}{\out{
}} This doesn't change the visual display, but you might be surprised if you try to catch this error with \code{tryCatch()} or \code{withCallingHandlers()}: \if{html}{\out{
}}\preformatted{tryCatch( map(c(1, 4, 2, 5, 3), f), my_error = function(err) \{ # use NULL value if error NULL \} ) #> Error in `map()`: #> i In index: 1. #> Caused by error in `.f()`: #> ! This is an error withCallingHandlers( map(c(1, 4, 2, 5, 3), f), my_error = function(err) \{ # throw a more informative error abort("Wrapped error", parent = err) \} ) #> Error in `map()`: #> i In index: 1. #> Caused by error in `.f()`: #> ! This is an error }\if{html}{\out{
}} That's because, as described above, the error that \code{map()} throws will always have class \code{purrr_error_indexed}: \if{html}{\out{
}}\preformatted{tryCatch( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) \{ print("Hello! I am now called :)") \} ) #> [1] "Hello! I am now called :)" }\if{html}{\out{
}} In order to handle the error thrown by \code{f()}, you'll need to use \code{rlang::cnd_inherits()} on the parent error: \if{html}{\out{
}}\preformatted{tryCatch( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) \{ if (rlang::cnd_inherits(err, "my_error")) \{ NULL \} else \{ rlang::cnd_signal(err) \} \} ) #> NULL withCallingHandlers( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) \{ if (rlang::cnd_inherits(err, "my_error")) \{ abort("Wrapped error", parent = err) \} \} ) #> Error: #> ! Wrapped error #> Caused by error in `map()`: #> i In index: 1. #> Caused by error in `.f()`: #> ! This is an error }\if{html}{\out{
}} (The \code{tryCatch()} approach is suboptimal because we're no longer just handling errors, but also rethrowing them. The rethrown errors won't work correctly with (e.g.) \code{recover()} and \code{traceback()}, but we don't currently have a better approach. In the future we expect to \href{https://github.com/r-lib/rlang/issues/1534}{enhance \code{try_fetch()}} to make this easier to do 100\% correctly). Finally, if you just want to get rid of purrr's wrapper error, you can resignal the parent error: \if{html}{\out{
}}\preformatted{withCallingHandlers( map(c(1, 4, 2, 5, 3), f), purrr_error_indexed = function(err) \{ rlang::cnd_signal(err$parent) \} ) #> Error in `.f()`: #> ! This is an error }\if{html}{\out{
}} Because we are resignalling an error, it's important to use \code{withCallingHandlers()} and not \code{tryCatch()} in order to preserve the full backtrace context. That way \code{recover()}, \code{traceback()}, and related tools will continue to work correctly. } \keyword{internal} purrr/man/map.Rd0000644000176200001440000001606415163460322013254 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/map.R \name{map} \alias{map} \alias{map_lgl} \alias{map_int} \alias{map_dbl} \alias{map_chr} \alias{map_vec} \alias{walk} \title{Apply a function to each element of a vector} \usage{ map(.x, .f, ..., .progress = FALSE) map_lgl(.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, ..., .progress = FALSE) } \arguments{ \item{.x}{A list or atomic vector.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. Use \code{.x} to refer to the first argument. No longer recommended. \item A string, integer, or list, e.g. \code{"idx"}, \code{1}, or \code{list("idx", 1)} which are shorthand for \verb{\\(x) pluck(x, "idx")}, \verb{\\(x) pluck(x, 1)}, and \verb{\\(x) pluck(x, "idx", 1)} respectively. Optionally supply \code{.default} to set a default value if the indexed element is \code{NULL} or does not exist. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.progress}{Whether to show a progress bar. Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} for more 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; \code{.f()} can return anything. \item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double, 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. The return value of \code{.f()} is ignored. } Any errors thrown by \code{.f} will be wrapped in an error with class \link{purrr_error_indexed}. } \description{ The map functions transform their input by applying a function to each element of a list or atomic vector and returning an object of the same length as the input. \itemize{ \item \code{map()} always returns a list. See the \code{\link[=modify]{modify()}} family for 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). For these functions, \code{.f} must return a length-1 vector of the appropriate type. \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{walk()} calls \code{.f} for its side-effect and returns the input \code{.x}. } } \examples{ # Compute normal distributions from an atomic vector 1:10 |> map(rnorm, n = 10) # You can also use an anonymous function 1:10 |> map(\(x) rnorm(10, x)) # Simplify output to a vector instead of a list by computing the mean of the distributions 1:10 |> map(rnorm, n = 10) |> # output a list map_dbl(mean) # output an atomic vector # Using set_names() with character vectors is handy to keep track # of the original inputs: set_names(c("foo", "bar")) |> map_chr(paste0, ":suffix") # Working with lists favorite_desserts <- list(Sophia = "banana bread", Eliott = "pancakes", Karina = "chocolate cake") favorite_desserts |> map_chr(\(food) paste(food, "rocks!")) # Extract by name or position # .default specifies value for elements that are missing or NULL l1 <- list(list(a = 1L), list(a = NULL, b = 2L), list(b = 3L)) l1 |> map("a", .default = "???") l1 |> map_int("b", .default = NA) l1 |> map_int(2, .default = NA) # Supply multiple values to index deeply into a list l2 <- list( list(num = 1:3, letters[1:3]), list(num = 101:103, letters[4:6]), list() ) l2 |> map(c(2, 2)) # Use a list to build an extractor that mixes numeric indices and names, # and .default to provide a default value if the element does not exist l2 |> map(list("num", 3)) l2 |> map_int(list("num", 3), .default = NA) # Working with data frames # Use map_lgl(), map_dbl(), etc to return a vector instead of a list: mtcars |> map_dbl(sum) # A more realistic example: split a data frame into pieces, fit a # model to each piece, summarise and extract R^2 mtcars |> split(mtcars$cyl) |> map(\(df) lm(mpg ~ wt, data = df)) |> map(summary) |> map_dbl("r.squared") \dontshow{if (interactive() && rlang::is_installed("mirai") && rlang::is_installed("carrier")) withAutoprint(\{ # examplesIf} # Run in interactive sessions only as spawns additional processes # To use parallelized map: # 1. Set daemons (number of parallel processes) first: mirai::daemons(2) # 2. Wrap .f with in_parallel(): mtcars |> map_dbl(in_parallel(\(x) mean(x))) # Note that functions from packages should be fully qualified with `pkg::` # or call `library(pkg)` within the function 1:10 |> map(in_parallel(\(x) vctrs::vec_init(integer(), x))) |> map_int(in_parallel(\(x) { library(vctrs); vec_size(x) })) # A locally-defined function (or any required variables) # should be passed via ... of in_parallel(): slow_lm <- function(formula, data) { Sys.sleep(0.5) lm(formula, data) } mtcars |> split(mtcars$cyl) |> map(in_parallel(\(df) slow_lm(mpg ~ disp, data = df), slow_lm = slow_lm)) # Tear down daemons when no longer in use: mirai::daemons(0) \dontshow{\}) # examplesIf} } \seealso{ \code{\link[=map_if]{map_if()}} for applying a function to only those elements of \code{.x} that meet a specified condition. Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{modify}()}, \code{\link{pmap}()} } \concept{map variants} purrr/man/detect.Rd0000644000176200001440000000425515163460322013746 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/detect.R \name{detect} \alias{detect} \alias{detect_index} \title{Find the value or position of the first match} \usage{ detect(.x, .f, ..., .dir = c("forward", "backward"), .default = NULL) detect_index(.x, .f, ..., .dir = c("forward", "backward")) } \arguments{ \item{.x}{A list or vector.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. Use \code{.x} to refer to the first argument. No longer recommended. \item A string, integer, or list, e.g. \code{"idx"}, \code{1}, or \code{list("idx", 1)} which are shorthand for \verb{\\(x) pluck(x, "idx")}, \verb{\\(x) pluck(x, 1)}, and \verb{\\(x) pluck(x, "idx", 1)} respectively. Optionally supply \code{.default} to set a default value if the indexed element is \code{NULL} or does not exist. }} \item{...}{Additional arguments passed on to \code{.p}.} \item{.dir}{If \code{"forward"}, the default, starts at the beginning of the vector and move towards the end; if \code{"backward"}, starts at the end of the vector and moves towards the beginning.} \item{.default}{The value returned when nothing is detected.} } \value{ \code{detect} the value of the first item that matches the predicate; \code{detect_index} the position of the matching item. If not found, \code{detect} returns \code{NULL} and \code{detect_index} returns 0. } \description{ Find the value or position of the first match } \examples{ is_even <- function(x) x \%\% 2 == 0 3:10 |> detect(is_even) 3:10 |> detect_index(is_even) 3:10 |> detect(is_even, .dir = "backward") 3:10 |> detect_index(is_even, .dir = "backward") # Since `.f` is passed to as_mapper(), you can supply a pluck object: x <- list( list(1, foo = FALSE), list(2, foo = TRUE), list(3, foo = TRUE) ) detect(x, "foo") detect_index(x, "foo") # If you need to find all values, use keep(): keep(x, "foo") # If you need to find all positions, use map_lgl(): which(map_lgl(x, "foo")) } \seealso{ \code{\link[=keep]{keep()}} for keeping all matching values. } purrr/man/in_parallel.Rd0000644000176200001440000001755215163460322014764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parallelization.R \name{in_parallel} \alias{in_parallel} \alias{parallelization} \title{Parallelization in purrr} \usage{ in_parallel(.f, ...) } \arguments{ \item{.f}{A fresh formula or function. "Fresh" here means that they should be declared in the call to \code{\link[=in_parallel]{in_parallel()}}.} \item{...}{Named arguments to declare in the environment of the function.} } \value{ A 'crate' (classed function). } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} All map functions allow parallelized operation using \CRANpkg{mirai}. Wrap functions passed to the \code{.f} argument of \code{\link[=map]{map()}} and its variants with \code{\link[=in_parallel]{in_parallel()}}. \code{\link[=in_parallel]{in_parallel()}} is a \pkg{purrr} adverb that plays two roles: \itemize{ \item It is a signal to purrr verbs like \code{\link[=map]{map()}} to go ahead and perform computations in parallel. \item It helps you create self-contained functions that are isolated from your workspace. This is important because the function is packaged up (serialized) to be sent across to parallel processes. Isolation is critical for performance because it prevents accidentally sending very large objects between processes. } For maps to actually be performed in parallel, the user must also set \code{\link[mirai:daemons]{mirai::daemons()}}, otherwise they fall back to sequential processing. \code{\link[mirai:require_daemons]{mirai::require_daemons()}} may be used to enforce the use of parallel processing. See the section 'Daemons settings' below. } \section{Creating self-contained functions}{ \itemize{ \item They should call package functions with an explicit \code{::} namespace. For instance \code{ggplot()} from the ggplot2 package must be called with its namespace prefix: \code{ggplot2::ggplot()}. An alternative is to use \code{library()} within the function to attach a package to the search path, which allows subsequent use of package functions without the explicit namespace. \item They should declare any data they depend on. Declare data by supplying named arguments to \code{...}. When \code{.f} is an anonymous function to a locally-defined function of the form \verb{\\(x) fun(x)}, \code{fun} itself must be supplied to \code{...} in the manner of: \verb{in_parallel(\\(x) fun(x), fun = fun)}. \item Functions (closures) supplied to \code{...} must themselves be self-contained, as they are modified to share the same closure as the main function. This means that all helper functions and other required variables must also be supplied as further \code{...} arguments. This applies only for functions directly supplied to \code{...}: containers (such as lists) are not recursively analysed. In other words, if you supply complex objects to \code{...} you're at risk of unexpectedly including large objects. } \code{\link[=in_parallel]{in_parallel()}} is a simple wrapper of \code{\link[carrier:crate]{carrier::crate()}} and you may refer to that package for more details. Example usage: \if{html}{\out{
}}\preformatted{# The function needs to be freshly-defined, so instead of: mtcars |> map_dbl(in_parallel(sum)) # Use an anonymous function: mtcars |> map_dbl(in_parallel(\\(x) sum(x))) # Package functions need to be explicitly namespaced, so instead of: map(1:3, in_parallel(\\(x) vec_init(integer(), x))) # Use :: to namespace all package functions: map(1:3, in_parallel(\\(x) vctrs::vec_init(integer(), x))) fun <- function(x) \{ param + helper(x) \} helper <- function(x) \{ x \%\% 2 \} param <- 5 # Operating in parallel, locally-defined functions, including helper # functions and other objects required by it, will not be found: map(1:3, in_parallel(\\(x) fun(x))) # Use the ... argument to supply these objects: map(1:3, in_parallel(\\(x) fun(x), fun = fun, helper = helper, param = param)) }\if{html}{\out{
}} } \section{When to use}{ Parallelizing a map using 'n' processes does not automatically lead to it taking 1/n of the time. Additional overhead from setting up the parallel task and communicating with parallel processes eats into this benefit, and can outweigh it for very short tasks or those involving large amounts of data. The threshold at which parallelization becomes clearly beneficial will differ according to your individual setup and task, but a rough guide would be in the order of 100 microseconds to 1 millisecond for each map iteration. } \section{Daemons settings}{ How and where parallelization occurs is determined by \code{\link[mirai:daemons]{mirai::daemons()}}. This is a function from the \pkg{mirai} package that sets up daemons (persistent background processes that receive parallel computations) on your local machine or across the network. Daemons must be set prior to performing any parallel map operation, otherwise \code{\link[=in_parallel]{in_parallel()}} will fall back to sequential processing. To ensure that maps are always performed in parallel, place \code{\link[mirai:require_daemons]{mirai::require_daemons()}} before the map. It is usual to set daemons once per session. You can leave them running on your local machine as they consume almost no resources whilst waiting to receive tasks. The following sets up 6 daemons locally: \if{html}{\out{
}}\preformatted{mirai::daemons(6) }\if{html}{\out{
}} Function arguments: \itemize{ \item \code{n}: the number of daemons to launch on your local machine, e.g. \code{mirai::daemons(6)}. As a rule of thumb, for maximum efficiency this should be (at most) one less than the number of cores on your machine, leaving one core for the main R process. \item \code{url} and \code{remote}: used to set up and launch daemons for distributed computing over the network. See \code{\link[mirai:daemons]{mirai::daemons()}} documentation for more details. } Resetting daemons: Daemons persist for the duration of your session. To reset and tear down any existing daemons: \if{html}{\out{
}}\preformatted{mirai::daemons(0) }\if{html}{\out{
}} All daemons automatically terminate when your session ends. You do not need to explicitly terminate daemons in this instance, although it is still good practice to do so. Note: if you are using parallel map within a package, do not make any \code{\link[mirai:daemons]{mirai::daemons()}} calls within your package. It should always be up to the user how they wish to set up parallel processing: (i) resources are only known at run-time e.g. availability of local or remote daemons, (ii) packages should make use of existing daemons when already set, rather than reset them, and (iii) it helps prevent inadvertently spawning too many daemons when functions are used recursively within each other. } \examples{ \dontshow{if (interactive() && rlang::is_installed("mirai") && rlang::is_installed("carrier")) withAutoprint(\{ # examplesIf} # Run in interactive sessions only as spawns additional processes default_param <- 0.5 delay <- function(secs = default_param) { Sys.sleep(secs) } slow_lm <- function(formula, data) { delay() lm(formula, data) } # Example of a 'crate' returned by in_parallel(). The object print method # shows the size of the crate and any objects contained within: crate <- in_parallel( \(df) slow_lm(mpg ~ disp, data = df), slow_lm = slow_lm, delay = delay, default_param = default_param ) crate # Use mirai::mirai() to test that a crate is self-contained # by running it in a daemon and collecting its return value: mirai::mirai(crate(mtcars), crate = crate) |> mirai::collect_mirai() \dontshow{\}) # examplesIf} } \references{ \pkg{purrr}'s parallelization is powered by \CRANpkg{mirai}. See the \href{https://mirai.r-lib.org/}{mirai website} for more details. } \seealso{ \code{\link[=map]{map()}} for usage examples. } purrr/man/along.Rd0000644000176200001440000000150014326706774013602 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-along.R \name{along} \alias{along} \alias{list_along} \title{Create a list of given length} \usage{ list_along(x) } \arguments{ \item{x}{A vector.} } \value{ A list of the same length as \code{x}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 since it's not related to the core purpose of purrr. It can be useful to create an empty list that you plan to fill later. This is similar to the idea of \code{\link[=seq_along]{seq_along()}}, which creates a vector of the same length as its input. } \examples{ x <- 1:5 seq_along(x) list_along(x) } \keyword{internal} purrr/man/modify_in.Rd0000644000176200001440000000341714326706774014470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck-assign.R \name{modify_in} \alias{modify_in} \alias{assign_in} \title{Modify a pluck location} \usage{ modify_in(.x, .where, .f, ...) assign_in(x, where, value) } \arguments{ \item{.x, x}{A vector or environment} \item{.where, where}{A pluck location, as a numeric vector of positions, a character vector of names, or a list combining both. The location must exist in the data structure.} \item{.f}{A function to apply at the pluck location given by \code{.where}.} \item{...}{Arguments passed to \code{.f}.} \item{value}{A value to replace in \code{.x} at the pluck location. Use \code{zap()} to instead remove the element.} } \description{ \itemize{ \item \code{assign_in()} takes a data structure and a \link{pluck} location, assigns a value there, and returns the modified data structure. \item \code{modify_in()} applies a function to a pluck location, assigns the result back to that location with \code{\link[=assign_in]{assign_in()}}, and returns the modified data structure. } } \examples{ # Recall that pluck() returns a component of a data structure that # might be arbitrarily deep x <- list(list(bar = 1, foo = 2)) pluck(x, 1, "foo") # Use assign_in() to modify the pluck location: str(assign_in(x, list(1, "foo"), 100)) # Or zap to remove it str(assign_in(x, list(1, "foo"), zap())) # Like pluck(), this works even when the element (or its parents) don't exist pluck(x, 1, "baz") str(assign_in(x, list(2, "baz"), 100)) # modify_in() applies a function to that location and update the # element in place: modify_in(x, list(1, "foo"), \(x) x * 200) # Additional arguments are passed to the function in the ordinary way: modify_in(x, list(1, "foo"), `+`, 100) } \seealso{ \code{\link[=pluck]{pluck()}} } purrr/man/transpose.Rd0000644000176200001440000000511514334365317014517 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/superseded-transpose.R \name{transpose} \alias{transpose} \title{Transpose a list.} \usage{ transpose(.l, .names = NULL) } \arguments{ \item{.l}{A list of vectors to transpose. The first element is used as the template; you'll get a warning if a subsequent element has a different length.} \item{.names}{For efficiency, \code{transpose()} bases the return structure on the first component of \code{.l} by default. Specify \code{.names} to override this.} } \value{ A list with indexing transposed compared to \code{.l}. \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. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} \code{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]]}. This function was superseded in purrr 1.0.0 because \code{\link[=list_transpose]{list_transpose()}} has a better name and can automatically simplify the output, as is commonly needed. Superseded functions will not go away, but will only receive critical bug fixes. } \examples{ x <- map(1:5, \(i) list(x = runif(1), y = runif(5))) # was x |> 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)) # was y |> transpose() |> str() # now: y |> list_transpose() |> str() # 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() |> 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 ll <- list( list(x = 1, y = "one"), list(z = "deux", x = 2) ) 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} purrr/man/head_while.Rd0000644000176200001440000000270014326706774014576 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/head-tail.R \name{head_while} \alias{head_while} \alias{tail_while} \title{Find head/tail that all satisfies a predicate.} \usage{ head_while(.x, .p, ...) tail_while(.x, .p, ...) } \arguments{ \item{.x}{A list or atomic vector.} \item{.p}{A single predicate function, a formula describing such a predicate function, or a logical vector of the same length as \code{.x}. Alternatively, if the elements of \code{.x} are themselves lists of objects, a string indicating the name of a logical element in the inner lists. Only those elements where \code{.p} evaluates to \code{TRUE} will be modified.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} } \value{ A vector the same type as \code{.x}. } \description{ Find head/tail that all satisfies a predicate. } \examples{ pos <- function(x) x >= 0 head_while(5:-5, pos) tail_while(5:-5, negate(pos)) big <- function(x) x > 100 head_while(0:10, big) tail_while(0:10, big) } purrr/man/reduce.Rd0000644000176200001440000001116615063325731013747 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reduce.R \name{reduce} \alias{reduce} \alias{reduce2} \title{Reduce a list to a single value by iteratively applying a binary function} \usage{ reduce(.x, .f, ..., .init, .dir = c("forward", "backward")) reduce2(.x, .y, .f, ..., .init) } \arguments{ \item{.x}{A list or atomic vector.} \item{.f}{For \code{reduce()}, a 2-argument function. The function will be passed the accumulated value as the first argument and the "next" value as the second argument. For \code{reduce2()}, a 3-argument function. The function will be passed the accumulated value as the first argument, the next value of \code{.x} as the second argument, and the next value of \code{.y} as the third argument. The reduction terminates early if \code{.f} returns a value wrapped in a \code{\link[=done]{done()}}.} \item{...}{Additional arguments passed on to the reduce function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> reduce(f, 1, 2, collapse = ",") # do: x |> reduce(\\(x, y) f(x, y, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.init}{If supplied, will be used as the first value to start the accumulation, rather than using \code{.x[[1]]}. This is useful if you want to ensure that \code{reduce} returns a correct value when \code{.x} is empty. If missing, and \code{.x} is empty, will throw an error.} \item{.dir}{The direction of reduction as a string, one of \code{"forward"} (the default) or \code{"backward"}. See the section about direction below.} \item{.y}{For \code{reduce2()} an additional argument that is passed to \code{.f}. If \code{init} is not set, \code{.y} should be 1 element shorter than \code{.x}.} } \description{ \code{reduce()} is an operation that combines the elements of a vector into a single value. The combination is driven by \code{.f}, a binary function that takes two values and returns a single value: reducing \code{f} over \code{1:3} computes the value \code{f(f(1, 2), 3)}. } \section{Direction}{ When \code{.f} is an associative operation like \code{+} or \code{c()}, the direction of reduction does not matter. For instance, reducing the vector \code{1:3} with the binary function \code{+} computes the sum \code{((1 + 2) + 3)} from the left, and the same sum \code{(1 + (2 + 3))} from the right. In other cases, the direction has important consequences on the reduced value. For instance, reducing a vector with \code{list()} from the left produces a left-leaning nested list (or tree), while reducing \code{list()} from the right produces a right-leaning list. } \examples{ # Reducing `+` computes the sum of a vector while reducing `*` # computes the product: 1:3 |> reduce(`+`) 1:10 |> reduce(`*`) # By ignoring the input vector (nxt), you can turn output of one step into # the input for the next. This code takes 10 steps of a random walk: reduce(1:10, \(acc, nxt) acc + rnorm(1), .init = 0) # When the operation is associative, the direction of reduction # does not matter: reduce(1:4, `+`) reduce(1:4, `+`, .dir = "backward") # However with non-associative operations, the reduced value will # be different as a function of the direction. For instance, # `list()` will create left-leaning lists when reducing from the # right, and right-leaning lists otherwise: str(reduce(1:4, list)) str(reduce(1:4, list, .dir = "backward")) # reduce2() takes a ternary function and a second vector that is # one element smaller than the first vector: paste2 <- function(x, y, sep = ".") paste(x, y, sep = sep) letters[1:4] |> reduce(paste2) letters[1:4] |> reduce2(c("-", ".", "-"), paste2) x <- list(c(0, 1), c(2, 3), c(4, 5)) y <- list(c(6, 7), c(8, 9)) reduce2(x, y, paste) # You can shortcircuit a reduction and terminate it early by # returning a value wrapped in a done(). In the following example # we return early if the result-so-far, which is passed on the LHS, # meets a condition: paste3 <- function(out, input, sep = ".") { if (nchar(out) > 4) { return(done(out)) } paste(out, input, sep = sep) } letters |> reduce(paste3) # Here the early return branch checks the incoming inputs passed on # the RHS: paste4 <- function(out, input, sep = ".") { if (input == "j") { return(done(out)) } paste(out, input, sep = sep) } letters |> reduce(paste4) } \seealso{ \code{\link[=accumulate]{accumulate()}} for a version that returns all intermediate values of the reduction. } purrr/man/chuck.Rd0000644000176200001440000000247114326706774013607 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck.R \name{chuck} \alias{chuck} \title{Get an element deep within a nested data structure, failing if it doesn't exist} \usage{ chuck(.x, ...) } \arguments{ \item{.x}{A vector or environment} \item{...}{A list of accessors for indexing into the object. Can be an positive integer, a negative integer (to index from the right), a string (to index into names), or an accessor function (except for the assignment variants which only support names and positions). If the object being indexed is an S4 object, accessing it by name will return the corresponding slot. \link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your accessors are stored in a list, you can splice that in with \verb{!!!}.} } \description{ \code{chuck()} implements a generalised form of \code{[[} that allow you to index deeply and flexibly into data structures. If the index you are trying to access does not exist (or is \code{NULL}), it will throw (i.e. chuck) an error. } \examples{ x <- list(a = 1, b = 2) # When indexing an element that doesn't exist `[[` sometimes returns NULL: x[["y"]] # and sometimes errors: try(x[[3]]) # chuck() consistently errors: try(chuck(x, "y")) try(chuck(x, 3)) } \seealso{ \code{\link[=pluck]{pluck()}} for a quiet equivalent. } purrr/man/rbernoulli.Rd0000644000176200001440000000126414326706774014666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-utils.R \name{rbernoulli} \alias{rbernoulli} \title{Generate random sample from a Bernoulli distribution} \usage{ rbernoulli(n, p = 0.5) } \arguments{ \item{n}{Number of samples} \item{p}{Probability of getting \code{TRUE}} } \value{ A logical vector } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} This function was deprecated in purrr 1.0.0 because it's not related to the core purpose of purrr. } \examples{ rbernoulli(10) rbernoulli(100, 0.1) } \keyword{internal} purrr/man/lift.Rd0000644000176200001440000001165714350617571013447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/deprec-lift.R \name{lift} \alias{lift} \alias{lift_dl} \alias{lift_dv} \alias{lift_vl} \alias{lift_vd} \alias{lift_ld} \alias{lift_lv} \title{Lift the domain of a function} \usage{ lift(..f, ..., .unnamed = FALSE) lift_dl(..f, ..., .unnamed = FALSE) lift_dv(..f, ..., .unnamed = FALSE) lift_vl(..f, ..., .type) lift_vd(..f, ..., .type) lift_ld(..f, ...) lift_lv(..f, ...) } \arguments{ \item{..f}{A function to lift.} \item{...}{Default arguments for \code{..f}. These will be evaluated only once, when the lifting factory is called.} \item{.unnamed}{If \code{TRUE}, \code{ld} or \code{lv} will not 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 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. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} \code{lift_xy()} is a composition helper. It helps you compose functions by lifting their domain from a kind of input to another kind. The domain can be changed from and to a list (l), a vector (v) and dots (d). For example, \code{lift_ld(fun)} transforms a function taking a list to a function taking dots. The most important of those helpers is probably \code{lift_dl()} because it allows you to transform a regular function to one that takes a list. This is often essential for composition with purrr functional tools. Since this is such a common function, \code{lift()} is provided as an alias for that operation. These functions were superseded in purrr 1.0.0 because we no longer believe "lifting" to be a mainstream operation, and we are striving to reduce purrr to its most useful core. Superseded functions will not go away, but will only receive critical bug fixes. } \section{from ... to \code{list(...)} or \code{c(...)}}{ Here dots should be taken here in a figurative way. The lifted functions does not need to take dots per se. The function is simply wrapped a function in \code{\link[=do.call]{do.call()}}, so instead of taking multiple arguments, it takes a single named list or vector which will be interpreted as its arguments. This is particularly useful when you want to pass a row of a data frame or a list to a function and don't want to manually pull it apart in your function. } \section{from \code{c(...)} to \code{list(...)} or \code{...}}{ These factories allow a function taking a vector to take a list or dots instead. The lifted function internally transforms its inputs back to an atomic vector. purrr does not obey the usual R casting rules (e.g., \code{c(1, "2")} produces a character vector) and will produce an error if the types are not compatible. Additionally, you can enforce a particular vector type by supplying \code{.type}. } \section{from list(...) to c(...) or ...}{ \code{lift_ld()} turns a function that takes a list into a function that takes dots. \code{lift_vd()} does the same with a function that takes an atomic vector. These factory functions are the inverse operations of \code{lift_dl()} and \code{lift_dv()}. \code{lift_vd()} internally coerces the inputs of \code{..f} to an atomic vector. The details of this coercion can be controlled with \code{.type}. } \examples{ ### Lifting from ... to list(...) or c(...) x <- list(x = c(1:100, NA, 1000), na.rm = TRUE, trim = 0.9) lift_dl(mean)(x) # You can also use the lift() alias for this common operation: lift(mean)(x) # now: exec(mean, !!!x) # Default arguments can also be specified directly in lift_dl() list(c(1:100, NA, 1000)) |> lift_dl(mean, na.rm = TRUE)() # now: mean(c(1:100, NA, 1000), na.rm = TRUE) # lift_dl() and lift_ld() are inverse of each other. # Here we transform sum() so that it takes a list fun <- sum |> lift_dl() fun(list(3, NA, 4, na.rm = TRUE)) # now: fun <- function(x) exec("sum", !!!x) exec(sum, 3, NA, 4, na.rm = TRUE) ### Lifting from c(...) to list(...) or ... # In other situations we need the vector-valued function to take a # variable number of arguments as with pmap(). This is a job for # lift_vd(): pmap_dbl(mtcars, lift_vd(mean)) # now pmap_dbl(mtcars, \(...) mean(c(...))) ### Lifting from list(...) to c(...) or ... # This kind of lifting is sometimes needed for function # composition. An example would be to use pmap() with a function # that takes a list. In the following, we use some() on each row of # a data frame to check they each contain at least one element # satisfying a condition: mtcars |> pmap_lgl(lift_ld(some, partial(`<`, 200))) # now mtcars |> pmap_lgl(\(...) any(c(...) > 200)) } \seealso{ \code{\link[=invoke]{invoke()}} } \keyword{internal} purrr/man/pmap.Rd0000644000176200001440000001200515063325731013426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pmap.R \name{pmap} \alias{pmap} \alias{pmap_lgl} \alias{pmap_int} \alias{pmap_dbl} \alias{pmap_chr} \alias{pmap_vec} \alias{pwalk} \title{Map over multiple input simultaneously (in "parallel")} \usage{ pmap(.l, .f, ..., .progress = FALSE) pmap_lgl(.l, .f, ..., .progress = FALSE) pmap_int(.l, .f, ..., .progress = FALSE) pmap_dbl(.l, .f, ..., .progress = FALSE) pmap_chr(.l, .f, ..., .progress = FALSE) pmap_vec(.l, .f, ..., .ptype = NULL, .progress = FALSE) pwalk(.l, .f, ..., .progress = FALSE) } \arguments{ \item{.l}{A list of vectors. The length of \code{.l} determines the number of arguments that \code{.f} will be called with. Arguments will be supply by position if unnamed, and by name if named. Vectors of length 1 will be recycled to any length; all other elements must be have the same length. A data frame is an important special case of \code{.l}. It will cause \code{.f} to be called once for each row.} \item{.f}{A function, specified in one of the following ways: \itemize{ \item A named function. \item An anonymous function, e.g. \verb{\\(x, y, z) x + y / z} or \code{function(x, y, z) x + y / z} \item A formula, e.g. \code{~ ..1 + ..2 / ..3}. No longer recommended. } \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Wrap a function with \code{\link[=in_parallel]{in_parallel()}} to declare that it should be performed in parallel. See \code{\link[=in_parallel]{in_parallel()}} for more details. Use of \code{...} is not permitted in this context.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.progress}{Whether to show a progress bar. Use \code{TRUE} to turn on a basic progress bar, use a string to give it a name, or see \link{progress_bars} for more 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 maximum length of all elements of \code{.l}. The output names are determined by the names of the first element of \code{.l}. The output type is determined by the suffix: \itemize{ \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; \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 it is length 1. \item \code{pwalk()} returns the input \code{.l} (invisibly). This makes it easy to use in a pipe. The return value of \code{.f()} is ignored. } Any errors thrown by \code{.f} will be wrapped in an error with class \link{purrr_error_indexed}. } \description{ These functions are variants of \code{\link[=map]{map()}} that iterate over multiple arguments simultaneously. They are parallel in the sense that each input is processed in parallel with the others, not in the sense of multicore computing, i.e. they share the same notion of "parallel" as \code{\link[base:Extremes]{base::pmax()}} and \code{\link[base:Extremes]{base::pmin()}}. } \examples{ x <- list(1, 1, 1) y <- list(10, 20, 30) z <- list(100, 200, 300) pmap(list(x, y, z), sum) # Matching arguments by position pmap(list(x, y, z), function(first, second, third) (first + third) * second) # Matching arguments by name l <- list(a = x, b = y, c = z) pmap(l, function(c, b, a) (a + c) * b) # Vectorizing a function over multiple arguments df <- data.frame( x = c("apple", "banana", "cherry"), pattern = c("p", "n", "h"), replacement = c("P", "N", "H"), stringsAsFactors = FALSE ) pmap(df, gsub) pmap_chr(df, gsub) # Use `...` to absorb unused components of input list .l df <- data.frame( x = 1:3, y = 10:12, z = letters[1:3] ) plus <- function(x, y) x + y \dontrun{ # this won't work pmap(df, plus) } # but this will plus2 <- function(x, y, ...) x + y pmap_dbl(df, plus2) # The "p" for "parallel" in pmap() is the same as in base::pmin() # and base::pmax() df <- data.frame( x = c(1, 2, 5), y = c(5, 4, 8) ) # all produce the same result pmin(df$x, df$y) map2_dbl(df$x, df$y, min) pmap_dbl(df, min) } \seealso{ Other map variants: \code{\link{imap}()}, \code{\link{lmap}()}, \code{\link{map}()}, \code{\link{map2}()}, \code{\link{map_depth}()}, \code{\link{map_if}()}, \code{\link{modify}()} } \concept{map variants} purrr/man/accumulate.Rd0000644000176200001440000001656415063325731014632 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/reduce.R \name{accumulate} \alias{accumulate} \alias{accumulate2} \title{Accumulate intermediate results of a vector reduction} \usage{ accumulate( .x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = NA, .ptype = NULL ) accumulate2(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) } \arguments{ \item{.x}{A list or atomic vector.} \item{.f}{For \code{accumulate()} \code{.f} is 2-argument function. The function will be passed the accumulated result or initial value as the first argument. The next value in sequence is passed as the second argument. For \code{accumulate2()}, a 3-argument function. The function will be passed the accumulated result as the first argument. The next value in sequence from \code{.x} is passed as the second argument. The next value in sequence from \code{.y} is passed as the third argument. The accumulation terminates early if \code{.f} returns a value wrapped in a \code{\link[=done]{done()}}.} \item{...}{Additional arguments passed on to the mapped function. We now generally recommend against using \code{...} to pass additional (constant) arguments to \code{.f}. Instead use a shorthand anonymous function: \if{html}{\out{
}}\preformatted{# Instead of x |> map(f, 1, 2, collapse = ",") # do: x |> map(\\(x) f(x, 1, 2, collapse = ",")) }\if{html}{\out{
}} This makes it easier to understand which arguments belong to which function and will tend to yield better error messages.} \item{.init}{If supplied, will be used as the first value to start the accumulation, rather than using \code{.x[[1]]}. This is useful if you want to ensure that \code{reduce} returns a correct value when \code{.x} is empty. If missing, and \code{.x} is empty, will throw an error.} \item{.dir}{The direction of accumulation as a string, one of \code{"forward"} (the default) or \code{"backward"}. See the section about direction below.} \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{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}). If \code{.init} is set, \code{.y} needs to be one element shorted than the concatenation of the initial value and \code{.x}.} } \value{ A vector the same length of \code{.x} with the same names as \code{.x}. If \code{.init} is supplied, the length is extended by 1. If \code{.x} has names, the initial value is given the name \code{".init"}, otherwise the returned vector is kept unnamed. If \code{.dir} is \code{"forward"} (the default), the first element is the initial value (\code{.init} if supplied, or the first element of \code{.x}) and the last element is the final reduced value. In case of a right accumulation, this order is reversed. The accumulation terminates early if \code{.f} returns a value wrapped in a \code{\link[=done]{done()}}. If the done box is empty, the last value is used instead and the result is one element shorter (but always includes the initial value, even when terminating at the first iteration). } \description{ \code{accumulate()} sequentially applies a 2-argument function to elements of a vector. Each application of the function uses the initial value or result of the previous application as the first argument. The second argument is the next value of the vector. The results of each application are returned in a list. The accumulation can optionally terminate before processing the whole vector in response to a \code{done()} signal returned by the accumulation function. By contrast to \code{accumulate()}, \code{reduce()} applies a 2-argument function in the same way, but discards all results except that of the final function application. \code{accumulate2()} sequentially applies a function to elements of two lists, \code{.x} and \code{.y}. } \section{Direction}{ When \code{.f} is an associative operation like \code{+} or \code{c()}, the direction of reduction does not matter. For instance, reducing the vector \code{1:3} with the binary function \code{+} computes the sum \code{((1 + 2) + 3)} from the left, and the same sum \code{(1 + (2 + 3))} from the right. In other cases, the direction has important consequences on the reduced value. For instance, reducing a vector with \code{list()} from the left produces a left-leaning nested list (or tree), while reducing \code{list()} from the right produces a right-leaning list. } \examples{ # With an associative operation, the final value is always the # same, no matter the direction. You'll find it in the first element for a # backward (left) accumulation, and in the last element for forward # (right) one: 1:5 |> accumulate(`+`) 1:5 |> accumulate(`+`, .dir = "backward") # The final value is always equal to the equivalent reduction: 1:5 |> reduce(`+`) # It is easier to understand the details of the reduction with # `paste()`. accumulate(letters[1:5], paste, sep = ".") # Note how the intermediary reduced values are passed to the left # with a left reduction, and to the right otherwise: accumulate(letters[1:5], paste, sep = ".", .dir = "backward") # By ignoring the input vector (nxt), you can turn output of one step into # the input for the next. This code takes 10 steps of a random walk: accumulate(1:10, \(acc, nxt) acc + rnorm(1), .init = 0) # `accumulate2()` is a version of `accumulate()` that works with # 3-argument functions and one additional vector: paste2 <- function(acc, nxt, sep = ".") paste(acc, nxt, sep = sep) letters[1:4] |> accumulate(paste2) letters[1:4] |> accumulate2(c("-", ".", "-"), paste2) # You can shortcircuit an accumulation and terminate it early by # returning a value wrapped in a done(). In the following example # we return early if the result-so-far, which is passed on the LHS, # meets a condition: paste3 <- function(out, input, sep = ".") { if (nchar(out) > 4) { return(done(out)) } paste(out, input, sep = sep) } letters |> accumulate(paste3) # Note how we get twice the same value in the accumulation. That's # because we have returned it twice. To prevent this, return an empty # done box to signal to accumulate() that it should terminate with the # value of the last iteration: paste3 <- function(out, input, sep = ".") { if (nchar(out) > 4) { return(done()) } paste(out, input, sep = sep) } letters |> accumulate(paste3) # Here the early return branch checks the incoming inputs passed on # the RHS: paste4 <- function(out, input, sep = ".") { if (input == "f") { return(done()) } paste(out, input, sep = sep) } letters |> accumulate(paste4) # Simulating stochastic processes with drift \dontrun{ library(dplyr) library(ggplot2) map(1:5, \(i) rnorm(100)) |> set_names(paste0("sim", 1:5)) |> map(\(l) accumulate(l, \(acc, nxt) .05 + acc + nxt)) |> map(\(x) tibble(value = x, step = 1:100)) |> list_rbind(names_to = "simulation") |> ggplot(aes(x = step, y = value)) + geom_line(aes(color = simulation)) + ggtitle("Simulations of a random walk with drift") } } \seealso{ \code{\link[=reduce]{reduce()}} when you only need the final reduced value. } purrr/man/slowly.Rd0000644000176200001440000000322015163460322014016 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adverb-slowly.R \name{slowly} \alias{slowly} \title{Wrap a function to wait between executions} \usage{ slowly(f, rate = rate_delay(), quiet = TRUE) } \arguments{ \item{f}{A function to modify, specified in one of the following ways: \itemize{ \item A named function, e.g. \code{mean}. \item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. \item A formula, e.g. \code{~ .x + 1}. No longer recommended. }} \item{rate}{A \link[=rate-helpers]{rate} object. Defaults to a constant delay.} \item{quiet}{Hide errors (\code{TRUE}, the default), or display them as they occur?} } \value{ A function that takes the same arguments as \code{.f}, but returns a different value, as described above. } \description{ \code{slowly()} takes a function and modifies it to wait a given amount of time between each call. } \section{Adverbs}{ This function is called an adverb because it modifies the effect of a function (a verb). If you'd like to include a function created an adverb in a package, be sure to read \link{faq-adverbs-export}. } \examples{ # For these example, we first create a custom rate # with a low waiting time between attempts: rate <- rate_delay(0.1) # slowly() causes a function to sleep for a given time between calls: slow_runif <- slowly(\(x) runif(1), rate = rate, quiet = FALSE) out <- map(1:5, slow_runif) } \seealso{ Other adverbs: \code{\link{auto_browse}()}, \code{\link{compose}()}, \code{\link{insistently}()}, \code{\link{negate}()}, \code{\link{partial}()}, \code{\link{possibly}()}, \code{\link{quietly}()}, \code{\link{safely}()} } \concept{adverbs} purrr/man/list_c.Rd0000644000176200001440000000366514326706774013775 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/list-combine.R \name{list_c} \alias{list_c} \alias{list_cbind} \alias{list_rbind} \title{Combine list elements into a single data structure} \usage{ list_c(x, ..., ptype = NULL) list_cbind( x, ..., name_repair = c("unique", "universal", "check_unique"), size = NULL ) list_rbind(x, ..., names_to = rlang::zap(), ptype = NULL) } \arguments{ \item{x}{A list. For \code{list_rbind()} and \code{list_cbind()} the list must only contain only data frames or \code{NULL}.} \item{...}{These dots are for future extensions and must be empty.} \item{ptype}{An optional prototype to ensure that the output type is always the same.} \item{name_repair}{One of \code{"unique"}, \code{"universal"}, or \code{"check_unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for the meaning of these options.} \item{size}{An optional integer size to ensure that every input has the same size (i.e. number of rows).} \item{names_to}{By default, \code{names(x)} are lost. To keep them, supply a string to \code{names_to} and the names will be saved into a column with that name. If \code{names_to} is supplied and \code{x} is not named, the position of the elements will be used instead of the names.} } \description{ \itemize{ \item \code{list_c()} combines elements into a vector by concatenating them together with \code{\link[vctrs:vec_c]{vctrs::vec_c()}}. \item \code{list_rbind()} combines elements into a data frame by row-binding them together with \code{\link[vctrs:vec_bind]{vctrs::vec_rbind()}}. \item \code{list_cbind()} combines elements into a data frame by column-binding them together with \code{\link[vctrs:vec_bind]{vctrs::vec_cbind()}}. } } \examples{ x1 <- list(a = 1, b = 2, c = 3) list_c(x1) x2 <- list( a = data.frame(x = 1:2), b = data.frame(y = "a") ) list_rbind(x2) list_rbind(x2, names_to = "id") list_rbind(unname(x2), names_to = "id") list_cbind(x2) } purrr/man/rate-helpers.Rd0000644000176200001440000000300514326706774015077 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rate.R \name{rate-helpers} \alias{rate-helpers} \alias{rate_delay} \alias{rate_backoff} \alias{is_rate} \title{Create delaying rate settings} \usage{ rate_delay(pause = 1, max_times = Inf) rate_backoff( pause_base = 1, pause_cap = 60, pause_min = 1, max_times = 3, jitter = TRUE ) is_rate(x) } \arguments{ \item{pause}{Delay between attempts in seconds.} \item{max_times}{Maximum number of requests to attempt.} \item{pause_base, pause_cap}{\code{rate_backoff()} uses an exponential back-off so that each request waits \code{pause_base * 2^i} seconds, up to a maximum of \code{pause_cap} seconds.} \item{pause_min}{Minimum time to wait in the backoff; generally only necessary if you need pauses less than one second (which may not be kind to the server, use with caution!).} \item{jitter}{Whether to introduce a random jitter in the waiting time.} \item{x}{An object to test.} } \description{ These helpers create rate settings that you can pass to \code{\link[=insistently]{insistently()}} and \code{\link[=slowly]{slowly()}}. You can also use them in your own functions with \code{\link[=rate_sleep]{rate_sleep()}}. } \examples{ # A delay rate waits the same amount of time: rate <- rate_delay(0.02) for (i in 1:3) rate_sleep(rate, quiet = FALSE) # A backoff rate waits exponentially longer each time, with random # jitter by default: rate <- rate_backoff(pause_base = 0.2, pause_min = 0.005) for (i in 1:3) rate_sleep(rate, quiet = FALSE) } purrr/man/keep.Rd0000644000176200001440000000373715163460322013426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/keep.R \name{keep} \alias{keep} \alias{discard} \alias{compact} \title{Keep/discard elements based on their values} \usage{ keep(.x, .p, ...) discard(.x, .p, ...) compact(.x, .p = identity) } \arguments{ \item{.x}{A list or vector.} \item{.p}{A predicate function (i.e. a function that returns either \code{TRUE} or \code{FALSE}) specified in one of the following ways: \itemize{ \item A named function, e.g. \code{is.character}. \item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}. \item A formula, e.g. \code{~ all(.x < 0)}. Use \code{.x} to refer to the first argument. No longer recommended. }} \item{...}{Additional arguments passed on to \code{.p}.} } \description{ \code{keep()} selects all elements where \code{.p} evaluates to \code{TRUE}; \code{discard()} selects all elements where \code{.p} evaluates to \code{FALSE}. \code{compact()} discards elements where \code{.p} evaluates to an empty vector. } \details{ In other languages, \code{keep()} and \code{discard()} are often called \code{select()}/ \code{filter()} and \code{reject()}/ \code{drop()}, but those names are already taken in R. \code{keep()} is similar to \code{\link[=Filter]{Filter()}}, but the argument order is more convenient, and the evaluation of the predicate function \code{.p} is stricter. } \examples{ rep(10, 10) |> map(sample, 5) |> keep(function(x) mean(x) > 6) # Or use shorthand form rep(10, 10) |> map(sample, 5) |> keep(\(x) mean(x) > 6) # Using a string instead of a function will select all list elements # where that subelement is TRUE x <- rerun(5, a = rbernoulli(1), b = sample(10)) x x |> keep("a") x |> discard("a") # compact() discards elements that are NULL or that have length zero list(a = "a", b = NULL, c = integer(0), d = NA, e = list()) |> compact() } \seealso{ \code{\link[=keep_at]{keep_at()}}/\code{\link[=discard_at]{discard_at()}} to keep/discard elements by name. } purrr/DESCRIPTION0000644000176200001440000000274515166226231013146 0ustar liggesusersPackage: purrr Title: Functional Programming Tools Version: 1.2.2 Authors@R: c( person("Hadley", "Wickham", , "hadley@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4757-117X")), person("Lionel", "Henry", , "lionel@posit.co", role = "aut"), person("Posit Software, PBC", role = c("cph", "fnd"), comment = c(ROR = "https://ror.org/03wc8by49")) ) Description: A complete and consistent functional programming toolkit for R. License: MIT + file LICENSE URL: https://purrr.tidyverse.org/, https://github.com/tidyverse/purrr BugReports: https://github.com/tidyverse/purrr/issues Depends: R (>= 4.1) Imports: cli (>= 3.6.1), lifecycle (>= 1.0.3), magrittr (>= 1.5.0), rlang (>= 1.1.1), vctrs (>= 0.6.3) Suggests: carrier (>= 0.3.0), covr, dplyr (>= 0.7.8), httr, knitr, lubridate, mirai (>= 2.5.1), rmarkdown, testthat (>= 3.0.0), tibble, tidyselect LinkingTo: cli VignetteBuilder: knitr Biarch: true Config/build/compilation-database: true Config/Needs/website: tidyverse/tidytemplate, tidyr Config/testthat/edition: 3 Config/testthat/parallel: TRUE Encoding: UTF-8 RoxygenNote: 7.3.3 NeedsCompilation: yes Packaged: 2026-04-10 10:15:54 UTC; lionel Author: Hadley Wickham [aut, cre] (ORCID: ), Lionel Henry [aut], Posit Software, PBC [cph, fnd] (ROR: ) Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2026-04-10 17:00:09 UTC