tests/testthat/test-pmap.R

In purrr: Functional Programming Tools

test_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)))
})