test-new-borders.R
In huxtable: Easily Create and Style Tables for LaTeX, HTML and Other Formats

local_edition(2)


test_that("brdr objects", {
  expect_silent(b <- brdr(1, "solid", "red"))
  expect_s3_class(b, "brdr")
  expect_true(is_brdr(b))
  expect_true(is_borderish(b))
  expect_true(is_borderish(1))
  expect_false(is_borderish(-1))

  expect_silent(b <- brdr())
  expect_equivalent(b$thickness, 0.4)
  expect_equivalent(b$style, "solid")
  expect_equivalent(b$color, NA_character_)
})


test_that("brdr object printing", {
  expect_silent(b <- brdr(2, "solid", "red"))
  expect_match(format(b), "2.*solid.*red")
  expect_output(print(b), "2.*solid.*red")
})



test_that("left_border", {
  ht <- hux(1:3, 1:3)
  expect_s3_class(left_border(ht), "brdr")
})


test_that("left_border(ht) <- number", {
  ht <- hux(1:3, 1:3)
  expect_silent(left_border(ht) <- 1)
  expect_equivalent(brdr_thickness(left_border(ht)), matrix(1, 3, 2))
  expect_equivalent(brdr_thickness(left_border(ht))[1, 1], 1)
})


test_that("left_border(ht) <- brdr(...)", {
  ht <- hux(1:3, 1:3)
  expect_silent(left_border(ht) <- brdr(1, "double", "red"))
  expect_equivalent(brdr_thickness(left_border(ht)), matrix(1, 3, 2))
  expect_equivalent(left_border_style(ht), matrix("double", 3, 2))
  expect_equivalent(left_border_color(ht), matrix("red", 3, 2))
})


test_that("left_border(ht)[i,j] <-number", {
  ht <- hux(1:3, 1:3)
  expect_silent(left_border(ht)[1:2, 1] <- 1)
  expect_equivalent(brdr_thickness(left_border(ht)),
        matrix(c(1, 1, 0, 0, 0, 0), 3, 2))
})


test_that("left_border(ht)[i, j] <- brdr(...)", {
  ht <- hux(1:3, 1:3)
  expect_silent(left_border(ht)[1:2, 1] <- brdr(1, "double", "red"))
  expect_equivalent(brdr_thickness(left_border(ht))[1, 1], 1)
})


test_that("set_left_border(ht, number)", {
  ht <- hux(1:3, 1:3)
  ht2 <- set_left_border(ht, 1)
  expect_equivalent(brdr_thickness(left_border(ht2)), matrix(1, 3, 2))

  ht3 <- set_left_border(ht)
  expect_equivalent(brdr_thickness(left_border(ht3)), matrix(0.4, 3, 2))
})



test_that("set_left_border(ht, brdr)", {
  ht <- hux(1:3, 1:3)
  ht2 <- set_left_border(ht, brdr(1, "double", "red"))
  expect_equivalent(brdr_thickness(left_border(ht2)), matrix(1, 3, 2))
  expect_equivalent(left_border_style(ht2), matrix("double", 3, 2))
  expect_equivalent(left_border_color(ht2), matrix("red", 3, 2))
})


test_that("set_left_border(ht, row, col, number)", {
  ht <- hux(1:3, 1:3)
  ht2 <- set_left_border(ht, 1, 1, 1)
  expect_equivalent(brdr_thickness(left_border(ht2)),
        matrix(c(1, 0, 0, 0, 0, 0), 3, 2))

  ht3 <- set_left_border(ht, everywhere, 1, 1)
  expect_equivalent(brdr_thickness(left_border(ht3)),
        matrix(c(1, 1, 1, 0, 0, 0), 3, 2))

  colnames(ht) <- c("a", "b")
  ht4 <- set_left_border(ht, everywhere, "a", 1)
  expect_equivalent(brdr_thickness(left_border(ht4)),
        matrix(c(1, 1, 1, 0, 0, 0), 3, 2))

  ht5 <- set_left_border(ht, everywhere, 1)
  expect_equivalent(brdr_thickness(left_border(ht5)),
        matrix(c(0.4, 0.4, 0.4, 0, 0, 0), 3, 2))
})


