Nothing
local_edition(2)
test_that("Standard map_xxx", {
ht <- huxtable(
Type = c("Strawberry", "Raspberry", "Plum"),
Price = c(1.90, 2.10, 1.80),
add_colnames = FALSE
)
align(ht) <- "left"
test_map <- function (map_fn, result, rows = 1:nrow(ht), cols = 1:ncol(ht)) {
result <- strsplit(result, "")[[1]]
result <- c("l" = "left", "c" = "center", "r" = "right")[result]
expect_equivalent(
align(map_align(ht, rows, cols, map_fn)),
matrix(result, nrow(ht), ncol(ht))
)
}
test_map(by_cols("centre", "right"),
"cccrrr")
test_map(by_cols("centre", "right"), "cclrrl", 1:2, 1:2)
test_map(by_cols("right"), "lllrrr", 1:3, 2)
test_map(by_rows("left", "centre", "right"), "lcrlcr")
test_map(by_rows("left", "centre", "right"), "lcrlll", 1:3, 1)
test_map(by_rows("right"), "llrllr", 3, 1:2)
test_map(by_values(Strawberry = "right", Plum = "right", "centre"), "rcrccc")
f <- function (x) ifelse(x == "Plum", "center", "right")
test_map(by_function(f), "rrcrrr")
test_map(by_regex(".*berry" = "right", "\\." = "centre"), "rrlccc")
test_map(by_equal_groups(3, c("left", "centre", "right")), "lllcrl", 1:3, 2)
test_map(by_quantiles(0.75, c("centre", "right")), "lllcrc", 1:3, 2)
ht_2col <- hux(1:3, 4:6)
expect_equivalent(
align(map_align(ht_2col,
by_equal_groups(3, c("left", "center", "right"), colwise = TRUE))),
matrix(rep(c("left", "center", "right"), 2), 3, 2)
)
expect_equivalent(
align(map_align(ht_2col,
by_quantiles(c(.1, .9), c("left", "center", "right"), colwise = TRUE))),
matrix(rep(c("left", "center", "right"), 2), 3, 2)
)
test_map(by_ranges(c(1.85, 2.05), c("left", "centre", "right")), "lllcrl", 1:3, 2)
skip_if_not_installed("dplyr")
test_map(by_cases(. == "Plum" ~ "centre", grepl("berry", .) ~ "right"),
"rrclll")
skip_if_not_installed("scales")
expect_silent(ht2 <- map_text_color(ht, by_colorspace("red", "yellow", na_color = "green")))
expect_equivalent(text_color(ht2)[, 1], rep("green", 3))
expect_silent(col2rgb(text_color(ht2)))
expect_equivalent(
text_color(map_text_color(ht_2col, by_colorspace("red", "white", "blue", colwise = TRUE))),
matrix(rep(c("#FF0000", "#FFFFFF", "#0000FF"), 2), 3, 2)
)
})
test_that("standard ways to mention columns work", {
ht <- hux(a = 1:3, b = 1:3, add_colnames = TRUE)
br <- by_rows("left", "centre", "right")
ht2 <- map_align(ht, 1:3, 1, br)
expect_equivalent(ht2, map_align(ht, 1:3, "a", br))
skip_if_not_installed("dplyr")
expect_equivalent(ht2, map_align(ht, 1:3, dplyr::matches("a"), br))
expect_equivalent(ht2, map_align(ht, everywhere, dplyr::matches("a"), br))
expect_equivalent(ht2, map_align(ht, everywhere, dplyr::starts_with("a"), br))
expect_equivalent(ht2, map_align(ht, everywhere, -2, br))
expect_equivalent(ht2, map_align(ht, everywhere, odds, br))
ht3 <- map_align(ht, c(1, 3), 1:2, br)
expect_equivalent(ht3, map_align(ht, -2, 1:2, br))
expect_equivalent(ht3, map_align(ht, odds, 1:2, br))
})
test_that("map_all_*", {
# we include the NAs because we don't make guarantees about
# what happens when borders overlap!
m <- matrix(c(1, NA, 2, NA, NA, NA, 2, NA, 1), 3, 3)
ht <- as_huxtable(m)
m1 <- ! is.na(m) & m == 1
m2 <- ! is.na(m) & m == 2
ht2 <- map_all_borders(ht, by_ranges(1.5, c(1, 2)))
expect_true(all(brdr_thickness(left_border(ht2))[m1] == 1))
expect_true(all(brdr_thickness(right_border(ht2))[m1] == 1))
expect_true(all(brdr_thickness(top_border(ht2))[m1] == 1))
expect_true(all(brdr_thickness(bottom_border(ht2))[m1] == 1))
expect_true(all(brdr_thickness(left_border(ht2))[m2] == 2))
expect_true(all(brdr_thickness(right_border(ht2))[m2] == 2))
expect_true(all(brdr_thickness(top_border(ht2))[m2] == 2))
expect_true(all(brdr_thickness(bottom_border(ht2))[m2] == 2))
ht3 <- map_all_border_colors(ht, by_ranges(1.5, c("red", "black")))
expect_true(all(left_border_color(ht3)[m1] == "red"))
expect_true(all(right_border_color(ht3)[m1] == "red"))
expect_true(all(top_border_color(ht3)[m1] == "red"))
expect_true(all(bottom_border_color(ht3)[m1] == "red"))
expect_true(all(left_border_color(ht3)[m2] == "black"))
expect_true(all(right_border_color(ht3)[m2] == "black"))
expect_true(all(top_border_color(ht3)[m2] == "black"))
expect_true(all(bottom_border_color(ht3)[m2] == "black"))
ht4 <- map_all_border_styles(ht, by_ranges(1.5, c("solid", "double")))
expect_true(all(left_border_style(ht4)[m1] == "solid"))
expect_true(all(right_border_style(ht4)[m1] == "solid"))
expect_true(all(top_border_style(ht4)[m1] == "solid"))
expect_true(all(bottom_border_style(ht4)[m1] == "solid"))
expect_true(all(left_border_style(ht4)[m2] == "double"))
expect_true(all(right_border_style(ht4)[m2] == "double"))
expect_true(all(top_border_style(ht4)[m2] == "double"))
expect_true(all(bottom_border_style(ht4)[m2] == "double"))
ht5 <- map_all_borders(ht, 1:3, 1, by_ranges(1.5, c(1, 2)))
expect_equivalent(brdr_thickness(left_border(ht5))[1:3, 1], c(1, 0, 2))
expect_equivalent(brdr_thickness(top_border(ht5))[c(1, 3), 1], c(1, 2))
expect_equivalent(brdr_thickness(right_border(ht5))[1:3, 1], c(1, 0, 2))
expect_equivalent(brdr_thickness(bottom_border(ht5))[c(1, 3), 1], c(1, 2))
ht <- as_huxtable(matrix(1:10, 5, 2))
ht6 <- map_all_padding(ht, by_ranges(3, c(0, 10)))
expect_equivalent(left_padding(ht6), 10 * (as.matrix(ht) >= 3))
expect_equivalent(right_padding(ht6), 10 * (as.matrix(ht) >= 3))
})
test_that("map_lr/tb_*", {
ht <- huxtable(1:5, rep(NA, 5), 5:1, add_colnames = FALSE)
ht2 <- map_lr_border_styles(ht, by_ranges(3, c("solid", "double")))
expected <- matrix(ifelse(as.matrix(ht) >= 3, "double", "solid"), 5, 3)
expect_equivalent(left_border_style(ht2)[, c(1, 3)], expected[, c(1, 3)])
expect_equivalent(right_border_style(ht2)[, c(1, 3)], expected[, c(1, 3)])
expect_equivalent(top_border_style(ht2), matrix("solid", 5, 3))
expect_equivalent(bottom_border_style(ht2), matrix("solid", 5, 3))
ht <- huxtable(c(1, NA, 5), c(5, NA, 1))
ht3 <- map_tb_border_styles(ht, by_ranges(3, c("solid", "double")))
expected <- matrix(ifelse(as.matrix(ht) >= 3, "double", "solid"), 3, 2)
expect_equivalent(left_border_style(ht3), matrix("solid", 3, 2))
expect_equivalent(right_border_style(ht3), matrix("solid", 3, 2))
expect_equivalent(top_border_style(ht3)[c(1, 3),], expected[c(1, 3),])
expect_equivalent(bottom_border_style(ht3)[c(1, 3),], expected[c(1, 3),])
})
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.