tests/testthat/test-factor.R

In vroom: Read and Write Rectangular Text Data Quickly

test_that("strings mapped to levels", {
  test_vroom("a\nb\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b"))),
    equals = tibble::tibble(X1 = factor(c("a", "b")))
  )
})

test_that("can generate ordered factor", {
  res <- test_vroom("a\nb\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b"), ordered = TRUE)),
    equals = tibble::tibble(X1 = ordered(c("a", "b")))
  )

  expect_true(is.ordered(res$X1))
})

test_that("NA if value not in levels", {
  test_vroom("a\nb\nc\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b"))),
    equals = tibble::tibble(X1 = factor(c("a", "b", NA)))
  )
})

test_that("NAs silently passed along", {
  test_vroom("a\nb\nNA\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b"), include_na = FALSE)),
    equals = tibble::tibble(X1 = factor(c("a", "b", NA)))
  )
})

test_that("levels = NULL", {
  test_vroom("a\nb\nc\nb\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = NULL)),
    equals = tibble::tibble(X1 = factor(c("a", "b", "c", "b")))
  )
})

test_that("levels = NULL orders by data", {
  test_vroom("b\na\nc\nb\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = NULL)),
    equals = tibble::tibble(X1 = factor(c("b", "a", "c", "b"), levels = c("b", "a", "c")))
  )
})

test_that("levels = NULL is the default", {
  test_vroom("a\nb\nc\nd\n", col_names = FALSE,
    col_types = list(X1 = "f"),
    equals = tibble::tibble(X1 = factor(c("a", "b", "c", "d")))
  )
})

test_that("NAs included in levels if desired", {
  test_vroom("NA\nb\na\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b", NA))),
    equals = tibble::tibble(X1 = factor(c(NA, "b", "a"), levels = c("a", "b", NA), exclude = NULL))
  )

  test_vroom("NA\nb\na\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("a", "b", NA), include_na = TRUE)),
    equals = tibble::tibble(X1 = factor(c(NA, "b", "a"), levels = c("a", "b", NA), exclude = NULL))
  )

  test_vroom("NA\nb\na\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = NULL, include_na = FALSE)),
    equals = tibble::tibble(X1 = factor(c(NA, "b", "a"), levels = c("b", "a")))
  )

  test_vroom("NA\nb\na\n", col_names = FALSE,
    col_types = list(X1 = col_factor(levels = NULL, include_na = TRUE)),
    equals = tibble::tibble(X1 = factor(c(NA, "b", "a"), levels = c(NA, "b", "a"), exclude = NULL))
  )
})

test_that("Factors handle encodings properly (#615)", {
  encoded <- function(x, encoding) {
    Encoding(x) <- encoding
    x
  }
  f <- tempfile()
  on.exit(unlink(f))
  writeBin(charToRaw(encoded("test\nA\n\xC4\n", "latin1")), f)
  x <- test_vroom(f,
    delim = ",",
    col_types = cols(col_factor(c("A", "\uC4"))),
    locale = locale(encoding = "latin1"),
    equals = tibble::tibble(test = factor(c("A", "\uC4"), levels = c("A", "\uC4")))
  )
})

test_that("factors parse like factor if trim_ws = FALSE", {
  test_vroom("a\na \n", col_names = FALSE, trim_ws = FALSE,
    col_types = list(X1 = col_factor(levels = "a")),
    equals = tibble::tibble(X1 = factor(c("a", "a "), levels = c("a")))
  )
  test_vroom("a\na \n", col_names = FALSE, trim_ws = FALSE,
    col_types = list(X1 = col_factor(levels = "a ")),
    equals = tibble::tibble(X1 = factor(c("a", "a "), levels = c("a ")))
  )
  test_vroom("a\na \n", col_names = FALSE, trim_ws = FALSE,
    col_types = list(X1 = col_factor(levels = c("a ", "a"))),
    equals = tibble::tibble(X1 = factor(c("a", "a "), levels = c("a ", "a")))
  )
})

