tests/testthat/test-properties.R

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

local_edition(3)


# =============================================================================
# PROPERTY INTERFACE TESTS
# Tests for user-facing property getters/setters and their behavior
# =============================================================================

test_that("Basic property assignment works", {
  ht <- hux(1:2, 3:4)

  # Test basic assignment and retrieval
  align(ht) <- "left"
  expect_equal(align(ht), matrix("left", 2, 2), ignore_attr = TRUE)

  bold(ht) <- TRUE
  expect_equal(bold(ht), matrix(TRUE, 2, 2), ignore_attr = TRUE)

  # Test individual cell assignment
  align(ht)[1, 1] <- "right"
  expect_equal(align(ht)[1, 1], "right")
  expect_equal(align(ht)[1, 2], "left") # unchanged

  # Test table properties
  width(ht) <- 0.8
  expect_equal(width(ht), 0.8)

  # Test row/column properties
  col_width(ht) <- c(0.3, 0.7)
  expect_equal(col_width(ht), c(0.3, 0.7), ignore_attr = TRUE)

  row_height(ht) <- c(0.5, 0.5)
  expect_equal(row_height(ht), c(0.5, 0.5), ignore_attr = TRUE)
})


test_that("Can refer to properties by colnames", {
  ht <- huxtable(a = 1:5, b = letters[1:5], d = 1:5)
  number_format(ht)[1, 1] <- 3
  col_width(ht) <- c(.2, .6, .2)
  row_height(ht) <- rep(.2, 6)
  expect_equal(number_format(ht)[1, "a"], list(3))
  expect_equal(col_width(ht)["a"], .2, ignore_attr = TRUE)
})


test_that("Assignment to properties preserves colnames", {
  ht <- huxtable(a = 1:5, b = letters[1:5], d = 1:5)
  cn <- colnames(align(ht))
  align(ht) <- "right"
  expect_equal(cn, colnames(align(ht)))
  align(ht)[1, 1] <- "left"
  expect_equal(cn, colnames(align(ht)))
})


test_that("Can assign numeric to width, col_width etc. after assigning character", {
  ht <- huxtable(letters[1:3])
  width(ht) <- "300pt"
  width(ht) <- 0.5
  expect_type(width(ht), "double")
  row_height(ht) <- paste0(1:3, "em")
  row_height(ht) <- rep(1 / 3, 3)
  expect_type(row_height(ht), "double")
  number_format(ht) <- "%.3f"
  number_format(ht) <- 2L
  nf <- number_format(ht)
  expect_equal(mode(nf[1, 1][[1]]), "numeric")
  expect_equal(dim(nf), dim(ht))
})


test_that("Can set properties to NA", {
  ht <- hux(1:3, 4:6)
  # expect no error
  expect_error(caption(ht) <- NA, regexp = NA)
  expect_error(font(ht) <- NA, regexp = NA)
  expect_error(col_width(ht) <- NA, regexp = NA)
})


test_that("align, position and caption_pos change \"centre\" to \"center\"", {
  ht <- hux(1)
  align(ht) <- "centre"
  expect_equal(align(ht), matrix("center", 1, 1), ignore_attr = TRUE)

  position(ht) <- "centre"
  expect_equal(position(ht), "center")
  caption_pos(ht) <- "topcentre"
  expect_equal(caption_pos(ht), "topcenter")
  caption_pos(ht) <- "bottomcentre"
  expect_equal(caption_pos(ht), "bottomcenter")
})


# =============================================================================
# SPAN PROPERTY TESTS
# Tests for rowspan/colspan validation and behavior
# =============================================================================

test_that("rowspan and colspan error when overlapping", {
  ht <- hux(1:4, 1:4)
  rowspan(ht)[1, 2] <- 3
  expect_error(rowspan(ht)[2, 2] <- 2)
  expect_error(rowspan(ht)[3, 2] <- 2)
  expect_error(colspan(ht)[1, 1] <- 2)
  expect_error(colspan(ht)[1, 2] <- 2)
})


