tests/testthat/test-tribble.R

In tibble: Simple Data Frames

test_that("tribble() constructs 'tibble' as expected", {
  result <- tribble(
    ~colA, ~colB,
    "a", 1,
    "b", 2
  )

  compared <- tibble(colA = c("a", "b"), colB = c(1, 2))
  expect_equal(result, compared)

  ## wide
  wide <- tribble(
    ~colA, ~colB, ~colC, ~colD,
    1, 2, 3, 4,
    5, 6, 7, 8
  )

  wide_expectation <- tibble(
    colA = c(1, 5),
    colB = c(2, 6),
    colC = c(3, 7),
    colD = c(4, 8)
  )

  expect_equal(wide, wide_expectation)

  ## long
  long <- tribble(
    ~colA, ~colB,
    1, 6,
    2, 7,
    3, 8,
    4, 9,
    5, 10
  )

  long_expectation <- tibble(
    colA = as.numeric(1:5),
    colB = as.numeric(6:10)
  )

  expect_equal(long, long_expectation)
})

test_that("tribble() tolerates a trailing comma", {
  result <- tribble(
    ~colA, ~colB,
    "a", 1,
    "b", 2,
  )

  compared <- tibble(colA = c("a", "b"), colB = c(1, 2))
  expect_equal(result, compared)
})

test_that("tribble() handles columns with a class (#161)", {
  sys_date <- Sys.Date()
  sys_time <- Sys.time()
  date_time_col <- tribble(
    ~dt, ~dttm,
    sys_date, sys_time,
    as.Date("2003-01-02"), as.POSIXct("2004-04-05 13:45:17", tz = "UTC")
  )

  date_time_col_expectation <- tibble(
    dt = vec_c(sys_date, as.Date("2003-01-02")),
    dttm = vec_c(sys_time, as.POSIXct("2004-04-05 13:45:17", tz = "UTC"))
  )

  expect_equal(date_time_col, date_time_col_expectation)
})

test_that("tribble() creates lists for non-atomic inputs (#7)", {
  expect_identical(
    tribble(~a, ~b, NA, "A", letters, LETTERS[-1L]),
    tibble(a = list(NA, letters), b = list("A", LETTERS[-1L]))
  )

  expect_identical(
    tribble(~a, ~b, NA, NULL, 1, 2),
    tibble(a = c(NA, 1), b = list(NULL, 2))
  )
})

test_that("tribble() errs appropriately on bad calls", {
  # no colname
  expect_tibble_abort(
    tribble(1, 2, 3),
    abort_tribble_needs_columns()
  )

  # invalid colname syntax
  expect_tibble_abort(
    tribble(a ~ b),
    abort_tribble_lhs_column_syntax(quote(a))
  )

  # invalid colname syntax
  expect_tibble_abort(
    tribble(~ a + b),
    abort_tribble_rhs_column_syntax(quote(a + b))
  )

  # tribble() must be passed colnames
  expect_tibble_abort(
    tribble(
      "a", "b",
      1, 2
    ),
    abort_tribble_needs_columns()
  )

  # tribble() must produce rectangular structure (no filling)
  expect_tibble_abort(
    tribble(
      ~a, ~b, ~c,
      1, 2,
      3, 4, 5
    ),
    abort_tribble_non_rectangular(3, 5)
  )

  expect_tibble_abort(
    tribble(
      ~a, ~b, ~c, ~d,
      1, 2, 3, 4, 5,
      6, 7, 8, 9,
    ),
    abort_tribble_non_rectangular(4, 9)
  )
})

test_that("tribble can have list columns", {
  df <- tribble(
    ~x, ~y,
    1, list(a = 1),
    2, list(b = 2)
  )
  expect_equal(df$x, c(1, 2))
  expect_equal(df$y, list(list(a = 1), list(b = 2)))
})

test_that("tribble creates n-col empty data frame", {
  df <- tribble(~x, ~y)
  expect_equal(df, tibble(x = unspecified(), y = unspecified()))
})

test_that("tribble recognizes quoted non-formula call", {
  df <- tribble(
    ~x, ~y,
    quote(mean(1)), 1
  )
  expect_equal(df$x, list(quote(mean(1))))
  expect_equal(df$y, 1)
})

test_that("tribble returns 0x0 tibble when there's no argument", {
  df <- tribble()
  expect_equal(df, tibble())
})

test_that("names stripped at appropriate time (#775)", {
  expect_equal(
    tribble(~x, c(a = 1)),
    tibble(x = 1)
  )
})

test_that("lubridate::Period (#784)", {
  skip_if_not_installed("lubridate")
  expect_equal(
    tribble(~x, lubridate::days(1), lubridate::days(2)),
    tibble(x = lubridate::days(1:2))
  )
})

test_that("formattable (#785)", {
  skip_if_not_installed("formattable")
  expect_equal(
    tribble(~x, formattable::formattable(1.0, 1), formattable::formattable(2.0, 1)),
    tibble(x = formattable::formattable(1:2 + 0, 1))
  )
})

# ---- frame_matrix() ----

test_that("frame_matrix constructs a matrix as expected", {
  result <- frame_matrix(
    ~col1, ~col2,
    10, 3,
    5, 2
  )
  expected <- matrix(c(10, 5, 3, 2), ncol = 2)
  colnames(expected) <- c("col1", "col2")
  expect_equal(result, expected)
})

test_that("frame_matrix constructs empty matrix as expected", {
  result <- frame_matrix(
    ~col1, ~col2
  )
  expected <- matrix(logical(), ncol = 2)
  colnames(expected) <- c("col1", "col2")
  expect_equal(result, expected)
})

test_that("frame_matrix cannot have list columns", {
  expect_tibble_abort(
    frame_matrix(
      ~x,   ~y,
      "a", 1:3,
      "b", 4:6
    ),
    abort_frame_matrix_list(c(2, 4))
  )
})

test_that("tribble and frame_matrix cannot have named arguments", {
  expect_tibble_abort(
    extract_frame_data_from_dots(
      ~x, ~y,
      "a" = 1:3,
      "b" = 4:6
    ),
    abort_tribble_named_after_tilde()
  )
})

test_that("output test", {
  expect_snapshot(error = TRUE, {
    tribble(1)
    tribble(~a, ~b, 1)
    tribble(a ~ b, 1)
    tribble(a ~ b + c, 1)
    tribble(~b, 1, "a")

    frame_matrix(1)
    frame_matrix(~a, list(1))
  })
})