Nothing
local_edition(2)
test_that("set_* works with variables as arguments", {
ht_orig <- hux(a = 1:2, b = 1:2)
rownum <- 2
colnum <- 1
ht2 <- set_bold(ht_orig, rownum, colnum, TRUE)
expect_equivalent(bold(ht2), matrix(c(FALSE, TRUE, FALSE, FALSE), 2, 2))
boldness <- TRUE
ht3 <- set_bold(ht_orig, 1:2, 1:2, boldness)
expect_equivalent(bold(ht3), matrix(TRUE, 2, 2))
})
test_that("set_* works with logical arguments", {
ht <- hux(a = 1:2, b = 1:2)
ht2 <- set_bold(ht, 1:2, c(TRUE, FALSE))
expect_equivalent(bold(ht2), matrix(c(TRUE, TRUE, FALSE, FALSE), 2, 2))
ht3 <- set_bold(ht, c(TRUE, FALSE), 1:2)
expect_equivalent(bold(ht3), matrix(c(TRUE, FALSE, TRUE, FALSE), 2, 2))
ht4 <- set_bold(ht, c(TRUE, FALSE), c(TRUE, FALSE))
expect_equivalent(bold(ht4), matrix(c(TRUE, FALSE, FALSE, FALSE), 2, 2))
})
test_that("set_* works with cell functions", {
ht <- hux(a = 1:4, b = 1:4)
ht <- set_font(ht, evens, 1:2, "times")
ht <- set_font(ht, odds, 1:2, "palatino")
expect_equivalent(font(ht), matrix(c("palatino", "times"), 4, 2))
ht <- hux(a = 1:4, b = 1:4)
ht <- set_font(ht, stripe(1), evens, "times")
ht <- set_font(ht, stripe(1), odds, "palatino")
expect_equivalent(font(ht), matrix(c("palatino", "times"), 4, 2, byrow = TRUE))
ht <- hux(a = 1:4, b = 1:4)
ht <- set_font(ht, stripe(3, from = 1), stripe(1), "times")
expect_equivalent(font(ht), matrix(c("times", NA, NA, "times"), 4, 2))
})
test_that("set_* works with row and column functions", {
ht <- hux(a = 1:4, b = 1:4)
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_equivalent(col_width(ht), c("40pt", "20pt"))
expect_equivalent(row_height(ht), rep(c("30pt", "15pt"), 2))
})
test_that("set_*: 2 argument form", {
ht <- hux(a = c(1, 0), b = c(0, 1))
ht2 <- set_font(ht, "times")
expect_equivalent(font(ht2), matrix("times", 2, 2))
ht3 <- set_font(ht, value = "times")
expect_equivalent(font(ht3), matrix("times", 2, 2))
ht4 <- set_col_width(ht, c(.6, .4))
expect_equivalent(col_width(ht4), c(.6, .4))
ht5 <- set_row_height(ht, c(.6, .4))
expect_equivalent(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))
ht2 <- set_font(ht_orig, 1, everywhere, "times")
expect_equivalent(font(ht2), matrix(c("times", NA), 2, 2))
ht3 <- set_font(ht_orig, everywhere, 1, "times")
expect_equivalent(font(ht3), matrix(c("times", "times", NA, NA), 2, 2))
ht4 <- set_font(ht_orig, "times")
expect_equivalent(font(ht4), matrix("times", 2, 2))
})
test_that("set_* default arguments", {
ht <- hux(a = 1)
expect_silent(ht1 <- set_bold(ht))
expect_equivalent(bold(ht1), matrix(TRUE, 1, 1))
expect_silent(ht2 <- set_bold(ht, 1, 1))
expect_equivalent(bold(ht1), matrix(TRUE, 1, 1))
expect_silent(ht3 <- set_italic(ht))
expect_equivalent(italic(ht3), matrix(TRUE, 1, 1))
})
test_that("set_contents works", {
ht <- hux(1:3, 1:3)
expect_equivalent(set_contents(ht, 1:6), hux(1:3, 4:6))
expect_equivalent(set_contents(ht, 1, 1, 0), hux(c(0, 2:3), 1:3))
expect_equivalent(set_contents(ht, 1, 1, 0), hux(c(0, 2:3), 1:3))
expect_equivalent(set_contents(ht, 2:3, 2, 3:2), hux(1:3, c(1, 3, 2)))
ht <- hux(a = 1:3, b = 1:3)
align(ht) <- "right"
test_props_same <- function(ht2) expect_equivalent(align(ht2), align(ht))
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_equivalent(set_contents(ht, 1, "a", 0), set_contents(ht, 1, 1, 0))
# dplyr::matches not testthat::matches
skip_if_not_installed("dplyr")
expect_equivalent(set_contents(ht, 1, dplyr::matches("b"), 0), set_contents(ht, 1, 2, 0))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.