test_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())
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.