test_that("Can parse a factor with levels of NA and empty string", {
  x <- c("NC", "NC", "NC", "", "", "NB", "NA", "", "", "NB", "NA",
    "NA", "NC", "NB", "NB", "NC", "NB", "NA", "NA")

  x_in <- paste0(paste(x, collapse = "\n"), "\n")

  test_vroom(x_in, col_names = FALSE,
    col_types = list(X1 = col_factor(levels = c("NA", "NB", "NC", ""))),
    na = character(),
    skip_empty_rows = FALSE,
    equals = tibble::tibble(X1 = factor(x, levels = c("NA", "NB", "NC", "")))
  )
})


test_that("encodings are respected", {
  loc <- locale(encoding = "ISO-8859-1")
  expected <- c("fran\u00e7ais", "\u00e9l\u00e8ve")

  x <- vroom(test_path("enc-iso-8859-1.txt"), delim = "\n", locale = loc, col_types = c(X1 = "f"), col_names = FALSE)
  expect_equal(x[[1]], factor(expected, levels = expected))

  y <- vroom(
    test_path("enc-iso-8859-1.txt"),
    delim = "\n",
    locale = loc,
    col_types = list(X1 = col_factor(levels = expected)),
    col_names = FALSE
  )

  expect_equal(y[[1]], factor(expected, levels = expected))
})

test_that("Results are correct with backslash escapes", {
  obj <- vroom(I("A,T\nB,F\n"), col_names = FALSE, col_types = list("f", "f"), escape_backslash = TRUE)
  exp <- tibble::tibble(X1 = factor(c("A", "B")), X2 = factor(c("T", "F"), levels = c("T", "F")))
  expect_equal(obj, exp)

  obj2 <- vroom(I("A,T\nB,F\n"), col_names = FALSE, col_types = list("f", "f"), escape_backslash = FALSE)
  expect_equal(obj2, exp)
})


test_that("subsetting works with both double and integer indexes", {
  x <- vroom(I("X1\nfoo"), delim = ",", col_types = "f")
  expect_equal(x$X1[1L], factor("foo"))
  expect_equal(x$X1[1], factor("foo"))
  expect_equal(x$X1[NA_integer_], factor(NA_character_, levels = "foo"))
  expect_equal(x$X1[NA_real_], factor(NA_character_, levels = "foo"))
})

test_that("results are correct even with quoted values", {
  expect_equal(
    vroom(I('day\n"Sun"\n"Sat"\n"Sat"'), altrep = FALSE, col_types = "f", delim = ",")$day,
    factor(c("Sun", "Sat", "Sat"), levels = c("Sun", "Sat"))
  )
})

test_that("NAs are correctly encoded and not included in levels unless desired", {
  test_vroom("X\nunknown\nb\na\n",
    col_types = list(X = col_factor(levels = NULL, include_na = FALSE)),
    na = "unknown",
    equals = tibble::tibble(X = factor(c(NA, "b", "a"), levels = c("b", "a"), exclude = NULL))
  )
  test_vroom("X\nunknown\nb\na\nmissing\n",
    col_types = list(X = col_factor(levels = NULL, include_na = FALSE)),
    na = c("unknown", "missing"),
    equals = tibble::tibble(X = factor(c(NA, "b", "a", NA), levels = c("b", "a"), exclude = NULL))
  )
  test_vroom("X\nunknown\nb\na\n",
    col_types = list(X = col_factor(levels = NULL, include_na = TRUE)),
    na = "unknown",
    equals = tibble::tibble(X = factor(c(NA, "b", "a"), levels = c(NA, "b", "a"), exclude = NULL))
  )
  test_vroom("X\nunknown\nb\na\nmissing\n",
    col_types = list(X = col_factor(levels = NULL, include_na = TRUE)),
    na = c("unknown", "missing"),
    equals = tibble::tibble(X = factor(c(NA, "b", "a", NA), levels = c(NA, "b", "a"), exclude = NULL))
  )
})