tests/testthat/test-set-interface.R

In huxtable: Easily Create and Style Tables for LaTeX, HTML and Other Formats

local_edition(3)


test_that("set_* works with variables as arguments", {
  ht_orig <- hux(a = 1:2, b = 1:2, add_colnames = FALSE) # Keep clean for interface testing
  rownum <- 2
  colnum <- 1
  ht2 <- set_bold(ht_orig, rownum, colnum, TRUE)
  expect_equal(bold(ht2), matrix(c(FALSE, TRUE, FALSE, FALSE), 2, 2), ignore_attr = TRUE)
  boldness <- TRUE
  ht3 <- set_bold(ht_orig, 1:2, 1:2, boldness)
  expect_equal(bold(ht3), matrix(TRUE, 2, 2), ignore_attr = TRUE)
})


test_that("set_* works with logical arguments", {
  ht <- hux(a = 1:2, b = 1:2, add_colnames = FALSE) # Keep clean for interface testing

  ht2 <- set_bold(ht, 1:2, c(TRUE, FALSE))
  expect_equal(bold(ht2), matrix(c(TRUE, TRUE, FALSE, FALSE), 2, 2), ignore_attr = TRUE)
  ht3 <- set_bold(ht, c(TRUE, FALSE), 1:2)
  expect_equal(bold(ht3), matrix(c(TRUE, FALSE, TRUE, FALSE), 2, 2), ignore_attr = TRUE)
  ht4 <- set_bold(ht, c(TRUE, FALSE), c(TRUE, FALSE))
  expect_equal(bold(ht4), matrix(c(TRUE, FALSE, FALSE, FALSE), 2, 2), ignore_attr = TRUE)
})


test_that("set_* works with cell functions", {
  ht <- hux(a = 1:4, b = 1:4, add_colnames = FALSE) # Keep clean for interface testing
  ht <- set_font(ht, evens, 1:2, "times")
  ht <- set_font(ht, odds, 1:2, "palatino")
  expect_equal(font(ht), matrix(c("palatino", "times"), 4, 2), ignore_attr = TRUE)
  ht <- hux(a = 1:4, b = 1:4, add_colnames = FALSE) # Keep clean for interface testing
  ht <- set_font(ht, stripe(1), evens, "times")
  ht <- set_font(ht, stripe(1), odds, "palatino")
  expect_equal(font(ht), matrix(c("palatino", "times"), 4, 2, byrow = TRUE), ignore_attr = TRUE)
  ht <- hux(a = 1:4, b = 1:4, add_colnames = FALSE) # Keep clean for interface testing
  ht <- set_font(ht, stripe(3, from = 1), stripe(1), "times")
  expect_equal(font(ht), matrix(c("times", NA, NA, "times"), 4, 2), ignore_attr = TRUE)
})


test_that("set_* works with row and column functions", {
  ht <- hux(a = 1:4, b = 1:4, add_colnames = FALSE) # Keep clean for interface testing
  ht <- set_col_width(ht, evens, "20pt")
  ht <- set_col_width(ht, odds, "40pt")
  ht <- set_row_height(ht, evens, "15pt")
  ht <- set_row_height(ht, odds, "30pt")
  expect_equal(as.vector(col_width(ht)), c("40pt", "20pt"))
  expect_equal(as.vector(row_height(ht)), rep(c("30pt", "15pt"), 2))
})


test_that("set_*: 2 argument form", {
  ht <- hux(a = c(1, 0), b = c(0, 1), add_colnames = FALSE) # Keep clean for interface testing
  ht2 <- set_font(ht, "times")
  expect_equal(font(ht2), matrix("times", 2, 2), ignore_attr = TRUE)
  ht3 <- set_font(ht, value = "times")
  expect_equal(font(ht3), matrix("times", 2, 2), ignore_attr = TRUE)

  ht4 <- set_col_width(ht, c(.6, .4))
  expect_equal(as.vector(col_width(ht4)), c(.6, .4))
  ht5 <- set_row_height(ht, c(.6, .4))
  expect_equal(as.vector(row_height(ht5)), c(.6, .4))
})


test_that("set_* works with row and col 'empty'", {
  ht_orig <- hux(a = c(1, 0), b = c(0, 1), add_colnames = FALSE)
  ht2 <- set_font(ht_orig, 1, everywhere, "times")
  expect_equal(font(ht2), matrix(c("times", NA), 2, 2), ignore_attr = TRUE)
  ht3 <- set_font(ht_orig, everywhere, 1, "times")
  expect_equal(font(ht3), matrix(c("times", "times", NA, NA), 2, 2), ignore_attr = TRUE)
  ht4 <- set_font(ht_orig, "times")
  expect_equal(font(ht4), matrix("times", 2, 2), ignore_attr = TRUE)
})


test_that("set_* default arguments", {
  ht <- hux(a = 1, add_colnames = FALSE) # Keep clean for interface testing
  expect_silent(ht1 <- set_bold(ht))
  expect_equal(bold(ht1), matrix(TRUE, 1, 1), ignore_attr = TRUE)
  expect_silent(ht2 <- set_bold(ht, 1, 1))
  expect_equal(bold(ht1), matrix(TRUE, 1, 1), ignore_attr = TRUE)
  expect_silent(ht3 <- set_italic(ht))
  expect_equal(italic(ht3), matrix(TRUE, 1, 1), ignore_attr = TRUE)
})


test_that("set_contents works", {
  ht <- hux(1:3, 1:3, add_colnames = FALSE)

  expect_equal(as.matrix(set_contents(ht, 1:6)), as.matrix(hux(1:3, 4:6, add_colnames = FALSE)))
  expect_equal(as.matrix(set_contents(ht, 1, 1, 0)), as.matrix(hux(c(0, 2:3), 1:3, add_colnames = FALSE)))
  expect_equal(as.matrix(set_contents(ht, 1, 1, 0)), as.matrix(hux(c(0, 2:3), 1:3, add_colnames = FALSE)))
  expect_equal(as.matrix(set_contents(ht, 2:3, 2, 3:2)), as.matrix(hux(1:3, c(1, 3, 2), add_colnames = FALSE)))

  ht <- hux(a = 1:3, b = 1:3, add_colnames = FALSE)
  align(ht) <- "right"
  test_props_same <- function(ht2) expect_equal(align(ht2), align(ht), ignore_attr = TRUE)
  test_props_same(set_contents(ht, 1:6))
  test_props_same(set_contents(ht, 1, 1, 0))
  test_props_same(set_contents(ht, 1, 1, 0))
  test_props_same(set_contents(ht, 2:3, 2, 3:2))

  expect_equal(set_contents(ht, 1, "a", 0), set_contents(ht, 1, 1, 0))
  # dplyr::matches not testthat::matches
  skip_if_not_installed("dplyr")
  expect_equal(set_contents(ht, 1, dplyr::matches("b"), 0), set_contents(ht, 1, 2, 0))
})