tests/testthat/test-nth-value.R

In dplyr: A Grammar of Data Manipulation

# ------------------------------------------------------------------------------
# nth()

test_that("nth works with lists and uses `vec_slice2()` to return elements (#6331)", {
  # We'd like to use `vec_slice()` everywhere, but it breaks too many revdeps
  # that rely on `nth(<list>)` returning list elements
  x <- list(1, 2, 3:5)

  expect_equal(nth(x, 1), 1)
  expect_equal(nth(x, 3), 3:5)
})

test_that("nth `default` for lists defaults to `NULL` since it uses `vec_slice2()`", {
  expect_null(nth(list(1), 2))
  expect_null(nth(list(), 1))
})

test_that("nth `default` for lists can be anything", {
  # Because list elements can be anything
  x <- list(1, 2)

  default <- environment()
  expect_identical(nth(x, 3, default = default), default)

  default <- 1:3
  expect_identical(nth(x, 3, default = default), default)
})

test_that("nth treats list-of like lists", {
  x <- list_of(1, 2, c(3, 4))

  expect_identical(nth(x, 3), c(3, 4))
  expect_identical(nth(x, 4), NULL)

  # Not particularly strict about `default` here,
  # even though `list_of()` elements are typed
  expect_identical(nth(x, 4, default = "x"), "x")
})

test_that("nth works with data frames and always returns a single row", {
  x <- tibble(x = 1:3, y = 4:6)

  expect_identical(nth(x, 1), tibble(x = 1L, y = 4L))
  expect_identical(nth(x, 4), tibble(x = NA_integer_, y = NA_integer_))
  expect_identical(nth(x, 4, default = tibble(x = 0, y = 0)), tibble(x = 0L, y = 0L))
})

test_that("nth works with rcrds", {
  x <- new_rcrd(list(x = 1:3, y = 4:6))

  expect_identical(nth(x, 1), vec_slice(x, 1))
  expect_identical(nth(x, 4), vec_init(x))
  expect_identical(nth(x, 4, default = x[2]), x[2])
})

test_that("drops names, because it uses `vec_slice2()`", {
  x <- c(a = 1, b = 2)
  expect_named(nth(x, 2), NULL)
})

test_that("negative values index from end", {
  x <- 1:5

  expect_equal(nth(x, -1), 5L)
  expect_equal(nth(x, -3), 3L)
})

test_that("indexing past ends returns default value", {
  expect_equal(nth(1:4, 5), NA_integer_)
  expect_equal(nth(1:4, -5), NA_integer_)
  expect_equal(nth(1:4, -10), NA_integer_)
  expect_equal(nth(1:4, -10, default = 6L), 6L)
})

test_that("gets corner case indexing correct", {
  expect_identical(nth(1:4, -5), NA_integer_)
  expect_identical(nth(1:4, -4), 1L)
  expect_identical(nth(1:4, -3), 2L)

  expect_identical(nth(1:4, -1), 4L)
  expect_identical(nth(1:4, 0), NA_integer_)
  expect_identical(nth(1:4, 1), 1L)

  expect_identical(nth(1:4, 3), 3L)
  expect_identical(nth(1:4, 4), 4L)
  expect_identical(nth(1:4, 5), NA_integer_)
})

test_that("`order_by` can be used to alter the order", {
  expect_identical(nth(1:5, n = 1L, order_by = 5:1), 5L)
  expect_identical(nth(as.list(1:5), n = 1L, order_by = 5:1), 5L)
})

test_that("can use a data frame as `order_by`", {
  x <- 1:3
  order_by <- tibble(a = c(1, 1, 2), b = c(2, 1, 0))

  expect_identical(nth(x, 1, order_by = order_by), 2L)
  expect_identical(nth(x, 2, order_by = order_by), 1L)
})

test_that("`na_rm` can be used to drop missings before selecting the value (#6242)", {
  x <- c(NA, 4, 10, NA, 5, NA)

  expect_identical(nth(x, 1, na_rm = TRUE), 4)
  expect_identical(nth(x, -1, na_rm = TRUE), 5)
  expect_identical(nth(x, 3, na_rm = TRUE), 5)
})

