test_that("fontawesome, test repeats", { check_suggests() skip_on_cran() fa_rep_html <- mtcars[1:5, 1:4] %>% dplyr::add_row(mpg = 20.09, cyl = NA, disp = 200, hp = 108) %>% gt::gt() %>% gt_fa_repeats(cyl, name = "car") %>% gt::as_raw_html() %>% rvest::read_html() row_counter <- function(row_n) { fa_rep_html %>% rvest::html_nodes(paste0("tbody > tr:nth-child(", row_n, ")")) %>% rvest::html_nodes("svg") %>% rvest::html_attr("aria-label") } expect_equal(row_counter(1), rep("Car", 6)) expect_equal(row_counter(2), rep("Car", 6)) expect_equal(row_counter(3), rep("Car", 4)) expect_equal(row_counter(4), rep("Car", 6)) expect_equal(row_counter(5), rep("Car", 8)) expect_equal(row_counter(6), character(0)) }) test_that("fontawesome, test column, name and colors", { check_suggests() skip_on_cran() fa_car_html <- head(mtcars) %>% dplyr::select(cyl, mpg, am, gear) %>% dplyr::add_row(cyl = 6, mpg = mean(mtcars$mpg), am = NA, gear = 3) %>% dplyr::mutate(man = dplyr::case_when(am == 1 ~ "gear", am == 0 ~ "gears", TRUE ~ NA_character_)) %>% gt::gt() %>% gt_fa_column(man) %>% gt::as_raw_html() %>% rvest::read_html() fa_cogs <- fa_car_html %>% rvest::html_nodes("td:nth-child(5)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("aria-label") cog_colors <- fa_car_html %>% rvest::html_nodes("td:nth-child(5)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("style") %>% gsub(x = ., pattern = ".*fill:", "") %>% substr(1, 7) expect_equal(fa_cogs, rep(c("Gear", "Gears"), each = 3)) expect_equal(cog_colors, rep(c("#000000", "#E69F00"), each = 3)) }) test_that("fontawesome, test ratings all R and colors/numbers match", { check_suggests() skip_on_cran() rate_html <- mtcars %>% dplyr::select(mpg:hp) %>% dplyr::slice(1:5) %>% dplyr::mutate(rating = c(2, 3, 5, 4, 1)) %>% dplyr::add_row(mpg = mean(mtcars$mpg), cyl = 6, disp = 190, rating = NA) %>% gt::gt() %>% gt_fa_rating(rating, icon = "r-project") %>% gt::as_raw_html() %>% rvest::read_html() fa_stars <- rate_html %>% rvest::html_nodes("td:nth-child(5)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("aria-label") star_color_fn <- function(row_n) { rate_html %>% rvest::html_nodes(paste0("tr:nth-child(", row_n, ")")) %>% rvest::html_nodes("td:nth-child(5)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("style") %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") } expect_equal(fa_stars, rep("R Project", 25)) expect_equal(star_color_fn(1), c(rep("orange", 2), rep("grey", 3))) expect_equal(star_color_fn(2), c(rep("orange", 3), rep("grey", 2))) expect_equal(star_color_fn(3), c(rep("orange", 5), rep("grey", 0))) expect_equal(star_color_fn(4), c(rep("orange", 4), rep("grey", 1))) expect_equal(star_color_fn(5), c(rep("orange", 1), rep("grey", 4))) }) # fa-palette -------------------------------------------------------------- test_that("fontawesome, test repeats", { check_suggests() skip_on_cran() color_fn <- function(pal = "#FF0000") { mtcars[1:5, 1:4] %>% gt::gt() %>% gt_fa_repeats(cyl, name = "car", palette = pal) %>% gt::as_raw_html() %>% rvest::read_html() %>% rvest::html_nodes("td:nth-child(2)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("style") %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") } pal_out <- c("red", "blue", "green") pal_rep <- c(rep("red", 12), rep("blue", 4), rep("red", 6), rep("green", 8)) expect_equal(color_fn("#FF0000"), rep("#FF0000", 30)) expect_equal(color_fn("blue"), rep("blue", 30)) expect_equal(color_fn(pal_out), pal_rep) }) # Check for palette ------------------------------------------------------- test_that("fontawesome, test column, name and colors", { check_suggests() skip_on_cran() col_cog_fn <- function(pal) { head(mtcars) %>% dplyr::select(cyl, mpg, am, gear) %>% dplyr::mutate(man = ifelse(am == 1, "gear", "gears")) %>% gt::gt() %>% gt_fa_column(man, palette = pal) %>% gt::as_raw_html() %>% rvest::read_html() %>% rvest::html_nodes("td:nth-child(5)") %>% rvest::html_nodes("svg") %>% rvest::html_attr("style") %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") %>% substr(1, 7) } expect_equal(col_cog_fn(c("red", "green")), rep(c("red", "green"), each = 3)) expect_equal(col_cog_fn(c("red")), rep(c("red"), each = 6)) expect_equal(col_cog_fn(c("gear" = "red", "gears" = "green")), rep(c("red", "green"), each = 3)) }) # Check for palette ------------------------------------------------------- test_that("fontawesome, test rank change", { check_suggests() skip_on_cran() base_tab <- dplyr::tibble(x = c(1:3, -1, -2, -5, 0)) %>% gt::gt() rank_tab <- base_tab %>% gt_fa_rank_change(x, font_color = "match") %>% gt::as_raw_html() %>% rvest::read_html() rank_tab_items <- rank_tab %>% rvest::html_elements("svg") %>% rvest::html_attrs() %>% lapply(function(x) { x[c("aria-label", "style")] %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") }) expect_equal( c(sapply(rank_tab_items, function(x) x[1]) %>% unname()), c(rep("Angles Up", 3), rep("Angles Down", 3), "Equals") ) expect_equal( sapply(rank_tab_items, function(x) x[2]) %>% unname(), c(rep("#1b7837", 3), rep("#762a83", 3), "lightgrey") ) no_text <- base_tab %>% gt_fa_rank_change(x, show_text = FALSE, fa_type = "caret") %>% gt::as_raw_html() %>% rvest::read_html() no_text_items <- no_text %>% rvest::html_elements("svg") %>% rvest::html_attrs() %>% lapply(function(x) { x[c("aria-label", "style")] %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") }) expect_equal( sapply(no_text_items, function(x) x[1]) %>% unname(), c(rep("Caret Up", 3), rep("Caret Down", 3), "Equals") ) expect_equal( sapply(no_text_items, function(x) x[2]) %>% unname(), c(rep("#1b7837", 3), rep("#762a83", 3), "lightgrey") ) custom_tab <- base_tab %>% gt_fa_rank_change( x, palette = c("blue", "grey", "red"), font_color = "black", fa_type = "caret" ) %>% gt::as_raw_html() %>% rvest::read_html() custom_tab_items <- custom_tab %>% rvest::html_elements("svg") %>% rvest::html_attrs() %>% lapply(function(x) { x[c("aria-label", "style")] %>% gsub(x = ., pattern = ".*fill:", "") %>% gsub(x = ., pattern = ";.*", "") }) expect_equal( sapply(custom_tab_items, function(x) x[1]) %>% unname(), c(rep("Caret Up", 3), rep("Caret Down", 3), "Equals") ) expect_equal( sapply(custom_tab_items, function(x) x[2]) %>% unname(), c(rep("blue", 3), rep("red", 3), "grey") ) })