test_that("set_left_border(ht, row, col, brdr)", {
  ht <- hux(1:3, 1:3)
  ht2 <- set_left_border(ht, 1, 1, brdr(1, "double", "red"))
  expect_equivalent(brdr_thickness(left_border(ht2)),
        matrix(c(1, 0, 0, 0, 0, 0), 3, 2))
  expect_equivalent(left_border_style(ht2),
        matrix(c("double", rep("solid", 5)), 3, 2))
  expect_equivalent(left_border_color(ht2), matrix(c("red", rep(NA, 5)), 3, 2))
})


test_that("map_left_border", {
  ht <- hux(1:2, 2:1)
  ht2 <- map_left_border(ht, by_ranges(1.5, c(0, 1)))
  expect_equivalent(brdr_thickness(left_border(ht2)), matrix(c(0, 1, 1, 0), 2, 2))

  ht3 <- map_left_border(ht, by_ranges(1.5, list(brdr(0), brdr(1))))
  expect_equivalent(brdr_thickness(left_border(ht3)), matrix(c(0, 1, 1, 0), 2, 2))

  ht4 <- map_left_border(ht, by_rows(brdr(0), brdr(1)))
  expect_equivalent(brdr_thickness(left_border(ht4)),
        matrix(c(0, 1, 0, 1), 2, 2))

  ht5 <- map_left_border(ht, by_cols(brdr(0), brdr(1)))
  expect_equivalent(brdr_thickness(left_border(ht5)),
        matrix(c(0, 0, 1, 1), 2, 2))

  # ht8 <- map_left_border(ht, by_cases(. == 2 ~ brdr(1), TRUE ~ brdr(0)))
  # expect_equivalent(left_border(ht8)[], matrix(c(0, 1, 1, 0), 2, 2))

  ht9 <- map_left_border(ht, by_quantiles(0.5, list(brdr(0), brdr(1))))
  expect_equivalent(brdr_thickness(left_border(ht9)),
        matrix(c(0, 1, 1, 0), 2, 2))

  ht10 <- map_left_border(ht, by_equal_groups(2, list(brdr(0), brdr(1))))
  expect_equivalent(brdr_thickness(left_border(ht10)),
        matrix(c(0, 1, 1, 0), 2, 2))

  ht_char <- hux(letters[1:2], letters[2:1])
  ht6 <- map_left_border(ht_char, by_values("a" = brdr(0), "b" = brdr(1)))
  expect_equivalent(brdr_thickness(left_border(ht6)),
      matrix(c(0, 1, 1, 0), 2, 2))

  ht7 <- map_left_border(ht, by_function(function (x) brdr(1)))
  expect_equivalent(brdr_thickness(left_border(ht7)), matrix(1, 2, 2))
})


test_that("map_all_borders", {
  ht <- hux(1:2, 2:1)
  ht2 <- map_all_borders(ht, by_ranges(1.5, c(0, 1)))
  # these can be guaranteed whatever the order
  expect_equivalent(brdr_thickness(left_border(ht2))[2, 1], 1)
  expect_equivalent(brdr_thickness(bottom_border(ht2))[2, 1], 1)
  expect_equivalent(brdr_thickness(right_border(ht2))[2, 2], 0)
  expect_equivalent(brdr_thickness(left_border(ht2))[1, 1], 0)

  ht3 <- map_all_borders(ht, by_ranges(1.5, list(brdr(0), brdr(1))))
  expect_equivalent(brdr_thickness(left_border(ht3))[2, 1], 1)
  expect_equivalent(brdr_thickness(bottom_border(ht3))[2, 1], 1)
  expect_equivalent(brdr_thickness(right_border(ht3))[2, 2], 0)
  expect_equivalent(brdr_thickness(left_border(ht3))[1, 1], 0)


  ht4 <- map_all_borders(ht, 1, 1:2, by_ranges(1.5, list(brdr(0), brdr(1))))
  expect_equivalent(brdr_thickness(left_border(ht4))[2, 1], 0)
  expect_equivalent(brdr_thickness(bottom_border(ht4))[2, 1], 0)
  expect_equivalent(brdr_thickness(right_border(ht4))[2, 2], 0)
  expect_equivalent(brdr_thickness(left_border(ht4))[1, 1], 0)
  expect_equivalent(brdr_thickness(right_border(ht4))[1, 2], 1)
  expect_equivalent(brdr_thickness(top_border(ht4))[1, 2], 1)
})