test_that("`na_rm` removes `NULL` list elements", {
  x <- list(1:3, NULL, 4, integer(), NULL, NULL)

  expect_identical(nth(x, 2, na_rm = TRUE), 4)
  expect_identical(nth(x, -1, na_rm = TRUE), integer())
})

test_that("`na_rm` can generate OOB selections, resulting in `default`", {
  # Removes some values
  x <- c(NA, FALSE, NA)
  expect_identical(nth(x, 2, default = TRUE, na_rm = TRUE), TRUE)

  # Removes everything
  x <- c(NA, NA, NA)
  expect_identical(nth(x, 1, default = TRUE, na_rm = TRUE), TRUE)
  expect_identical(nth(x, -2, default = TRUE, na_rm = TRUE), TRUE)
})

test_that("`na_rm` slices `order_by` as well", {
  x <- c(NA, 4, 10, NA, 5, NA)
  o <- c(2, 1, 3, 1, 1, 0)

  expect_identical(nth(x, 1, order_by = o, na_rm = TRUE), 4)
  expect_identical(nth(x, -1, order_by = o, na_rm = TRUE), 10)
  expect_identical(nth(x, 2, order_by = o, na_rm = TRUE), 5)
  expect_identical(nth(x, 3, order_by = o, na_rm = TRUE), 10)
})

test_that("`na_rm` is validated", {
  expect_snapshot(error = TRUE, {
    nth(1, 1, na_rm = 1)
  })
  expect_snapshot(error = TRUE, {
    nth(1, 1, na_rm = c(TRUE, FALSE))
  })
})

test_that("`default` must be size 1 (when not used with lists)", {
  expect_snapshot(error = TRUE, {
    nth(1L, n = 2L, default = 1:2)
  })
})

test_that("`default` is cast to the type of `x` (when not used with lists)", {
  expect_snapshot(error = TRUE, {
    nth("x", 2, default = 2)
  })
})

test_that("`n` is validated (#5466)", {
  expect_snapshot(error = TRUE, {
    nth(1:10, n = "x")
  })
  expect_snapshot(error = TRUE, {
    nth(1:10, n = 1:2)
  })
  expect_snapshot(error = TRUE, {
    nth(1:10, n = NA_integer_)
  })
})

test_that("`x` must be a vector", {
  expect_snapshot(error = TRUE, {
    nth(environment(), 1L)
  })
})

test_that("`order_by` must be the same size as `x`", {
  expect_snapshot(error = TRUE, {
    nth(1:5, n = 1L, order_by = 1:2)
  })

  # Ensure that this is checked before `default` is early returned
  expect_snapshot(error = TRUE, {
    nth(1:5, n = 6L, order_by = 1:2)
  })
})

# ------------------------------------------------------------------------------
# first()

test_that("`first()` selects the first value", {
  expect_identical(first(1:5), 1L)
})

test_that("`first()` uses default value for 0 length vectors", {
  expect_equal(first(logical()), NA)
  expect_equal(first(integer()), NA_integer_)
  expect_equal(first(numeric()), NA_real_)
  expect_equal(first(character()), NA_character_)
})

test_that("`first()` uses `NULL` default for 0 length lists", {
  expect_identical(first(list()), NULL)
})

test_that("`first()` uses default value for 0 length augmented vectors", {
  fc <- factor("a")[0]
  dt <- Sys.Date()[0]
  tm <- Sys.time()[0]

  expect_equal(first(fc), vec_init(fc))
  expect_equal(first(dt), vec_init(dt))
  expect_equal(first(tm), vec_init(tm))
})

test_that("`first()` returns list elements", {
  expect_identical(first(list(2:3, 4:5)), 2:3)
})

test_that("`first()` respects `na_rm`", {
  x <- c(NA, NA, 2, 3)
  expect_identical(first(x, na_rm = TRUE), 2)
})

# ------------------------------------------------------------------------------
# last()

test_that("`last()` selects the last value", {
  expect_identical(last(1:5), 5L)
})

test_that("`last()` returns list elements", {
  expect_identical(last(list(2:3, 4:5)), 4:5)
})

test_that("`last()` respects `na_rm`", {
  x <- c(2, 3, NA, NA)
  expect_identical(last(x, na_rm = TRUE), 3)
})