test_that("rowspan and colspan overwrite shadowed cell contents when set", {
  ht <- hux(1:2)
  rowspan(ht)[1, 1] <- 2
  expect_equal(ht[[2, 1]], 1)

  ht <- hux(1, 2)
  colspan(ht)[1, 1] <- 2
  expect_equal(ht[[1, 2]], 1)
})


# =============================================================================
# CONTENT PROCESSING TESTS
# Tests for content formatting and processing
# =============================================================================

test_that("na_string works", {
  ht <- hux(c(1, 2, NA), c(NA, 1, 2))
  na_string(ht) <- "foo"
  na_string(ht)[3, 1] <- "bar"
  expect_silent(cc <- huxtable:::clean_contents(ht))

  expect_match(cc[1, 2], "foo")
  expect_match(cc[3, 1], "bar")
})


test_that("Can pad with align", {
  ht <- hux(c("1.5", "2.5"))
  ht2 <- ht
  expect_silent(align(ht) <- ".")
  expect_identical(huxtable:::clean_contents(ht), huxtable:::clean_contents(ht2))
})


# =============================================================================
# DEFAULT PROPERTIES TESTS
# Tests for default property management
# =============================================================================

test_that("set_default_properties", {
  old <- set_default_properties(bold = TRUE)
  expect_equal(bold(hux(1)), matrix(TRUE, 1, 1), ignore_attr = TRUE)
  set_default_properties(old)
  expect_equal(bold(hux(1)), matrix(FALSE, 1, 1), ignore_attr = TRUE)

  expect_error(set_default_properties(unknown = 1))
})


test_that("get_default_properties", {
  expect_equal(get_default_properties("bold"), list(bold = FALSE))
  expect_error(get_default_properties("unknown"))
})


# =============================================================================
# BORDER PROCESSING TESTS
# Tests for internal border processing functions
# =============================================================================

test_that("collapsed_border_colors works", {
  ht <- hux(1:2, 3:4)
  left_border_color(ht)[1, 2] <- "pink"
  top_border_color(ht)[2, 1] <- "green"
  cbc <- huxtable:::collapsed_border_colors(ht)
  expect_type(cbc, "list")
  expect_equal(cbc$vert, matrix(c(NA, "pink", NA, NA, NA, NA), 2, 3, byrow = TRUE), ignore_attr = TRUE)
  expect_equal(cbc$horiz, matrix(c(NA, NA, "green", NA, NA, NA), 3, 2, byrow = TRUE), ignore_attr = TRUE)
  right_border_color(ht)[1, 1] <- "blue" # overrides
  bottom_border_color(ht)[1, 1] <- "purple"
  cbc <- huxtable:::collapsed_border_colors(ht)
  expect_equal(cbc$vert, matrix(c(NA, "blue", NA, NA, NA, NA), 2, 3, byrow = TRUE), ignore_attr = TRUE)
  expect_equal(cbc$horiz, matrix(c(NA, NA, "purple", NA, NA, NA), 3, 2, byrow = TRUE), ignore_attr = TRUE)
})


test_that("collapsed_border_styles works", {
  ht <- hux(1:2, 3:4)
  left_border_style(ht)[1, 2] <- "dashed"
  top_border_style(ht)[2, 1] <- "double"
  cbs <- huxtable:::collapsed_border_styles(ht)
  expect_type(cbs, "list")
  vert <- matrix("solid", 2, 3)
  vert[1, 2] <- "dashed"
  horiz <- matrix("solid", 3, 2)
  horiz[2, 1] <- "double"
  expect_equal(cbs$vert, vert, ignore_attr = TRUE)
  expect_equal(cbs$horiz, horiz, ignore_attr = TRUE)
})


# =============================================================================
# PROPERTY HELPER FUNCTION TESTS
# Tests for internal property manipulation helpers
# =============================================================================

test_that("prop_get works", {
  ht <- huxtable(a = 1:3, b = 4:6)

  expect_equal(prop_get(ht, "align"), align(ht))
  expect_equal(prop_get(ht, "bold"), bold(ht))
  expect_equal(prop_get(ht, "width"), width(ht))
})


