tests/testthat/test-gt_index.R

In gtExtras: Extending 'gt' for Beautiful HTML Tables

test_that("gt_index has correct inputs, correct ouput index, and can affect correct rows", {
  check_suggests()

  # This is a key step, as gt will create the row groups
  # based on first observation of the unique row items
  # this sampling will return a row-group order for cyl of 6,4,8

  set.seed(1234)
  sliced_data <- mtcars %>%
    dplyr::group_by(cyl) %>%
    dplyr::slice_head(n = 3) %>%
    dplyr::ungroup() %>%
    # randomize the order
    dplyr::slice_sample(n = 9)

  # not in "order" yet
  raw_order <- sliced_data$cyl

  # But unique order of 6,4,8
  unique_order <- unique(sliced_data$cyl)

# Expect input order to match ---------------------------------------------


  expect_equal(c(6,4,8), unique_order)
  expect_equal(c(6, 6, 6, 4, 8, 4, 8, 8, 4), raw_order)

  # creating a standalone basic table
  test_tab <- sliced_data %>%
    gt::gt(groupname_col = "cyl")

  # can style a specific column based on the contents of another column
  tab_out_styled <- test_tab %>%
    gt::tab_style(locations = cells_body(mpg, rows = gt_index(., am) == 0),
              style = cell_fill("red")
    ) %>%
    gt::as_raw_html() %>%
    rvest::read_html()

  expect_equal(
    tab_out_styled %>%
      rvest::html_elements("td:nth-child(1)") %>%
      as.character() %>%
      grepl("background-color", .),
    c(TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE)
  )

  # tab_pattern <- "background-color: \\s*(.*?)\\s*;"
  # reg_matches <- regmatches(tab_styled, regexec(tab_pattern, tab_styled)) %>%
  #   lapply(function(x){x[2]}) %>%
  #   unlist()

#
# # Expect color backgrounds to match ---------------------------------------
#
#
#   expect_equal(reg_matches, c("#FFFFFF", "#FF0000", NA, NA, "#FFFFFF", NA,
#                               "#FF0000", "#FF0000", "#FFFFFF", "#FF0000",
#                               "#FF0000", "#FF0000"))


  # OR can extract the underlying data in the "correct order"
  # according to the internal gt structure, ie arranged by group
  # by cylinder, 6,4,8
  # gt_index(test_tab, mpg, as_vector = TRUE)
  # gt_index(test_tab, mpg, as_vector = FALSE)

  sliced_arranged <- sliced_data %>%
    dplyr::mutate(cyl = factor(cyl, levels = unique_order)) %>%
    dplyr::arrange(cyl) %>%
    dplyr::mutate(cyl = as.character(cyl))

# Expect the values to match ----------------------------------------------


  # expect_equal(gt_index(test_tab, mpg, as_vector = FALSE),
  #              sliced_arranged)
  # expect_equal(gt_index(test_tab, mpg, as_vector = TRUE),
  #              c(21.4, 21, 21, 22.8, 24.4, 22.8, 14.3, 18.7, 16.4))
})