local_edition(3) 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_equal( unname(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_equal( unname(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_equal( unname(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_equal(as.vector(text_color(ht2)[, 1]), rep("green", 3)) expect_silent(col2rgb(text_color(ht2))) expect_equal( unname(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_equal(ht2, map_align(ht, 1:3, "a", br)) skip_if_not_installed("dplyr") expect_equal(ht2, map_align(ht, 1:3, dplyr::matches("a"), br), ignore_attr = TRUE) expect_equal(ht2, map_align(ht, 1:3, dplyr::matches("a"), br)) expect_equal(ht2, map_align(ht, 1:3, dplyr::starts_with("a"), br)) expect_equal(ht2, map_align(ht, 1:3, -2, br)) expect_equal(ht2, map_align(ht, 1:3, odds, br)) ht3 <- map_align(ht, c(1, 3), 1:2, br) expect_equal(ht3, map_align(ht, -2, 1:2, br)) expect_equal(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_equal(as.vector(brdr_thickness(left_border(ht5))[1:3, 1]), c(1, 0, 2)) expect_equal(as.vector(brdr_thickness(top_border(ht5))[c(1, 3), 1]), c(1, 2)) expect_equal(as.vector(brdr_thickness(right_border(ht5))[1:3, 1]), c(1, 0, 2)) expect_equal(as.vector(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_equal(left_padding(ht6), 10 * (as.matrix(ht) >= 3), ignore_attr = TRUE) expect_equal(right_padding(ht6), 10 * (as.matrix(ht) >= 3), ignore_attr = TRUE) }) 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_equal(unname(left_border_style(ht2)[, c(1, 3)]), unname(expected[, c(1, 3)])) expect_equal(unname(right_border_style(ht2)[, c(1, 3)]), unname(expected[, c(1, 3)])) expect_equal(unname(top_border_style(ht2)), matrix("solid", 5, 3)) expect_equal(unname(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_equal(unname(left_border_style(ht3)), matrix("solid", 3, 2)) expect_equal(unname(right_border_style(ht3)), matrix("solid", 3, 2)) expect_equal(unname(top_border_style(ht3)[c(1, 3), ]), unname(expected[c(1, 3), ])) expect_equal(unname(bottom_border_style(ht3)[c(1, 3), ]), unname(expected[c(1, 3), ])) })