test_that("set-multiple with brdr", {
  ht <- hux(a = 1:2, b = 1:2, add_colnames = FALSE)
  b <- brdr(2, "dotted", "green")

  expect_silent(ht2 <- set_all_borders(ht, b))
  expect_equivalent(left_border_color(ht2), matrix("green", 2, 2))
  expect_equivalent(left_border_style(ht2), matrix("dotted", 2, 2))
  expect_equivalent(brdr_thickness(left_border(ht2)), matrix(2, 2, 2))
  expect_equivalent(right_border_color(ht2), matrix("green", 2, 2))
  expect_equivalent(right_border_style(ht2), matrix("dotted", 2, 2))
  expect_equivalent(brdr_thickness(right_border(ht2)), matrix(2, 2, 2))
  expect_equivalent(top_border_color(ht2), matrix("green", 2, 2))
  expect_equivalent(top_border_style(ht2), matrix("dotted", 2, 2))
  expect_equivalent(brdr_thickness(top_border(ht2)), matrix(2, 2, 2))
  expect_equivalent(bottom_border_color(ht2), matrix("green", 2, 2))
  expect_equivalent(bottom_border_style(ht2), matrix("dotted", 2, 2))
  expect_equivalent(brdr_thickness(bottom_border(ht2)), matrix(2, 2, 2))

  expect_silent(ht3 <- set_all_borders(ht, 1, 1, b))
  # sets right border of (1,1) = left border of (1,2)
  expect_equivalent(left_border_color(ht3),
        matrix(c("green", NA, "green", NA), 2, 2))

  expect_silent(ht4 <- set_tb_borders(ht, b))
  expect_equivalent(left_border_color(ht4), matrix(NA_character_, 2, 2))
  expect_equivalent(top_border_color(ht4), matrix("green", 2, 2))
  expect_equivalent(left_border_style(ht4), matrix("solid", 2, 2))
  expect_equivalent(top_border_style(ht4), matrix("dotted", 2, 2))

  expect_silent(ht5 <- set_tb_borders(ht, 1, 1, b))
  expect_equivalent(left_border_color(ht5), matrix(NA_character_, 2, 2))
  expect_equivalent(top_border_color(ht5),
        matrix(c("green", "green", NA_character_, NA_character_), 2, 2))
  expect_equivalent(left_border_style(ht5), matrix("solid", 2, 2))
  expect_equivalent(top_border_style(ht5),
        matrix(c("dotted", "dotted", "solid", "solid"), 2, 2))

  expect_silent(ht6 <- set_lr_borders(ht, b))
  expect_equivalent(left_border_color(ht6), matrix("green", 2, 2))
  expect_equivalent(top_border_color(ht6), matrix(NA_character_, 2, 2))
  expect_equivalent(left_border_style(ht6), matrix("dotted", 2, 2))
  expect_equivalent(top_border_style(ht6), matrix("solid", 2, 2))

  expect_silent(ht7 <- set_lr_borders(ht, 1, 1, b))
  expect_equivalent(left_border_color(ht7),
        matrix(c("green", NA_character_, "green", NA_character_), 2, 2))
  expect_equivalent(top_border_color(ht7), matrix(NA_character_, 2, 2))
  expect_equivalent(left_border_style(ht7),
        matrix(c("dotted", "solid", "dotted", "solid"), 2, 2))
  expect_equivalent(top_border_style(ht7), matrix("solid", 2, 2))
})


test_that("edit_defaults with borders", {
  expect_silent(
    old <- set_default_properties(border = 2, border_style = "double", border_color = "green")
  )
  on.exit(
    set_default_properties(old)
  )

  ht <- hux(1)
  expect_equivalent(brdr_thickness(left_border(ht)), matrix(2, 1, 1))
  expect_equivalent(left_border_style(ht), matrix("double", 1, 1))
  expect_equivalent(left_border_color(ht), matrix("green", 1, 1))
})