test_that("validate_prop works", {
  # Basic validation
  expect_equal(validate_prop(c("left", "right"), "align"), c("left", "right"))

  # Check function validation
  expect_error(validate_prop(c(1, 2), "align", check_fun = is.character))
  expect_silent(validate_prop(c("left", "right"), "align", check_fun = is.character))

  # Check values validation
  expect_error(validate_prop(c("invalid"), "align", check_values = c("left", "center", "right")))
  expect_silent(validate_prop(c("left"), "align", check_values = c("left", "center", "right")))

  # NA reset
  expect_equal(validate_prop(c(NA, "left"), "align"), c("left", "left"))
  expect_equal(validate_prop(c(NA, "left"), "align", reset_na = FALSE), c(NA, "left"))
})


test_that("prop_set replaces entire property when row/col missing", {
  ht <- huxtable(a = 1:3, b = 4:6)

  # Replace entire property (old prop_replace behavior)
  ht2 <- prop_set(ht, value = "center", prop = "align")
  expect_true(all(align(ht2) == "center"))

  # With validation
  expect_error(prop_set(ht, value = 123, prop = "align", check_fun = is.character))

  # With check_values
  expect_error(prop_set(ht, value = "invalid", prop = "align", check_values = c("left", "center", "right")))
})


test_that("prop_set works", {
  ht <- huxtable(a = letters[1:3], b = letters[4:6]) # Use characters so default is "left"

  # Set specific cells
  ht2 <- prop_set(ht, "align", 1, 1, value = "center")
  expect_equal(align(ht2)[1, 1], "center")
  expect_equal(align(ht2)[2, 2], "left") # unchanged

  # Set entire table using two-argument form
  ht3 <- prop_set(ht, "align", value = "center")
  expect_true(all(align(ht3) == "center"))

  # With validation
  expect_error(prop_set(ht, "align", 1, 1, value = 123, check_fun = is.character))
})


test_that("prop_map works", {
  ht <- huxtable(a = letters[1:3], b = letters[4:6]) # Use characters so default is "left"

  # Simple mapping function
  map_fn <- function(ht, row, col, current) {
    ifelse(current == "left", "right", "left")
  }

  ht2 <- prop_set(ht, "align", 1, 1, fn = map_fn)
  expect_equal(align(ht2)[1, 1], "right")
  expect_equal(align(ht2)[2, 2], "left") # unchanged

  # Map entire table using two-argument form
  ht3 <- prop_set(ht, "align", fn = map_fn)
  expect_true(all(align(ht3) == "right"))
})


test_that("prop_set_row works", {
  ht <- huxtable(a = 1:3, b = 4:6, add_colnames = FALSE)

  # Set specific rows
  ht2 <- prop_set_row(ht, 1, 0.5, "row_height")
  expect_equal(as.numeric(row_height(ht2)[1]), 0.5) # Convert to remove names
  expect_true(is.na(row_height(ht2)[2])) # unchanged

  # Set all rows using single argument form
  ht3 <- prop_set_row(ht, 0.3, prop = "row_height")
  expect_true(all(row_height(ht3) == 0.3))
})


test_that("prop_set_col works", {
  ht <- huxtable(a = 1:3, b = 4:6, add_colnames = FALSE)

  # Set specific columns
  ht2 <- prop_set_col(ht, 1, 0.5, "col_width")
  expect_equal(as.numeric(col_width(ht2)[1]), 0.5) # Convert to remove names
  expect_true(is.na(col_width(ht2)[2])) # unchanged

  # Set all columns using single argument form
  ht3 <- prop_set_col(ht, 0.4, prop = "col_width")
  expect_true(all(col_width(ht3) == 0.4))
})


test_that("prop_set_table works", {
  ht <- huxtable(a = 1:3, b = 4:6)

  # Set table property
  ht2 <- prop_set_table(ht, 0.8, "width")
  expect_equal(width(ht2), 0.8)

  # With validation
  expect_error(prop_set_table(ht, "invalid", "width", check_fun = is.numeric))
})